static PetscErrorCode DMRestrictHook_TSTheta(DM fine,Mat restrct,Vec rscale,Mat inject,DM coarse,void *ctx)
{
TS ts = (TS)ctx;
PetscErrorCode ierr;
Vec X0,Xdot,X0_c,Xdot_c;
PetscFunctionBegin;
ierr = TSThetaGetX0AndXdot(ts,fine,&X0,&Xdot);CHKERRQ(ierr);
ierr = TSThetaGetX0AndXdot(ts,coarse,&X0_c,&Xdot_c);CHKERRQ(ierr);
ierr = MatRestrict(restrct,X0,X0_c);CHKERRQ(ierr);
ierr = MatRestrict(restrct,Xdot,Xdot_c);CHKERRQ(ierr);
ierr = VecPointwiseMult(X0_c,rscale,X0_c);CHKERRQ(ierr);
ierr = VecPointwiseMult(Xdot_c,rscale,Xdot_c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PCMGGetRScale - Gets the pointwise scaling for the restriction operator from level l to l-1.
Collective on PC
Input Parameters:
+ pc - the multigrid context
. rscale - the scaling
- l - the level (0 is coarsest) to supply [Do not supply 0]
Level: advanced
Notes:
When evaluating a function on a coarse level one does not want to do F(R * x) one does F(rscale * R * x) where rscale is 1 over the row sums of R.
.keywords: MG, set, multigrid, restriction, level
.seealso: PCMGSetInterpolation(), PCMGGetRestriction()
@*/
PetscErrorCode PCMGGetRScale(PC pc,PetscInt l,Vec *rscale)
{
PetscErrorCode ierr;
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscFunctionBegin;
PetscValidHeaderSpecific(pc,PC_CLASSID,1);
if (!mglevels) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must set MG levels before calling");
if (l <= 0 || mg->nlevels <= l) SETERRQ2(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_OUTOFRANGE,"Level %D must be in range {1,...,%D}",l,mg->nlevels-1);
if (!mglevels[l]->rscale) {
Mat R;
Vec X,Y,coarse,fine;
PetscInt M,N;
ierr = PCMGGetRestriction(pc,l,&R);CHKERRQ(ierr);
ierr = MatCreateVecs(R,&X,&Y);CHKERRQ(ierr);
ierr = MatGetSize(R,&M,&N);CHKERRQ(ierr);
if (M < N) {
fine = X;
coarse = Y;
} else if (N < M) {
fine = Y; coarse = X;
} else SETERRQ(PetscObjectComm((PetscObject)R),PETSC_ERR_SUP,"Restriction matrix is square, cannot determine which Vec is coarser");
ierr = VecSet(fine,1.);CHKERRQ(ierr);
ierr = MatRestrict(R,fine,coarse);CHKERRQ(ierr);
ierr = VecDestroy(&fine);CHKERRQ(ierr);
ierr = VecReciprocal(coarse);CHKERRQ(ierr);
mglevels[l]->rscale = coarse;
}
*rscale = mglevels[l]->rscale;
PetscFunctionReturn(0);
}
PetscErrorCode PCMGACycle_Private(PC pc,PC_MG_Levels **mglevels)
{
PetscErrorCode ierr;
PetscInt i,l = mglevels[0]->levels;
PetscFunctionBegin;
/* compute RHS on each level */
for (i=l-1; i>0; i--) {
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatRestrict(mglevels[i]->restrct,mglevels[i]->b,mglevels[i-1]->b);CHKERRQ(ierr);
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
}
/* solve separately on each level */
for (i=0; i<l; i++) {
ierr = VecSet(mglevels[i]->x,0.0);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels[i]->smoothd,mglevels[i]->b,mglevels[i]->x);CHKERRQ(ierr);
ierr = KSPCheckSolve(mglevels[i]->smoothd,pc,mglevels[i]->x);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
}
for (i=1; i<l; i++) {
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatInterpolateAdd(mglevels[i]->interpolate,mglevels[i-1]->x,mglevels[i]->x,mglevels[i]->x);CHKERRQ(ierr);
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
}
PetscFunctionReturn(0);
}
PetscErrorCode PCMGKCycle_Private(PC pc,PC_MG_Levels **mglevels)
{
PetscErrorCode ierr;
PetscInt i,l = mglevels[0]->levels;
PetscFunctionBegin;
/* restrict the RHS through all levels to coarsest. */
for (i=l-1; i>0; i--){
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatRestrict(mglevels[i]->restrct,mglevels[i]->b,mglevels[i-1]->b);CHKERRQ(ierr);
if (mglevels[i]->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels[i]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
}
/* work our way up through the levels */
ierr = VecSet(mglevels[0]->x,0.0);CHKERRQ(ierr);
for (i=0; i<l-1; i++) {
if (mglevels[i]->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels[i]->smoothd,mglevels[i]->b,mglevels[i]->x);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
if (mglevels[i+1]->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels[i+1]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatInterpolate(mglevels[i+1]->interpolate,mglevels[i]->x,mglevels[i+1]->x);CHKERRQ(ierr);
if (mglevels[i+1]->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels[i+1]->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
}
if (mglevels[l-1]->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels[l-1]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels[l-1]->smoothd,mglevels[l-1]->b,mglevels[l-1]->x);CHKERRQ(ierr);
if (mglevels[l-1]->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels[l-1]->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
/*@
SNESFASRestrict - restrict a Vec to the next coarser level
Collective
Input Arguments:
+ fine - SNES from which to restrict
- Xfine - vector to restrict
Output Arguments:
. Xcoarse - result of restriction
Level: developer
.seealso: SNESFASSetRestriction(), SNESFASSetInjection()
@*/
PetscErrorCode SNESFASRestrict(SNES fine,Vec Xfine,Vec Xcoarse)
{
PetscErrorCode ierr;
SNES_FAS *fas = (SNES_FAS*)fine->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(fine,SNES_CLASSID,1);
PetscValidHeaderSpecific(Xfine,VEC_CLASSID,2);
PetscValidHeaderSpecific(Xcoarse,VEC_CLASSID,3);
if (fas->inject) {
ierr = MatRestrict(fas->inject,Xfine,Xcoarse);CHKERRQ(ierr);
} else {
ierr = MatRestrict(fas->restrct,Xfine,Xcoarse);CHKERRQ(ierr);
ierr = VecPointwiseMult(Xcoarse,fas->rscale,Xcoarse);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
Performs the FAS coarse correction as:
fine problem: F(x) = b
coarse problem: F^c(x^c) = b^c
b^c = F^c(Rx) - R(F(x) - b)
*/
PetscErrorCode SNESFASCoarseCorrection(SNES snes, Vec X, Vec F, Vec X_new)
{
PetscErrorCode ierr;
Vec X_c, Xo_c, F_c, B_c;
SNESConvergedReason reason;
SNES next;
Mat restrct, interpolate;
SNES_FAS *fasc;
PetscFunctionBegin;
ierr = SNESFASCycleGetCorrection(snes, &next);CHKERRQ(ierr);
if (next) {
fasc = (SNES_FAS*)next->data;
ierr = SNESFASCycleGetRestriction(snes, &restrct);CHKERRQ(ierr);
ierr = SNESFASCycleGetInterpolation(snes, &interpolate);CHKERRQ(ierr);
X_c = next->vec_sol;
Xo_c = next->work[0];
F_c = next->vec_func;
B_c = next->vec_rhs;
if (fasc->eventinterprestrict) {ierr = PetscLogEventBegin(fasc->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = SNESFASRestrict(snes,X,Xo_c);CHKERRQ(ierr);
/* restrict the defect: R(F(x) - b) */
ierr = MatRestrict(restrct, F, B_c);CHKERRQ(ierr);
if (fasc->eventinterprestrict) {ierr = PetscLogEventEnd(fasc->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
if (fasc->eventresidual) {ierr = PetscLogEventBegin(fasc->eventresidual,0,0,0,0);CHKERRQ(ierr);}
/* F_c = F^c(Rx) - R(F(x) - b) since the second term was sitting in next->vec_rhs */
ierr = SNESComputeFunction(next, Xo_c, F_c);CHKERRQ(ierr);
if (fasc->eventresidual) {ierr = PetscLogEventEnd(fasc->eventresidual,0,0,0,0);CHKERRQ(ierr);}
/* solve the coarse problem corresponding to F^c(x^c) = b^c = F^c(Rx) - R(F(x) - b) */
ierr = VecCopy(B_c, X_c);CHKERRQ(ierr);
ierr = VecCopy(F_c, B_c);CHKERRQ(ierr);
ierr = VecCopy(X_c, F_c);CHKERRQ(ierr);
/* set initial guess of the coarse problem to the projected fine solution */
ierr = VecCopy(Xo_c, X_c);CHKERRQ(ierr);
/* recurse to the next level */
ierr = SNESSetInitialFunction(next, F_c);CHKERRQ(ierr);
ierr = SNESSolve(next, B_c, X_c);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
/* correct as x <- x + I(x^c - Rx)*/
ierr = VecAXPY(X_c, -1.0, Xo_c);CHKERRQ(ierr);
if (fasc->eventinterprestrict) {ierr = PetscLogEventBegin(fasc->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatInterpolateAdd(interpolate, X_c, X, X_new);CHKERRQ(ierr);
if (fasc->eventinterprestrict) {ierr = PetscLogEventEnd(fasc->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
}
PetscFunctionReturn(0);
}
PetscErrorCode PCMGMCycle_Private(PC pc,PC_MG_Levels **mglevelsin,PCRichardsonConvergedReason *reason)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels *mgc,*mglevels = *mglevelsin;
PetscErrorCode ierr;
PetscInt cycles = (mglevels->level == 1) ? 1 : (PetscInt) mglevels->cycles;
PC subpc;
PCFailedReason pcreason;
PetscFunctionBegin;
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels->smoothd,mglevels->b,mglevels->x);CHKERRQ(ierr); /* pre-smooth */
ierr = KSPGetPC(mglevels->smoothd,&subpc);CHKERRQ(ierr);
ierr = PCGetSetUpFailedReason(subpc,&pcreason);CHKERRQ(ierr);
if (pcreason) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
if (mglevels->level) { /* not the coarsest grid */
if (mglevels->eventresidual) {ierr = PetscLogEventBegin(mglevels->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = (*mglevels->residual)(mglevels->A,mglevels->b,mglevels->x,mglevels->r);CHKERRQ(ierr);
if (mglevels->eventresidual) {ierr = PetscLogEventEnd(mglevels->eventresidual,0,0,0,0);CHKERRQ(ierr);}
/* if on finest level and have convergence criteria set */
if (mglevels->level == mglevels->levels-1 && mg->ttol && reason) {
PetscReal rnorm;
ierr = VecNorm(mglevels->r,NORM_2,&rnorm);CHKERRQ(ierr);
if (rnorm <= mg->ttol) {
if (rnorm < mg->abstol) {
*reason = PCRICHARDSON_CONVERGED_ATOL;
ierr = PetscInfo2(pc,"Linear solver has converged. Residual norm %g is less than absolute tolerance %g\n",(double)rnorm,(double)mg->abstol);CHKERRQ(ierr);
} else {
*reason = PCRICHARDSON_CONVERGED_RTOL;
ierr = PetscInfo2(pc,"Linear solver has converged. Residual norm %g is less than relative tolerance times initial residual norm %g\n",(double)rnorm,(double)mg->ttol);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
}
mgc = *(mglevelsin - 1);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatRestrict(mglevels->restrct,mglevels->r,mgc->b);CHKERRQ(ierr);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = VecSet(mgc->x,0.0);CHKERRQ(ierr);
while (cycles--) {
ierr = PCMGMCycle_Private(pc,mglevelsin-1,reason);CHKERRQ(ierr);
}
if (mglevels->eventinterprestrict) {ierr = PetscLogEventBegin(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
ierr = MatInterpolateAdd(mglevels->interpolate,mgc->x,mglevels->x,mglevels->x);CHKERRQ(ierr);
if (mglevels->eventinterprestrict) {ierr = PetscLogEventEnd(mglevels->eventinterprestrict,0,0,0,0);CHKERRQ(ierr);}
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventBegin(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSolve(mglevels->smoothu,mglevels->b,mglevels->x);CHKERRQ(ierr); /* post smooth */
if (mglevels->eventsmoothsolve) {ierr = PetscLogEventEnd(mglevels->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
}
PetscFunctionReturn(0);
}
static PetscErrorCode DMRestrictHook_TSEIMEX(DM fine,Mat restrct,Vec rscale,Mat inject,DM coarse,void *ctx)
{
TS ts = (TS)ctx;
PetscErrorCode ierr;
Vec Z,Z_c;
PetscFunctionBegin;
ierr = TSEIMEXGetVecs(ts,fine,&Z,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = TSEIMEXGetVecs(ts,coarse,&Z_c,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatRestrict(restrct,Z,Z_c);CHKERRQ(ierr);
ierr = VecPointwiseMult(Z_c,rscale,Z_c);CHKERRQ(ierr);
ierr = TSEIMEXRestoreVecs(ts,fine,&Z,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = TSEIMEXRestoreVecs(ts,coarse,&Z_c,NULL,NULL,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscInt M = 14,dof = 1,s = 1,ratio = 2,dim = 2;
PetscErrorCode ierr;
DM da_c,da_f;
Vec v_c,v_f;
Mat I;
PetscScalar one = 1.0;
MPI_Comm comm_f, comm_c;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-dim",&dim,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-sw",&s,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-ratio",&ratio,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-dof",&dof,PETSC_NULL);CHKERRQ(ierr);
comm_f = PETSC_COMM_WORLD;
ierr = DMDASplitComm2d(comm_f,M,M,s,&comm_c);CHKERRQ(ierr);
/* Set up the array */
if (dim == 2) {
ierr = DMDACreate2d(comm_c,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_BOX,M,M,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL,PETSC_NULL,&da_c);CHKERRQ(ierr);
M = ratio*(M-1) + 1;
ierr = DMDACreate2d(comm_f,DMDA_BOUNDARY_NONE,DMDA_BOUNDARY_NONE,DMDA_STENCIL_BOX,M,M,PETSC_DECIDE,PETSC_DECIDE,dof,s,PETSC_NULL,PETSC_NULL,&da_f);CHKERRQ(ierr);
} else if (dim == 3) {
;
}
ierr = DMCreateGlobalVector(da_c,&v_c);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da_f,&v_f);CHKERRQ(ierr);
ierr = VecSet(v_c,one);CHKERRQ(ierr);
ierr = DMCreateInterpolation(da_c,da_f,&I,PETSC_NULL);CHKERRQ(ierr);
ierr = MatInterpolate(I,v_c,v_f);CHKERRQ(ierr);
ierr = VecView(v_f,PETSC_VIEWER_STDOUT_(comm_f));CHKERRQ(ierr);
ierr = MatRestrict(I,v_f,v_c);CHKERRQ(ierr);
ierr = VecView(v_c,PETSC_VIEWER_STDOUT_(comm_c));CHKERRQ(ierr);
ierr = MatDestroy(&I);CHKERRQ(ierr);
ierr = VecDestroy(&v_c);CHKERRQ(ierr);
ierr = DMDestroy(&da_c);CHKERRQ(ierr);
ierr = VecDestroy(&v_f);CHKERRQ(ierr);
ierr = DMDestroy(&da_f);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/* This could restrict auxiliary information to the coarse level.
*/
static PetscErrorCode CoefficientRestrictHook(DM dm,Mat restrct,Vec rscale,Mat Inject,DM dmc,void *ctx)
{
Vec c,cc;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMGetNamedGlobalVector(dm,"coefficient",&c);CHKERRQ(ierr);
ierr = DMGetNamedGlobalVector(dmc,"coefficient",&cc);CHKERRQ(ierr);
/* restrict the coefficient rather than injecting it */
ierr = MatRestrict(restrct,c,cc);CHKERRQ(ierr);
ierr = DMRestoreNamedGlobalVector(dm,"coefficient",&c);CHKERRQ(ierr);
ierr = DMRestoreNamedGlobalVector(dmc,"coefficient",&cc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCSetUp_MG(PC pc)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt i,n = mglevels[0]->levels;
PC cpc;
PetscBool dump = PETSC_FALSE,opsset,use_amat,missinginterpolate = PETSC_FALSE;
Mat dA,dB;
Vec tvec;
DM *dms;
PetscViewer viewer = 0;
PetscFunctionBegin;
/* FIX: Move this to PCSetFromOptions_MG? */
if (mg->usedmfornumberoflevels) {
PetscInt levels;
ierr = DMGetRefineLevel(pc->dm,&levels);CHKERRQ(ierr);
levels++;
if (levels > n) { /* the problem is now being solved on a finer grid */
ierr = PCMGSetLevels(pc,levels,NULL);CHKERRQ(ierr);
n = levels;
ierr = PCSetFromOptions(pc);CHKERRQ(ierr); /* it is bad to call this here, but otherwise will never be called for the new hierarchy */
mglevels = mg->levels;
}
}
ierr = KSPGetPC(mglevels[0]->smoothd,&cpc);CHKERRQ(ierr);
/* If user did not provide fine grid operators OR operator was not updated since last global KSPSetOperators() */
/* so use those from global PC */
/* Is this what we always want? What if user wants to keep old one? */
ierr = KSPGetOperatorsSet(mglevels[n-1]->smoothd,NULL,&opsset);CHKERRQ(ierr);
if (opsset) {
Mat mmat;
ierr = KSPGetOperators(mglevels[n-1]->smoothd,NULL,&mmat);CHKERRQ(ierr);
if (mmat == pc->pmat) opsset = PETSC_FALSE;
}
if (!opsset) {
ierr = PCGetUseAmat(pc,&use_amat);CHKERRQ(ierr);
if(use_amat){
ierr = PetscInfo(pc,"Using outer operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->mat,pc->pmat);CHKERRQ(ierr);
}
else {
ierr = PetscInfo(pc,"Using matrix (pmat) operators to define finest grid operator \n because PCMGGetSmoother(pc,nlevels-1,&ksp);KSPSetOperators(ksp,...); was not called.\n");CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[n-1]->smoothd,pc->pmat,pc->pmat);CHKERRQ(ierr);
}
}
for (i=n-1; i>0; i--) {
if (!(mglevels[i]->interpolate || mglevels[i]->restrct)) {
missinginterpolate = PETSC_TRUE;
continue;
}
}
/*
Skipping if user has provided all interpolation/restriction needed (since DM might not be able to produce them (when coming from SNES/TS)
Skipping for galerkin==2 (externally managed hierarchy such as ML and GAMG). Cleaner logic here would be great. Wrap ML/GAMG as DMs?
*/
if (missinginterpolate && pc->dm && mg->galerkin != 2 && !pc->setupcalled) {
/* construct the interpolation from the DMs */
Mat p;
Vec rscale;
ierr = PetscMalloc1(n,&dms);CHKERRQ(ierr);
dms[n-1] = pc->dm;
/* Separately create them so we do not get DMKSP interference between levels */
for (i=n-2; i>-1; i--) {ierr = DMCoarsen(dms[i+1],MPI_COMM_NULL,&dms[i]);CHKERRQ(ierr);}
for (i=n-2; i>-1; i--) {
DMKSP kdm;
PetscBool dmhasrestrict;
ierr = KSPSetDM(mglevels[i]->smoothd,dms[i]);CHKERRQ(ierr);
if (mg->galerkin) {ierr = KSPSetDMActive(mglevels[i]->smoothd,PETSC_FALSE);CHKERRQ(ierr);}
ierr = DMGetDMKSPWrite(dms[i],&kdm);CHKERRQ(ierr);
/* Ugly hack so that the next KSPSetUp() will use the RHS that we set. A better fix is to change dmActive to take
* a bitwise OR of computing the matrix, RHS, and initial iterate. */
kdm->ops->computerhs = NULL;
kdm->rhsctx = NULL;
if (!mglevels[i+1]->interpolate) {
ierr = DMCreateInterpolation(dms[i],dms[i+1],&p,&rscale);CHKERRQ(ierr);
ierr = PCMGSetInterpolation(pc,i+1,p);CHKERRQ(ierr);
if (rscale) {ierr = PCMGSetRScale(pc,i+1,rscale);CHKERRQ(ierr);}
ierr = VecDestroy(&rscale);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
ierr = DMHasCreateRestriction(dms[i],&dmhasrestrict);CHKERRQ(ierr);
if (dmhasrestrict && !mglevels[i+1]->restrct){
ierr = DMCreateRestriction(dms[i],dms[i+1],&p);CHKERRQ(ierr);
ierr = PCMGSetRestriction(pc,i+1,p);CHKERRQ(ierr);
ierr = MatDestroy(&p);CHKERRQ(ierr);
}
}
for (i=n-2; i>-1; i--) {ierr = DMDestroy(&dms[i]);CHKERRQ(ierr);}
ierr = PetscFree(dms);CHKERRQ(ierr);
}
if (pc->dm && !pc->setupcalled) {
/* finest smoother also gets DM but it is not active, independent of whether galerkin==2 */
ierr = KSPSetDM(mglevels[n-1]->smoothd,pc->dm);CHKERRQ(ierr);
ierr = KSPSetDMActive(mglevels[n-1]->smoothd,PETSC_FALSE);CHKERRQ(ierr);
}
if (mg->galerkin == 1) {
Mat B;
/* currently only handle case where mat and pmat are the same on coarser levels */
ierr = KSPGetOperators(mglevels[n-1]->smoothd,&dA,&dB);CHKERRQ(ierr);
if (!pc->setupcalled) {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_INITIAL_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
if (i != n-2) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
dB = B;
}
if (n > 1) {ierr = PetscObjectDereference((PetscObject)dB);CHKERRQ(ierr);}
} else {
for (i=n-2; i>-1; i--) {
if (!mglevels[i+1]->restrct && !mglevels[i+1]->interpolate) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Must provide interpolation or restriction for each MG level except level 0");
if (!mglevels[i+1]->interpolate) {
ierr = PCMGSetInterpolation(pc,i+1,mglevels[i+1]->restrct);CHKERRQ(ierr);
}
if (!mglevels[i+1]->restrct) {
ierr = PCMGSetRestriction(pc,i+1,mglevels[i+1]->interpolate);CHKERRQ(ierr);
}
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&B);CHKERRQ(ierr);
if (mglevels[i+1]->interpolate == mglevels[i+1]->restrct) {
ierr = MatPtAP(dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
} else {
ierr = MatMatMatMult(mglevels[i+1]->restrct,dB,mglevels[i+1]->interpolate,MAT_REUSE_MATRIX,1.0,&B);CHKERRQ(ierr);
}
ierr = KSPSetOperators(mglevels[i]->smoothd,B,B);CHKERRQ(ierr);
dB = B;
}
}
} else if (!mg->galerkin && pc->dm && pc->dm->x) {
/* need to restrict Jacobian location to coarser meshes for evaluation */
for (i=n-2; i>-1; i--) {
Mat R;
Vec rscale;
if (!mglevels[i]->smoothd->dm->x) {
Vec *vecs;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vecs,0,NULL);CHKERRQ(ierr);
mglevels[i]->smoothd->dm->x = vecs[0];
ierr = PetscFree(vecs);CHKERRQ(ierr);
}
ierr = PCMGGetRestriction(pc,i+1,&R);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
ierr = MatRestrict(R,mglevels[i+1]->smoothd->dm->x,mglevels[i]->smoothd->dm->x);CHKERRQ(ierr);
ierr = VecPointwiseMult(mglevels[i]->smoothd->dm->x,mglevels[i]->smoothd->dm->x,rscale);CHKERRQ(ierr);
}
}
if (!mg->galerkin && pc->dm) {
for (i=n-2; i>=0; i--) {
DM dmfine,dmcoarse;
Mat Restrict,Inject;
Vec rscale;
ierr = KSPGetDM(mglevels[i+1]->smoothd,&dmfine);CHKERRQ(ierr);
ierr = KSPGetDM(mglevels[i]->smoothd,&dmcoarse);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i+1,&Restrict);CHKERRQ(ierr);
ierr = PCMGGetRScale(pc,i+1,&rscale);CHKERRQ(ierr);
Inject = NULL; /* Callback should create it if it needs Injection */
ierr = DMRestrict(dmfine,Restrict,rscale,Inject,dmcoarse);CHKERRQ(ierr);
}
}
if (!pc->setupcalled) {
for (i=0; i<n; i++) {
ierr = KSPSetFromOptions(mglevels[i]->smoothd);CHKERRQ(ierr);
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && (mglevels[i]->smoothu != mglevels[i]->smoothd)) {
ierr = KSPSetFromOptions(mglevels[i]->smoothu);CHKERRQ(ierr);
}
}
/* insure that if either interpolation or restriction is set the other other one is set */
for (i=1; i<n; i++) {
ierr = PCMGGetInterpolation(pc,i,NULL);CHKERRQ(ierr);
ierr = PCMGGetRestriction(pc,i,NULL);CHKERRQ(ierr);
}
for (i=0; i<n-1; i++) {
if (!mglevels[i]->b) {
Vec *vec;
ierr = KSPCreateVecs(mglevels[i]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetRhs(pc,i,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
if (!mglevels[i]->r && i) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetR(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
if (!mglevels[i]->x) {
ierr = VecDuplicate(mglevels[i]->b,&tvec);CHKERRQ(ierr);
ierr = PCMGSetX(pc,i,tvec);CHKERRQ(ierr);
ierr = VecDestroy(&tvec);CHKERRQ(ierr);
}
}
if (n != 1 && !mglevels[n-1]->r) {
/* PCMGSetR() on the finest level if user did not supply it */
Vec *vec;
ierr = KSPCreateVecs(mglevels[n-1]->smoothd,1,&vec,0,NULL);CHKERRQ(ierr);
ierr = PCMGSetR(pc,n-1,*vec);CHKERRQ(ierr);
ierr = VecDestroy(vec);CHKERRQ(ierr);
ierr = PetscFree(vec);CHKERRQ(ierr);
}
}
if (pc->dm) {
/* need to tell all the coarser levels to rebuild the matrix using the DM for that level */
for (i=0; i<n-1; i++) {
if (mglevels[i]->smoothd->setupstage != KSP_SETUP_NEW) mglevels[i]->smoothd->setupstage = KSP_SETUP_NEWMATRIX;
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu == mglevels[i]->smoothd || mg->am == PC_MG_FULL || mg->am == PC_MG_KASKADE || mg->cyclesperpcapply > 1){
/* if doing only down then initial guess is zero */
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothd,PETSC_TRUE);CHKERRQ(ierr);
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothd);CHKERRQ(ierr);
if (mglevels[i]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
if (!mglevels[i]->residual) {
Mat mat;
ierr = KSPGetOperators(mglevels[i]->smoothd,NULL,&mat);CHKERRQ(ierr);
ierr = PCMGSetResidual(pc,i,PCMGResidualDefault,mat);CHKERRQ(ierr);
}
}
for (i=1; i<n; i++) {
if (mglevels[i]->smoothu && mglevels[i]->smoothu != mglevels[i]->smoothd) {
Mat downmat,downpmat;
/* check if operators have been set for up, if not use down operators to set them */
ierr = KSPGetOperatorsSet(mglevels[i]->smoothu,&opsset,NULL);CHKERRQ(ierr);
if (!opsset) {
ierr = KSPGetOperators(mglevels[i]->smoothd,&downmat,&downpmat);CHKERRQ(ierr);
ierr = KSPSetOperators(mglevels[i]->smoothu,downmat,downpmat);CHKERRQ(ierr);
}
ierr = KSPSetInitialGuessNonzero(mglevels[i]->smoothu,PETSC_TRUE);CHKERRQ(ierr);
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[i]->smoothu);CHKERRQ(ierr);
if (mglevels[i]->smoothu->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[i]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[i]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
}
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventBegin(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
ierr = KSPSetUp(mglevels[0]->smoothd);CHKERRQ(ierr);
if (mglevels[0]->smoothd->reason == KSP_DIVERGED_PCSETUP_FAILED) {
pc->failedreason = PC_SUBPC_ERROR;
}
if (mglevels[0]->eventsmoothsetup) {ierr = PetscLogEventEnd(mglevels[0]->eventsmoothsetup,0,0,0,0);CHKERRQ(ierr);}
/*
Dump the interpolation/restriction matrices plus the
Jacobian/stiffness on each level. This allows MATLAB users to
easily check if the Galerkin condition A_c = R A_f R^T is satisfied.
Only support one or the other at the same time.
*/
#if defined(PETSC_USE_SOCKET_VIEWER)
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_matlab",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_SOCKET_(PetscObjectComm((PetscObject)pc));
dump = PETSC_FALSE;
#endif
ierr = PetscOptionsGetBool(((PetscObject)pc)->options,((PetscObject)pc)->prefix,"-pc_mg_dump_binary",&dump,NULL);CHKERRQ(ierr);
if (dump) viewer = PETSC_VIEWER_BINARY_(PetscObjectComm((PetscObject)pc));
if (viewer) {
for (i=1; i<n; i++) {
ierr = MatView(mglevels[i]->restrct,viewer);CHKERRQ(ierr);
}
for (i=0; i<n; i++) {
ierr = KSPGetPC(mglevels[i]->smoothd,&pc);CHKERRQ(ierr);
ierr = MatView(pc->mat,viewer);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
/*
The additive cycle looks like:
xhat = x
xhat = dS(x, b)
x = coarsecorrection(xhat, b_d)
x = x + nu*(xhat - x);
(optional) x = uS(x, b)
With the coarse RHS (defect correction) as below.
*/
PetscErrorCode SNESFASCycle_Additive(SNES snes, Vec X)
{
Vec F, B, Xhat;
Vec X_c, Xo_c, F_c, B_c;
PetscErrorCode ierr;
SNESConvergedReason reason;
PetscReal xnorm, fnorm, ynorm;
PetscBool lssuccess;
SNES next;
Mat restrct, interpolate;
SNES_FAS *fas = (SNES_FAS*)snes->data,*fasc;
PetscFunctionBegin;
ierr = SNESFASCycleGetCorrection(snes, &next);CHKERRQ(ierr);
F = snes->vec_func;
B = snes->vec_rhs;
Xhat = snes->work[1];
ierr = VecCopy(X, Xhat);CHKERRQ(ierr);
/* recurse first */
if (next) {
fasc = (SNES_FAS*)next->data;
ierr = SNESFASCycleGetRestriction(snes, &restrct);CHKERRQ(ierr);
ierr = SNESFASCycleGetInterpolation(snes, &interpolate);CHKERRQ(ierr);
if (fas->eventresidual) {ierr = PetscLogEventBegin(fas->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = SNESComputeFunction(snes, Xhat, F);CHKERRQ(ierr);
if (fas->eventresidual) {ierr = PetscLogEventEnd(fas->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr);
X_c = next->vec_sol;
Xo_c = next->work[0];
F_c = next->vec_func;
B_c = next->vec_rhs;
ierr = SNESFASRestrict(snes,Xhat,Xo_c);CHKERRQ(ierr);
/* restrict the defect */
ierr = MatRestrict(restrct, F, B_c);CHKERRQ(ierr);
/* solve the coarse problem corresponding to F^c(x^c) = b^c = Rb + F^c(Rx) - RF(x) */
if (fasc->eventresidual) {ierr = PetscLogEventBegin(fasc->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = SNESComputeFunction(next, Xo_c, F_c);CHKERRQ(ierr);
if (fasc->eventresidual) {ierr = PetscLogEventEnd(fasc->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = VecCopy(B_c, X_c);CHKERRQ(ierr);
ierr = VecCopy(F_c, B_c);CHKERRQ(ierr);
ierr = VecCopy(X_c, F_c);CHKERRQ(ierr);
/* set initial guess of the coarse problem to the projected fine solution */
ierr = VecCopy(Xo_c, X_c);CHKERRQ(ierr);
/* recurse */
ierr = SNESSetInitialFunction(next, F_c);CHKERRQ(ierr);
ierr = SNESSolve(next, B_c, X_c);CHKERRQ(ierr);
/* smooth on this level */
ierr = SNESFASDownSmooth_Private(snes, B, X, F, &fnorm);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
/* correct as x <- x + I(x^c - Rx)*/
ierr = VecAYPX(X_c, -1.0, Xo_c);CHKERRQ(ierr);
ierr = MatInterpolate(interpolate, X_c, Xhat);CHKERRQ(ierr);
/* additive correction of the coarse direction*/
ierr = SNESLineSearchApply(snes->linesearch, X, F, &fnorm, Xhat);CHKERRQ(ierr);
ierr = SNESLineSearchGetSuccess(snes->linesearch, &lssuccess);CHKERRQ(ierr);
if (!lssuccess) {
if (++snes->numFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_LINE_SEARCH;
PetscFunctionReturn(0);
}
}
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &snes->norm, &ynorm);CHKERRQ(ierr);
} else {
ierr = SNESFASDownSmooth_Private(snes, B, X, F, &snes->norm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
#if !defined(PETSC_USE_COMPLEX)
PetscErrorCode ierr;
Vec x,yp1,yp2,yp3,yp4,ym1,ym2,ym3,ym4;
PetscReal *values;
PetscViewer viewer_in,viewer_outp1,viewer_outp2,viewer_outp3,viewer_outp4;
PetscViewer viewer_outm1,viewer_outm2,viewer_outm3,viewer_outm4;
DM daf,dac1,dac2,dac3,dac4,daf1,daf2,daf3,daf4;
Vec scaling_p1,scaling_p2,scaling_p3,scaling_p4;
Mat interp_p1,interp_p2,interp_p3,interp_p4,interp_m1,interp_m2,interp_m3,interp_m4;
#endif
PetscInitialize(&argc,&argv, (char*)0, help);
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"Not for complex numbers");
#else
ierr = DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,DM_BOUNDARY_PERIODIC,DMDA_STENCIL_BOX,1024,1024,PETSC_DECIDE,PETSC_DECIDE, 1, 1,NULL,NULL,&daf);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(daf,&x);CHKERRQ(ierr);
ierr = VecGetArray(x,&values);CHKERRQ(ierr);
ierr = DMCoarsen(daf,PETSC_COMM_WORLD,&dac1);CHKERRQ(ierr);
ierr = DMCoarsen(dac1,PETSC_COMM_WORLD,&dac2);CHKERRQ(ierr);
ierr = DMCoarsen(dac2,PETSC_COMM_WORLD,&dac3);CHKERRQ(ierr);
ierr = DMCoarsen(dac3,PETSC_COMM_WORLD,&dac4);CHKERRQ(ierr);
ierr = DMRefine(daf,PETSC_COMM_WORLD,&daf1);CHKERRQ(ierr);
ierr = DMRefine(daf1,PETSC_COMM_WORLD,&daf2);CHKERRQ(ierr);
ierr = DMRefine(daf2,PETSC_COMM_WORLD,&daf3);CHKERRQ(ierr);
ierr = DMRefine(daf3,PETSC_COMM_WORLD,&daf4);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dac1,&yp1);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dac2,&yp2);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dac3,&yp3);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dac4,&yp4);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(daf1,&ym1);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(daf2,&ym2);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(daf3,&ym3);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(daf4,&ym4);CHKERRQ(ierr);
ierr = DMCreateInterpolation(dac1,daf,&interp_p1,&scaling_p1);CHKERRQ(ierr);
ierr = DMCreateInterpolation(dac2,dac1,&interp_p2,&scaling_p2);CHKERRQ(ierr);
ierr = DMCreateInterpolation(dac3,dac2,&interp_p3,&scaling_p3);CHKERRQ(ierr);
ierr = DMCreateInterpolation(dac4,dac3,&interp_p4,&scaling_p4);CHKERRQ(ierr);
ierr = DMCreateInterpolation(daf,daf1,&interp_m1,NULL);CHKERRQ(ierr);
ierr = DMCreateInterpolation(daf1,daf2,&interp_m2,NULL);CHKERRQ(ierr);
ierr = DMCreateInterpolation(daf2,daf3,&interp_m3,NULL);CHKERRQ(ierr);
ierr = DMCreateInterpolation(daf3,daf4,&interp_m4,NULL);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phi",FILE_MODE_READ,&viewer_in);CHKERRQ(ierr);
ierr = PetscViewerBinaryRead(viewer_in,values,1048576,PETSC_DOUBLE);CHKERRQ(ierr);
ierr = MatRestrict(interp_p1,x,yp1);
ierr = VecPointwiseMult(yp1,yp1,scaling_p1);CHKERRQ(ierr);
ierr = MatRestrict(interp_p2,yp1,yp2);
ierr = VecPointwiseMult(yp2,yp2,scaling_p2);CHKERRQ(ierr);
ierr = MatRestrict(interp_p3,yp2,yp3);
ierr = VecPointwiseMult(yp3,yp3,scaling_p3);CHKERRQ(ierr);
ierr = MatRestrict(interp_p4,yp3,yp4);
ierr = VecPointwiseMult(yp4,yp4,scaling_p4);CHKERRQ(ierr);
ierr = MatRestrict(interp_m1,x,ym1);
ierr = MatRestrict(interp_m2,ym1,ym2);
ierr = MatRestrict(interp_m3,ym2,ym3);
ierr = MatRestrict(interp_m4,ym3,ym4);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phi1",FILE_MODE_WRITE,&viewer_outp1);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phi2",FILE_MODE_WRITE,&viewer_outp2);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phi3",FILE_MODE_WRITE,&viewer_outp3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phi4",FILE_MODE_WRITE,&viewer_outp4);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phim1",FILE_MODE_WRITE,&viewer_outm1);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phim2",FILE_MODE_WRITE,&viewer_outm2);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phim3",FILE_MODE_WRITE,&viewer_outm3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,"phim4",FILE_MODE_WRITE,&viewer_outm4);CHKERRQ(ierr);
ierr = VecView(yp1,viewer_outp1);CHKERRQ(ierr);
ierr = VecView(x,viewer_outp1);CHKERRQ(ierr);
ierr = VecView(yp2,viewer_outp2);CHKERRQ(ierr);
ierr = VecView(yp3,viewer_outp3);CHKERRQ(ierr);
ierr = VecView(yp4,viewer_outp4);CHKERRQ(ierr);
ierr = VecView(ym1,viewer_outm1);CHKERRQ(ierr);
ierr = VecView(ym2,viewer_outm2);CHKERRQ(ierr);
ierr = VecView(ym3,viewer_outm3);CHKERRQ(ierr);
ierr = VecView(ym4,viewer_outm4);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_in);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outp1);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outp2);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outp3);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outp4);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outm1);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outm2);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outm3);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer_outm4);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&yp1);CHKERRQ(ierr);
ierr = VecDestroy(&yp2);CHKERRQ(ierr);
ierr = VecDestroy(&yp3);CHKERRQ(ierr);
ierr = VecDestroy(&yp4);CHKERRQ(ierr);
ierr = VecDestroy(&ym1);CHKERRQ(ierr);
ierr = VecDestroy(&ym2);CHKERRQ(ierr);
ierr = VecDestroy(&ym3);CHKERRQ(ierr);
ierr = VecDestroy(&ym4);CHKERRQ(ierr);
#endif
PetscFinalize();
return 0;
}
