/* Computes y = w + A * x
It is possible that w == y, but not x == y
*/
static PetscErrorCode MatMultAdd_ML(Mat A,Vec x,Vec w,Vec y)
{
Mat_MLShell *shell;
PetscScalar *xarray,*yarray;
PetscInt x_length,y_length;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatShellGetContext(A, (void **) &shell);CHKERRQ(ierr);
if (y == w) {
if (!shell->work) {
ierr = VecDuplicate(y, &shell->work);CHKERRQ(ierr);
}
ierr = VecGetArray(x, &xarray);CHKERRQ(ierr);
ierr = VecGetArray(shell->work, &yarray);CHKERRQ(ierr);
x_length = shell->mlmat->invec_leng;
y_length = shell->mlmat->outvec_leng;
ML_Operator_Apply(shell->mlmat, x_length, xarray, y_length, yarray);
ierr = VecRestoreArray(x, &xarray);CHKERRQ(ierr);
ierr = VecRestoreArray(shell->work, &yarray);CHKERRQ(ierr);
ierr = VecAXPY(y, 1.0, shell->work);CHKERRQ(ierr);
} else {
ierr = VecGetArray(x, &xarray);CHKERRQ(ierr);
ierr = VecGetArray(y, &yarray);CHKERRQ(ierr);
x_length = shell->mlmat->invec_leng;
y_length = shell->mlmat->outvec_leng;
ML_Operator_Apply(shell->mlmat, x_length, xarray, y_length, yarray);
ierr = VecRestoreArray(x, &xarray);CHKERRQ(ierr);
ierr = VecRestoreArray(y, &yarray);CHKERRQ(ierr);
ierr = VecAXPY(y, 1.0, w);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
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;
}
int ML_Smoother_Ifpack(ML_Smoother *sm,int inlen,double x[],int outlen,
double rhs[])
{
ML_Smoother *smooth_ptr = (ML_Smoother *) sm;
void *Ifpack_Handle = smooth_ptr->smoother->data;
double* x2 = NULL,* rhs2 = NULL;
/*int i;*/
int n, kk;
int one_int = 1;
double minus_one_double = -1.0;
if (sm->init_guess == ML_NONZERO)
{
n = sm->my_level->Amat->invec_leng;
assert (n == sm->my_level->Amat->outvec_leng);
rhs2 = (double*) ML_allocate(sizeof(double) * (n + 1));
x2 = (double*) ML_allocate(sizeof(double) * (n + 1));
ML_Operator_Apply(sm->my_level->Amat, n, x, n, rhs2);
DCOPY_F77(&n, x, &one_int, x2, &one_int);
DAXPY_F77(&n, &minus_one_double, rhs, &one_int, rhs2, &one_int);
ML_Ifpack_Solve(Ifpack_Handle, x2, rhs2);
DAXPY_F77(&n, &minus_one_double, x2, &one_int, x, &one_int);
ML_free(rhs2);
ML_free(x2);
}
else
ML_Ifpack_Solve(Ifpack_Handle, x, rhs);
for (kk = 1; kk < sm->ntimes; kk++) {
n = sm->my_level->Amat->invec_leng;
assert (n == sm->my_level->Amat->outvec_leng);
rhs2 = (double*) ML_allocate(sizeof(double) * (n + 1));
x2 = (double*) ML_allocate(sizeof(double) * (n + 1));
ML_Operator_Apply(sm->my_level->Amat, n, x, n, rhs2);
DCOPY_F77(&n, x, &one_int, x2, &one_int);
DAXPY_F77(&n, &minus_one_double, rhs, &one_int, rhs2, &one_int);
ML_Ifpack_Solve(Ifpack_Handle, x2, rhs2);
DAXPY_F77(&n, &minus_one_double, x2, &one_int, x, &one_int);
ML_free(rhs2);
ML_free(x2);
}
return 0;
} /* ML_Smoother_Ifpack */
int user_smoothing(ML_Smoother *data, int x_length, double x[], int rhs_length, double rhs[])
{
int i;
double ap[129], omega = .5; /* temp vector and damping factor */
double *diag;
ML_Operator *Amat;
ML_Smoother *smoo;
smoo = (ML_Smoother *) data;
Amat = (ML_Operator *) ML_Get_MySmootherData(smoo);
ML_Operator_Apply(Amat, x_length, x, rhs_length, ap);
ML_Operator_Get_Diag(Amat, x_length, &diag);
for (i = 0; i < x_length; i++) x[i] = x[i] + omega*(rhs[i] - ap[i])/diag[i];
return 0;
}
static PetscErrorCode MatMult_ML(Mat A,Vec x,Vec y)
{
PetscErrorCode ierr;
Mat_MLShell *shell;
PetscScalar *xarray,*yarray;
PetscInt x_length,y_length;
PetscFunctionBegin;
ierr = MatShellGetContext(A,(void **)&shell);CHKERRQ(ierr);
ierr = VecGetArray(x,&xarray);CHKERRQ(ierr);
ierr = VecGetArray(y,&yarray);CHKERRQ(ierr);
x_length = shell->mlmat->invec_leng;
y_length = shell->mlmat->outvec_leng;
ML_Operator_Apply(shell->mlmat,x_length,xarray,y_length,yarray);
ierr = VecRestoreArray(x,&xarray);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&yarray);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void ML_interp_check(ML *ml, int coarse_level, int fine_level)
{
int ii, jj, ncoarse, nfine;
double *c_data, *f_data, coords[3], dtemp, d2, dlargest;
ML_GridFunc *coarse_funs, *fine_funs;
void *coarse_data, *fine_data;
int nfine_eqn, ncoarse_eqn, stride = 1;
/* check an interpolated linear function */
coarse_data = ml->SingleLevel[coarse_level].Grid->Grid;
fine_data = ml->SingleLevel[ fine_level].Grid->Grid;
coarse_funs = ml->SingleLevel[coarse_level].Grid->gridfcn;
fine_funs = ml->SingleLevel[ fine_level].Grid->gridfcn;
if ( (coarse_data==NULL)||(fine_data==NULL)) {
printf("ML_interp_check: grid data not found?\n");
exit(1);
}
if ( (coarse_funs==NULL)||(fine_funs==NULL)) {
printf("ML_interp_check: grid functions not found?\n");
exit(1);
}
if ( (coarse_funs->USR_grid_get_nvertices == 0) ||
( fine_funs->USR_grid_get_nvertices == 0)) {
printf("ML_interp_check: USR_grid_get_nvertices not found?\n");
exit(1);
}
ncoarse = coarse_funs->USR_grid_get_nvertices(coarse_data);
nfine = fine_funs->USR_grid_get_nvertices( fine_data);
nfine_eqn = ml->SingleLevel[coarse_level].Pmat->outvec_leng;
ncoarse_eqn = ml->SingleLevel[coarse_level].Pmat->invec_leng;
c_data = (double *) ML_allocate(ncoarse_eqn*sizeof(double));
f_data = (double *) ML_allocate(nfine_eqn*sizeof(double));
for (ii = 0; ii < ncoarse_eqn; ii++) c_data[ii] = 0.;
for (ii = 0; ii < nfine_eqn; ii++) f_data[ii] = 0.;
/* ASSUMING that for each grid point on this processor there are a */
/* set of equations and that all points at a grid point are numbered */
/* consecutively !!!!!!!!!!!!!! */
stride = nfine_eqn/nfine;
for (ii = 0 ; ii < ncoarse ; ii++) {
coarse_funs->USR_grid_get_vertex_coordinate(coarse_data,ii,coords);
for (jj = 0; jj < stride; jj++) {
c_data[ii*stride + jj] = coords[0] + 3.*coords[1] + .5;
}
}
ML_Operator_Apply(ml->SingleLevel[coarse_level].Pmat,ncoarse_eqn,c_data,
nfine_eqn,f_data);
dlargest = 0.0;
for (ii = 0 ; ii < nfine; ii++) {
fine_funs->USR_grid_get_vertex_coordinate(fine_data , ii, coords);
dtemp = coords[0] + 3.*coords[1] + .5;
d2 = ML_dabs(dtemp - f_data[ii*stride])/(ML_dabs(dtemp)+1.e-9);
/* Ray debugging
if ( d2 > 1.e-8)
printf("%d: f_data[%d] = %e %e | %e %e\n",ml->comm->ML_mypid,
ii,f_data[ii*stride],dtemp,coords[0],coords[1]);
*/
if ( d2 > dlargest) {
dlargest = d2;
}
}
ML_free(f_data);
ML_free(c_data);
}