int main(int argc, char** argv)
{
DM da;
PetscErrorCode ierr;
Vec x, rhs;
Mat A, jac;
ierr = PetscInitialize(&argc, &argv, NULL, NULL);
CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD, NULL, "Laplacian in 2D", "");
CHKERRQ(ierr);
ierr = PetscOptionsEnd();
CHKERRQ(ierr);
ierr = HpddmRegisterKSP();
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
double time = MPI_Wtime();
ierr = DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DMDA_STENCIL_STAR, 10, 10, PETSC_DECIDE, PETSC_DECIDE, 1, 1,
0, 0, &da);
CHKERRQ(ierr);
ierr = DMSetFromOptions(da);
CHKERRQ(ierr);
ierr = DMSetUp(da);
CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da, &rhs);
CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da, &x);
CHKERRQ(ierr);
ierr = DMCreateMatrix(da, &A);
CHKERRQ(ierr);
ierr = DMCreateMatrix(da, &jac);
CHKERRQ(ierr);
ierr = ComputeMatrix(da, jac, A);
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
time = MPI_Wtime() - time;
ierr = PetscPrintf(PETSC_COMM_WORLD, "--- Mat assembly = %f\n", time);
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
time = MPI_Wtime();
KSP ksp;
ierr = KSPCreate(PETSC_COMM_WORLD, &ksp);
CHKERRQ(ierr);
ierr = KSPSetDM(ksp, da);
CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);
CHKERRQ(ierr);
ierr = KSPSetOperators(ksp, A, A);
CHKERRQ(ierr);
ierr = KSPSetDMActive(ksp, PETSC_FALSE);
CHKERRQ(ierr);
ierr = KSPSetInitialGuessNonzero(ksp, PETSC_TRUE);
CHKERRQ(ierr);
ierr = KSPSetUp(ksp);
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
time = MPI_Wtime() - time;
ierr = PetscPrintf(PETSC_COMM_WORLD, "--- PC setup = %f\n", time);
CHKERRQ(ierr);
PetscScalar nus[SIZE_ARRAY_NU] = {0.1, 10.0, 0.001, 100.0};
float t_time[SIZE_ARRAY_NU];
int t_its[SIZE_ARRAY_NU];
int i, j;
for (j = 0; j < 2; ++j) {
{
if (j == 1) {
ierr = KSPSetType(ksp, "hpddm");
CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);
CHKERRQ(ierr);
ierr = VecZeroEntries(x);
CHKERRQ(ierr);
}
ierr = KSPSolve(ksp, rhs, x);
CHKERRQ(ierr);
if (j == 1) {
const HpddmOption* const opt = HpddmOptionGet();
int previous = HpddmOptionVal(opt, "krylov_method");
if (previous == HPDDM_KRYLOV_METHOD_GCRODR || previous == HPDDM_KRYLOV_METHOD_BGCRODR) HpddmDestroyRecycling();
}
}
for (i = 0; i < SIZE_ARRAY_NU; ++i) {
ierr = VecZeroEntries(x);
CHKERRQ(ierr);
ierr = ComputeRHS(da, rhs, nus[i]);
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
time = MPI_Wtime();
ierr = KSPSolve(ksp, rhs, x);
CHKERRQ(ierr);
MPI_Barrier(PETSC_COMM_WORLD);
t_time[i] = MPI_Wtime() - time;
PetscInt its;
ierr = KSPGetIterationNumber(ksp, &its);
CHKERRQ(ierr);
t_its[i] = its;
ierr = ComputeError(A, rhs, x);
CHKERRQ(ierr);
}
for (i = 0; i < SIZE_ARRAY_NU; ++i) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "%d\t%d\t%f\n", i + 1, t_its[i], t_time[i]);
CHKERRQ(ierr);
if (i > 0) {
t_its[0] += t_its[i];
t_time[0] += t_time[i];
}
}
if (SIZE_ARRAY_NU > 1) {
ierr = PetscPrintf(PETSC_COMM_WORLD, "------------------------\n\t%d\t%f\n", t_its[0], t_time[0]);
CHKERRQ(ierr);
}
}
ierr = KSPDestroy(&ksp);
CHKERRQ(ierr);
ierr = VecDestroy(&x);
CHKERRQ(ierr);
ierr = VecDestroy(&rhs);
CHKERRQ(ierr);
ierr = MatDestroy(&A);
CHKERRQ(ierr);
ierr = MatDestroy(&jac);
CHKERRQ(ierr);
ierr = DMDestroy(&da);
CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
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);
}
void PETSC_STDCALL kspsetdmactive_(KSP ksp,PetscBool *flg, int *__ierr ){
*__ierr = KSPSetDMActive(
(KSP)PetscToPointer((ksp) ),*flg);
}
