int ML_Reitzinger_Check_Hierarchy(ML *ml, ML_Operator **Tmat_array, int incr_or_decr)
{
int i,j;
int finest_level, coarsest_level;
ML_Operator *Amat, *Tmat;
double *randvec, *result, *result1;
double dnorm;
finest_level = ml->ML_finest_level;
coarsest_level = ml->ML_coarsest_level;
if (incr_or_decr == ML_INCREASING) {
if (ml->comm->ML_mypid == 0) {
printf("ML_Reitzinger_Check_Hierarchy: ML_INCREASING is not supported ");
printf(" at this time. Not checking hierarchy.\n");
}
return 1;
}
if ( ML_Get_PrintLevel() > 5 ) {
printf("ML_Reitzinger_Check_Hierarchy: Checking null space\n");
}
for (i=finest_level; i>coarsest_level; i--) {
Amat = ml->Amat+i;
Tmat = Tmat_array[i];
/* normalized random vector */
randvec = (double *) ML_allocate(Tmat->invec_leng * sizeof(double) );
ML_random_vec(randvec,Tmat->invec_leng, ml->comm);
dnorm = sqrt( ML_gdot(Tmat->invec_leng, randvec, randvec, ml->comm) );
for (j=0; j<Tmat->invec_leng; j++) randvec[j] /= dnorm;
result = (double *) ML_allocate(Amat->invec_leng * sizeof(double) );
result1 = (double *) ML_allocate(Amat->outvec_leng * sizeof(double) );
ML_Operator_Apply(Tmat, Tmat->invec_leng, randvec,
Tmat->outvec_leng, result);
ML_Operator_Apply(Amat, Amat->invec_leng, result,
Amat->outvec_leng, result1);
dnorm = sqrt( ML_gdot(Amat->outvec_leng, result1, result1, ml->comm) );
if ( (ML_Get_PrintLevel() > 5) && (ml->comm->ML_mypid == 0) ) {
printf("Level %d: for random v, ||S*T*v|| = %15.10e\n",i,dnorm);
}
ML_free(randvec);
ML_free(result);
ML_free(result1);
}
if ( (ML_Get_PrintLevel() > 5) && (ml->comm->ML_mypid == 0) ) printf("\n");
return 0;
}
void ML_rap_check(ML *ml, ML_Operator *RAP, ML_Operator *R,
ML_Operator *A, ML_Operator *P, int iNvec, int oNvec)
{
int i,j;
double *vec1, *vec2, *vec3, *vec4, *vec5;
double norm1, norm2;
#ifdef DEBUG
printf("ML_rap_check begins ...\n");
#endif
if (RAP->getrow->ML_id != ML_ID_MATRIX) {
if (ml->comm->ML_mypid == 0)
printf("ML_rap_check: RAP is the wrong object (=%d). \n",
RAP->getrow->ML_id);
exit(1);
}
if (R->getrow->ML_id != ML_ID_MATRIX) {
if (ml->comm->ML_mypid == 0)
printf("ML_rap_check: R is the wrong object (=%d). \n",
RAP->getrow->ML_id);
exit(1);
}
if (P->getrow->ML_id != ML_ID_MATRIX) {
if (ml->comm->ML_mypid == 0)
printf("ML_rap_check: P is the wrong object (=%d). \n",
RAP->getrow->ML_id);
exit(1);
}
if (A->getrow->ML_id != ML_ID_MATRIX) {
if (ml->comm->ML_mypid == 0)
printf("ML_rap_check: A is the wrong object (=%d). \n",
RAP->getrow->ML_id);
exit(1);
}
/* j is the number of external variables */
j = 0;
for (i = 0; i < RAP->getrow->pre_comm->N_neighbors; i++)
j += RAP->getrow->pre_comm->neighbors[i].N_rcv;
vec1 = (double *) ML_allocate((iNvec+ 1 + j)*sizeof(double));
vec2 = (double *) ML_allocate((P->getrow->Nrows+1)*sizeof(double));
vec3 = (double *) ML_allocate((A->getrow->Nrows+1)*sizeof(double));
vec4 = (double *) ML_allocate((oNvec + 1)*sizeof(double));
vec5 = (double *) ML_allocate((oNvec + 1)*sizeof(double));
for (i = 0; i < iNvec; i++)
vec1[i] = (double) (ml->comm->ML_mypid*2301 + i*7 + 1);
j = P->getrow->Nrows;
ML_getrow_matvec(P, vec1, iNvec, vec2,&j);
i = A->getrow->Nrows;
ML_getrow_matvec(A, vec2, j, vec3,&i);
ML_getrow_matvec(R, vec3, i, vec4,&oNvec);
/* j is the number of variables sent in communication */
j = 0;
for (i = 0; i < RAP->getrow->pre_comm->N_neighbors; i++)
j += RAP->getrow->pre_comm->neighbors[i].N_send;
ML_restricted_MSR_mult( RAP, oNvec, vec1, vec5, j);
norm1 = sqrt(ML_gdot(oNvec, vec5, vec5, ml->comm));
for (i = 0; i < oNvec; i++) vec5[i] -= vec4[i];
norm2 = sqrt(ML_gdot(oNvec, vec5, vec5, ml->comm));
if (norm2 > norm1*1e-10) {
norm2 = sqrt(ML_gdot(oNvec, vec4, vec4, ml->comm));
if (ml->comm->ML_mypid == 0) {
printf("***************************************\n");
printf("RAP seems inaccurate:\n");
printf(" || RAP v ||_2 = %e\n\n", norm1);
printf(" || R (A (P v)) ||_2 = %e\n",norm2);
printf("***************************************\n");
}
}
ML_free(vec5);
ML_free(vec4);
ML_free(vec3);
ML_free(vec2);
ML_free(vec1);
#ifdef DEBUG
printf("ML_rap_check ends ...\n");
#endif
}
