static void test_mgcr(ITER *ip, int i, MAT *Q, MAT *R)
#endif
{
VEC vt, vt1;
static MAT *R1 = MNULL;
static VEC *r = VNULL, *r1 = VNULL;
VEC *rr;
int k, j;
Real sm;
/* check Q*Q^T = I */
vt.dim = vt.max_dim = ip->b->dim;
vt1.dim = vt1.max_dim = ip->b->dim;
Q = m_resize(Q, i + 1, ip->b->dim);
R1 = m_resize(R1, i + 1, i + 1);
r = v_resize(r, ip->b->dim);
r1 = v_resize(r1, ip->b->dim);
MEM_STAT_REG(R1, TYPE_MAT);
MEM_STAT_REG(r, TYPE_VEC);
MEM_STAT_REG(r1, TYPE_VEC);
m_zero(R1);
for (k = 1; k <= i; k++)
for (j = 1; j <= i; j++) {
vt.ve = Q->me[k];
vt1.ve = Q->me[j];
R1->me[k][j] = in_prod(&vt, &vt1);
}
for (j = 1; j <= i; j++)
R1->me[j][j] -= 1.0;
#ifndef MEX
if (m_norm_inf(R1) > MACHEPS * ip->b->dim)
printf(" ! (mgcr:) m_norm_inf(Q*Q^T) = %g\n", m_norm_inf(R1));
#endif
/* check (r_i,Ap_j) = 0 for j <= i */
ip->Ax(ip->A_par, ip->x, r);
v_sub(ip->b, r, r);
rr = r;
if (ip->Bx) {
ip->Bx(ip->B_par, r, r1);
rr = r1;
}
#ifndef MEX
printf(" ||r|| = %g\n", v_norm2(rr));
#endif
sm = 0.0;
for (j = 1; j <= i; j++) {
vt.ve = Q->me[j];
sm = max(sm, in_prod(&vt,rr));
}
#ifndef MEX
if (sm >= MACHEPS * ip->b->dim)
printf(" ! (mgcr:) max_j (r,Ap_j) = %g\n", sm);
#endif
}
static void test_gmres(ITER *ip, int i, MAT *Q, MAT *R,
VEC *givc, VEC *givs, double h_val)
#endif
{
VEC vt, vt1;
STATIC MAT *Q1=MNULL, *R1=MNULL;
int j;
/* test Q*A*Q^T = R */
Q = m_resize(Q,i+1,ip->b->dim);
Q1 = m_resize(Q1,i+1,ip->b->dim);
R1 = m_resize(R1,i+1,i+1);
MEM_STAT_REG(Q1,TYPE_MAT);
MEM_STAT_REG(R1,TYPE_MAT);
vt.dim = vt.max_dim = ip->b->dim;
vt1.dim = vt1.max_dim = ip->b->dim;
for (j=0; j <= i; j++) {
vt.ve = Q->me[j];
vt1.ve = Q1->me[j];
ip->Ax(ip->A_par,&vt,&vt1);
}
mmtr_mlt(Q,Q1,R1);
R1 = m_resize(R1,i+2,i+1);
for (j=0; j < i; j++)
R1->me[i+1][j] = 0.0;
R1->me[i+1][i] = h_val;
for (j = 0; j <= i; j++) {
rot_rows(R1,j,j+1,givc->ve[j],givs->ve[j],R1);
}
R1 = m_resize(R1,i+1,i+1);
m_sub(R,R1,R1);
/* if (m_norm_inf(R1) > MACHEPS*ip->b->dim) */
#ifndef MEX
printf(" %d. ||Q*A*Q^T - H|| = %g [cf. MACHEPS = %g]\n",
ip->steps,m_norm_inf(R1),MACHEPS);
#endif
/* check Q*Q^T = I */
Q = m_resize(Q,i+1,ip->b->dim);
mmtr_mlt(Q,Q,R1);
for (j=0; j <= i; j++)
R1->me[j][j] -= 1.0;
#ifndef MEX
if (m_norm_inf(R1) > MACHEPS*ip->b->dim)
printf(" ! m_norm_inf(Q*Q^T) = %g\n",m_norm_inf(R1));
#endif
#ifdef THREADSAFE
M_FREE(Q1);
M_FREE(R1);
#endif
}
