예제 #1
0
void
basisproduct_clusteroperator(pcclusterbasis cb1, pcclusterbasis cb2,
			     pclusteroperator pr)
{
  pamatrix  X, Xt;
  amatrix   tmp1, tmp2;
  uint      i;

  assert(cb1->t == pr->t);
  assert(cb2->t == pr->t);

  resize_clusteroperator(pr, cb1->k, cb2->k);

  if (pr->sons > 0) {
    assert(cb1->sons == pr->sons);
    assert(cb2->sons == pr->sons);

    for (i = 0; i < pr->sons; i++)
      basisproduct_clusteroperator(cb1->son[i], cb2->son[i], pr->son[i]);

    clear_amatrix(&pr->C);
    for (i = 0; i < pr->sons; i++) {
      X = init_amatrix(&tmp1, cb1->son[i]->k, cb2->k);
      clear_amatrix(X);
      addmul_amatrix(1.0, false, &pr->son[i]->C, false, &cb2->son[i]->E, X);
      addmul_amatrix(1.0, true, &cb1->son[i]->E, false, X, &pr->C);
      uninit_amatrix(X);
    }
  }
  else {
    if (cb1->sons == 0) {
      if (cb2->sons == 0) {
	clear_amatrix(&pr->C);
	addmul_amatrix(1.0, true, &cb1->V, false, &cb2->V, &pr->C);
      }
      else {
	Xt = init_amatrix(&tmp1, cb2->kbranch, cb1->k);
	compress_clusterbasis_amatrix(cb2, &cb1->V, Xt);
	X = init_sub_amatrix(&tmp2, Xt, cb2->k, 0, cb1->k, 0);
	copy_amatrix(true, X, &pr->C);
	uninit_amatrix(X);
	uninit_amatrix(Xt);
      }
    }
    else {
      assert(cb2->sons == 0);	/* Could be generalized */

      Xt = init_amatrix(&tmp1, cb1->kbranch, cb2->k);
      compress_clusterbasis_amatrix(cb1, &cb2->V, Xt);
      X = init_sub_amatrix(&tmp2, Xt, cb1->k, 0, cb2->k, 0);
      copy_amatrix(false, X, &pr->C);
      uninit_amatrix(X);
      uninit_amatrix(Xt);
    }
  }
}
예제 #2
0
static void
check_uppereval(bool unit, bool atrans, pcamatrix a, bool xtrans)
{
    pamatrix  a2, x, b, b2;
    amatrix   a2tmp, xtmp, btmp;
    real      error;

    a2 = init_amatrix(&a2tmp, a->rows, a->cols);
    if (atrans)
        copy_lower_amatrix(a, unit, a2);
    else
        copy_upper_amatrix(a, unit, a2);

    x = (atrans ? init_amatrix(&xtmp, a->rows, a->rows) :
         init_amatrix(&xtmp, a->cols, a->cols));
    random_amatrix(x);

    b = (atrans ?
         (xtrans ? init_amatrix(&btmp, a->rows, UINT_MAX(a->cols, a->rows)) :
          init_amatrix(&btmp, UINT_MAX(a->rows, a->cols), a->rows)) :
         (xtrans ? init_amatrix(&btmp, a->cols, UINT_MAX(a->cols, a->rows)) :
          init_amatrix(&btmp, UINT_MAX(a->rows, a->cols), a->cols)));

    copy_sub_amatrix(false, x, b);
    triangulareval_amatrix(atrans, unit, atrans, a, xtrans, b);

    if (xtrans)
        addmul_amatrix(-1.0, false, x, !atrans, a2, b);
    else
        addmul_amatrix(-1.0, atrans, a2, false, x, b);

    uninit_amatrix(a2);
    b2 = (atrans ?
          (xtrans ? init_sub_amatrix(&a2tmp, b, b->rows, 0, a->cols, 0) :
           init_sub_amatrix(&a2tmp, b, a->cols, 0, b->cols, 0)) :
          (xtrans ? init_sub_amatrix(&a2tmp, b, b->rows, 0, a->rows, 0) :
           init_sub_amatrix(&a2tmp, b, a->rows, 0, b->cols, 0)));

    error = norm2_amatrix(b2) / norm2_amatrix(x);

    (void) printf("Checking uppereval(unit=%s, atrans=%s, xtrans=%s)\n"
                  "  Accuracy %g, %sokay\n", (unit ? "tr" : "fl"),
                  (atrans ? "tr" : "fl"), (xtrans ? "tr" : "fl"), error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    uninit_amatrix(b2);
    uninit_amatrix(b);
    uninit_amatrix(x);
}
예제 #3
0
파일: uniform.c 프로젝트: H2Lib/H2Lib
void
add_rkmatrix_uniform(pcrkmatrix r, puniform unew)
{
  amatrix   tmp1, tmp2, tmp3, tmp4;
  pamatrix  At, Bt, Ac, Bc;
  uint      k;

  assert(r->A.cols == r->B.cols);

  k = r->A.cols;

  At = init_amatrix(&tmp1, unew->rb->kbranch, k);
  compress_clusterbasis_amatrix(unew->rb, &r->A, At);

  Bt = init_amatrix(&tmp2, unew->cb->kbranch, k);
  compress_clusterbasis_amatrix(unew->cb, &r->B, Bt);

  Ac = init_sub_amatrix(&tmp3, At, unew->rb->k, 0, k, 0);
  Bc = init_sub_amatrix(&tmp4, Bt, unew->cb->k, 0, k, 0);

  addmul_amatrix(1.0, false, Ac, true, Bc, &unew->S);

  uninit_amatrix(Bc);
  uninit_amatrix(Ac);
  uninit_amatrix(Bt);
  uninit_amatrix(At);
}
예제 #4
0
파일: uniform.c 프로젝트: H2Lib/H2Lib
void
add_projected_uniform(pcuniform u,
		      pcclusteroperator ro, pcclusteroperator co,
		      puniform unew)
{
  amatrix   tmp;
  pamatrix  XS;

  if (u->rb == unew->rb) {
    if (u->cb == unew->cb)
      add_amatrix(1.0, false, &u->S, &unew->S);
    else {
      assert(co->krow == unew->cb->k);
      assert(co->kcol == u->cb->k);

      addmul_amatrix(1.0, false, &u->S, true, &co->C, &unew->S);
    }
  }
  else {
    if (u->cb == unew->cb) {
      assert(ro->krow == unew->rb->k);
      assert(ro->kcol == u->rb->k);

      addmul_amatrix(1.0, false, &ro->C, false, &u->S, &unew->S);
    }
    else {
      assert(ro->krow == unew->rb->k);
      assert(ro->kcol == u->rb->k);
      assert(co->krow == unew->cb->k);
      assert(co->kcol == u->cb->k);

      XS = init_amatrix(&tmp, unew->rb->k, u->cb->k);
      clear_amatrix(XS);
      addmul_amatrix(1.0, false, &ro->C, false, &u->S, XS);
      addmul_amatrix(1.0, false, XS, true, &co->C, &unew->S);
      uninit_amatrix(XS);
    }
  }
}
예제 #5
0
static    real
compareweights(pcclusteroperator co1, pcclusteroperator co2, uint level)
{
  amatrix   tmp;
  pamatrix  D;
  real      norm, error, error1;
  uint      k;
  uint      i;

  k = co1->kcol;
  assert(k == co2->kcol);

  D = init_amatrix(&tmp, k, k);

  clear_amatrix(D);
  addmul_amatrix(1.0, true, &co1->C, false, &co1->C, D);
  norm = norm2_amatrix(D);
  addmul_amatrix(-1.0, true, &co2->C, false, &co2->C, D);
  error = norm2_amatrix(D);

  uninit_amatrix(D);

  if (norm > 0.0)
    error /= norm;

  if (co1->sons != co2->sons)
    printf("Tree mismatch");
  else
    for (i = 0; i < co1->sons; i++) {
      error1 = compareweights(co1->son[i], co2->son[i], level + 1);
      if (error1 > error)
	error = error1;
    }

  return error;
}
예제 #6
0
int
main()
{
    pamatrix  a, acopy, l, ld, r, q, qr;
    pavector  x, b, tau;
    uint      rows, cols;
    real      error;

    rows = 8;
    cols = 5;

    (void) printf("----------------------------------------\n"
                  "Check random %u x %u Cholesky factorization\n", rows, rows);

    (void) printf("Creating random self-adjoint positive definite matrix\n");
    a = new_amatrix(rows, rows);
    random_spd_amatrix(a, 1.0);

    (void) printf("Creating random solution and right-hand side\n");
    x = new_avector(rows);
    random_avector(x);
    b = new_avector(rows);
    clear_avector(b);
    mvm_amatrix_avector(1.0, false, a, x, b);

    (void) printf("Copying matrix\n");
    acopy = new_amatrix(rows, rows);
    copy_amatrix(false, a, acopy);

    (void) printf("Computing Cholesky factorization\n");
    choldecomp_amatrix(a);

    (void) printf("Solving\n");
    cholsolve_amatrix_avector(a, b);
    add_avector(-1.0, x, b);
    error = norm2_avector(b);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    (void) printf("Building triangular factor\n");
    l = new_amatrix(rows, rows);
    copy_lower_amatrix(a, false, l);

    (void) printf("Checking factorization\n");
    copy_amatrix(false, acopy, a);
    addmul_amatrix(-1.0, false, l, true, l, a);
    error = normfrob_amatrix(a);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    del_amatrix(l);
    del_amatrix(acopy);
    del_avector(b);
    del_avector(x);
    del_amatrix(a);

    (void) printf("----------------------------------------\n"
                  "Check random %u x %u LDL^T factorization\n", rows, rows);

    (void) printf("Creating random self-adjoint positive definite matrix\n");
    a = new_amatrix(rows, rows);
    random_spd_amatrix(a, 1.0);

    (void) printf("Creating random solution and right-hand side\n");
    x = new_avector(rows);
    random_avector(x);
    b = new_avector(rows);
    clear_avector(b);
    mvm_amatrix_avector(1.0, false, a, x, b);

    (void) printf("Copying matrix\n");
    acopy = new_amatrix(rows, rows);
    copy_amatrix(false, a, acopy);

    (void) printf("Computing LDL^T factorization\n");
    ldltdecomp_amatrix(a);

    (void) printf("Solving\n");
    ldltsolve_amatrix_avector(a, b);
    add_avector(-1.0, x, b);
    error = norm2_avector(b);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    (void) printf("Building triangular factor\n");
    l = new_amatrix(rows, rows);
    copy_lower_amatrix(a, true, l);

    (void) printf("Multiplying by diagonal\n");
    ld = new_amatrix(rows, rows);
    copy_amatrix(false, l, ld);
    diageval_amatrix(true, a, true, ld);

    (void) printf("Checking factorization\n");
    copy_amatrix(false, acopy, a);
    addmul_amatrix(-1.0, false, ld, true, l, a);
    error = normfrob_amatrix(a);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    del_amatrix(ld);
    del_amatrix(l);
    del_amatrix(acopy);
    del_avector(b);
    del_avector(x);
    del_amatrix(a);

    (void) printf("----------------------------------------\n"
                  "Check random %u x %u LR factorization\n", rows, rows);

    (void) printf("Creating random invertible matrix\n");
    a = new_amatrix(rows, rows);
    random_invertible_amatrix(a, 1.0);

    (void) printf("Creating random solution and right-hand side\n");
    x = new_avector(rows);
    random_avector(x);
    b = new_avector(rows);
    clear_avector(b);
    mvm_amatrix_avector(1.0, false, a, x, b);

    (void) printf("Copying matrix\n");
    acopy = new_amatrix(rows, rows);
    copy_amatrix(false, a, acopy);

    (void) printf("Computing LR factorization\n");
    lrdecomp_amatrix(a);

    (void) printf("Solving\n");
    lrsolve_amatrix_avector(a, b);
    add_avector(-1.0, x, b);
    error = norm2_avector(b);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    (void) printf("Building triangular factors\n");
    l = new_amatrix(rows, rows);
    r = new_amatrix(rows, rows);
    copy_lower_amatrix(a, true, l);
    copy_upper_amatrix(a, false, r);

    (void) printf("Checking factorization\n");
    copy_amatrix(false, acopy, a);
    addmul_amatrix(-1.0, false, l, false, r, a);
    error = normfrob_amatrix(a);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    /* Check forward/backward substitution */
    (void) printf("----------------------------------------\n");
    check_triangularsolve(true, true, false, l, false);
    check_triangularsolve(true, true, false, l, true);
    check_triangularsolve(true, true, true, l, false);
    check_triangularsolve(true, true, true, l, true);
    check_triangularsolve(true, false, false, l, false);
    check_triangularsolve(true, false, false, l, true);
    check_triangularsolve(true, false, true, l, false);
    check_triangularsolve(true, false, true, l, true);

    check_triangularsolve(false, false, false, r, false);
    check_triangularsolve(false, false, false, r, true);
    check_triangularsolve(false, false, true, r, false);
    check_triangularsolve(false, false, true, r, true);
    set_unit(r);
    check_triangularsolve(false, true, false, r, false);
    check_triangularsolve(false, true, false, r, true);
    check_triangularsolve(false, true, true, r, false);
    check_triangularsolve(false, true, true, r, true);

    /* Intermediate clean-up */
    (void) printf("Cleaning up\n");
    del_amatrix(r);
    del_amatrix(l);

    /* Check triangular matrix multiplication */
    (void) printf("----------------------------------------\n");
    check_triangularaddmul(false, false, false, false);
    check_triangularaddmul(true, false, false, false);
    check_triangularaddmul(false, true, false, false);
    check_triangularaddmul(true, true, false, false);

    check_triangularaddmul(false, false, true, false);
    check_triangularaddmul(true, false, true, false);
    check_triangularaddmul(false, true, true, false);
    check_triangularaddmul(true, true, true, false);

    check_triangularaddmul(false, false, false, true);
    check_triangularaddmul(true, false, false, true);
    check_triangularaddmul(false, true, false, true);
    check_triangularaddmul(true, true, false, true);

    check_triangularaddmul(false, false, true, true);
    check_triangularaddmul(true, false, true, true);
    check_triangularaddmul(false, true, true, true);
    check_triangularaddmul(true, true, true, true);

    /* Checking QR factorization */
    (void) printf("----------------------------------------\n"
                  "Check square QR factorization\n");
    copy_amatrix(false, acopy, a);
    random_avector(x);
    clear_avector(b);
    mvm_amatrix_avector(1.0, false, a, x, b);

    tau = new_avector(rows);
    qrdecomp_amatrix(a, tau);

    (void) printf("Solving\n");
    qrsolve_amatrix_avector(a, tau, b);
    add_avector(-1.0, x, b);
    error = norm2_avector(b);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    q = new_amatrix(rows, rows);
    qrexpand_amatrix(a, tau, q);

    (void) printf("Checking factorization\n");
    r = new_amatrix(rows, rows);
    copy_upper_amatrix(a, false, r);
    qr = new_amatrix(rows, rows);
    copy_amatrix(false, acopy, qr);
    addmul_amatrix(-1.0, false, q, false, r, qr);
    error = normfrob_amatrix(qr);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    (void) printf("Checking inverse\n");
    copy_amatrix(false, acopy, a);
    qrinvert_amatrix(a);

    identity_amatrix(qr);
    addmul_amatrix(-1.0, false, acopy, false, a, qr);
    error = normfrob_amatrix(qr);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    /* Intermediate clean-up */
    (void) printf("Cleaning up\n");

    del_amatrix(qr);
    del_amatrix(r);
    del_amatrix(q);
    del_avector(tau);
    del_avector(b);
    del_avector(x);
    del_amatrix(acopy);
    del_amatrix(a);

    /* Check forward/backward evaluation */
    (void) printf("----------------------------------------\n");
    a = new_amatrix(rows, cols);
    random_amatrix(a);
    check_lowereval(false, false, a, false);
    check_lowereval(false, false, a, true);
    check_lowereval(false, true, a, false);
    check_lowereval(false, true, a, true);
    check_uppereval(false, false, a, false);
    check_uppereval(false, false, a, true);
    check_uppereval(false, true, a, false);
    check_uppereval(false, true, a, true);
    set_unit(a);
    check_lowereval(true, false, a, false);
    check_lowereval(true, false, a, true);
    check_lowereval(true, true, a, false);
    check_lowereval(true, true, a, true);
    check_uppereval(true, false, a, false);
    check_uppereval(true, false, a, true);
    check_uppereval(true, true, a, false);
    check_uppereval(true, true, a, true);
    (void) printf("Cleaning up\n");
    del_amatrix(a);
    a = new_amatrix(cols, rows);
    random_amatrix(a);
    check_lowereval(false, false, a, false);
    check_lowereval(false, false, a, true);
    check_lowereval(false, true, a, false);
    check_lowereval(false, true, a, true);
    check_uppereval(false, false, a, false);
    check_uppereval(false, false, a, true);
    check_uppereval(false, true, a, false);
    check_uppereval(false, true, a, true);
    set_unit(a);
    check_lowereval(true, false, a, false);
    check_lowereval(true, false, a, true);
    check_lowereval(true, true, a, false);
    check_lowereval(true, true, a, true);
    check_uppereval(true, false, a, false);
    check_uppereval(true, false, a, true);
    check_uppereval(true, true, a, false);
    check_uppereval(true, true, a, true);
    (void) printf("Cleaning up\n");
    del_amatrix(a);

    /* Test random QR factorizations */
    (void) printf("----------------------------------------\n"
                  "Check full rectangular QR factorization\n");
    a = new_amatrix(rows, cols);
    random_amatrix(a);
    acopy = new_amatrix(rows, cols);
    copy_amatrix(false, a, acopy);

    tau = new_avector(rows);
    qrdecomp_amatrix(a, tau);
    q = new_amatrix(rows, rows);
    r = new_amatrix(rows, cols);
    qrexpand_amatrix(a, tau, q);
    copy_upper_amatrix(a, false, r);
    qr = new_amatrix(rows, cols);
    copy_amatrix(false, acopy, qr);
    addmul_amatrix(-1.0, false, q, false, r, qr);
    error = normfrob_amatrix(qr);
    printf("  Accuracy %g, %sokay\n", error,
           (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    del_amatrix(r);
    del_amatrix(q);

    (void) printf("Check skinny QR factorization\n");
    q = new_amatrix(rows, cols);
    r = new_amatrix(cols, cols);
    qrexpand_amatrix(a, tau, q);
    copy_upper_amatrix(a, false, r);
    copy_amatrix(false, acopy, qr);
    addmul_amatrix(-1.0, false, q, false, r, qr);
    error = normfrob_amatrix(qr);
    printf("  Accuracy %g, %sokay\n", error,
           (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    /* Final clean-up */
    (void) printf("Cleaning up\n");
    del_amatrix(qr);
    del_amatrix(r);
    del_amatrix(q);
    del_avector(tau);
    del_amatrix(acopy);
    del_amatrix(a);

    (void) printf("----------------------------------------\n"
                  "  %u matrices and\n"
                  "  %u vectors still active\n"
                  "  %u errors found\n", getactives_amatrix(),
                  getactives_avector(), problems);

    return problems;
}
예제 #7
0
static void
check_triangularaddmul(bool alower, bool atrans, bool blower, bool btrans)
{
    pamatrix  a, b, at, bt, x;
    amatrix   atmp, btmp, attmp, bttmp, xtmp;
    real      error;
    uint      dim1, dim2, dim3;

    dim1 = 100;
    dim2 = 80;
    dim3 = 90;

    a =
        (atrans ? init_amatrix(&atmp, dim2, dim1) :
         init_amatrix(&atmp, dim1, dim2));
    random_amatrix(a);

    b =
        (btrans ? init_amatrix(&btmp, dim3, dim2) :
         init_amatrix(&btmp, dim2, dim3));
    random_amatrix(b);

    at = init_amatrix(&attmp, a->rows, a->cols);
    if (alower)
        copy_lower_amatrix(a, false, at);
    else
        copy_upper_amatrix(a, false, at);

    bt = init_amatrix(&bttmp, b->rows, b->cols);
    if (blower)
        copy_lower_amatrix(b, false, bt);
    else
        copy_upper_amatrix(b, false, bt);

    x = init_amatrix(&xtmp, dim1, dim3);
    clear_amatrix(x);

    triangularaddmul_amatrix(1.0, alower, atrans, a, blower, btrans, b, x);

    addmul_amatrix(-1.0, atrans, at, btrans, bt, x);

    error = norm2_amatrix(x);

    (void)
    printf
    ("Checking triangularaddmul(alower=%s, atrans=%s, blower=%s, btrans=%s)\n"
     "  Accuracy %g, %sokay\n", (alower ? "tr" : "fl"),
     (atrans ? "tr" : "fl"), (blower ? "tr" : "fl"), (btrans ? "tr" : "fl"),
     error, (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    uninit_amatrix(x);
    uninit_amatrix(bt);
    uninit_amatrix(at);
    uninit_amatrix(b);
    uninit_amatrix(a);

    dim1 = 70;
    dim2 = 80;
    dim3 = 90;

    a =
        (atrans ? init_amatrix(&atmp, dim2, dim1) :
         init_amatrix(&atmp, dim1, dim2));
    random_amatrix(a);

    b =
        (btrans ? init_amatrix(&btmp, dim3, dim2) :
         init_amatrix(&btmp, dim2, dim3));
    random_amatrix(b);

    at = init_amatrix(&attmp, a->rows, a->cols);
    if (alower)
        copy_lower_amatrix(a, false, at);
    else
        copy_upper_amatrix(a, false, at);

    bt = init_amatrix(&bttmp, b->rows, b->cols);
    if (blower)
        copy_lower_amatrix(b, false, bt);
    else
        copy_upper_amatrix(b, false, bt);

    x = init_amatrix(&xtmp, dim1, dim3);
    clear_amatrix(x);

    triangularaddmul_amatrix(1.0, alower, atrans, a, blower, btrans, b, x);

    addmul_amatrix(-1.0, atrans, at, btrans, bt, x);

    error = norm2_amatrix(x);

    (void)
    printf
    ("Checking triangularaddmul(alower=%s, atrans=%s, blower=%s, btrans=%s)\n"
     "  Accuracy %g, %sokay\n", (alower ? "tr" : "fl"),
     (atrans ? "tr" : "fl"), (blower ? "tr" : "fl"), (btrans ? "tr" : "fl"),
     error, (error < tolerance ? "" : "    NOT "));
    if (error >= tolerance)
        problems++;

    uninit_amatrix(x);
    uninit_amatrix(bt);
    uninit_amatrix(at);
    uninit_amatrix(b);
    uninit_amatrix(a);
}
예제 #8
0
static void
check_triangularsolve(bool lower, bool unit, bool atrans,
                      pcamatrix a, bool xtrans)
{
    uint      n = a->rows;
    amatrix   xtmp, btmp;
    pamatrix  x, b;
    avector   xvtmp, bvtmp;
    pavector  xv, bv;
    real      error;

    assert(n == a->cols);

    /*
     * amatrix
     */

    x = init_amatrix(&xtmp, n, n);
    random_amatrix(x);

    b = init_zero_amatrix(&btmp, n, n);

    if (xtrans)
        addmul_amatrix(1.0, false, x, !atrans, a, b);
    else
        addmul_amatrix(1.0, atrans, a, false, x, b);

    triangularsolve_amatrix(lower, unit, atrans, a, xtrans, b);

    add_amatrix(-1.0, false, x, b);
    error = norm2_amatrix(b) / norm2_amatrix(x);

    (void) printf("Checking amatrix triangularsolve\n"
                  "  (lower=%s, unit=%s, atrans=%s, xtrans=%s)\n"
                  "  Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
                  (unit ? "tr" : "fl"), (atrans ? "tr" : "fl"),
                  (xtrans ? "tr" : "fl"), error,
                  (IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : "    NOT "));
    if (!IS_IN_RANGE(0.0, error, 1.0e-14))
        problems++;

    copy_amatrix(false, x, b);
    triangulareval_amatrix(lower, unit, atrans, a, xtrans, b);

    triangularsolve_amatrix(lower, unit, atrans, a, xtrans, b);

    add_amatrix(-1.0, false, x, b);
    error = norm2_amatrix(b) / norm2_amatrix(x);

    (void) printf("Checking amatrix triangulareval/triangularsolve\n"
                  "  (lower=%s, unit=%s, atrans=%s, xtrans=%s):\n"
                  "  Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
                  (unit ? "tr" : "fl"), (atrans ? "tr" : "fl"),
                  (xtrans ? "tr" : "fl"), error,
                  (IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : "    NOT "));
    if (!IS_IN_RANGE(0.0, error, 1.0e-14))
        problems++;

    /*
     * avector
     */

    xv = init_avector(&xvtmp, n);
    random_avector(xv);

    bv = init_avector(&bvtmp, n);
    clear_avector(bv);

    if (atrans) {
        addevaltrans_amatrix_avector(1.0, a, xv, bv);
    }
    else {
        addeval_amatrix_avector(1.0, a, xv, bv);
    }

    triangularsolve_amatrix_avector(lower, unit, atrans, a, bv);

    add_avector(-1.0, xv, bv);
    error = norm2_avector(bv) / norm2_avector(xv);

    (void) printf("Checking avector triangularsolve\n"
                  "  (lower=%s, unit=%s, atrans=%s)\n"
                  "  Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
                  (unit ? "tr" : "fl"), (atrans ? "tr" : "fl"), error,
                  (IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : "    NOT "));
    if (!IS_IN_RANGE(0.0, error, 1.0e-14))
        problems++;

    copy_avector(xv, bv);
    triangulareval_amatrix_avector(lower, unit, atrans, a, bv);

    triangularsolve_amatrix_avector(lower, unit, atrans, a, bv);

    add_avector(-1.0, xv, bv);
    error = norm2_avector(bv) / norm2_avector(xv);

    (void) printf("Checking avector triangulareval/triangularsolve\n"
                  "  (lower=%s, unit=%s, atrans=%s):\n"
                  "  Accuracy %g, %sokay\n", (lower ? "tr" : "fl"),
                  (unit ? "tr" : "fl"), (atrans ? "tr" : "fl"), error,
                  (IS_IN_RANGE(0.0, error, 1.0e-14) ? "" : "    NOT "));
    if (!IS_IN_RANGE(0.0, error, 1.0e-14))
        problems++;

    uninit_amatrix(b);
    uninit_amatrix(x);
    uninit_avector(bv);
    uninit_avector(xv);
}
예제 #9
0
파일: uniform.c 프로젝트: H2Lib/H2Lib
void
project_inplace_uniform(puniform u,
			pclusterbasis rb, pcclusteroperator ro,
			pclusterbasis cb, pcclusteroperator co)
{
  amatrix   tmp;
  pamatrix  X;

  if (u->rb == rb) {
    if (u->cb == cb) {
      /* Nothing to do */
    }
    else {
      assert(co);
      assert(co->krow == cb->k);
      assert(co->kcol == u->cb->k);

      /* Transform coupling matrix */
      X = init_amatrix(&tmp, u->rb->k, cb->k);
      clear_amatrix(X);
      addmul_amatrix(1.0, false, &u->S, true, &co->C, X);

      resize_amatrix(&u->S, X->rows, X->cols);
      copy_amatrix(false, X, &u->S);

      uninit_amatrix(X);

      /* Update pointer */
      ref_col_uniform(u, cb);
    }
  }
  else {
    assert(ro);
    assert(ro->krow == rb->k);
    assert(ro->kcol == u->rb->k);

    if (u->cb == cb) {
      /* Transform coupling matrix */
      X = init_amatrix(&tmp, rb->k, u->cb->k);
      clear_amatrix(X);
      addmul_amatrix(1.0, false, &ro->C, false, &u->S, X);

      resize_amatrix(&u->S, X->rows, X->cols);
      copy_amatrix(false, X, &u->S);

      uninit_amatrix(X);

      /* Update pointer */
      ref_row_uniform(u, rb);
    }
    else {
      assert(co);
      assert(co->krow == cb->k);
      assert(co->kcol == u->cb->k);

      /* Transform coupling matrix for row... */
      X = init_amatrix(&tmp, rb->k, u->cb->k);
      clear_amatrix(X);
      addmul_amatrix(1.0, false, &ro->C, false, &u->S, X);

      /* ... and column basis */
      resize_amatrix(&u->S, rb->k, cb->k);
      clear_amatrix(&u->S);
      addmul_amatrix(1.0, false, X, true, &co->C, &u->S);

      uninit_amatrix(X);

      /* Update pointers */
      ref_row_uniform(u, rb);
      ref_col_uniform(u, cb);
    }
  }
}
예제 #10
0
파일: test_eigen.c 프로젝트: H2Lib/H2Lib
int
main()
{
  ptridiag  T, Tcopy;
  pamatrix  A, Acopy, Q, U, Vt;
  pavector  work;
  prealavector sigma, lambda;
  real      error;
  uint      rows, cols, mid;
  uint      i, n, iter;
  int       info;

  /* ------------------------------------------------------------
   * Testing symmetric tridiagonal eigenvalue solver
   * ------------------------------------------------------------ */

  n = 6;

  /* Testing symmetric tridiagonal eigenvalue solver */

  (void) printf("==================================================\n"
		"Testing symmetric tridiagonal eigenvalue solver\n"
		"==================================================\n"
		"Setting up %u x %u tridiagonal matrix\n", n, n);
  T = new_tridiag(n);
  for (i = 0; i < n; i++)
    T->d[i] = 2.0;
  for (i = 0; i < n - 1; i++)
    T->l[i] = T->u[i] = -1.0;
  Tcopy = new_tridiag(n);
  copy_tridiag(T, Tcopy);

  A = new_amatrix(n, n);
  clear_amatrix(A);
  for (i = 0; i < n; i++)
    A->a[i + i * A->ld] = T->d[i];
  for (i = 0; i < n - 1; i++) {
    A->a[(i + 1) + i * A->ld] = T->l[i];
    A->a[i + (i + 1) * A->ld] = T->u[i];
  }
  Acopy = clone_amatrix(A);

  Q = new_identity_amatrix(n, n);
  U = new_amatrix(n, n);

  (void) printf("Performing self-made implicit QR iteration\n");
  iter = sb_muleig_tridiag(T, Q, 8 * n);

  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Q, U);
  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g. %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Performing default implicit QR iteration\n");
  identity_amatrix(Q);
  i = muleig_tridiag(Tcopy, Q);
  if (i == 0)
    (void) printf("  Success\n");
  else {
    (void) printf("  Failure\n");
    problems++;
  }

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Q, U);
  diageval_tridiag_amatrix(1.0, true, Tcopy, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g. %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  del_amatrix(U);
  del_amatrix(Q);
  del_amatrix(Acopy);
  del_amatrix(A);
  del_tridiag(Tcopy);
  del_tridiag(T);

  (void) printf("--------------------------------------------------\n"
		"Setting up random %u x %u tridiagonal matrix\n", n, n);
  T = new_tridiag(n);
  for (i = 0; i < n; i++)
    T->d[i] = 2.0 * rand() / RAND_MAX - 1.0;
  for (i = 0; i < n - 1; i++) {
    T->l[i] = 2.0 * rand() / RAND_MAX - 1.0;
    T->u[i] = CONJ(T->l[i]);
  }
  A = new_amatrix(n, n);
  clear_amatrix(A);
  for (i = 0; i < n; i++)
    A->a[i + i * A->ld] = T->d[i];
  for (i = 0; i < n - 1; i++) {
    A->a[(i + 1) + i * A->ld] = T->l[i];
    A->a[i + (i + 1) * A->ld] = T->u[i];
  }
  Tcopy = new_tridiag(n);
  copy_tridiag(T, Tcopy);
  Acopy = clone_amatrix(A);

  Q = new_identity_amatrix(n, n);
  U = new_amatrix(n, n);

  (void) printf("Performing implicit QR iteration\n");
  iter = sb_muleig_tridiag(T, Q, 8 * n);

  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Q, U);
  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Using default eigenvalue solver\n");
  identity_amatrix(Q);
  muleig_tridiag(Tcopy, Q);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Q, U);
  diageval_tridiag_amatrix(1.0, true, Tcopy, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "    NOT "));
  if (error >= tolerance)
    problems++;

  del_amatrix(U);
  del_amatrix(Q);
  del_amatrix(Acopy);
  del_amatrix(A);
  del_tridiag(Tcopy);
  del_tridiag(T);

  /* ------------------------------------------------------------
   * Testing self-adjoint matrix eigenvalue solver
   * ------------------------------------------------------------ */

  (void) printf("==================================================\n"
		"Testing self-adjoint matrix eigenvalue solver\n"
		"==================================================\n"
		"Setting up random %u x %u self-adjoint matrix\n", n, n);
  A = new_amatrix(n, n);
  random_selfadjoint_amatrix(A);

  Acopy = new_amatrix(n, n);
  copy_amatrix(false, A, Acopy);

  lambda = new_realavector(n);
  Q = new_identity_amatrix(n, n);

  (void) printf("Performing implicit QR iteration\n");
  iter = sb_eig_amatrix(A, lambda, Q, 8 * n);

  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  U = new_amatrix(n, n);
  copy_amatrix(false, Q, U);
  copy_amatrix(false, Acopy, A);
  diageval_realavector_amatrix(1.0, true, lambda, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Using default eigenvalue solver\n");
  copy_amatrix(false, Acopy, A);
  info = eig_amatrix(A, lambda, Q);
  assert(info == 0);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, Q);
  (void) printf("  Orthogonality Q %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Q, U);
  diageval_realavector_amatrix(1.0, true, lambda, true, U);
  addmul_amatrix(-1.0, false, U, true, Q, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_amatrix(U);
  del_amatrix(Q);
  del_realavector(lambda);
  del_amatrix(Acopy);
  del_amatrix(A);

  /* ------------------------------------------------------------
   * Testing bidiagonal SVD solver
   * ------------------------------------------------------------ */

  (void) printf("==================================================\n"
		"Testing bidiagonal SVD solver\n"
		"==================================================\n"
		"Setting up bidiagonal %u x %u matrix\n", n, n);
  T = new_tridiag(n);
  for (i = 0; i < n; i++)
    T->d[i] = i + 1.0;
  for (i = 0; i < n - 1; i++) {
    T->l[i] = 1.0;
    T->u[i] = 0.0;
  }
  A = new_amatrix(n, n);
  clear_amatrix(A);
  for (i = 0; i < n; i++)
    A->a[i + i * A->ld] = T->d[i];
  for (i = 0; i < n - 1; i++)
    A->a[(i + 1) + i * A->ld] = T->l[i];

  Tcopy = new_tridiag(n);
  copy_tridiag(T, Tcopy);
  Acopy = new_amatrix(n, n);
  copy_amatrix(false, A, Acopy);

  U = new_identity_amatrix(n, n);
  Vt = new_identity_amatrix(n, n);

  (void) printf("Performing self-made implicit SVD iteration\n");
  iter = sb_mulsvd_tridiag(T, U, Vt, 8 * n);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Using default SVD solver\n");
  copy_tridiag(Tcopy, T);
  identity_amatrix(U);
  identity_amatrix(Vt);
  mulsvd_tridiag(T, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Acopy, A);
  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_tridiag(Tcopy);
  del_amatrix(A);
  del_tridiag(T);

  (void) printf("--------------------------------------------------\n"
		"Setting up random bidiagonal %u x %u matrix\n", n, n);
  T = new_tridiag(n);
  for (i = 0; i < n; i++) {
    T->d[i] = 2.0 * rand() / RAND_MAX - 1.0;
  }
  for (i = 0; i < n - 1; i++) {
    T->l[i] = 2.0 * rand() / RAND_MAX - 1.0;
    T->u[i] = 0.0;
  }
  A = new_amatrix(n, n);
  clear_amatrix(A);
  for (i = 0; i < n; i++)
    A->a[i + i * A->ld] = T->d[i];
  for (i = 0; i < n - 1; i++)
    A->a[(i + 1) + i * A->ld] = T->l[i];

  Tcopy = new_tridiag(n);
  copy_tridiag(T, Tcopy);
  Acopy = clone_amatrix(A);

  U = new_identity_amatrix(n, n);
  Vt = new_identity_amatrix(n, n);

  (void) printf("Performing implicit SVD iteration\n");
  iter = sb_mulsvd_tridiag(T, U, Vt, 8 * n);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Using default SVD solver\n");
  copy_tridiag(Tcopy, T);
  copy_amatrix(false, Acopy, A);
  identity_amatrix(U);
  identity_amatrix(Vt);
  mulsvd_tridiag(T, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_tridiag(Tcopy);
  del_amatrix(A);
  del_tridiag(T);

  /* ------------------------------------------------------------
   * Testing Golub-Kahan bidiagonalization
   * ------------------------------------------------------------ */

  rows = 10;
  cols = 7;
  mid = UINT_MIN(rows, cols);
  (void) printf("==================================================\n"
		"Testing Golub-Kahan bidiagonalization\n"
		"==================================================\n"
		"Setting up random %u x %u matrix\n", rows, cols);
  A = new_amatrix(rows, cols);
  random_amatrix(A);
  Acopy = new_amatrix(rows, cols);
  copy_amatrix(false, A, Acopy);
  U = new_amatrix(rows, mid);
  Vt = new_amatrix(mid, cols);
  T = new_tridiag(mid);

  (void) printf("Bidiagonalizing\n");
  bidiagonalize_amatrix(A, T, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  lowereval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_tridiag(T);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  rows = 8;
  cols = 15;
  mid = UINT_MIN(rows, cols);
  (void) printf("--------------------------------------------------\n"
		"Setting up %u x %u matrix\n", rows, cols);
  A = new_amatrix(rows, cols);
  random_amatrix(A);
  Acopy = new_amatrix(rows, cols);
  copy_amatrix(false, A, Acopy);
  U = new_amatrix(rows, mid);
  Vt = new_amatrix(mid, cols);
  T = new_tridiag(mid);

  (void) printf("Bidiagonalizing\n");
  bidiagonalize_amatrix(A, T, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  lowereval_tridiag_amatrix(1.0, true, T, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_tridiag(T);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  /* ------------------------------------------------------------
   * Testing general SVD solver
   * ------------------------------------------------------------ */

  (void) printf("==================================================\n"
		"Testing general SVD solver\n"
		"==================================================\n"
		"Setting up 3 x 4 matrix\n");
  A = new_amatrix(3, 4);
  setentry_amatrix(A, 0, 0, 1.0);
  setentry_amatrix(A, 1, 0, 2.0);
  setentry_amatrix(A, 2, 0, 3.0);
  setentry_amatrix(A, 0, 1, 2.0);
  setentry_amatrix(A, 1, 1, 4.0);
  setentry_amatrix(A, 2, 1, 6.0);
  setentry_amatrix(A, 0, 2, 2.0);
  setentry_amatrix(A, 1, 2, 5.0);
  setentry_amatrix(A, 2, 2, 8.0);
  setentry_amatrix(A, 0, 3, 1.0);
  setentry_amatrix(A, 1, 3, 4.0);
  setentry_amatrix(A, 2, 3, 7.0);

  Acopy = new_amatrix(A->rows, A->cols);
  copy_amatrix(false, A, Acopy);

  U = new_identity_amatrix(3, 3);
  Vt = new_identity_amatrix(3, 4);
  sigma = new_realavector(3);
  work = new_avector(3 * 3);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 24);

  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  (void) printf("--------------------------------------------------\n"
		"Setting up 4 x 3 matrix\n");
  A = new_amatrix(4, 3);
  setentry_amatrix(A, 0, 0, 1.0);
  setentry_amatrix(A, 0, 1, 2.0);
  setentry_amatrix(A, 0, 2, 3.0);
  setentry_amatrix(A, 1, 0, 2.0);
  setentry_amatrix(A, 1, 1, 4.0);
  setentry_amatrix(A, 1, 2, 6.0);
  setentry_amatrix(A, 2, 0, 2.0);
  setentry_amatrix(A, 2, 1, 5.0);
  setentry_amatrix(A, 2, 2, 8.0);
  setentry_amatrix(A, 3, 0, 1.0);
  setentry_amatrix(A, 3, 1, 4.0);
  setentry_amatrix(A, 3, 2, 7.0);

  Acopy = new_amatrix(A->rows, A->cols);
  copy_amatrix(false, A, Acopy);

  U = new_amatrix(4, 3);
  Vt = new_amatrix(3, 3);
  sigma = new_realavector(3);
  work = new_avector(3 * 3);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 24);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality V %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  (void) printf("--------------------------------------------------\n"
		"Setting up 4 x 3 matrix\n");
  A = new_amatrix(4, 3);
  setentry_amatrix(A, 0, 0, 1.0);
  setentry_amatrix(A, 0, 1, 2.0);
  setentry_amatrix(A, 0, 2, 3.0);
  setentry_amatrix(A, 1, 0, 2.0);
  setentry_amatrix(A, 1, 1, 4.0);
  setentry_amatrix(A, 1, 2, 6.0);
  setentry_amatrix(A, 2, 0, 2.0);
  setentry_amatrix(A, 2, 1, 5.0);
  setentry_amatrix(A, 2, 2, 8.0);
  setentry_amatrix(A, 3, 0, 1.0);
  setentry_amatrix(A, 3, 1, 4.0);
  setentry_amatrix(A, 3, 2, 7.0);

  Acopy = clone_amatrix(A);

  U = new_amatrix(4, 3);
  Vt = new_amatrix(3, 3);
  sigma = new_realavector(3);
  work = new_avector(3 * 3);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 24);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  rows = 9;
  cols = 7;
  mid = UINT_MIN(rows, cols);
  (void) printf("--------------------------------------------------\n"
		"Setting up random %u x %u matrix\n", rows, cols);
  A = new_amatrix(rows, cols);
  random_amatrix(A);

  Acopy = new_amatrix(A->rows, A->cols);
  copy_amatrix(false, A, Acopy);

  U = new_amatrix(rows, mid);
  Vt = new_amatrix(mid, cols);
  sigma = new_realavector(mid);
  work = new_avector(3 * mid);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
  error = normfrob_amatrix(Acopy);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  rows = 10;
  cols = 6;
  mid = UINT_MIN(rows, cols);
  (void) printf("--------------------------------------------------\n"
		"Setting up random %u x %u matrix\n", rows, cols);
  A = new_amatrix(rows, cols);
  random_amatrix(A);

  Acopy = new_amatrix(A->rows, A->cols);
  copy_amatrix(false, A, Acopy);

  U = new_amatrix(rows, mid);
  Vt = new_amatrix(mid, cols);
  sigma = new_realavector(mid);
  work = new_avector(3 * mid);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Acopy, A);
  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Running default SVD solver\n");
  copy_amatrix(false, Acopy, A);
  svd_amatrix(A, sigma, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Acopy, A);
  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  rows = 7;
  cols = 13;
  mid = UINT_MIN(rows, cols);
  (void) printf("--------------------------------------------------\n"
		"Setting up random %u x %u matrix\n", rows, cols);
  A = new_amatrix(rows, cols);
  random_amatrix(A);

  Acopy = new_amatrix(A->rows, A->cols);
  copy_amatrix(false, A, Acopy);

  U = new_amatrix(rows, mid);
  Vt = new_amatrix(mid, cols);
  sigma = new_realavector(mid);
  work = new_avector(3 * mid);

  (void) printf("Running self-made SVD solver\n");
  iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
  (void) printf("  %u iterations\n", iter);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Acopy, A);
  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  (void) printf("Running default SVD solver\n");
  copy_amatrix(false, Acopy, A);
  svd_amatrix(A, sigma, U, Vt);

  (void) printf("Checking accuracy\n");
  error = check_ortho_amatrix(false, U);
  (void) printf("  Orthogonality U %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  error = check_ortho_amatrix(true, Vt);
  (void) printf("  Orthogonality Vt %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  copy_amatrix(false, Acopy, A);
  diageval_realavector_amatrix(1.0, true, sigma, true, U);
  addmul_amatrix(-1.0, false, U, false, Vt, A);
  error = normfrob_amatrix(A);
  (void) printf("  Accuracy %g, %sokay\n", error,
		(error < tolerance ? "" : "NOT "));
  if (error >= tolerance)
    problems++;

  del_avector(work);
  del_realavector(sigma);
  del_amatrix(Vt);
  del_amatrix(U);
  del_amatrix(Acopy);
  del_amatrix(A);

  printf("----------------------------------------\n"
	 "  %u matrices and\n"
	 "  %u vectors still active\n"
	 "  %u errors found\n", getactives_amatrix(), getactives_avector(),
	 problems);

  return problems;
}