int hmat_cg(phmatrix hm, pavector b, pavector x) { if (hm->rc->size != b->dim) { return -1; } else { double ep = 1e-2; pavector r = new_avector(b->dim); pavector p = new_avector(b->dim); pavector q = new_avector(b->dim); pavector tempq = new_avector(b->dim); pavector newb = new_avector(b->dim); addeval_hmatrix_avector(f_one, hm, CblasConjTrans, b, newb); for (int i=0;i<b->dim;i++) { r->v[i] = newb->v[i]; x->v[i] = 0; } int i; field alpha, beta; field rr1; field rr; for (i=0;i<10001;i++) { rr = dot_prod_avec('c', r, r); if (i == 0) { for (int j=0;j<b->dim;j++) { p->v[j] = r->v[j]; } } else { beta = rr / rr1; add_avec(1, r, beta, p); } addeval_hmatrix_avector(f_one, hm, CblasNoTrans, p, tempq); addeval_hmatrix_avector(f_one, hm, CblasConjTrans, tempq, q); alpha = rr / dot_prod_avec('c', q, p); add_avec(alpha, p, 1, x); add_avec(-alpha, q, 1, r); rr1 = rr; if (LAPACKE_zlange(LAPACK_ROW_MAJOR, 'f', 1, r->dim, (MKL_Complex16 *)r->v, r->dim) < ep) { break; } } return i; } }
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); }
void addeval_A(field alpha, void *matrix, pcavector x, pavector y) { struct _eval_A *eval = (struct _eval_A *) matrix; field beta; beta = -I * alpha * eval->eta; switch (eval->KMtype) { case AMATRIX: addeval_amatrix_avector(alpha, (pamatrix) eval->KM, x, y); break; case HMATRIX: addeval_hmatrix_avector(alpha, (phmatrix) eval->KM, x, y); break; case H2MATRIX: addeval_h2matrix_avector(alpha, (ph2matrix) eval->KM, x, y); break; default: printf("ERROR: unknown matrix type!\n"); abort(); break; } switch (eval->Vtype) { case AMATRIX: addeval_amatrix_avector(beta, (pamatrix) eval->V, x, y); break; case HMATRIX: addeval_hmatrix_avector(beta, (phmatrix) eval->V, x, y); break; case H2MATRIX: addeval_h2matrix_avector(beta, (ph2matrix) eval->V, x, y); break; default: printf("ERROR: unknown matrix type!\n"); abort(); break; } }