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);
}
/* Simple convenience wrapper for conjugate gradient solver */
static void
solve_cg_bem2d(matrixtype type, void *A, pavector b, pavector x,
real accuracy, uint steps)
{
addeval_t addevalA;
pavector r, p, a;
uint i, n;
real norm;
switch (type) {
case AMATRIX:
addevalA = (addeval_t) addeval_amatrix_avector;
break;
case HMATRIX:
addevalA = (addeval_t) addeval_hmatrix_avector;
break;
case H2MATRIX:
addevalA = (addeval_t) addeval_h2matrix_avector;
break;
default:
printf("ERROR: unknown matrix type!\n");
abort();
break;
}
n = b->dim;
assert(x->dim == n);
r = new_avector(n);
p = new_avector(n);
a = new_avector(n);
random_avector(x);
init_cg(addevalA, A, b, x, r, p, a);
for (i = 1; i < steps; i++) {
step_cg(addevalA, A, b, x, r, p, a);
norm = norm2_avector(r);
#ifndef NDEBUG
printf(" Residual: %.5e\t Iterations: %u\r", norm, i);
fflush(stdout);
#endif
if (norm <= accuracy) {
break;
}
}
#ifndef NDEBUG
printf(" Residual: %.5e\t Iterations: %u\n", norm2_avector(r), i);
#endif
del_avector(r);
del_avector(p);
del_avector(a);
}
/* Simple convenience wrapper for GMRES solver */
static void
solve_gmres_bem3d(matrixtype type, void *A, pavector b, pavector x,
real accuracy, uint steps)
{
addeval_t addevalA;
pavector rhat, q, tau;
pamatrix qr;
uint i, j, n, kk, kmax;
real norm;
addevalA = (addeval_t) addeval_A;
kmax = 500;
n = b->dim;
assert(x->dim == n);
qr = new_zero_amatrix(n, kmax);
rhat = new_avector(n);
q = new_avector(n);
tau = new_avector(kmax);
clear_avector(x);
init_gmres(addevalA, A, b, x, rhat, q, &kk, qr, tau);
for (i = 0; i < steps; i += kmax) {
for (j = 0; j < kmax && i + j < steps; ++j) {
step_gmres(addevalA, A, b, x, rhat, q, &kk, qr, tau);
norm = residualnorm_gmres(rhat, kk);
#ifndef NDEBUG
printf(" Residual: %.5e\t Iterations: %u\r", norm, j + i);
fflush(stdout);
#endif
if (norm <= accuracy) {
finish_gmres(addevalA, A, b, x, rhat, q, &kk, qr, tau);
break;
}
}
if (norm <= accuracy) {
break;
}
else {
finish_gmres(addevalA, A, b, x, rhat, q, &kk, qr, tau);
}
}
printf("\n");
del_avector(rhat);
del_avector(q);
del_avector(tau);
del_amatrix(qr);
}
int
main(int argc, char **argv)
{
ptet3d *gr;
ptet3dp1 *dc;
ptet3dref *rf;
psparsematrix A, Af;
pavector xd, b, x;
uint L;
real error;
pstopwatch sw;
real runtime;
uint i;
real eps;
uint steps;
uint iter;
init_h2lib(&argc, &argv);
sw = new_stopwatch();
L = 5;
eps = 1e-12;
steps = 2500;
(void) printf("----------------------------------------\n"
"Creating mesh hierarchy\n");
gr = (ptet3d *) allocmem(sizeof(ptet3d) * (L + 1));
rf = (ptet3dref *) allocmem(sizeof(ptet3dref) * L);
gr[0] = new_unitcube_tet3d();
(void)
printf(" Level %2u: %u vertices, %u edges, %u faces, %u tetrahedra\n", 0,
gr[0]->vertices, gr[0]->edges, gr[0]->faces, gr[0]->tetrahedra);
for (i = 0; i < L; i++) {
gr[i + 1] = refine_tet3d(gr[i], rf + i);
(void)
printf(" Level %2u: %u vertices, %u edges, %u faces, %u tetrahedra\n",
i + 1, gr[i + 1]->vertices, gr[i + 1]->edges, gr[i + 1]->faces,
gr[i + 1]->tetrahedra);
}
(void) printf("Creating discretizations\n");
dc = (ptet3dp1 *) allocmem(sizeof(ptet3dp1) * (L + 1));
for (i = 0; i <= L; i++) {
dc[i] = new_tet3dp1(gr[i]);
(void) printf(" Level %2u: %u degrees of freedom, %u fixed\n",
i, dc[i]->ndof, dc[i]->nfix);
}
for (i = 2; i <= L; i++) {
(void) printf("Testing level %u\n" " Setting up matrix\n", i);
start_stopwatch(sw);
A = build_tet3dp1_sparsematrix(dc[i]);
Af = build_tet3dp1_interaction_sparsematrix(dc[i]);
assemble_tet3dp1_laplace_sparsematrix(dc[i], A, Af);
runtime = stop_stopwatch(sw);
(void) printf(" %.1f seconds\n"
" %.1f MB (interaction %.1f MB)\n"
" %.1f KB/DoF (interaction %.1f KB/DoF)\n"
" %u non-zero entries (interaction %u)\n",
runtime,
getsize_sparsematrix(A) / 1048576.0,
getsize_sparsematrix(Af) / 1048576.0,
getsize_sparsematrix(A) / 1024.0 / dc[i]->ndof,
getsize_sparsematrix(Af) / 1024.0 / dc[i]->ndof,
A->nz, Af->nz);
(void) printf(" Setting up Dirichlet data\n");
xd = new_avector(dc[i]->nfix);
assemble_tet3dp1_dirichlet_avector(dc[i], sin_solution, 0, xd);
(void) printf(" Setting up right-hand side\n");
b = new_avector(dc[i]->ndof);
assemble_tet3dp1_functional_avector(dc[i], sin_rhs, 0, b);
(void) printf(" Starting iteration\n");
x = new_avector(dc[i]->ndof);
random_real_avector(x);
start_stopwatch(sw);
iter = solve_cg_sparsematrix_avector(A, b, x, eps, steps);
runtime = stop_stopwatch(sw);
(void) printf(" %u CG iterations\n", iter);
(void) printf("\n"
" %.1f seconds\n"
" %.1f seconds per step\n", runtime, runtime / iter);
error = norml2_tet3dp1(dc[i], sin_solution, 0, x, xd);
(void) printf(" rel. L^2 error %.4e %s\n", error,
(IS_IN_RANGE(1.0e-3, error, 9.0e-2) ? " okay" :
"NOT okay"));
if (!IS_IN_RANGE(1.0e-3, error, 9.0e-2))
problems++;
del_avector(x);
del_avector(b);
del_avector(xd);
del_sparsematrix(Af);
del_sparsematrix(A);
}
(void) printf("----------------------------------------\n" "Cleaning up\n");
for (i = 0; i <= L; i++)
del_tet3dp1(dc[i]);
freemem(dc);
for (i = 0; i < L; i++)
del_tet3dref(rf[i]);
freemem(rf);
for (i = 0; i <= L; i++)
del_tet3d(gr[i]);
freemem(gr);
del_stopwatch(sw);
uninit_h2lib();
return problems;
}
int
main()
{
pamatrix a, acopy, l, ld, r, q, qr;
pavector x, b, tau;
uint rows, cols;
real error;
rows = 8;
cols = 5;
(void) printf("----------------------------------------\n"
"Check random %u x %u Cholesky factorization\n", rows, rows);
(void) printf("Creating random self-adjoint positive definite matrix\n");
a = new_amatrix(rows, rows);
random_spd_amatrix(a, 1.0);
(void) printf("Creating random solution and right-hand side\n");
x = new_avector(rows);
random_avector(x);
b = new_avector(rows);
clear_avector(b);
mvm_amatrix_avector(1.0, false, a, x, b);
(void) printf("Copying matrix\n");
acopy = new_amatrix(rows, rows);
copy_amatrix(false, a, acopy);
(void) printf("Computing Cholesky factorization\n");
choldecomp_amatrix(a);
(void) printf("Solving\n");
cholsolve_amatrix_avector(a, b);
add_avector(-1.0, x, b);
error = norm2_avector(b);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Building triangular factor\n");
l = new_amatrix(rows, rows);
copy_lower_amatrix(a, false, l);
(void) printf("Checking factorization\n");
copy_amatrix(false, acopy, a);
addmul_amatrix(-1.0, false, l, true, l, a);
error = normfrob_amatrix(a);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
del_amatrix(l);
del_amatrix(acopy);
del_avector(b);
del_avector(x);
del_amatrix(a);
(void) printf("----------------------------------------\n"
"Check random %u x %u LDL^T factorization\n", rows, rows);
(void) printf("Creating random self-adjoint positive definite matrix\n");
a = new_amatrix(rows, rows);
random_spd_amatrix(a, 1.0);
(void) printf("Creating random solution and right-hand side\n");
x = new_avector(rows);
random_avector(x);
b = new_avector(rows);
clear_avector(b);
mvm_amatrix_avector(1.0, false, a, x, b);
(void) printf("Copying matrix\n");
acopy = new_amatrix(rows, rows);
copy_amatrix(false, a, acopy);
(void) printf("Computing LDL^T factorization\n");
ldltdecomp_amatrix(a);
(void) printf("Solving\n");
ldltsolve_amatrix_avector(a, b);
add_avector(-1.0, x, b);
error = norm2_avector(b);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Building triangular factor\n");
l = new_amatrix(rows, rows);
copy_lower_amatrix(a, true, l);
(void) printf("Multiplying by diagonal\n");
ld = new_amatrix(rows, rows);
copy_amatrix(false, l, ld);
diageval_amatrix(true, a, true, ld);
(void) printf("Checking factorization\n");
copy_amatrix(false, acopy, a);
addmul_amatrix(-1.0, false, ld, true, l, a);
error = normfrob_amatrix(a);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
del_amatrix(ld);
del_amatrix(l);
del_amatrix(acopy);
del_avector(b);
del_avector(x);
del_amatrix(a);
(void) printf("----------------------------------------\n"
"Check random %u x %u LR factorization\n", rows, rows);
(void) printf("Creating random invertible matrix\n");
a = new_amatrix(rows, rows);
random_invertible_amatrix(a, 1.0);
(void) printf("Creating random solution and right-hand side\n");
x = new_avector(rows);
random_avector(x);
b = new_avector(rows);
clear_avector(b);
mvm_amatrix_avector(1.0, false, a, x, b);
(void) printf("Copying matrix\n");
acopy = new_amatrix(rows, rows);
copy_amatrix(false, a, acopy);
(void) printf("Computing LR factorization\n");
lrdecomp_amatrix(a);
(void) printf("Solving\n");
lrsolve_amatrix_avector(a, b);
add_avector(-1.0, x, b);
error = norm2_avector(b);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Building triangular factors\n");
l = new_amatrix(rows, rows);
r = new_amatrix(rows, rows);
copy_lower_amatrix(a, true, l);
copy_upper_amatrix(a, false, r);
(void) printf("Checking factorization\n");
copy_amatrix(false, acopy, a);
addmul_amatrix(-1.0, false, l, false, r, a);
error = normfrob_amatrix(a);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
/* Check forward/backward substitution */
(void) printf("----------------------------------------\n");
check_triangularsolve(true, true, false, l, false);
check_triangularsolve(true, true, false, l, true);
check_triangularsolve(true, true, true, l, false);
check_triangularsolve(true, true, true, l, true);
check_triangularsolve(true, false, false, l, false);
check_triangularsolve(true, false, false, l, true);
check_triangularsolve(true, false, true, l, false);
check_triangularsolve(true, false, true, l, true);
check_triangularsolve(false, false, false, r, false);
check_triangularsolve(false, false, false, r, true);
check_triangularsolve(false, false, true, r, false);
check_triangularsolve(false, false, true, r, true);
set_unit(r);
check_triangularsolve(false, true, false, r, false);
check_triangularsolve(false, true, false, r, true);
check_triangularsolve(false, true, true, r, false);
check_triangularsolve(false, true, true, r, true);
/* Intermediate clean-up */
(void) printf("Cleaning up\n");
del_amatrix(r);
del_amatrix(l);
/* Check triangular matrix multiplication */
(void) printf("----------------------------------------\n");
check_triangularaddmul(false, false, false, false);
check_triangularaddmul(true, false, false, false);
check_triangularaddmul(false, true, false, false);
check_triangularaddmul(true, true, false, false);
check_triangularaddmul(false, false, true, false);
check_triangularaddmul(true, false, true, false);
check_triangularaddmul(false, true, true, false);
check_triangularaddmul(true, true, true, false);
check_triangularaddmul(false, false, false, true);
check_triangularaddmul(true, false, false, true);
check_triangularaddmul(false, true, false, true);
check_triangularaddmul(true, true, false, true);
check_triangularaddmul(false, false, true, true);
check_triangularaddmul(true, false, true, true);
check_triangularaddmul(false, true, true, true);
check_triangularaddmul(true, true, true, true);
/* Checking QR factorization */
(void) printf("----------------------------------------\n"
"Check square QR factorization\n");
copy_amatrix(false, acopy, a);
random_avector(x);
clear_avector(b);
mvm_amatrix_avector(1.0, false, a, x, b);
tau = new_avector(rows);
qrdecomp_amatrix(a, tau);
(void) printf("Solving\n");
qrsolve_amatrix_avector(a, tau, b);
add_avector(-1.0, x, b);
error = norm2_avector(b);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
q = new_amatrix(rows, rows);
qrexpand_amatrix(a, tau, q);
(void) printf("Checking factorization\n");
r = new_amatrix(rows, rows);
copy_upper_amatrix(a, false, r);
qr = new_amatrix(rows, rows);
copy_amatrix(false, acopy, qr);
addmul_amatrix(-1.0, false, q, false, r, qr);
error = normfrob_amatrix(qr);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Checking inverse\n");
copy_amatrix(false, acopy, a);
qrinvert_amatrix(a);
identity_amatrix(qr);
addmul_amatrix(-1.0, false, acopy, false, a, qr);
error = normfrob_amatrix(qr);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
/* Intermediate clean-up */
(void) printf("Cleaning up\n");
del_amatrix(qr);
del_amatrix(r);
del_amatrix(q);
del_avector(tau);
del_avector(b);
del_avector(x);
del_amatrix(acopy);
del_amatrix(a);
/* Check forward/backward evaluation */
(void) printf("----------------------------------------\n");
a = new_amatrix(rows, cols);
random_amatrix(a);
check_lowereval(false, false, a, false);
check_lowereval(false, false, a, true);
check_lowereval(false, true, a, false);
check_lowereval(false, true, a, true);
check_uppereval(false, false, a, false);
check_uppereval(false, false, a, true);
check_uppereval(false, true, a, false);
check_uppereval(false, true, a, true);
set_unit(a);
check_lowereval(true, false, a, false);
check_lowereval(true, false, a, true);
check_lowereval(true, true, a, false);
check_lowereval(true, true, a, true);
check_uppereval(true, false, a, false);
check_uppereval(true, false, a, true);
check_uppereval(true, true, a, false);
check_uppereval(true, true, a, true);
(void) printf("Cleaning up\n");
del_amatrix(a);
a = new_amatrix(cols, rows);
random_amatrix(a);
check_lowereval(false, false, a, false);
check_lowereval(false, false, a, true);
check_lowereval(false, true, a, false);
check_lowereval(false, true, a, true);
check_uppereval(false, false, a, false);
check_uppereval(false, false, a, true);
check_uppereval(false, true, a, false);
check_uppereval(false, true, a, true);
set_unit(a);
check_lowereval(true, false, a, false);
check_lowereval(true, false, a, true);
check_lowereval(true, true, a, false);
check_lowereval(true, true, a, true);
check_uppereval(true, false, a, false);
check_uppereval(true, false, a, true);
check_uppereval(true, true, a, false);
check_uppereval(true, true, a, true);
(void) printf("Cleaning up\n");
del_amatrix(a);
/* Test random QR factorizations */
(void) printf("----------------------------------------\n"
"Check full rectangular QR factorization\n");
a = new_amatrix(rows, cols);
random_amatrix(a);
acopy = new_amatrix(rows, cols);
copy_amatrix(false, a, acopy);
tau = new_avector(rows);
qrdecomp_amatrix(a, tau);
q = new_amatrix(rows, rows);
r = new_amatrix(rows, cols);
qrexpand_amatrix(a, tau, q);
copy_upper_amatrix(a, false, r);
qr = new_amatrix(rows, cols);
copy_amatrix(false, acopy, qr);
addmul_amatrix(-1.0, false, q, false, r, qr);
error = normfrob_amatrix(qr);
printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
del_amatrix(r);
del_amatrix(q);
(void) printf("Check skinny QR factorization\n");
q = new_amatrix(rows, cols);
r = new_amatrix(cols, cols);
qrexpand_amatrix(a, tau, q);
copy_upper_amatrix(a, false, r);
copy_amatrix(false, acopy, qr);
addmul_amatrix(-1.0, false, q, false, r, qr);
error = normfrob_amatrix(qr);
printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
/* Final clean-up */
(void) printf("Cleaning up\n");
del_amatrix(qr);
del_amatrix(r);
del_amatrix(q);
del_avector(tau);
del_amatrix(acopy);
del_amatrix(a);
(void) printf("----------------------------------------\n"
" %u matrices and\n"
" %u vectors still active\n"
" %u errors found\n", getactives_amatrix(),
getactives_avector(), problems);
return problems;
}
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);
}
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;
}
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;
}
int
main()
{
ptridiag T, Tcopy;
pamatrix A, Acopy, Q, U, Vt;
pavector work;
prealavector sigma, lambda;
real error;
uint rows, cols, mid;
uint i, n, iter;
int info;
/* ------------------------------------------------------------
* Testing symmetric tridiagonal eigenvalue solver
* ------------------------------------------------------------ */
n = 6;
/* Testing symmetric tridiagonal eigenvalue solver */
(void) printf("==================================================\n"
"Testing symmetric tridiagonal eigenvalue solver\n"
"==================================================\n"
"Setting up %u x %u tridiagonal matrix\n", n, n);
T = new_tridiag(n);
for (i = 0; i < n; i++)
T->d[i] = 2.0;
for (i = 0; i < n - 1; i++)
T->l[i] = T->u[i] = -1.0;
Tcopy = new_tridiag(n);
copy_tridiag(T, Tcopy);
A = new_amatrix(n, n);
clear_amatrix(A);
for (i = 0; i < n; i++)
A->a[i + i * A->ld] = T->d[i];
for (i = 0; i < n - 1; i++) {
A->a[(i + 1) + i * A->ld] = T->l[i];
A->a[i + (i + 1) * A->ld] = T->u[i];
}
Acopy = clone_amatrix(A);
Q = new_identity_amatrix(n, n);
U = new_amatrix(n, n);
(void) printf("Performing self-made implicit QR iteration\n");
iter = sb_muleig_tridiag(T, Q, 8 * n);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Q, U);
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, true, Q, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g. %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Performing default implicit QR iteration\n");
identity_amatrix(Q);
i = muleig_tridiag(Tcopy, Q);
if (i == 0)
(void) printf(" Success\n");
else {
(void) printf(" Failure\n");
problems++;
}
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Q, U);
diageval_tridiag_amatrix(1.0, true, Tcopy, true, U);
addmul_amatrix(-1.0, false, U, true, Q, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g. %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
del_amatrix(U);
del_amatrix(Q);
del_amatrix(Acopy);
del_amatrix(A);
del_tridiag(Tcopy);
del_tridiag(T);
(void) printf("--------------------------------------------------\n"
"Setting up random %u x %u tridiagonal matrix\n", n, n);
T = new_tridiag(n);
for (i = 0; i < n; i++)
T->d[i] = 2.0 * rand() / RAND_MAX - 1.0;
for (i = 0; i < n - 1; i++) {
T->l[i] = 2.0 * rand() / RAND_MAX - 1.0;
T->u[i] = CONJ(T->l[i]);
}
A = new_amatrix(n, n);
clear_amatrix(A);
for (i = 0; i < n; i++)
A->a[i + i * A->ld] = T->d[i];
for (i = 0; i < n - 1; i++) {
A->a[(i + 1) + i * A->ld] = T->l[i];
A->a[i + (i + 1) * A->ld] = T->u[i];
}
Tcopy = new_tridiag(n);
copy_tridiag(T, Tcopy);
Acopy = clone_amatrix(A);
Q = new_identity_amatrix(n, n);
U = new_amatrix(n, n);
(void) printf("Performing implicit QR iteration\n");
iter = sb_muleig_tridiag(T, Q, 8 * n);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Q, U);
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, true, Q, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
(void) printf("Using default eigenvalue solver\n");
identity_amatrix(Q);
muleig_tridiag(Tcopy, Q);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Q, U);
diageval_tridiag_amatrix(1.0, true, Tcopy, true, U);
addmul_amatrix(-1.0, false, U, true, Q, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : " NOT "));
if (error >= tolerance)
problems++;
del_amatrix(U);
del_amatrix(Q);
del_amatrix(Acopy);
del_amatrix(A);
del_tridiag(Tcopy);
del_tridiag(T);
/* ------------------------------------------------------------
* Testing self-adjoint matrix eigenvalue solver
* ------------------------------------------------------------ */
(void) printf("==================================================\n"
"Testing self-adjoint matrix eigenvalue solver\n"
"==================================================\n"
"Setting up random %u x %u self-adjoint matrix\n", n, n);
A = new_amatrix(n, n);
random_selfadjoint_amatrix(A);
Acopy = new_amatrix(n, n);
copy_amatrix(false, A, Acopy);
lambda = new_realavector(n);
Q = new_identity_amatrix(n, n);
(void) printf("Performing implicit QR iteration\n");
iter = sb_eig_amatrix(A, lambda, Q, 8 * n);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
U = new_amatrix(n, n);
copy_amatrix(false, Q, U);
copy_amatrix(false, Acopy, A);
diageval_realavector_amatrix(1.0, true, lambda, true, U);
addmul_amatrix(-1.0, false, U, true, Q, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
(void) printf("Using default eigenvalue solver\n");
copy_amatrix(false, Acopy, A);
info = eig_amatrix(A, lambda, Q);
assert(info == 0);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, Q);
(void) printf(" Orthogonality Q %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Q, U);
diageval_realavector_amatrix(1.0, true, lambda, true, U);
addmul_amatrix(-1.0, false, U, true, Q, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_amatrix(U);
del_amatrix(Q);
del_realavector(lambda);
del_amatrix(Acopy);
del_amatrix(A);
/* ------------------------------------------------------------
* Testing bidiagonal SVD solver
* ------------------------------------------------------------ */
(void) printf("==================================================\n"
"Testing bidiagonal SVD solver\n"
"==================================================\n"
"Setting up bidiagonal %u x %u matrix\n", n, n);
T = new_tridiag(n);
for (i = 0; i < n; i++)
T->d[i] = i + 1.0;
for (i = 0; i < n - 1; i++) {
T->l[i] = 1.0;
T->u[i] = 0.0;
}
A = new_amatrix(n, n);
clear_amatrix(A);
for (i = 0; i < n; i++)
A->a[i + i * A->ld] = T->d[i];
for (i = 0; i < n - 1; i++)
A->a[(i + 1) + i * A->ld] = T->l[i];
Tcopy = new_tridiag(n);
copy_tridiag(T, Tcopy);
Acopy = new_amatrix(n, n);
copy_amatrix(false, A, Acopy);
U = new_identity_amatrix(n, n);
Vt = new_identity_amatrix(n, n);
(void) printf("Performing self-made implicit SVD iteration\n");
iter = sb_mulsvd_tridiag(T, U, Vt, 8 * n);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
(void) printf("Using default SVD solver\n");
copy_tridiag(Tcopy, T);
identity_amatrix(U);
identity_amatrix(Vt);
mulsvd_tridiag(T, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Acopy, A);
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_tridiag(Tcopy);
del_amatrix(A);
del_tridiag(T);
(void) printf("--------------------------------------------------\n"
"Setting up random bidiagonal %u x %u matrix\n", n, n);
T = new_tridiag(n);
for (i = 0; i < n; i++) {
T->d[i] = 2.0 * rand() / RAND_MAX - 1.0;
}
for (i = 0; i < n - 1; i++) {
T->l[i] = 2.0 * rand() / RAND_MAX - 1.0;
T->u[i] = 0.0;
}
A = new_amatrix(n, n);
clear_amatrix(A);
for (i = 0; i < n; i++)
A->a[i + i * A->ld] = T->d[i];
for (i = 0; i < n - 1; i++)
A->a[(i + 1) + i * A->ld] = T->l[i];
Tcopy = new_tridiag(n);
copy_tridiag(T, Tcopy);
Acopy = clone_amatrix(A);
U = new_identity_amatrix(n, n);
Vt = new_identity_amatrix(n, n);
(void) printf("Performing implicit SVD iteration\n");
iter = sb_mulsvd_tridiag(T, U, Vt, 8 * n);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
(void) printf("Using default SVD solver\n");
copy_tridiag(Tcopy, T);
copy_amatrix(false, Acopy, A);
identity_amatrix(U);
identity_amatrix(Vt);
mulsvd_tridiag(T, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_tridiag(Tcopy);
del_amatrix(A);
del_tridiag(T);
/* ------------------------------------------------------------
* Testing Golub-Kahan bidiagonalization
* ------------------------------------------------------------ */
rows = 10;
cols = 7;
mid = UINT_MIN(rows, cols);
(void) printf("==================================================\n"
"Testing Golub-Kahan bidiagonalization\n"
"==================================================\n"
"Setting up random %u x %u matrix\n", rows, cols);
A = new_amatrix(rows, cols);
random_amatrix(A);
Acopy = new_amatrix(rows, cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(rows, mid);
Vt = new_amatrix(mid, cols);
T = new_tridiag(mid);
(void) printf("Bidiagonalizing\n");
bidiagonalize_amatrix(A, T, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
lowereval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_tridiag(T);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
rows = 8;
cols = 15;
mid = UINT_MIN(rows, cols);
(void) printf("--------------------------------------------------\n"
"Setting up %u x %u matrix\n", rows, cols);
A = new_amatrix(rows, cols);
random_amatrix(A);
Acopy = new_amatrix(rows, cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(rows, mid);
Vt = new_amatrix(mid, cols);
T = new_tridiag(mid);
(void) printf("Bidiagonalizing\n");
bidiagonalize_amatrix(A, T, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
lowereval_tridiag_amatrix(1.0, true, T, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_tridiag(T);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
/* ------------------------------------------------------------
* Testing general SVD solver
* ------------------------------------------------------------ */
(void) printf("==================================================\n"
"Testing general SVD solver\n"
"==================================================\n"
"Setting up 3 x 4 matrix\n");
A = new_amatrix(3, 4);
setentry_amatrix(A, 0, 0, 1.0);
setentry_amatrix(A, 1, 0, 2.0);
setentry_amatrix(A, 2, 0, 3.0);
setentry_amatrix(A, 0, 1, 2.0);
setentry_amatrix(A, 1, 1, 4.0);
setentry_amatrix(A, 2, 1, 6.0);
setentry_amatrix(A, 0, 2, 2.0);
setentry_amatrix(A, 1, 2, 5.0);
setentry_amatrix(A, 2, 2, 8.0);
setentry_amatrix(A, 0, 3, 1.0);
setentry_amatrix(A, 1, 3, 4.0);
setentry_amatrix(A, 2, 3, 7.0);
Acopy = new_amatrix(A->rows, A->cols);
copy_amatrix(false, A, Acopy);
U = new_identity_amatrix(3, 3);
Vt = new_identity_amatrix(3, 4);
sigma = new_realavector(3);
work = new_avector(3 * 3);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 24);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
(void) printf("--------------------------------------------------\n"
"Setting up 4 x 3 matrix\n");
A = new_amatrix(4, 3);
setentry_amatrix(A, 0, 0, 1.0);
setentry_amatrix(A, 0, 1, 2.0);
setentry_amatrix(A, 0, 2, 3.0);
setentry_amatrix(A, 1, 0, 2.0);
setentry_amatrix(A, 1, 1, 4.0);
setentry_amatrix(A, 1, 2, 6.0);
setentry_amatrix(A, 2, 0, 2.0);
setentry_amatrix(A, 2, 1, 5.0);
setentry_amatrix(A, 2, 2, 8.0);
setentry_amatrix(A, 3, 0, 1.0);
setentry_amatrix(A, 3, 1, 4.0);
setentry_amatrix(A, 3, 2, 7.0);
Acopy = new_amatrix(A->rows, A->cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(4, 3);
Vt = new_amatrix(3, 3);
sigma = new_realavector(3);
work = new_avector(3 * 3);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 24);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality V %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
(void) printf("--------------------------------------------------\n"
"Setting up 4 x 3 matrix\n");
A = new_amatrix(4, 3);
setentry_amatrix(A, 0, 0, 1.0);
setentry_amatrix(A, 0, 1, 2.0);
setentry_amatrix(A, 0, 2, 3.0);
setentry_amatrix(A, 1, 0, 2.0);
setentry_amatrix(A, 1, 1, 4.0);
setentry_amatrix(A, 1, 2, 6.0);
setentry_amatrix(A, 2, 0, 2.0);
setentry_amatrix(A, 2, 1, 5.0);
setentry_amatrix(A, 2, 2, 8.0);
setentry_amatrix(A, 3, 0, 1.0);
setentry_amatrix(A, 3, 1, 4.0);
setentry_amatrix(A, 3, 2, 7.0);
Acopy = clone_amatrix(A);
U = new_amatrix(4, 3);
Vt = new_amatrix(3, 3);
sigma = new_realavector(3);
work = new_avector(3 * 3);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 24);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
rows = 9;
cols = 7;
mid = UINT_MIN(rows, cols);
(void) printf("--------------------------------------------------\n"
"Setting up random %u x %u matrix\n", rows, cols);
A = new_amatrix(rows, cols);
random_amatrix(A);
Acopy = new_amatrix(A->rows, A->cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(rows, mid);
Vt = new_amatrix(mid, cols);
sigma = new_realavector(mid);
work = new_avector(3 * mid);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, Acopy);
error = normfrob_amatrix(Acopy);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
rows = 10;
cols = 6;
mid = UINT_MIN(rows, cols);
(void) printf("--------------------------------------------------\n"
"Setting up random %u x %u matrix\n", rows, cols);
A = new_amatrix(rows, cols);
random_amatrix(A);
Acopy = new_amatrix(A->rows, A->cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(rows, mid);
Vt = new_amatrix(mid, cols);
sigma = new_realavector(mid);
work = new_avector(3 * mid);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Acopy, A);
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
(void) printf("Running default SVD solver\n");
copy_amatrix(false, Acopy, A);
svd_amatrix(A, sigma, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Acopy, A);
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
rows = 7;
cols = 13;
mid = UINT_MIN(rows, cols);
(void) printf("--------------------------------------------------\n"
"Setting up random %u x %u matrix\n", rows, cols);
A = new_amatrix(rows, cols);
random_amatrix(A);
Acopy = new_amatrix(A->rows, A->cols);
copy_amatrix(false, A, Acopy);
U = new_amatrix(rows, mid);
Vt = new_amatrix(mid, cols);
sigma = new_realavector(mid);
work = new_avector(3 * mid);
(void) printf("Running self-made SVD solver\n");
iter = sb_svd_amatrix(A, sigma, U, Vt, 10 * mid);
(void) printf(" %u iterations\n", iter);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Acopy, A);
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
(void) printf("Running default SVD solver\n");
copy_amatrix(false, Acopy, A);
svd_amatrix(A, sigma, U, Vt);
(void) printf("Checking accuracy\n");
error = check_ortho_amatrix(false, U);
(void) printf(" Orthogonality U %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
error = check_ortho_amatrix(true, Vt);
(void) printf(" Orthogonality Vt %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
copy_amatrix(false, Acopy, A);
diageval_realavector_amatrix(1.0, true, sigma, true, U);
addmul_amatrix(-1.0, false, U, false, Vt, A);
error = normfrob_amatrix(A);
(void) printf(" Accuracy %g, %sokay\n", error,
(error < tolerance ? "" : "NOT "));
if (error >= tolerance)
problems++;
del_avector(work);
del_realavector(sigma);
del_amatrix(Vt);
del_amatrix(U);
del_amatrix(Acopy);
del_amatrix(A);
printf("----------------------------------------\n"
" %u matrices and\n"
" %u vectors still active\n"
" %u errors found\n", getactives_amatrix(), getactives_avector(),
problems);
return problems;
}
pcluster
build_pca_cluster(pclustergeometry cf, uint size, uint * idx, uint clf)
{
const uint dim = cf->dim;
pamatrix C, Q;
pavector v;
prealavector lambda;
real *x, *y;
real w;
uint i, j, k, size0, size1;
pcluster t;
assert(size > 0);
size0 = 0;
size1 = 0;
if (size > clf) {
x = allocreal(dim);
y = allocreal(dim);
/* determine weight of current cluster */
w = 0.0;
for (i = 0; i < size; ++i) {
w += cf->w[idx[i]];
}
w = 1.0 / w;
for (j = 0; j < dim; ++j) {
x[j] = 0.0;
}
/* determine center of mass */
for (i = 0; i < size; ++i) {
for (j = 0; j < dim; ++j) {
x[j] += cf->w[idx[i]] * cf->x[idx[i]][j];
}
}
for (j = 0; j < dim; ++j) {
x[j] *= w;
}
C = new_zero_amatrix(dim, dim);
Q = new_zero_amatrix(dim, dim);
lambda = new_realavector(dim);
/* setup covariance matrix */
for (i = 0; i < size; ++i) {
for (j = 0; j < dim; ++j) {
y[j] = cf->x[idx[i]][j] - x[j];
}
for (j = 0; j < dim; ++j) {
for (k = 0; k < dim; ++k) {
C->a[j + k * C->ld] += cf->w[idx[i]] * y[j] * y[k];
}
}
}
/* get eigenvalues and eigenvectors of covariance matrix */
eig_amatrix(C, lambda, Q);
/* get eigenvector from largest eigenvalue */
v = new_avector(0);
init_column_avector(v, Q, dim - 1);
/* separate cluster with v as separation-plane */
for (i = 0; i < size; ++i) {
/* x_i - X */
for (j = 0; j < dim; ++j) {
y[j] = cf->x[idx[i]][j] - x[j];
}
/* <y,v> */
w = 0.0;
for (j = 0; j < dim; ++j) {
w += y[j] * v->v[j];
}
if (w >= 0.0) {
j = idx[i];
idx[i] = idx[size0];
idx[size0] = j;
size0++;
}
else {
size1++;
}
}
assert(size0 + size1 == size);
del_amatrix(Q);
del_amatrix(C);
del_realavector(lambda);
del_avector(v);
freemem(x);
freemem(y);
/* recursion */
if (size0 > 0) {
if (size1 > 0) {
t = new_cluster(size, idx, 2, cf->dim);
t->son[0] = build_pca_cluster(cf, size0, idx, clf);
t->son[1] = build_pca_cluster(cf, size1, idx + size0, clf);
update_bbox_cluster(t);
}
else {
t = new_cluster(size, idx, 1, cf->dim);
t->son[0] = build_pca_cluster(cf, size0, idx, clf);
update_bbox_cluster(t);
}
}
else {
assert(size1 > 0);
t = new_cluster(size, idx, 1, cf->dim);
t->son[0] = build_pca_cluster(cf, size1, idx, clf);
update_bbox_cluster(t);
}
}
else {
t = new_cluster(size, idx, 0, cf->dim);
update_support_bbox_cluster(cf, t);
}
update_cluster(t);
return t;
}
