void replace_entry(ENTRY *pe)
{
retrieve_block(pci->level, CB(pci->level));
pe->idxptr = ENT_ADR(block_ptr, CO(pci->level))->idxptr;
del_block(block_ptr, CO(pci->level));
prev_entry(CO(pci->level));
insert_ix(pe, pci);
}
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;
}
int
main(int argc, char **argv)
{
pcurve2d gr;
pamatrix Vfull, KMfull;
pbem2d bem_slp, bem_dlp;
pcluster root;
pblock block;
phmatrix V, KM;
pclusterbasis Vrb, Vcb, KMrb, KMcb;
ph2matrix V2, KM2;
uint n, q, clf, m, l;
real eta, delta, eps_aca;
init_h2lib(&argc, &argv);
n = 579;
q = 2;
clf = 16;
eta = 1.0;
gr = new_circle_curve2d(n, 0.333);
bem_slp = new_slp_laplace_bem2d(gr, q, BASIS_CONSTANT_BEM2D);
bem_dlp = new_dlp_laplace_bem2d(gr, q, BASIS_CONSTANT_BEM2D,
BASIS_CONSTANT_BEM2D, 0.5);
root = build_bem2d_cluster(bem_slp, clf, BASIS_CONSTANT_BEM2D);
block = build_nonstrict_block(root, root, &eta, admissible_max_cluster);
Vfull = new_amatrix(n, n);
KMfull = new_amatrix(n, n);
bem_slp->nearfield(NULL, NULL, bem_slp, false, Vfull);
bem_dlp->nearfield(NULL, NULL, bem_dlp, false, KMfull);
V = build_from_block_hmatrix(block, 0);
KM = build_from_block_hmatrix(block, 0);
printf("----------------------------------------\n");
printf("Testing inner Boundary integral equations:\n");
printf("----------------------------------------\n\n");
/*
* Test Interpolation
*/
m = 9;
setup_hmatrix_aprx_inter_row_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_row_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
setup_hmatrix_aprx_inter_col_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_col_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation column", Vfull, KMfull, block, bem_slp,
V, bem_dlp, KM, false);
setup_hmatrix_aprx_inter_mixed_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_mixed_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
/*
* Test Green
*/
m = 10;
l = 2;
delta = 0.5;
setup_hmatrix_aprx_green_row_bem2d(bem_slp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_row_bem2d(bem_dlp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Green row", Vfull, KMfull, block, bem_slp, V, bem_dlp,
KM, false);
setup_hmatrix_aprx_green_col_bem2d(bem_slp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_col_bem2d(bem_dlp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Green column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
setup_hmatrix_aprx_green_mixed_bem2d(bem_slp, root, root, block, m, l,
delta, build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_mixed_bem2d(bem_dlp, root, root, block, m, l,
delta, build_bem2d_rect_quadpoints);
test_hmatrix_system("Green mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
/*
* Test Greenhybrid
*/
m = 3;
l = 1;
delta = 1.0;
eps_aca = 1.0e-7;
setup_hmatrix_aprx_greenhybrid_row_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_row_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
setup_hmatrix_aprx_greenhybrid_col_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_col_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
setup_hmatrix_aprx_greenhybrid_mixed_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_mixed_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
/*
* Test ACA / PACA / HCA
*/
m = 4;
eps_aca = 1.0e-6;
setup_hmatrix_aprx_aca_bem2d(bem_slp, root, root, block, eps_aca);
setup_hmatrix_aprx_aca_bem2d(bem_dlp, root, root, block, eps_aca);
test_hmatrix_system("ACA full pivoting", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false);
setup_hmatrix_aprx_paca_bem2d(bem_slp, root, root, block, eps_aca);
setup_hmatrix_aprx_paca_bem2d(bem_dlp, root, root, block, eps_aca);
test_hmatrix_system("ACA partial pivoting", Vfull, KMfull, block, bem_slp,
V, bem_dlp, KM, false);
setup_hmatrix_aprx_hca_bem2d(bem_slp, root, root, block, m, eps_aca);
setup_hmatrix_aprx_hca_bem2d(bem_dlp, root, root, block, m, eps_aca);
test_hmatrix_system("HCA2", Vfull, KMfull, block, bem_slp, V, bem_dlp, KM,
false);
/*
* H2-matrix
*/
del_hmatrix(V);
del_hmatrix(KM);
del_block(block);
block = build_strict_block(root, root, &eta, admissible_max_cluster);
Vrb = build_from_cluster_clusterbasis(root);
Vcb = build_from_cluster_clusterbasis(root);
KMrb = build_from_cluster_clusterbasis(root);
KMcb = build_from_cluster_clusterbasis(root);
V2 = build_from_block_h2matrix(block, Vrb, Vcb);
KM2 = build_from_block_h2matrix(block, KMrb, KMcb);
/*
* Test Interpolation
*/
m = 9;
setup_h2matrix_aprx_inter_bem2d(bem_slp, Vrb, Vcb, block, m);
setup_h2matrix_aprx_inter_bem2d(bem_dlp, KMrb, KMcb, block, m);
test_h2matrix_system("Interpolation", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, false);
/*
* Test Greenhybrid
*/
m = 3;
l = 1;
delta = 1.0;
eps_aca = 1.0e-7;
setup_h2matrix_aprx_greenhybrid_bem2d(bem_slp, Vrb, Vcb, block, m, l, delta,
eps_aca, build_bem2d_rect_quadpoints);
setup_h2matrix_aprx_greenhybrid_bem2d(bem_dlp, KMrb, KMcb, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_h2matrix_system("Greenhybrid", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, false);
setup_h2matrix_aprx_greenhybrid_ortho_bem2d(bem_slp, Vrb, Vcb, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_h2matrix_aprx_greenhybrid_ortho_bem2d(bem_dlp, KMrb, KMcb, block, m,
l, delta, eps_aca,
build_bem2d_rect_quadpoints);
test_h2matrix_system("Greenhybrid ortho", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, false);
del_h2matrix(V2);
del_h2matrix(KM2);
del_block(block);
del_bem2d(bem_dlp);
printf("----------------------------------------\n");
printf("Testing outer Boundary integral equations:\n");
printf("----------------------------------------\n\n");
bem_dlp = new_dlp_laplace_bem2d(gr, q, BASIS_CONSTANT_BEM2D,
BASIS_CONSTANT_BEM2D, -0.5);
block = build_nonstrict_block(root, root, &eta, admissible_max_cluster);
bem_dlp->nearfield(NULL, NULL, bem_dlp, false, KMfull);
V = build_from_block_hmatrix(block, 0);
KM = build_from_block_hmatrix(block, 0);
/*
* Test Interpolation
*/
m = 9;
setup_hmatrix_aprx_inter_row_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_row_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
setup_hmatrix_aprx_inter_col_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_col_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation column", Vfull, KMfull, block, bem_slp,
V, bem_dlp, KM, true);
setup_hmatrix_aprx_inter_mixed_bem2d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_mixed_bem2d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
/*
* Test Green
*/
m = 10;
l = 2;
delta = 0.5;
setup_hmatrix_aprx_green_row_bem2d(bem_slp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_row_bem2d(bem_dlp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Green row", Vfull, KMfull, block, bem_slp, V, bem_dlp,
KM, true);
setup_hmatrix_aprx_green_col_bem2d(bem_slp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_col_bem2d(bem_dlp, root, root, block, m, l, delta,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Green column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
setup_hmatrix_aprx_green_mixed_bem2d(bem_slp, root, root, block, m, l,
delta, build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_green_mixed_bem2d(bem_dlp, root, root, block, m, l,
delta, build_bem2d_rect_quadpoints);
test_hmatrix_system("Green mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
/*
* Test Greenhybrid
*/
m = 3;
l = 1;
delta = 1.0;
eps_aca = 1.0e-7;
setup_hmatrix_aprx_greenhybrid_row_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_row_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
setup_hmatrix_aprx_greenhybrid_col_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_col_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
setup_hmatrix_aprx_greenhybrid_mixed_bem2d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_hmatrix_aprx_greenhybrid_mixed_bem2d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_hmatrix_system("Greenhybrid mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
/*
* Test ACA / PACA / HCA
*/
m = 4;
eps_aca = 1.0e-6;
setup_hmatrix_aprx_aca_bem2d(bem_slp, root, root, block, eps_aca);
setup_hmatrix_aprx_aca_bem2d(bem_dlp, root, root, block, eps_aca);
test_hmatrix_system("ACA full pivoting", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, true);
setup_hmatrix_aprx_paca_bem2d(bem_slp, root, root, block, eps_aca);
setup_hmatrix_aprx_paca_bem2d(bem_dlp, root, root, block, eps_aca);
test_hmatrix_system("ACA partial pivoting", Vfull, KMfull, block, bem_slp,
V, bem_dlp, KM, true);
setup_hmatrix_aprx_hca_bem2d(bem_slp, root, root, block, m, eps_aca);
setup_hmatrix_aprx_hca_bem2d(bem_dlp, root, root, block, m, eps_aca);
test_hmatrix_system("HCA2", Vfull, KMfull, block, bem_slp, V, bem_dlp, KM,
true);
/*
* H2-matrix
*/
del_hmatrix(V);
del_hmatrix(KM);
del_block(block);
block = build_strict_block(root, root, &eta, admissible_max_cluster);
Vrb = build_from_cluster_clusterbasis(root);
Vcb = build_from_cluster_clusterbasis(root);
KMrb = build_from_cluster_clusterbasis(root);
KMcb = build_from_cluster_clusterbasis(root);
V2 = build_from_block_h2matrix(block, Vrb, Vcb);
KM2 = build_from_block_h2matrix(block, KMrb, KMcb);
/*
* Test Interpolation
*/
m = 9;
setup_h2matrix_aprx_inter_bem2d(bem_slp, Vrb, Vcb, block, m);
setup_h2matrix_aprx_inter_bem2d(bem_dlp, KMrb, KMcb, block, m);
test_h2matrix_system("Interpolation", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, true);
/*
* Test Greenhybrid
*/
m = 3;
l = 1;
delta = 1.0;
eps_aca = 1.0e-7;
setup_h2matrix_aprx_greenhybrid_bem2d(bem_slp, Vrb, Vcb, block, m, l, delta,
eps_aca, build_bem2d_rect_quadpoints);
setup_h2matrix_aprx_greenhybrid_bem2d(bem_dlp, KMrb, KMcb, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
test_h2matrix_system("Greenhybrid", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, true);
setup_h2matrix_aprx_greenhybrid_ortho_bem2d(bem_slp, Vrb, Vcb, block, m, l,
delta, eps_aca,
build_bem2d_rect_quadpoints);
setup_h2matrix_aprx_greenhybrid_ortho_bem2d(bem_dlp, KMrb, KMcb, block, m,
l, delta, eps_aca,
build_bem2d_rect_quadpoints);
test_h2matrix_system("Greenhybrid Ortho", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, true);
del_h2matrix(V2);
del_h2matrix(KM2);
del_block(block);
freemem(root->idx);
del_cluster(root);
del_bem2d(bem_slp);
del_bem2d(bem_dlp);
del_amatrix(Vfull);
del_amatrix(KMfull);
del_curve2d(gr);
(void) printf("----------------------------------------\n"
" %u matrices and\n"
" %u vectors still active\n"
" %u errors found\n", getactives_amatrix(),
getactives_avector(), problems);
uninit_h2lib();
return problems;
}
int
main(int argc, char **argv)
{
pmacrosurface3d mg;
psurface3d gr;
pamatrix Vfull, KMfull;
pbem3d bem_slp, bem_dlp;
pcluster root;
pblock block;
phmatrix V, KM;
pclusterbasis Vrb, Vcb, KMrb, KMcb;
ph2matrix V2, KM2;
uint n, q, clf, m, l;
real eta, delta, eps_aca;
field kvec[3];
cl_device_id *devices;
cl_uint ndevices;
uint *idx;
uint i;
init_h2lib(&argc, &argv);
get_opencl_devices(&devices, &ndevices);
ndevices = 1;
set_opencl_devices(devices, ndevices, 2);
kvec[0] = 2.0, kvec[1] = 0.0, kvec[2] = 0.0;
n = 512;
q = 2;
clf = 16;
eta = 1.0;
mg = new_sphere_macrosurface3d();
gr = build_from_macrosurface3d_surface3d(mg, REAL_SQRT(n * 0.125));
n = gr->triangles;
printf("Testing unit sphere with %d triangles\n", n);
bem_slp = new_slp_helmholtz_ocl_bem3d(kvec, gr, q, q + 2,
BASIS_CONSTANT_BEM3D);
bem_dlp = new_dlp_helmholtz_ocl_bem3d(kvec, gr, q, q + 2,
BASIS_CONSTANT_BEM3D,
BASIS_CONSTANT_BEM3D, 0.5);
root = build_bem3d_cluster(bem_slp, clf, BASIS_CONSTANT_BEM3D);
block = build_nonstrict_block(root, root, &eta, admissible_max_cluster);
max_pardepth = 0;
Vfull = new_amatrix(n, n);
KMfull = new_amatrix(n, n);
idx = allocuint(n);
for (i = 0; i < n; ++i) {
idx[i] = i;
}
SCHEDULE_OPENCL(0, 1, bem_slp->nearfield, idx, idx, bem_slp, false, Vfull);
SCHEDULE_OPENCL(0, 1, bem_dlp->nearfield, idx, idx, bem_dlp, false, KMfull);
V = build_from_block_hmatrix(block, 0);
KM = build_from_block_hmatrix(block, 0);
printf("----------------------------------------\n");
printf("Testing outer Boundary integral equations:\n");
printf("----------------------------------------\n\n");
/*
* Test Interpolation
*/
m = 4;
setup_hmatrix_aprx_inter_row_bem3d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_row_bem3d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_inter_col_bem3d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_col_bem3d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation column", Vfull, KMfull, block, bem_slp,
V, bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_inter_mixed_bem3d(bem_slp, root, root, block, m);
setup_hmatrix_aprx_inter_mixed_bem3d(bem_dlp, root, root, block, m);
test_hmatrix_system("Interpolation mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
/*
* Test Green
*/
m = 5;
l = 1;
delta = 0.5;
setup_hmatrix_aprx_green_row_bem3d(bem_slp, root, root, block, m, l, delta,
build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_green_row_bem3d(bem_dlp, root, root, block, m, l, delta,
build_bem3d_cube_quadpoints);
test_hmatrix_system("Green row", Vfull, KMfull, block, bem_slp, V, bem_dlp,
KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_green_col_bem3d(bem_slp, root, root, block, m, l, delta,
build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_green_col_bem3d(bem_dlp, root, root, block, m, l, delta,
build_bem3d_cube_quadpoints);
test_hmatrix_system("Green column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_green_mixed_bem3d(bem_slp, root, root, block, m, l,
delta, build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_green_mixed_bem3d(bem_dlp, root, root, block, m, l,
delta, build_bem3d_cube_quadpoints);
test_hmatrix_system("Green mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
/*
* Test Greenhybrid
*/
m = 2;
l = 1;
delta = 1.0;
eps_aca = 2.0e-2;
setup_hmatrix_aprx_greenhybrid_row_bem3d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_greenhybrid_row_bem3d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
test_hmatrix_system("Greenhybrid row", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_greenhybrid_col_bem3d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_greenhybrid_col_bem3d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
test_hmatrix_system("Greenhybrid column", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_greenhybrid_mixed_bem3d(bem_slp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
setup_hmatrix_aprx_greenhybrid_mixed_bem3d(bem_dlp, root, root, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
test_hmatrix_system("Greenhybrid mixed", Vfull, KMfull, block, bem_slp, V,
bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
/*
* Test ACA / PACA / HCA
*/
m = 2;
eps_aca = 1.0e-2;
/* Nearfield computation on GPU not applicable here yet! */
// setup_hmatrix_aprx_aca_bem3d(bem_slp, root, root, block, eps_aca);
// setup_hmatrix_aprx_aca_bem3d(bem_dlp, root, root, block, eps_aca);
// test_hmatrix_system("ACA full pivoting", Vfull, KMfull, block, bem_slp, V,
// bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
//
// setup_hmatrix_aprx_paca_bem3d(bem_slp, root, root, block, eps_aca);
// setup_hmatrix_aprx_paca_bem3d(bem_slp, root, root, block, eps_aca);
// test_hmatrix_system("ACA partial pivoting", Vfull, KMfull, block, bem_slp, V,
// bem_dlp, KM, false, true, 1.0e-3, 2.0e-3);
setup_hmatrix_aprx_hca_bem3d(bem_slp, root, root, block, m, eps_aca);
setup_hmatrix_aprx_hca_bem3d(bem_slp, root, root, block, m, eps_aca);
test_hmatrix_system("HCA2", Vfull, KMfull, block, bem_slp, V, bem_dlp, KM,
false, true, 1.0e-3, 2.0e-3);
del_hmatrix(V);
del_hmatrix(KM);
del_block(block);
/*
* H2-matrix
*/
block = build_strict_block(root, root, &eta, admissible_max_cluster);
Vrb = build_from_cluster_clusterbasis(root);
Vcb = build_from_cluster_clusterbasis(root);
KMrb = build_from_cluster_clusterbasis(root);
KMcb = build_from_cluster_clusterbasis(root);
V2 = build_from_block_h2matrix(block, Vrb, Vcb);
KM2 = build_from_block_h2matrix(block, KMrb, KMcb);
/*
* Test Interpolation
*/
m = 3;
setup_h2matrix_aprx_inter_bem3d(bem_slp, Vrb, Vcb, block, m);
setup_h2matrix_aprx_inter_bem3d(bem_dlp, KMrb, KMcb, block, m);
test_h2matrix_system("Interpolation", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, false, true, 1.0e-3, 2.0e-3);
/*
* Test Greenhybrid
*/
m = 2;
l = 1;
delta = 1.0;
eps_aca = 2.0e-2;
setup_h2matrix_aprx_greenhybrid_bem3d(bem_slp, Vrb, Vcb, block, m, l, delta,
eps_aca, build_bem3d_cube_quadpoints);
setup_h2matrix_aprx_greenhybrid_bem3d(bem_dlp, KMrb, KMcb, block, m, l,
delta, eps_aca,
build_bem3d_cube_quadpoints);
test_h2matrix_system("Greenhybrid", Vfull, KMfull, block, bem_slp, V2,
bem_dlp, KM2, false, true, 1.0e-3, 2.0e-3);
/* Nearfield computation on GPU not applicable here yet! */
// setup_h2matrix_aprx_greenhybrid_ortho_bem3d(bem_slp, Vrb, Vcb, block, m, l,
// delta, eps_aca, build_bem3d_cube_quadpoints);
// setup_h2matrix_aprx_greenhybrid_ortho_bem3d(bem_dlp, KMrb, KMcb, block, m, l,
// delta, eps_aca, build_bem3d_cube_quadpoints);
// test_h2matrix_system("Greenhybrid ortho", Vfull, KMfull, block, bem_slp, V2,
// bem_dlp, KM2, false, true, 1.0e-3, 2.0e-3);
del_h2matrix(V2);
del_h2matrix(KM2);
del_block(block);
freemem(root->idx);
del_cluster(root);
del_helmholtz_ocl_bem3d(bem_slp);
del_helmholtz_ocl_bem3d(bem_dlp);
del_amatrix(Vfull);
del_amatrix(KMfull);
del_surface3d(gr);
del_macrosurface3d(mg);
freemem(idx);
(void) printf("----------------------------------------\n"
" %u matrices and\n"
" %u vectors still active\n"
" %u errors found\n", getactives_amatrix(),
getactives_avector(), problems);
uninit_h2lib();
return problems;
}
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;
}
/* BPLUS delete key functions */
int delete_key(ENTRY *pe, IX_DESC *pix)
{
ENTRY e;
RECPOS ads;
int h, leveli, levelf;
if (!find_exact(pe, pix))
{
return (IX_NOTEXISTED);
}
h = 1;
if ((ads = pe->idxptr) != NULLREC)
{
leveli = pci->level;
do
{
retrieve_block(++(pci->level), ads);
CO(pci->level) = -1;
}
while ((ads = block_ptr->p0) != NULLREC);
CO(pci->level) = 0;
copy_entry(&e, ENT_ADR(block_ptr, CO(pci->level)));
levelf = pci->level;
pci->level = leveli;
replace_entry(&e);
pci->level = levelf;
/*update_root(&pci->root);*/
}
while ( h )
{
retrieve_block(pci->level, CB(pci->level));
del_block(block_ptr, CO(pci->level));
update_block();
if ( (pci->level == 0) && (block_ptr->bend == 0))
/* tree was reduced in height */
{
if (pci->root.p0 != NULLREC)
{
retrieve_block(++pci->level, pci->root.p0);
memcpy(&(pci->root), block_ptr, sizeof(BLOCK));
(pci->dx.nl)--;
write_free(block_ptr->brec, block_ptr);
BUFDIRTY(cache_ptr) = 0;
BUFHANDLE(cache_ptr) = 0;
update_root(&pci->root);
}
break;
}
h = (block_ptr->bend < comb_size) && (pci->level > 0);
if ( h )
{
h = combineblk(CB(pci->level), block_ptr->bend);
}
}
/*return flush_index(pix);*/
if(root_dirty == 1)
{
flush_index(pix);
root_dirty = 0;
}
return(IX_OK);
}
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;
}
