Beispiel #1
0
int
main()
{
    ph2matrix h2, h2copy, L, R;
    pclusterbasis rb, cb, rbcopy, cbcopy, rblow, cblow, rbup, cbup;
    pclusteroperator rwf, cwf, rwflow, cwflow, rwfup, cwfup, rwfh2, cwfh2;
    ptruncmode tm;

    pavector  x, b;
    uint      n;
    real      error;
    pcurve2d  gr2;
    pbem2d    bem2;
    pcluster  root2;
    pblock    block2;
    uint      clf, m;
    real      tol, eta, delta, eps_aca;

    n = 579;
    tol = 1.0e-13;

    clf = 16;
    eta = 1.0;
    m = 4;
    delta = 1.0;
    eps_aca = 1.0e-13;

    gr2 = new_circle_curve2d(n, 0.333);
    bem2 = new_slp_laplace_bem2d(gr2, 2, BASIS_CONSTANT_BEM2D);
    root2 = build_bem2d_cluster(bem2, clf, BASIS_CONSTANT_BEM2D);
    block2 = build_strict_block(root2, root2, &eta, admissible_max_cluster);

    rb = build_from_cluster_clusterbasis(root2);
    cb = build_from_cluster_clusterbasis(root2);
    setup_h2matrix_aprx_greenhybrid_bem2d(bem2, rb, cb, block2, m, 1, delta,
                                          eps_aca, build_bem2d_rect_quadpoints);

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

    (void) printf("Creating laplacebem2d SLP matrix\n");
    assemble_bem2d_h2matrix_row_clusterbasis(bem2, rb);
    assemble_bem2d_h2matrix_col_clusterbasis(bem2, cb);
    h2 = build_from_block_h2matrix(block2, rb, cb);
    assemble_bem2d_h2matrix(bem2, block2, h2);

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

    (void) printf("Copying matrix\n");

    rbcopy = clone_clusterbasis(h2->rb);
    cbcopy = clone_clusterbasis(h2->cb);
    h2copy = clone_h2matrix(h2, rbcopy, cbcopy);


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

    tm = new_releucl_truncmode();
    rblow = build_from_cluster_clusterbasis(root2);
    cblow = build_from_cluster_clusterbasis(root2);
    L = build_from_block_lower_h2matrix(block2, rblow, cblow);

    rwflow = prepare_row_clusteroperator(L->rb, L->cb, tm);
    cwflow = prepare_col_clusteroperator(L->rb, L->cb, tm);
    rwf = NULL;
    cwf = NULL;
    init_cholesky_h2matrix(h2, &rwf, &cwf, tm);
    choldecomp_h2matrix(h2, rwf, cwf, L, rwflow, cwflow, tm, tol);

    (void) printf("Solving\n");

    cholsolve_h2matrix_avector(L, b);

    add_avector(-1.0, x, b);
    error = norm2_avector(b) / norm2_avector(x);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  IS_IN_RANGE(2.0e-13, error, 3.0e-12) ? "" : "    NOT ");
    if (!IS_IN_RANGE(2.0e-13, error, 3.0e-12))
        problems++;

    rwfh2 = prepare_row_clusteroperator(h2copy->rb, h2copy->cb, tm);
    cwfh2 = prepare_col_clusteroperator(h2copy->rb, h2copy->cb, tm);

    (void) printf("Checking factorization\n");
    error = norm2_h2matrix(h2copy);
    addmul_h2matrix(-1.0, L, true, L, h2copy, rwfh2, cwfh2, tm, tol);
    error = norm2_h2matrix(h2copy) / error;
    (void) printf("  Accuracy %g, %sokay\n", error,
                  IS_IN_RANGE(4.0e-15, error, 4.0e-14) ? "" : "    NOT ");
    if (!IS_IN_RANGE(4.0e-15, error, 4.0e-14))
        problems++;




    del_h2matrix(h2copy);
    del_h2matrix(h2);
    del_h2matrix(L);
    del_avector(b);
    del_avector(x);
    del_truncmode(tm);

    del_clusteroperator(rwflow);
    del_clusteroperator(cwflow);
    del_clusteroperator(rwf);
    del_clusteroperator(cwf);
    del_clusteroperator(rwfh2);
    del_clusteroperator(cwfh2);


    rb = build_from_cluster_clusterbasis(root2);
    cb = build_from_cluster_clusterbasis(root2);
    setup_h2matrix_aprx_greenhybrid_bem2d(bem2, rb, cb, block2, m, 1, delta,
                                          eps_aca, build_bem2d_rect_quadpoints);

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

    (void) printf("Creating laplacebem2d SLP matrix\n");
    assemble_bem2d_h2matrix_row_clusterbasis(bem2, rb);
    assemble_bem2d_h2matrix_col_clusterbasis(bem2, cb);
    h2 = build_from_block_h2matrix(block2, rb, cb);
    assemble_bem2d_h2matrix(bem2, block2, h2);

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

    (void) printf("Copying matrix\n");
    rbcopy = clone_clusterbasis(h2->rb);
    cbcopy = clone_clusterbasis(h2->cb);
    h2copy = clone_h2matrix(h2, rbcopy, cbcopy);

    (void) printf("Computing LR factorization\n");
    rblow = build_from_cluster_clusterbasis(root2);
    cblow = build_from_cluster_clusterbasis(root2);
    L = build_from_block_lower_h2matrix(block2, rblow, cblow);

    rbup = build_from_cluster_clusterbasis(root2);
    cbup = build_from_cluster_clusterbasis(root2);
    R = build_from_block_upper_h2matrix(block2, rbup, cbup);

    tm = new_releucl_truncmode();
    rwf = prepare_row_clusteroperator(h2->rb, h2->cb, tm);
    cwf = prepare_col_clusteroperator(h2->rb, h2->cb, tm);
    rwflow = prepare_row_clusteroperator(L->rb, L->cb, tm);
    cwflow = prepare_col_clusteroperator(L->rb, L->cb, tm);
    rwfup = prepare_row_clusteroperator(R->rb, R->cb, tm);
    cwfup = prepare_col_clusteroperator(R->rb, R->cb, tm);

    lrdecomp_h2matrix(h2, rwf, cwf, L, rwflow, cwflow, R, rwfup, cwfup, tm,
                      tol);

    (void) printf("Solving\n");
    lrsolve_h2matrix_avector(L, R, b);

    add_avector(-1.0, x, b);
    error = norm2_avector(b) / norm2_avector(x);
    (void) printf("  Accuracy %g, %sokay\n", error,
                  IS_IN_RANGE(2e-13, error, 2e-12) ? "" : "    NOT ");
    if (!IS_IN_RANGE(2e-13, error, 2e-12))
        problems++;


    rwfh2 = prepare_row_clusteroperator(h2copy->rb, h2copy->cb, tm);
    cwfh2 = prepare_col_clusteroperator(h2copy->rb, h2copy->cb, tm);

    (void) printf("Checking factorization\n");
    error = norm2_h2matrix(h2copy);
    addmul_h2matrix(-1.0, L, false, R, h2copy, rwfh2, cwfh2, tm, tol);
    error = norm2_h2matrix(h2copy) / error;
    (void) printf("  Accuracy %g, %sokay\n", error,
                  IS_IN_RANGE(4.0e-15, error, 5.0e-14) ? "" : "    NOT ");
    if (!IS_IN_RANGE(4.0e-15, error, 5.0e-14))
        problems++;


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

    del_h2matrix(h2);
    del_h2matrix(h2copy);
    del_h2matrix(L);
    del_h2matrix(R);
    del_clusteroperator(rwf);
    del_clusteroperator(cwf);
    del_clusteroperator(rwflow);
    del_clusteroperator(cwflow);
    del_clusteroperator(rwfup);
    del_clusteroperator(cwfup);
    del_clusteroperator(rwfh2);
    del_clusteroperator(cwfh2);

    del_avector(b);
    del_avector(x);
    del_truncmode(tm);

    freemem(root2->idx);
    del_bem2d(bem2);
    del_block(block2);
    del_cluster(root2);
    del_curve2d(gr2);

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

    return problems;
}
Beispiel #2
0
int
main(int argc, char **argv)
{

  uint      prob;		/* Used for selecting the problem: 2d or 3d? */
  uint      L;			/* Number of grid refinements */
  uint      clf;		/* Leafsize */
  uint      clustermode;	/* Used for selecting the cluster strategy */
  uint      decomp;		/* Used for selecting the type of the decomposition */
  uint      i, j;		/* Auxiliary variable for loops */
  ptri2d   *gr_2d;		/* 2d mesh hierarchy */
  ptri2dp1  p1_2d;		/* Linear p1 basis functions in 2d */
  ptet3d   *gr_3d;		/* 3d mesh hierarchy */
  ptet3dp1  p1_3d;		/* Linear p1 basis functions in 3d */
  psparsematrix sp;		/* Sparsematrix object */
  uint      ndof;		/* Number of degrees of freedom */
  uint     *idx;		/* Array of indices for the clustergeometry */
  pclustergeometry cg;		/* Clustergeometry object */
  uint      dim;		/* Dimension for domain decomposition clustering */
  uint     *flag;		/* Auxiliary array for domain decompostion clustering */
  pcluster  root;		/* Cluster tree object */
  pblock    broot;		/* Block cluster tree object */
  real      eta;		/* Admissibility parameter */
  phmatrix  hm;			/* Hierarchical matrices */
  real      tol_decomp;		/* Tolerance for decompositions */
  real      tol_coarsen;	/* Tolerance for coarsening of the hierarchical matrix */
  phmatrix  l;			/* Hierarchical matrices for storing the Cholesky factor */
  ptruncmode tm;		/* truncmode for truncations within the arithmetic */
  real      error;		/* Auxiliary variable for testing */
  pstopwatch sw;		/* Stopwatch for time measuring */
  real      time;		/* Variable for time measuring */
  size_t    sz, sz_rk, sz_full;	/* Variables for memory footprint */

  /* First initialise the library */
  init_h2lib(&argc, &argv);

  /*Initialise variables */
  eta = 2.0;
  tol_coarsen = 1e-16;
  tol_decomp = 1e-12;
  tm = new_releucl_truncmode();
  sw = new_stopwatch();

  /* Set problem parameters */
  printf("Select problem\n");
  prob = askforint("1 = fem2d,\t 2 = fem3d\t \n", "h2lib_fem", 1);
  L = askforint("Refinement?\n", "h2lib_L", 4);
  clf = askforint("Leafsize?\n", "h2lib_clf", 32);
  clustermode =
    askforint("1 = adaptive, \t 2 = ddcluster", "h2lib_clusterstrategy", 2);
  decomp =
    askforint("1 = LU-decomposition,\t, 2 = cholesky-decomposition\n",
	      "h2lib_decomp", 1);
  tol_decomp = askforreal("tol_decomp=?\n", "h2lib_tol_decomp", 1e-13);

  /* Build geometry and discretisation for laplace equation */
  if (prob == 1) {
    printf("========================================\n"
	   "  Create and fill fem2d sparsematrix\n");
    /* Mesh hierarchy */
    gr_2d = (ptri2d *) allocmem((size_t) sizeof(ptri2d) * (L + 1));
    gr_2d[0] = new_unitsquare_tri2d();	/* Set domain */
    //gr_2d[0]=new_unitcircle_tri2d();
    //gr_2d[0] = new_lshape_tri2d();
    for (i = 0; i < L; i++) {	/* Mesh refinements */
      gr_2d[i + 1] = refine_tri2d(gr_2d[i], NULL);
    }
    check_tri2d(gr_2d[L]);	/* Check mesh for inconsistencies */
    p1_2d = new_tri2dp1(gr_2d[L]);	/* Build discretisation */
    sp = build_tri2dp1_sparsematrix(p1_2d);	/* Build corresponding sparsematrix */
    assemble_tri2dp1_laplace_sparsematrix(p1_2d, sp, 0);	/* Fill the sparsematrix */
    ndof = p1_2d->ndof;
    printf("ndof = %u\n", ndof);
    /* Initialise index array for the cluster geometry */
    idx = allocuint(ndof);
    for (i = 0; i < ndof; i++)
      idx[i] = i;
    /* Build clustergeometry for the problem */
    cg = build_tri2dp1_clustergeometry(p1_2d, idx);
    del_tri2dp1(p1_2d);
    for (i = 0; i <= L; i++) {
      j = L - i;
      del_tri2d(gr_2d[j]);
    }
    freemem(gr_2d);
    dim = 2;			/* Set dimenison for domain decomposition clustering */
  }
  else {
    assert(prob == 2);
    printf("========================================\n"
	   "  Create and fill fem3d sparsematrix\n");
    /* Mesh hierarchy */
    gr_3d = (ptet3d *) allocmem((size_t) sizeof(ptri2d) * (L + 1));
    gr_3d[0] = new_unitcube_tet3d();	/* Set domain */
    for (i = 0; i < L; i++) {
      gr_3d[i + 1] = refine_tet3d(gr_3d[i], NULL);
    }
    check_tet3d(gr_3d[L]);	/* Check mesh for inconsistencies */
    p1_3d = new_tet3dp1(gr_3d[L]);	/* build discretisation */
    sp = build_tet3dp1_sparsematrix(p1_3d);	/* Build corresponding sparsematrix */
    assemble_tet3dp1_laplace_sparsematrix(p1_3d, sp, 0);	/* Fill the sparsematrix */
    ndof = p1_3d->ndof;
    printf("ndof = %u\n", ndof);
    /* initialise index array for the clustergeometry */
    idx = allocuint(ndof);
    for (i = 0; i < ndof; i++)
      idx[i] = i;
    /* Build clustergeometry for the problem */
    cg = build_tet3dp1_clustergeometry(p1_3d, idx);
    del_tet3dp1(p1_3d);
    for (i = 0; i <= L; i++) {
      j = L - i;
      del_tet3d(gr_3d[j]);
    }
    freemem(gr_3d);
    dim = 3;
  }

  /* Build and fill the corresponding hierarchical matrix */
  printf("========================================\n"
	 "  Create and fill hierarchical matrix\n");
  if (clustermode == 1) {
    /* Build cluster tree based on adaptive clustering */
    root = build_cluster(cg, ndof, idx, clf, H2_ADAPTIVE);
    /* Build block cluster tree using the euclidian (maximum) admissibilty condition */
    broot = build_nonstrict_block(root, root, &eta, admissible_2_cluster);
    /*Build hierarchical matrix from block */
    hm = build_from_block_hmatrix(broot, 0);
    /* Fill hierarchical matrix with sparsematrix entries */
    copy_sparsematrix_hmatrix(sp, hm);
    /* Compute error */
    error = norm2diff_sparsematrix_hmatrix(hm, sp);
    printf("error = %g\n", error);
    del_block(broot);
  }
  else {			/* clustermode == 2 */
    /* Initialise auxiliary array for domain decomposition clustering */
    flag = allocuint(ndof);
    for (i = 0; i < ndof; i++)
      flag[i] = 0;
    /* build cluster tree based adaptive doamin decomposition clustering */
    root = build_adaptive_dd_cluster(cg, ndof, idx, clf, sp, dim, flag);
    freemem(flag);
    /* Build block cluster tree using the domain decompostion admissibilty condition */
    broot = build_nonstrict_block(root, root, &eta, admissible_dd_cluster);
    /* Build hierarchical matrix from block cluster tree */
    hm = build_from_block_hmatrix(broot, 0);
    /* Fill hierarchical matrix with sparsematrix entries */
    copy_sparsematrix_hmatrix(sp, hm);
    /* Compute error */
    error = norm2diff_sparsematrix_hmatrix(hm, sp);
    printf("error = %g\n", error);
    del_block(broot);
  }

  /* Draw hierarchical matrix with cairo */
#if 0
#ifdef USE_CAIRO
  cairo_t  *cr;
  printf("Draw hmatrix to \"hm_p1.pdf\"\n");
  cr = new_cairopdf("../hm_p1.pdf", 1024.0, 1024.0);
  draw_cairo_hmatrix(cr, hm, false, 0);
  cairo_destroy(cr);
#endif
#endif

  /* Compute size of the hierarchical matrix */
  sz = getsize_hmatrix(hm);
  sz_rk = getfarsize_hmatrix(hm);
  sz_full = getnearsize_hmatrix(hm);
  printf("size original matrix:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	 sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n",
	 sz_rk / 1024.0 / 1024.0, sz_full / 1024.0 / 1024.0);
  printf("Coarsen hmatrix\n");

  /* Coarsening of the hierarchical matrix to safe storage */
  coarsen_hmatrix(hm, tm, tol_coarsen, true);

  /* Compute size of the hierarchical matrix after coarsening */
  sz = getsize_hmatrix(hm);
  sz_rk = getfarsize_hmatrix(hm);
  sz_full = getnearsize_hmatrix(hm);
  printf("size original matrix:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	 sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n",
	 sz_rk / 1024.0 / 1024.0, sz_full / 1024.0 / 1024.0);
  /* Compute error after coarseing */
  error = norm2diff_sparsematrix_hmatrix(hm, sp);
  printf("error = %g\n", error);

  /* Draw the hierarchical matrix after coarsening */
#if 0
#ifdef USE_CAIRO
  cairo_t  *cr2;
  printf("Draw hmatrix to \"hm_p1_coarsend.pdf\"\n");
  cr2 = new_cairopdf("../hm_p1_coarsend.pdf", 1024.0, 1024.0);
  draw_cairo_hmatrix(cr2, hm, false, 0);
  cairo_destroy(cr2);
#endif
#endif

  /* Compute decomposition of the hierarchical matrix */
  if (decomp == 1) {
    printf("========================================\n"
	   "  Test lu-decomposition\n");
    /* Compute size of the hierarchical matrix */
    sz = getsize_hmatrix(hm);
    printf("size original matrix:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
    /* Compute lu-decomposition of the hierarchical matrix */
    start_stopwatch(sw);
    lrdecomp_hmatrix(hm, 0, tol_decomp);
    time = stop_stopwatch(sw);
    /* Compute size of the lu-decomposition */
    sz = getsize_hmatrix(hm);
    sz_rk = getfarsize_hmatrix(hm);
    sz_full = getnearsize_hmatrix(hm);
    printf
      ("size lu-decomposition (lu):\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
       sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
    printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n",
	   sz_rk / 1024.0 / 1024.0, sz_full / 1024.0 / 1024.0);
    printf("time = %f s\n", time);
#if 0
#ifdef USE_CAIRO
    cairo_t  *cr;
    printf("Draw lu-decomposition to \"hm_p1_lu.pdf\"\n");
    cr = new_cairopdf("../hm_p1_lu_staging.pdf", 512.0, 512.0);
    draw_cairo_hmatrix(cr, hm, false, 100);
    cairo_destroy(cr);
#endif
#endif
    /* Compute error */
    error = norm2lu_sparsematrix(hm, sp);
    printf("||I-(lu)^-1 sp||_2 ");
    printf("error = %g\n", error);
  }
  else {			/*decomp == 2 */
    printf("========================================\n"
	   "  Test cholesky-decomposition\n");
    /* Compute size of the hierarchical matrix */
    sz = getsize_hmatrix(hm);
    printf("size original matrix:\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
    /* Compute cholesky-decomposition */
    start_stopwatch(sw);
    choldecomp_hmatrix(hm, 0, tol_decomp);
    time = stop_stopwatch(sw);
    /* Compute size of the cholesky-factor */
    l = clone_lower_hmatrix(false, hm);
    sz = getsize_hmatrix(l);
    sz_rk = getfarsize_hmatrix(l);
    sz_full = getnearsize_hmatrix(l);
    printf
      ("size chol-decomposition (l):\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
       sz / 1024.0 / 1024.0, sz / 1024.0, sz / 1024.0 / ndof);
    printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n",
	   sz_rk / 1024.0 / 1024.0, sz_full / 1024.0 / 1024.0);
    printf("time = %f s\n", time);
#if 0
#ifdef USE_CAIRO
    cairo_t  *cr;
    printf("Draw chol-factor to \"hm_chol_staging.pdf\"\n");
    cr = new_cairopdf("../hm_chol_staging.pdf", 512.0, 512.0);
    draw_cairo_hmatrix(cr, l, false, 1000);
    cairo_destroy(cr);
#endif
#endif
    /* Compute error */
    error = norm2chol_sparsematrix(hm, sp);
    printf("||I-(ll*)^-1 sp||_2 ");
    printf("error = %g\n", error);

    del_hmatrix(l);
  }

  /* Cleaning up */
  del_truncmode(tm);
  del_stopwatch(sw);
  del_hmatrix(hm);

  del_cluster(root);
  del_clustergeometry(cg);
  del_sparsematrix(sp);
  freemem(idx);
  (void) printf("  %u matrices and\n"
		"  %u vectors still active\n",
		getactives_amatrix(), getactives_avector());
  uninit_h2lib();
  printf("The end\n");
  return 0;
}
Beispiel #3
0
int main (int argc, char **argv) {
  
  uint prob;		/* Used for selecting the problem: 2d or 3d? */
  uint L;		/* Number of grid refinements */
  uint clf;		/* Leafsize */
  uint clustermode;	/* Used for selecting the cluster strategy */ 
  uint decomp;		/* Used for selecting the type of the decomposition */
  uint i, j;		/* Auxiliary variables for loops */
  ptri2d *gr_2d;	/* 2d mesh hierarchy */
  ptri2drt0 rt0_2d;	/* Raviart_Thomas functions in 2d */	
  ptet3d *gr_3d;	/* 3d mesh hierarchy */
  ptet3drt0 rt0_3d;	/* Raviart-Thomas functions in 3d */
  psparsematrix sp_A, sp_B;	/* Sparsematrix object*/
  pavector k;		/* Vector for permeabilities */
  uint ndof;		/* Number of degree of freedom */
  uint *idx_B_rows, *idx_B_cols;	/* Array of indices for the clustergeometry */
  pclustergeometry cg_B_rows, cg_B_cols;/* Clustergeometry object */
  uint dim;		/* Dimension for domain decomposition clustering */
  pcluster root_B_cols, root_B_rows;	/* Cluster tree object */
  pblock broot_A, broot_B;		/* Block cluster tree object */
  real eta;		/* Admissibilty parameter*/
  phmatrix hm_A, hm_B;	/* Hierarchical matrices*/
  real tol_decomp;	/* Tolerance for decompositions*/
  real tol_coarsen;	/* Tolerance for coarsening of the hierarchical matrix */
  phmatrix l;		/* Hierarchical matrices for storing the cholesky factor*/
  ptruncmode tm;	/* Truncmode for truncations within the arithmetic */
  real error;		/* Auxiliary variable for testing*/
  pstopwatch sw;	/* Stopwatch for time measuring */
  real time;		/* Variable for time measurement */
  size_t sz, sz_rk, sz_full; /* Variables for memory footprint */
  uint elements;	/*Auxiliary variable: numberof elements*/
  
  /* First initialise the library */
  init_h2lib(&argc, &argv);	
  
  /*Initialise variables*/  
  eta = 2.0;
  tol_coarsen = 1e-16;
  tm = new_releucl_truncmode();
  sw = new_stopwatch();
  
  /* Set problme parameters */
  printf("Select problem\n");
  prob = askforint("1 = fem2d,\t 2 = fem3d\t \n","h2lib_fem", 1);
  L = askforint("Refinement?\n", "h2lib_L", 4);
  clf = askforint("Leafsize?\n", "h2lib_clf", 32);
  clustermode = askforint("1 = adaptive, \t 2 = adaptive from cluster", "h2lib_clusterstrategy", 2);
  decomp = askforint("1 = LU-decomposition of hm_A,\t, 2 = cholesky-decomposition of hm_A\n","h2lib_decomp",1);
  tol_decomp = askforreal("tol_decomp=?\n", "h2lib_tol_decomp", 1e-13);
  
  /* Build geomtery and discretisation for Darcy's equation */
  if(prob==1){
    printf("========================================\n"
	   "  Create and fill fem2d sparsematrix\n");
    /* Mesh hierarchy */
    gr_2d = (ptri2d *) allocmem((size_t) sizeof(ptri2d) * (L+1)); 
    gr_2d[0] = new_unitsquare_tri2d(); /* Set domain */
    //gr_2d[0]=new_unitcircle_tri2d();
    //gr_2d[0] = new_lshape_tri2d();
    for(i=0;i<L;i++){ /* Mesh refinements */
     gr_2d[i+1] = refine_tri2d(gr_2d[i], NULL); 
     fixnormals_tri2d(gr_2d[i]);
    }
    fixnormals_tri2d(gr_2d[i]);
    check_tri2d(gr_2d[L]); /*Check mesh for inconsistencies */
    rt0_2d = new_tri2drt0(gr_2d[L]); /*Build discretisation */
    set_boundary_unitsquare_tri2drt0(rt0_2d);  
    update_tri2drt0(rt0_2d);
    sp_A = build_tri2drt0_A_sparsematrix(rt0_2d); /*Build corresponding sparsematrices */
    sp_B = build_tri2drt0_B_sparsematrix(rt0_2d);
    k = new_avector(gr_2d[L]->triangles); /*Build and fill vector for the permeabilities */
    function_permeability_2d(gr_2d[L], k);
    assemble_tri2drt0_darcy_A_sparsematrix(rt0_2d, sp_A, 0, k); /*Fill the sparsematrices */
    assemble_tri2drt0_darcy_B_sparsematrix(rt0_2d, sp_B, 0);
    ndof = rt0_2d->ndof;printf("ndof = %u\n", ndof);
    /*Initialise index arrays for the cluster geometries */
    idx_B_rows = allocuint(rt0_2d->t2->triangles); 
    for(i=0;i<rt0_2d->t2->triangles;i++)
      idx_B_rows[i]  = i;
    idx_B_cols = allocuint(rt0_2d->ndof);
    for(i=0;i<rt0_2d->ndof;i++)
      idx_B_cols[i] = i;
    /* Build clustergeomtries for the problem */
    cg_B_rows = build_tri2drt0_B_clustergeometry(rt0_2d, idx_B_rows);
    cg_B_cols = build_tri2drt0_A_clustergeometry(rt0_2d, idx_B_cols);
    elements = gr_2d[L]->triangles;
    del_tri2drt0(rt0_2d);
    for(i=0;i<=L;i++){
      j =  L-i;
      del_tri2d(gr_2d[j]);
    }
    freemem(gr_2d);
    del_avector(k);
    dim = 2; /* Set dimenison for domain decomposition clustering */
  }
  else { assert(prob==2); 
    printf("========================================\n"
	   "  Create and fill fem3d sparsematrix\n");
    /* Mesh hierarchy */
    gr_3d = (ptet3d *) allocmem((size_t) sizeof(ptet3d) * (L+1));
    gr_3d[0] = new_unitcube_tet3d(); /* Set domain */
    for(i=0;i<L;i++){
      gr_3d[i+1] = refine_tet3d(gr_3d[i],NULL); 
      fixnormals_tet3d(gr_3d[i]);
    }
    fixnormals_tet3d(gr_3d[i]);
    check_tet3d(gr_3d[L]); /*Check mesh for inconsistencies */
    rt0_3d = new_tet3drt0(gr_3d[L]); /*build discretisation */
    set_boundary_unitcube_tet3drt0(rt0_3d);  
    update_tet3drt0(rt0_3d);
    sp_A = build_tet3drt0_A_sparsematrix(rt0_3d); /*Build corresponding sparsematrices*/
    sp_B = build_tet3drt0_B_sparsematrix(rt0_3d);
    k = new_avector(gr_3d[L]->tetrahedra); /* Build and fill vector for the permeabilities */
    function_permeability_3d(gr_3d[L], k);
    assemble_tet3drt0_darcy_A_sparsematrix(rt0_3d, sp_A, 0, k); /*Fill the sparsematrices*/
    assemble_tet3drt0_darcy_B_sparsematrix(rt0_3d, sp_B, 0);
    ndof = rt0_3d->ndof;printf("ndof = %u\n", ndof);
    /*Initialise index arrays for the cluster geometries */
    idx_B_rows = allocuint(rt0_3d->t3->tetrahedra); 
    for(i=0;i<rt0_3d->t3->tetrahedra;i++)
      idx_B_rows[i]  = i;
    idx_B_cols = allocuint(rt0_3d->ndof);
    for(i=0;i<rt0_3d->ndof;i++)
      idx_B_cols[i] = i;
    /* Build clustergeomtries for the problem */
    cg_B_rows = build_tet3drt0_B_clustergeometry(rt0_3d, idx_B_rows);
    cg_B_cols = build_tet3drt0_A_clustergeometry(rt0_3d, idx_B_cols);
    elements = gr_3d[L]->tetrahedra;
    del_tet3drt0(rt0_3d);
    for(i=0;i<=L;i++){
      j = L -i;
      del_tet3d(gr_3d[j]);
    }
    freemem(gr_3d);
    del_avector(k);
    dim = 3;
  }
  
  /* Build and fill the corresponding hierarchical matrices*/
  printf("========================================\n"
	 "  Create and fill hierarchical matrix\n");
  if(clustermode ==1){
    /* Build cluster trees based on adaptive clustering*/
    root_B_rows = build_cluster(cg_B_rows, elements, idx_B_rows, clf, H2_ADAPTIVE); 
    root_B_cols = build_cluster(cg_B_cols, ndof,     idx_B_cols, clf, H2_ADAPTIVE);
    /*Build block cluster trees using the euclidian (maximum) admissibilty condition*/
    broot_B = build_nonstrict_block(root_B_rows, root_B_cols, &eta, admissible_2_cluster);
    broot_A = build_nonstrict_block(root_B_cols, root_B_cols, &eta, admissible_2_cluster);
    /*Build hierarchical matrices from block*/
    hm_A = build_from_block_hmatrix(broot_A, 0);
    hm_B = build_from_block_hmatrix(broot_B, 0);
    /*Fill hierarchical matrices with sparsematrix entries*/
    copy_sparsematrix_hmatrix(sp_A, hm_A);
    copy_sparsematrix_hmatrix(sp_B, hm_B);
    /* Compute error */
    printf("sp_A: rows %u cols: %u\n", sp_A->rows, sp_A->cols);
    printf("sp_B: rows %u cols: %u\n", sp_B->rows, sp_B->cols);
    printf("hm_A: rows %u cols: %u\n", hm_A->rc->size, hm_A->cc->size);
    printf("hm_B: rows %u cols: %u\n", hm_B->rc->size, hm_B->cc->size);
    error = norm2diff_sparsematrix_hmatrix(hm_A, sp_A);
    printf("error A = %g\n", error);
    error = norm2diff_sparsematrix_hmatrix(hm_B, sp_B);
    printf("error B = %g\n", error);
    del_block(broot_A);
    del_block(broot_B);
  }
  else{ /*clustermode == 2*/
    /* Build cluster tree based on adaptive clustering */
    root_B_rows = build_cluster(cg_B_rows, elements, idx_B_rows, clf, H2_ADAPTIVE); 
    /* Build cluster tree based adaptive doamin decomposition clustering */
    root_B_cols = build_adaptive_fromcluster_cluster(root_B_rows, cg_B_cols, ndof, idx_B_cols, clf, dim);
   // freemem(flag);
    /* Build block cluster trees using the domain decompostion admissibilty (rt0) condition*/
    broot_B = build_nonstrict_block(root_B_rows, root_B_cols, &eta, admissible_2_cluster);
    //broot_B = build_nonstrict_block(root_B_rows, root_B_cols, &eta, admissible_dd_rt0_cluster);
    broot_A = build_nonstrict_block(root_B_cols, root_B_cols, &eta, admissible_dd_cluster);
    /* Build hierarchical matrices from block cluster tree*/
    hm_A = build_from_block_hmatrix(broot_A, 0);
    hm_B = build_from_block_hmatrix(broot_B, 0);
    /* Fill hierarchical matrices with sparsematrix entries*/
    copy_sparsematrix_hmatrix(sp_A, hm_A);
    copy_sparsematrix_hmatrix(sp_B, hm_B);
    /* Compute error */
    printf("sp_A: rows %u cols: %u\n", sp_A->rows, sp_A->cols);
    printf("sp_B: rows %u cols: %u\n", sp_B->rows, sp_B->cols);
    printf("hm_A: rows %u cols: %u\n", hm_A->rc->size, hm_A->cc->size);
    printf("hm_B: rows %u cols: %u\n", hm_B->rc->size, hm_B->cc->size);
    error = norm2diff_sparsematrix_hmatrix(hm_A, sp_A);
    printf("error A = %g\n", error);
    error = norm2diff_sparsematrix_hmatrix(hm_B, sp_B);
    printf("error B = %g\n", error);
    del_block(broot_A);
    del_block(broot_B);
  }
    
    /* Draw hierarchical matrix with cairo */
#if 0
    #ifdef USE_CAIRO
    cairo_t *cr;
    printf("Draw hmatrix to \"hm_p1.pdf\"\n");
    cr = new_cairopdf("../hm_p1.pdf", 1024.0, 1024.0);
    draw_cairo_hmatrix(cr, hm, false, 0);
    cairo_destroy(cr);
    #endif
#endif

  /*Compute size of the hierarchical matrix A*/
  sz = getsize_hmatrix(hm_A);
  sz_rk = getfarsize_hmatrix(hm_A);
  sz_full = getnearsize_hmatrix(hm_A);
  printf("matrix A:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	 sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
  printf("Coarsen hmatrix\n");
  
  /*Coarsening of the hierarchical matrix A to safe storage */
  coarsen_hmatrix(hm_A, tm, tol_coarsen, true);
  
  /* Compute size of the hierarchical matrix A after coarsening*/
  sz = getsize_hmatrix(hm_A);
  sz_rk = getfarsize_hmatrix(hm_A);
  sz_full = getnearsize_hmatrix(hm_A);
  printf("matrix A:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
  /* Compute error after coarseing */  
  error = norm2diff_sparsematrix_hmatrix(hm_A, sp_A);
  printf("error = %g\n", error);
  
  /*Compute size of the hierarchical matrix B */
  sz = getsize_hmatrix(hm_B);
  sz_rk = getfarsize_hmatrix(hm_B);
  sz_full = getnearsize_hmatrix(hm_B);
  printf("matrix B:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	 sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
  printf("Coarsen hmatrix\n");
  
  /*Coarsening of the hierarchical matrix B to safe storage */
  coarsen_hmatrix(hm_B, tm, tol_coarsen, true);
  
  /* Compute size of the hierarchical matrix B after coarsening*/
  sz = getsize_hmatrix(hm_B);
  sz_rk = getfarsize_hmatrix(hm_B);
  sz_full = getnearsize_hmatrix(hm_B);
  printf("matrix B:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
  printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
  /* Compute error after coarseing */  
  error = norm2diff_sparsematrix_hmatrix(hm_B, sp_B);
  printf("error = %g\n", error);
  
  /* Compute decomposition of the hierarchical matrix A */
  if(decomp == 1){
    printf("========================================\n"
	 "  Test lu-decomposition (A)\n");
    /*Compute size of the hierarchical matrix*/
    sz = getsize_hmatrix(hm_A);
    printf("size original matrix:\t \t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
    /*Compute lu-decomposition of the hierarchical matrix*/
    start_stopwatch(sw);
    lrdecomp_hmatrix(hm_A, 0, tol_decomp); 
    time = stop_stopwatch(sw);
    /*Compute size of the lu-decomposition*/
    sz = getsize_hmatrix(hm_A);
    sz_rk = getfarsize_hmatrix(hm_A);
    sz_full = getnearsize_hmatrix(hm_A);
    printf("size lu-decomposition (lu):\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n", 
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
    printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
    printf("time = %f s\n", time);

    /*Compute error*/
    error = norm2lu_sparsematrix(hm_A, sp_A);
    printf("||I-(lu)^-1 sp||_2 ");
    printf("error = %g\n", error);
  }
  else{ /*decomp == 2*/
    printf("========================================\n"
	 "  Test cholesky-decomposition (A)\n");
    /*Compute size of the hierarchical matrix*/
    sz = getsize_hmatrix(hm_A);
    printf("size original matrix:\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n",
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
    /* Compute cholesky-decomposition*/
    start_stopwatch(sw);
    choldecomp_hmatrix(hm_A, 0, tol_decomp);
    time = stop_stopwatch(sw);
    /* Compute size of the cholesky-factor*/
    l = clone_lower_hmatrix(false, hm_A);
    sz = getsize_hmatrix(l);
    sz_rk = getfarsize_hmatrix(l);
    sz_full = getnearsize_hmatrix(l);
    printf("size chol-decomposition (l):\t %.2f MB \t %.2f KB \t %.2f KB/DoF\n", 
	   sz/1024.0/1024.0, sz/1024.0, sz/1024.0/ndof);
    printf("size rk: \t %.2f MB\t size full: \t %.2f MB \n", sz_rk/1024.0/1024.0, sz_full
            /1024.0/1024.0);
    printf("time = %f s\n", time);

    /* Compute error */
    error = norm2chol_sparsematrix(hm_A, sp_A);
    printf("||I-(ll*)^-1 sp||_2 ");
    printf("error = %g\n", error);

    del_hmatrix(l);
  }
  
  /*Cleaning up*/
  del_truncmode(tm);
  del_stopwatch(sw);
  del_hmatrix(hm_A); del_hmatrix(hm_B);
  
  
  del_cluster(root_B_cols); del_cluster(root_B_rows);
  del_clustergeometry(cg_B_rows); del_clustergeometry(cg_B_cols);
  del_sparsematrix(sp_A); del_sparsematrix(sp_B);
  freemem(idx_B_rows); freemem(idx_B_cols);
  (void) printf("  %u matrices and\n"
    "  %u vectors still active\n",
    getactives_amatrix(),
    getactives_avector());
  uninit_h2lib();
  printf("The end\n");
  return 0;
}