PetscErrorCode SNESDestroy_FAS(SNES snes)
{
SNES_FAS * fas = (SNES_FAS *)snes->data;
PetscErrorCode ierr = 0;
PetscFunctionBegin;
/* recursively resets and then destroys */
ierr = SNESReset(snes);CHKERRQ(ierr);
if (fas->next) ierr = SNESDestroy(&fas->next);CHKERRQ(ierr);
ierr = PetscFree(fas);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESNASMSetSubdomains_NASM(SNES snes,PetscInt n,SNES subsnes[],VecScatter iscatter[],VecScatter oscatter[],VecScatter gscatter[])
{
PetscInt i;
PetscErrorCode ierr;
SNES_NASM *nasm = (SNES_NASM*)snes->data;
PetscFunctionBegin;
if (snes->setupcalled) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE,"SNESNASMSetSubdomains() should be called before calling SNESSetUp().");
/* tear down the previously set things */
ierr = SNESReset(snes);CHKERRQ(ierr);
nasm->n = n;
if (oscatter) {
for (i=0; i<n; i++) {ierr = PetscObjectReference((PetscObject)oscatter[i]);CHKERRQ(ierr);}
}
if (iscatter) {
for (i=0; i<n; i++) {ierr = PetscObjectReference((PetscObject)iscatter[i]);CHKERRQ(ierr);}
}
if (gscatter) {
for (i=0; i<n; i++) {ierr = PetscObjectReference((PetscObject)gscatter[i]);CHKERRQ(ierr);}
}
if (oscatter) {
ierr = PetscMalloc(n*sizeof(IS),&nasm->oscatter);CHKERRQ(ierr);
for (i=0; i<n; i++) {
nasm->oscatter[i] = oscatter[i];
}
}
if (iscatter) {
ierr = PetscMalloc(n*sizeof(IS),&nasm->iscatter);CHKERRQ(ierr);
for (i=0; i<n; i++) {
nasm->iscatter[i] = iscatter[i];
}
}
if (gscatter) {
ierr = PetscMalloc(n*sizeof(IS),&nasm->gscatter);CHKERRQ(ierr);
for (i=0; i<n; i++) {
nasm->gscatter[i] = gscatter[i];
}
}
if (subsnes) {
ierr = PetscMalloc(n*sizeof(SNES),&nasm->subsnes);CHKERRQ(ierr);
for (i=0; i<n; i++) {
nasm->subsnes[i] = subsnes[i];
}
nasm->same_local_solves = PETSC_FALSE;
}
PetscFunctionReturn(0);
}
/*@C
SNESFASSetLevels - Sets the number of levels to use with FAS.
Must be called before any other FAS routine.
Input Parameters:
+ snes - the snes context
. levels - the number of levels
- comms - optional communicators for each level; this is to allow solving the coarser
problems on smaller sets of processors. Use NULL_OBJECT for default in
Fortran.
Level: intermediate
Notes:
If the number of levels is one then the multigrid uses the -fas_levels prefix
for setting the level options rather than the -fas_coarse prefix.
.keywords: FAS, MG, set, levels, multigrid
.seealso: SNESFASGetLevels()
@*/
PetscErrorCode SNESFASSetLevels(SNES snes, PetscInt levels, MPI_Comm * comms)
{
PetscErrorCode ierr;
PetscInt i;
const char *optionsprefix;
char tprefix[128];
SNES_FAS *fas = (SNES_FAS*)snes->data;
SNES prevsnes;
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
if (levels == fas->levels) {
if (!comms) PetscFunctionReturn(0);
}
/* user has changed the number of levels; reset */
ierr = SNESReset(snes);CHKERRQ(ierr);
/* destroy any coarser levels if necessary */
if (fas->next) SNESDestroy(&fas->next);CHKERRQ(ierr);
fas->next = NULL;
fas->previous = NULL;
prevsnes = snes;
/* setup the finest level */
ierr = SNESGetOptionsPrefix(snes, &optionsprefix);CHKERRQ(ierr);
for (i = levels - 1; i >= 0; i--) {
if (comms) comm = comms[i];
fas->level = i;
fas->levels = levels;
fas->fine = snes;
fas->next = NULL;
if (i > 0) {
ierr = SNESCreate(comm, &fas->next);CHKERRQ(ierr);
ierr = SNESGetOptionsPrefix(fas->fine, &optionsprefix);CHKERRQ(ierr);
sprintf(tprefix,"fas_levels_%d_cycle_",(int)fas->level);
ierr = SNESAppendOptionsPrefix(fas->next,optionsprefix);CHKERRQ(ierr);
ierr = SNESAppendOptionsPrefix(fas->next,tprefix);CHKERRQ(ierr);
ierr = SNESSetType(fas->next, SNESFAS);CHKERRQ(ierr);
ierr = SNESSetTolerances(fas->next, fas->next->abstol, fas->next->rtol, fas->next->stol, fas->n_cycles, fas->next->max_funcs);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)fas->next, (PetscObject)snes, levels - i);CHKERRQ(ierr);
((SNES_FAS*)fas->next->data)->previous = prevsnes;
prevsnes = fas->next;
fas = (SNES_FAS*)prevsnes->data;
}
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESReset_FAS(SNES snes)
{
PetscErrorCode ierr = 0;
SNES_FAS * fas = (SNES_FAS *)snes->data;
PetscFunctionBegin;
ierr = SNESDestroy(&fas->smoothu);CHKERRQ(ierr);
ierr = SNESDestroy(&fas->smoothd);CHKERRQ(ierr);
ierr = MatDestroy(&fas->inject);CHKERRQ(ierr);
ierr = MatDestroy(&fas->interpolate);CHKERRQ(ierr);
ierr = MatDestroy(&fas->restrct);CHKERRQ(ierr);
ierr = VecDestroy(&fas->rscale);CHKERRQ(ierr);
if (fas->next) ierr = SNESReset(fas->next);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESReset_Multiblock(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks = mb->blocks, next;
PetscErrorCode ierr;
PetscFunctionBegin;
while (blocks) {
ierr = SNESReset(blocks->snes);CHKERRQ(ierr);
#if 0
ierr = VecDestroy(&blocks->x);CHKERRQ(ierr);
#endif
ierr = VecScatterDestroy(&blocks->sctx);CHKERRQ(ierr);
ierr = ISDestroy(&blocks->is);CHKERRQ(ierr);
next = blocks->next;
blocks = next;
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESReset_Composite(SNES snes)
{
SNES_Composite *jac = (SNES_Composite*)snes->data;
PetscErrorCode ierr;
SNES_CompositeLink next = jac->head;
PetscFunctionBegin;
while (next) {
ierr = SNESReset(next->snes);CHKERRQ(ierr);
next = next->next;
}
ierr = VecDestroy(&jac->Xorig);CHKERRQ(ierr);
if (jac->Xes) {ierr = VecDestroyVecs(jac->nsnes,&jac->Xes);CHKERRQ(ierr);}
if (jac->Fes) {ierr = VecDestroyVecs(jac->nsnes,&jac->Fes);CHKERRQ(ierr);}
ierr = PetscFree(jac->fnorms);CHKERRQ(ierr);
ierr = PetscFree(jac->h);CHKERRQ(ierr);
ierr = PetscFree(jac->s);CHKERRQ(ierr);
ierr = PetscFree(jac->g);CHKERRQ(ierr);
ierr = PetscFree(jac->beta);CHKERRQ(ierr);
ierr = PetscFree(jac->work);CHKERRQ(ierr);
ierr = PetscFree(jac->rwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscConvEstGetConvRate - Returns an estimate of the convergence rate for the discretization
Not collective
Input Parameter:
. ce - The PetscConvEst object
Output Parameter:
. alpha - The convergence rate for each field
Note: The convergence rate alpha is defined by
$ || u_h - u_exact || < C h^alpha
where u_h is the discrete solution, and h is a measure of the discretization size.
We solve a series of problems on refined meshes, calculate an error based upon the exact solution in the DS,
and then fit the result to our model above using linear regression.
Options database keys:
. -snes_convergence_estimate : Execute convergence estimation and print out the rate
Level: intermediate
.keywords: PetscConvEst, convergence
.seealso: PetscConvEstSetSolver(), PetscConvEstCreate(), PetscConvEstGetConvRate()
@*/
PetscErrorCode PetscConvEstGetConvRate(PetscConvEst ce, PetscReal alpha[])
{
DM *dm;
PetscObject disc;
MPI_Comm comm;
const char *uname, *dmname;
void *ctx;
Vec u;
PetscReal t = 0.0, *x, *y, slope, intercept;
PetscInt *dof, dim, Nr = ce->Nr, r, f, oldlevel, oldnlev;
PetscLogEvent event;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject) ce, &comm);CHKERRQ(ierr);
ierr = DMGetDimension(ce->idm, &dim);CHKERRQ(ierr);
ierr = DMGetApplicationContext(ce->idm, &ctx);CHKERRQ(ierr);
ierr = DMPlexSetRefinementUniform(ce->idm, PETSC_TRUE);CHKERRQ(ierr);
ierr = DMGetRefineLevel(ce->idm, &oldlevel);CHKERRQ(ierr);
ierr = PetscMalloc2((Nr+1), &dm, (Nr+1)*ce->Nf, &dof);CHKERRQ(ierr);
dm[0] = ce->idm;
for (f = 0; f < ce->Nf; ++f) alpha[f] = 0.0;
/* Loop over meshes */
ierr = PetscLogEventRegister("ConvEst Error", PETSC_OBJECT_CLASSID, &event);CHKERRQ(ierr);
for (r = 0; r <= Nr; ++r) {
PetscLogStage stage;
char stageName[PETSC_MAX_PATH_LEN];
ierr = PetscSNPrintf(stageName, PETSC_MAX_PATH_LEN-1, "ConvEst Refinement Level %D", r);CHKERRQ(ierr);
ierr = PetscLogStageRegister(stageName, &stage);CHKERRQ(ierr);
ierr = PetscLogStagePush(stage);CHKERRQ(ierr);
if (r > 0) {
ierr = DMRefine(dm[r-1], MPI_COMM_NULL, &dm[r]);CHKERRQ(ierr);
ierr = DMSetCoarseDM(dm[r], dm[r-1]);CHKERRQ(ierr);
ierr = DMCopyDisc(ce->idm, dm[r]);CHKERRQ(ierr);
ierr = DMCopyTransform(ce->idm, dm[r]);CHKERRQ(ierr);
ierr = PetscObjectGetName((PetscObject) dm[r-1], &dmname);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) dm[r], dmname);CHKERRQ(ierr);
for (f = 0; f <= ce->Nf; ++f) {
PetscErrorCode (*nspconstr)(DM, PetscInt, MatNullSpace *);
ierr = DMGetNullSpaceConstructor(dm[r-1], f, &nspconstr);CHKERRQ(ierr);
ierr = DMSetNullSpaceConstructor(dm[r], f, nspconstr);CHKERRQ(ierr);
}
}
ierr = DMViewFromOptions(dm[r], NULL, "-conv_dm_view");CHKERRQ(ierr);
/* Create solution */
ierr = DMCreateGlobalVector(dm[r], &u);CHKERRQ(ierr);
ierr = DMGetField(dm[r], 0, NULL, &disc);CHKERRQ(ierr);
ierr = PetscObjectGetName(disc, &uname);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) u, uname);CHKERRQ(ierr);
/* Setup solver */
ierr = SNESReset(ce->snes);CHKERRQ(ierr);
ierr = SNESSetDM(ce->snes, dm[r]);CHKERRQ(ierr);
ierr = DMPlexSetSNESLocalFEM(dm[r], ctx, ctx, ctx);CHKERRQ(ierr);
ierr = SNESSetFromOptions(ce->snes);CHKERRQ(ierr);
/* Create initial guess */
ierr = DMProjectFunction(dm[r], t, ce->initGuess, ce->ctxs, INSERT_VALUES, u);CHKERRQ(ierr);
ierr = SNESSolve(ce->snes, NULL, u);CHKERRQ(ierr);
ierr = PetscLogEventBegin(event, ce, 0, 0, 0);CHKERRQ(ierr);
ierr = DMComputeL2FieldDiff(dm[r], t, ce->exactSol, ce->ctxs, u, &ce->errors[r*ce->Nf]);CHKERRQ(ierr);
ierr = PetscLogEventEnd(event, ce, 0, 0, 0);CHKERRQ(ierr);
for (f = 0; f < ce->Nf; ++f) {
PetscSection s, fs;
PetscInt lsize;
/* Could use DMGetOutputDM() to add in Dirichlet dofs */
ierr = DMGetSection(dm[r], &s);CHKERRQ(ierr);
ierr = PetscSectionGetField(s, f, &fs);CHKERRQ(ierr);
ierr = PetscSectionGetConstrainedStorageSize(fs, &lsize);CHKERRQ(ierr);
ierr = MPI_Allreduce(&lsize, &dof[r*ce->Nf+f], 1, MPIU_INT, MPI_SUM, PetscObjectComm((PetscObject) ce->snes));CHKERRQ(ierr);
ierr = PetscLogEventSetDof(event, f, dof[r*ce->Nf+f]);CHKERRQ(ierr);
ierr = PetscLogEventSetError(event, f, ce->errors[r*ce->Nf+f]);CHKERRQ(ierr);
}
/* Monitor */
if (ce->monitor) {
PetscReal *errors = &ce->errors[r*ce->Nf];
ierr = PetscPrintf(comm, "L_2 Error: ");CHKERRQ(ierr);
if (ce->Nf > 1) {ierr = PetscPrintf(comm, "[");CHKERRQ(ierr);}
for (f = 0; f < ce->Nf; ++f) {
if (f > 0) {ierr = PetscPrintf(comm, ", ");CHKERRQ(ierr);}
if (errors[f] < 1.0e-11) {ierr = PetscPrintf(comm, "< 1e-11");CHKERRQ(ierr);}
else {ierr = PetscPrintf(comm, "%g", (double)errors[f]);CHKERRQ(ierr);}
}
if (ce->Nf > 1) {ierr = PetscPrintf(comm, "]");CHKERRQ(ierr);}
ierr = PetscPrintf(comm, "\n");CHKERRQ(ierr);
}
if (!r) {
/* PCReset() does not wipe out the level structure */
KSP ksp;
PC pc;
ierr = SNESGetKSP(ce->snes, &ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCMGGetLevels(pc, &oldnlev);CHKERRQ(ierr);
}
/* Cleanup */
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
}
for (r = 1; r <= Nr; ++r) {
ierr = DMDestroy(&dm[r]);CHKERRQ(ierr);
}
/* Fit convergence rate */
ierr = PetscMalloc2(Nr+1, &x, Nr+1, &y);CHKERRQ(ierr);
for (f = 0; f < ce->Nf; ++f) {
for (r = 0; r <= Nr; ++r) {
x[r] = PetscLog10Real(dof[r*ce->Nf+f]);
y[r] = PetscLog10Real(ce->errors[r*ce->Nf+f]);
}
ierr = PetscLinearRegression(Nr+1, x, y, &slope, &intercept);CHKERRQ(ierr);
/* Since h^{-dim} = N, lg err = s lg N + b = -s dim lg h + b */
alpha[f] = -slope * dim;
}
ierr = PetscFree2(x, y);CHKERRQ(ierr);
ierr = PetscFree2(dm, dof);CHKERRQ(ierr);
/* Restore solver */
ierr = SNESReset(ce->snes);CHKERRQ(ierr);
{
/* PCReset() does not wipe out the level structure */
KSP ksp;
PC pc;
ierr = SNESGetKSP(ce->snes, &ksp);CHKERRQ(ierr);
ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
ierr = PCMGSetLevels(pc, oldnlev, NULL);CHKERRQ(ierr);
ierr = DMSetRefineLevel(ce->idm, oldlevel);CHKERRQ(ierr); /* The damn DMCoarsen() calls in PCMG can reset this */
}
ierr = SNESSetDM(ce->snes, ce->idm);CHKERRQ(ierr);
ierr = DMPlexSetSNESLocalFEM(ce->idm, ctx, ctx, ctx);CHKERRQ(ierr);
ierr = SNESSetFromOptions(ce->snes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
