Exemple #1
0
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);
}
Exemple #2
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);
    }
  }
}
Exemple #3
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);
}
Exemple #4
0
void
del_uniform(puniform u)
{
  assert(u != 0);

  uninit_amatrix(&u->S);

  unref_row_uniform(u);
  unref_col_uniform(u);

  freemem(u);
}
Exemple #5
0
void
uninit_clusteroperator(pclusteroperator co)
{
  uint      i;

  assert(co->refs == 0);

  if (co->sons > 0) {
    for (i = 0; i < co->sons; i++)
      unref_clusteroperator(co->son[i]);
    freemem(co->son);
  }

  uninit_amatrix(&co->C);

  assert(active_clusteroperator > 0);

#ifdef USE_OPENMP
#pragma omp atomic
#endif
  active_clusteroperator--;
}
Exemple #6
0
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);
    }
  }
}
Exemple #7
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;
}
Exemple #8
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);
}
Exemple #9
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);
}
Exemple #10
0
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);
    }
  }
}
Exemple #11
0
void
coarsen_hmatrix(phmatrix G, ptruncmode tm, real eps, bool recursive)
{
  uint      rsons = G->rsons;
  uint      csons = G->csons;

  phmatrix  son;
  prkmatrix R;
  pamatrix  A, B;
  amatrix   T, S;
  uint      i, j, leafs, ranksum, rankoffset, rowoffset, coloffset, rank;
  size_t    sizeold, sizenew;

  leafs = 0;

  /* recursion */
  if (rsons * csons > 0) {
    for (j = 0; j < csons; ++j) {
      for (i = 0; i < rsons; ++i) {
	son = G->son[i + j * rsons];
	if (recursive == true) {
	  coarsen_hmatrix(son, tm, eps, recursive);
	}
	leafs += son->rsons * son->csons;
      }
    }

    update_hmatrix(G);
  }
  else {
    /* matrix is a leaf -> northing to do */
    return;
  }

  if (leafs > 0) {
    /* matrix has sons which are not leafs  -> nothing to do */
    return;
  }
  else {
    if (G->rc == G->cc) {
      return;
    }

    /* determine ranksum and size of sons */
    ranksum = 0;
    sizeold = 0;
    for (j = 0; j < csons; ++j) {
      for (i = 0; i < rsons; ++i) {
	son = G->son[i + j * rsons];
	if (son->r) {
	  ranksum += son->r->k;
	  sizeold += getsize_rkmatrix(son->r);
	}
	else {
	  assert(son->f != NULL);
	  ranksum += son->f->cols;
	  sizeold += getsize_amatrix(son->f);
	}
      }
    }

    /* new rank-k-matrix */
    R = new_rkmatrix(G->rc->size, G->cc->size, ranksum);
    A = &R->A;
    B = &R->B;
    clear_amatrix(A);
    clear_amatrix(B);

    /* copy sons into a big rank-k-matrix */
    rankoffset = 0;
    coloffset = 0;
    for (j = 0; j < csons; ++j) {
      rowoffset = 0;
      for (i = 0; i < rsons; ++i) {
	son = G->son[i + j * rsons];
	rank = son->r ? son->r->k : son->f->cols;

	init_sub_amatrix(&T, A, son->rc->size, rowoffset, rank, rankoffset);
	init_sub_amatrix(&S, B, son->cc->size, coloffset, rank, rankoffset);

	if (son->r) {
	  copy_amatrix(false, &(son->r->A), &T);
	  copy_amatrix(false, &(son->r->B), &S);
	}
	else {
	  copy_amatrix(false, son->f, &T);
	  identity_amatrix(&S);
	}

	rankoffset += rank;
	rowoffset += son->rc->size;
	uninit_amatrix(&T);
	uninit_amatrix(&S);
      }
      coloffset += G->son[j * rsons]->cc->size;
    }

    /* compression */
    trunc_rkmatrix(tm, eps, R);

    sizenew = getsize_rkmatrix(R);

    /* use new rank-k-matrix or discard */
    if (sizenew < sizeold) {
      for (j = 0; j < csons; ++j) {
	for (i = 0; i < rsons; ++i) {
	  unref_hmatrix(G->son[i + j * rsons]);
	}
      }

      G->rsons = 0;
      G->csons = 0;
      freemem(G->son);
      G->son = NULL;
      G->f = NULL;
      G->r = R;
      G->desc = 1;
    }
    else {
      del_rkmatrix(R);
    }

  }
}