static void
test_hmatrix_system(const char *apprxtype, pcamatrix Vfull,
pcamatrix KMfull, pblock block, pbem2d bem_slp,
phmatrix V, pbem2d bem_dlp, phmatrix KM, bool exterior)
{
pavector x, b;
real errorV, errorKM, error_solve, eps_solve;
uint steps;
eps_solve = 1.0e-12;
steps = 1000;
printf("Testing: %s Hmatrix %s\n"
"====================================\n\n",
(exterior == true ? "exterior" : "interior"), apprxtype);
assemble_bem2d_hmatrix(bem_slp, block, V);
assemble_bem2d_hmatrix(bem_dlp, block, KM);
errorV = norm2diff_amatrix_hmatrix(V, Vfull) / norm2_amatrix(Vfull);
printf("rel. error V : %.5e\n", errorV);
errorKM = norm2diff_amatrix_hmatrix(KM, KMfull) / norm2_amatrix(KMfull);
printf("rel. error K%c0.5*M : %.5e\n", (exterior == true ? '-' : '+'),
errorKM);
x = new_avector(Vfull->rows);
b = new_avector(KMfull->cols);
printf("Solving Dirichlet problem:\n");
projectl2_bem2d_const_avector(bem_dlp,
eval_dirichlet_quadratic_laplacebem2d, x);
clear_avector(b);
addeval_hmatrix_avector(1.0, KM, x, b);
solve_cg_bem2d(HMATRIX, V, b, x, eps_solve, steps);
if (exterior == true) {
scale_avector(-1.0, x);
}
error_solve = L2gamma_c_diff_norm2(bem_slp, x,
eval_neumann_quadratic_laplacebem2d);
clear_avector(x);
error_solve = error_solve
/ L2gamma_c_diff_norm2(bem_slp, x, eval_neumann_quadratic_laplacebem2d);
printf("rel. error neumann : %.5e %s\n", error_solve,
(IS_IN_RANGE(3.0e-3, error_solve, 4.0e-3) ? " okay" :
"NOT okay"));
if (!IS_IN_RANGE(3.0e-3, error_solve, 4.0e-3))
problems++;
printf("\n");
del_avector(x);
del_avector(b);
}
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);
}
static void
print_tree(pcclusteroperator co, uint level)
{
uint i;
for (i = 0; i < level; i++)
printf(" ");
printf("%u %u %.4g\n", co->krow, co->kcol, norm2_amatrix(&(co->C)));
for (i = 0; i < co->sons; i++)
print_tree(co->son[i], level + 1);
}
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;
}
static void
norm2diff(pcclusteroperator co1, pcclusteroperator co2, uint level)
{
uint i;
for (i = 0; i < level; i++)
printf(" ");
if (co1->sons != co2->sons)
printf("Tree mismatch ");
if (co1->krow != co2->krow || co1->kcol != co2->kcol)
printf("Dimension mismatch\n");
else
printf("%g %g\n",
norm2_amatrix(&co1->C), norm2diff_amatrix(&co1->C, &co2->C));
if (co1->sons == co2->sons)
for (i = 0; i < co1->sons; i++)
norm2diff(co1->son[i], co2->son[i], level + 1);
}
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);
}
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);
}
static void
test_h2matrix_system(const char *apprxtype, pcamatrix Vfull,
pcamatrix KMfull, pblock block, pbem3d bem_slp,
ph2matrix V, pbem3d bem_dlp, ph2matrix KM, bool linear,
bool exterior, real low, real high)
{
struct _eval_A eval;
helmholtz_data hdata;
pavector x, b;
real errorV, errorKM, error_solve, eps_solve;
uint steps;
boundary_func3d rhs = (boundary_func3d) rhs_dirichlet_point_helmholtzbem3d;
eps_solve = 1.0e-12;
steps = 1000;
printf("Testing: %s H2matrix %s\n"
"====================================\n\n",
(exterior == true ? "exterior" : "interior"), apprxtype);
assemble_bem3d_h2matrix_row_clusterbasis(bem_slp, V->rb);
assemble_bem3d_h2matrix_col_clusterbasis(bem_slp, V->cb);
SCHEDULE_OPENCL(0, 1, assemble_bem3d_h2matrix, bem_slp, block, V);
assemble_bem3d_h2matrix_row_clusterbasis(bem_dlp, KM->rb);
assemble_bem3d_h2matrix_col_clusterbasis(bem_dlp, KM->cb);
SCHEDULE_OPENCL(0, 1, assemble_bem3d_h2matrix, bem_dlp, block, KM);
eval.V = V;
eval.Vtype = H2MATRIX;
eval.KM = KM;
eval.KMtype = H2MATRIX;
eval.eta =
REAL_SQRT(ABSSQR(bem_slp->kvec[0]) + ABSSQR(bem_slp->kvec[1]) +
ABSSQR(bem_slp->kvec[2]));
hdata.kvec = bem_slp->kvec;
hdata.source = allocreal(3);
if (exterior) {
hdata.source[0] = 0.0, hdata.source[1] = 0.0, hdata.source[2] = 0.2;
}
else {
hdata.source[0] = 0.0, hdata.source[1] = 0.0, hdata.source[2] = 5.0;
}
errorV = norm2diff_amatrix_h2matrix(V, Vfull) / norm2_amatrix(Vfull);
printf("rel. error V : %.5e\n", errorV);
errorKM = norm2diff_amatrix_h2matrix(KM, KMfull) / norm2_amatrix(KMfull);
printf("rel. error K%c0.5*M : %.5e\n", (exterior == true ? '-' : '+'),
errorKM);
x = new_avector(Vfull->rows);
b = new_avector(KMfull->cols);
printf("Solving Dirichlet problem:\n");
integrate_bem3d_const_avector(bem_dlp, rhs, b, (void *) &hdata);
solve_gmres_bem3d(HMATRIX, &eval, b, x, eps_solve, steps);
error_solve = max_rel_outer_error(bem_slp, &hdata, x, rhs);
printf("max. rel. error : %.5e %s\n", error_solve,
(IS_IN_RANGE(low, error_solve, high) ? " okay" : "NOT okay"));
if (!IS_IN_RANGE(low, error_solve, high))
problems++;
printf("\n");
del_avector(x);
del_avector(b);
freemem(hdata.source);
}
