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