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; }