static PetscErrorCode SNESComputePicardJacobian_DMDA(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x;
PetscFunctionBegin;
if (!dmdasnes->jacobianplocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->jacobianplocal)(&info,x,A,B,dmdasnes->picardlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
if (A != B) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeFunction_DMLocal(SNES snes,Vec X,Vec F,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc,Floc;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(F,VEC_CLASSID,3);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->residuallocal)(dm,Xloc,Floc,dmlocalsnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeObjective_DMDA(SNES snes,Vec X,PetscReal *ob,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidPointer(ob,3);
if (!dmdasnes->objectivelocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->objectivelocal)(&info,x,ob,dmdasnes->objectivelocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode ReactingFlowPostCheck(SNESLineSearch linesearch, Vec X, Vec Y, Vec W, PetscBool *changed_y, PetscBool *changed_w, void *vctx)
{
PetscInt i,j,l,Mx,My,xs,ys,xm,ym;
PetscErrorCode ierr;
Field **x;
SNES snes;
DM da;
PetscScalar min;
PetscFunctionBeginUser;
*changed_w = PETSC_FALSE;
ierr = VecMin(X,NULL,&min);CHKERRQ(ierr);
if (min >= 0.) PetscFunctionReturn(0);
*changed_w = PETSC_TRUE;
ierr = SNESLineSearchGetSNES(linesearch, &snes);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);
ierr = DMDAVecGetArray(da,W,&x);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&xs,&ys,NULL,&xm,&ym,NULL);CHKERRQ(ierr);
for (j=ys; j<ys+ym; j++) {
for (i=xs; i<xs+xm; i++) {
for (l = 0; l < N_SPECIES; l++) {
if (x[j][i].sp[l] < 0.) x[j][i].sp[l] = 0.;
}
}
}
ierr = DMDAVecRestoreArray(da,W,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
MatColoring mc;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec,matcolor = PETSC_FALSE;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
if (!color) {ierr = PetscObjectQuery((PetscObject)B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
matcolor = PETSC_FALSE;
ierr = PetscOptionsGetBool(((PetscObject)snes)->options,((PetscObject)snes)->prefix,"-snes_fd_color_use_mat",&matcolor,NULL);CHKERRQ(ierr);
if (hascolor && !matcolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
} else {
ierr = MatColoringCreate(B,&mc);CHKERRQ(ierr);
ierr = MatColoringSetDistance(mc,2);CHKERRQ(ierr);
ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,iscoloring,&color);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))SNESComputeFunctionCtx,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,iscoloring,color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
Vec F;
ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,color,x1,snes);CHKERRQ(ierr);
if (J != B) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeJacobian_DMLocal(SNES snes,Vec X,Mat A,Mat B,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_Local *dmlocalsnes = (DMSNES_Local*)ctx;
Vec Xloc;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (dmlocalsnes->jacobianlocal) {
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = VecZeroEntries(Xloc);CHKERRQ(ierr);
if (dmlocalsnes->boundarylocal) {ierr = (*dmlocalsnes->boundarylocal)(dm,Xloc,dmlocalsnes->boundarylocalctx);CHKERRQ(ierr);}
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmlocalsnes->jacobianlocal)(dm,Xloc,A,B,dmlocalsnes->jacobianlocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
} else {
MatFDColoring fdcoloring;
ierr = PetscObjectQuery((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject*)&fdcoloring);CHKERRQ(ierr);
if (!fdcoloring) {
ISColoring coloring;
ierr = DMCreateColoring(dm,dm->coloringtype,&coloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(B,coloring,&fdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&coloring);CHKERRQ(ierr);
switch (dm->coloringtype) {
case IS_COLORING_GLOBAL:
ierr = MatFDColoringSetFunction(fdcoloring,(PetscErrorCode (*)(void))SNESComputeFunction_DMLocal,dmlocalsnes);CHKERRQ(ierr);
break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"No support for coloring type '%s'",ISColoringTypes[dm->coloringtype]);
}
ierr = PetscObjectSetOptionsPrefix((PetscObject)fdcoloring,((PetscObject)dm)->prefix);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(fdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(B,coloring,fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectCompose((PetscObject)dm,"DMDASNES_FDCOLORING",(PetscObject)fdcoloring);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)fdcoloring);CHKERRQ(ierr);
/* The following breaks an ugly reference counting loop that deserves a paragraph. MatFDColoringApply() will call
* VecDuplicate() with the state Vec and store inside the MatFDColoring. This Vec will duplicate the Vec, but the
* MatFDColoring is composed with the DM. We dereference the DM here so that the reference count will eventually
* drop to 0. Note the code in DMDestroy() that exits early for a negative reference count. That code path will be
* taken when the PetscObjectList for the Vec inside MatFDColoring is destroyed.
*/
ierr = PetscObjectDereference((PetscObject)dm);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(B,fdcoloring,X,snes);CHKERRQ(ierr);
}
/* This will be redundant if the user called both, but it's too common to forget. */
if (A != B) {
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
SNESGetObjective - Returns the objective function.
Not Collective
Input Parameter:
. snes - the SNES context
Output Parameter:
+ func - the function (or PETSC_NULL)
- ctx - the function context (or PETSC_NULL)
Level: advanced
.keywords: SNES, nonlinear, get, objective
.seealso: SNESSetObjective(), SNESGetSolution()
@*/
PetscErrorCode SNESGetObjective(SNES snes,PetscErrorCode (**SNESObjectiveFunction)(SNES,Vec,PetscReal *,void*),void **ctx)
{
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMSNESGetObjective(dm,SNESObjectiveFunction,ctx);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESComputeFunction_DMDA(SNES snes,Vec X,Vec F,void *ctx)
{
PetscErrorCode ierr;
DM dm;
DMSNES_DA *dmdasnes = (DMSNES_DA*)ctx;
DMDALocalInfo info;
Vec Xloc;
void *x,*f;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(F,VEC_CLASSID,3);
if (!dmdasnes->residuallocal) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_PLIB,"Corrupt context");
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetLocalVector(dm,&Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(dm,X,INSERT_VALUES,Xloc);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(dm,&info);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Xloc,&x);CHKERRQ(ierr);
switch (dmdasnes->residuallocalimode) {
case INSERT_VALUES: {
ierr = DMDAVecGetArray(dm,F,&f);CHKERRQ(ierr);
ierr = PetscLogEventBegin(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->residuallocal)(&info,x,f,dmdasnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = PetscLogEventEnd(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dm,F,&f);CHKERRQ(ierr);
} break;
case ADD_VALUES: {
Vec Floc;
ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr);
ierr = VecZeroEntries(Floc);CHKERRQ(ierr);
ierr = DMDAVecGetArray(dm,Floc,&f);CHKERRQ(ierr);
ierr = PetscLogEventBegin(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
CHKMEMQ;
ierr = (*dmdasnes->residuallocal)(&info,x,f,dmdasnes->residuallocalctx);CHKERRQ(ierr);
CHKMEMQ;
ierr = PetscLogEventEnd(SNES_FunctionEval,snes,X,F,0);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(dm,Floc,&f);CHKERRQ(ierr);
ierr = VecZeroEntries(F);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr);
} break;
default: SETERRQ1(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_INCOMP,"Cannot use imode=%d",(int)dmdasnes->residuallocalimode);
}
ierr = DMDAVecRestoreArray(dm,Xloc,&x);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(dm,&Xloc);CHKERRQ(ierr);
if (snes->domainerror) {
ierr = VecSetInf(F);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
PetscConvEstSetSolver - Sets the solver used to produce discrete solutions
Not collective
Input Parameters:
+ ce - The PetscConvEst object
- snes - The solver
Level: intermediate
Note: The solver MUST have an attached DM/DS, so that we know the exact solution
.keywords: PetscConvEst, convergence
.seealso: PetscConvEstGetSolver(), PetscConvEstCreate(), PetscConvEstGetConvRate()
@*/
PetscErrorCode PetscConvEstSetSolver(PetscConvEst ce, SNES snes)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ce, PETSC_OBJECT_CLASSID, 1);
PetscValidHeaderSpecific(snes, SNES_CLASSID, 2);
ce->snes = snes;
ierr = SNESGetDM(ce->snes, &ce->idm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MyComputeJacobian(SNES snes,Vec x,Mat *J,Mat *Jp,MatStructure *str,void* ctx)
{
PetscErrorCode ierr;
DM dm;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = FormMatrix(dm,*Jp);CHKERRQ(ierr);
*str = SAME_NONZERO_PATTERN;
PetscFunctionReturn(0);
}
PetscErrorCode SNESComputeJacobianDefaultColor(SNES snes,Vec x1,Mat *J,Mat *B,MatStructure *flag,void *ctx)
{
MatFDColoring color = (MatFDColoring)ctx;
PetscErrorCode ierr;
DM dm;
PetscErrorCode (*func)(SNES,Vec,Vec,void*);
Vec F;
void *funcctx;
ISColoring iscoloring;
PetscBool hascolor;
PetscBool solvec;
PetscFunctionBegin;
if (color) PetscValidHeaderSpecific(color,MAT_FDCOLORING_CLASSID,6);
else {ierr = PetscObjectQuery((PetscObject)*B,"SNESMatFDColoring",(PetscObject*)&color);CHKERRQ(ierr);}
*flag = SAME_NONZERO_PATTERN;
ierr = SNESGetFunction(snes,&F,&func,&funcctx);CHKERRQ(ierr);
if (!color) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMHasColoring(dm,&hascolor);CHKERRQ(ierr);
if (hascolor) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
} else {
ierr = MatGetColoring(*B,MATCOLORINGSL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(*B,iscoloring,&color);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(color,(PetscErrorCode (*)(void))func,(void*)funcctx);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(color);CHKERRQ(ierr);
}
ierr = PetscObjectCompose((PetscObject)*B,"SNESMatFDColoring",(PetscObject)color);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)color);CHKERRQ(ierr);
}
/* F is only usable if there is no RHS on the SNES and the full solution corresponds to x1 */
ierr = VecEqual(x1,snes->vec_sol,&solvec);CHKERRQ(ierr);
if (!snes->vec_rhs && solvec) {
ierr = MatFDColoringSetF(color,F);CHKERRQ(ierr);
}
ierr = MatFDColoringApply(*B,color,x1,flag,snes);CHKERRQ(ierr);
if (*J != *B) {
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
SNESSetWorkVecs - Gets a number of work vectors.
Input Parameters:
. snes - the SNES context
. nw - number of work vectors to allocate
Level: developer
Developers Note: This is PETSC_EXTERN because it may be used by user written plugin SNES implementations
@*/
PetscErrorCode SNESSetWorkVecs(SNES snes,PetscInt nw)
{
DM dm;
Vec v;
PetscErrorCode ierr;
PetscFunctionBegin;
if (snes->work) {ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);}
snes->nwork = nw;
ierr = SNESGetDM(snes, &dm);CHKERRQ(ierr);
ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = VecDuplicateVecs(v,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,nw,snes->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESComputeObjective - Computes the objective.
Collective on SNES
Input Parameter:
+ snes - the SNES context
- X - the state vector
Output Parameter:
. ob - the objective value
Level: advanced
.keywords: SNES, nonlinear, compute, objective
.seealso: SNESSetObjective(), SNESGetSolution()
@*/
PetscErrorCode SNESComputeObjective(SNES snes,Vec X,PetscReal *ob)
{
PetscErrorCode ierr;
DM dm;
DMSNES sdm;
PetscFunctionBegin;
PetscValidHeaderSpecific(snes,SNES_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidPointer(ob,3);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetDMSNES(dm,&sdm);CHKERRQ(ierr);
if (sdm->ops->computeobjective) {
ierr = (sdm->ops->computeobjective)(snes,X,ob,sdm->objectivectx);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE, "Must call SNESSetObjective() before SNESComputeObjective().");
PetscFunctionReturn(0);
}
static PetscErrorCode SNESCompositeAddSNES_Composite(SNES snes,SNESType type)
{
SNES_Composite *jac;
SNES_CompositeLink next,ilink;
PetscErrorCode ierr;
PetscInt cnt = 0;
const char *prefix;
char newprefix[20];
DM dm;
PetscFunctionBegin;
ierr = PetscNewLog(snes,&ilink);CHKERRQ(ierr);
ilink->next = 0;
ierr = SNESCreate(PetscObjectComm((PetscObject)snes),&ilink->snes);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = SNESSetDM(ilink->snes,dm);CHKERRQ(ierr);
ierr = SNESSetTolerances(ilink->snes,ilink->snes->abstol,ilink->snes->rtol,ilink->snes->stol,1,ilink->snes->max_funcs);CHKERRQ(ierr);
ierr = PetscObjectCopyFortranFunctionPointers((PetscObject)snes,(PetscObject)ilink->snes);CHKERRQ(ierr);
jac = (SNES_Composite*)snes->data;
next = jac->head;
if (!next) {
jac->head = ilink;
ilink->previous = NULL;
} else {
cnt++;
while (next->next) {
next = next->next;
cnt++;
}
next->next = ilink;
ilink->previous = next;
}
ierr = SNESGetOptionsPrefix(snes,&prefix);CHKERRQ(ierr);
ierr = SNESSetOptionsPrefix(ilink->snes,prefix);CHKERRQ(ierr);
sprintf(newprefix,"sub_%d_",(int)cnt);
ierr = SNESAppendOptionsPrefix(ilink->snes,newprefix);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ilink->snes,(PetscObject)snes,1);CHKERRQ(ierr);
ierr = SNESSetType(ilink->snes,type);CHKERRQ(ierr);
ierr = SNESSetNormSchedule(ilink->snes, SNES_NORM_FINAL_ONLY);CHKERRQ(ierr);
ilink->dmp = 1.0;
jac->nsnes++;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormJacobian_EIMEX(SNES snes,Vec X,Mat A,Mat B,TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
Vec Ydot;
PetscErrorCode ierr;
DM dm,dmsave;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = TSEIMEXGetVecs(ts,dm,NULL,&Ydot,NULL,NULL);CHKERRQ(ierr);
/* ierr = VecZeroEntries(Ydot);CHKERRQ(ierr); */
/* ext->Ydot have already been computed in SNESTSFormFunction_EIMEX (SNES guarantees this) */
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIJacobian(ts,ts->ptime,X,Ydot,ext->shift,A,B,PETSC_TRUE);CHKERRQ(ierr);
ts->dm = dmsave;
ierr = TSEIMEXRestoreVecs(ts,dm,NULL,&Ydot,NULL,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormFunctionMatlab(SNES snes,Vec X,Vec F,void *ptr)
{
AppCtx *user = (AppCtx*)ptr;
PetscErrorCode ierr;
PetscInt Mx,My;
PetscReal lambda,hx,hy;
Vec localX,localF;
MPI_Comm comm;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMGetLocalVector(da,&localF);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)localX,"localX");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)localF,"localF");CHKERRQ(ierr);
ierr = DMDAGetInfo(da,PETSC_IGNORE,&Mx,&My,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
lambda = user->param;
hx = 1.0/(PetscReal)(Mx-1);
hy = 1.0/(PetscReal)(My-1);
ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
/*
Scatter ghost points to local vector,using the 2-step process
DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
By placing code between these two statements, computations can be
done while messages are in transition.
*/
ierr = DMGlobalToLocalBegin(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(da,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = PetscMatlabEnginePut(PETSC_MATLAB_ENGINE_(comm),(PetscObject)localX);CHKERRQ(ierr);
ierr = PetscMatlabEngineEvaluate(PETSC_MATLAB_ENGINE_(comm),"localF=ex5m(localX,%18.16e,%18.16e,%18.16e)",hx,hy,lambda);CHKERRQ(ierr);
ierr = PetscMatlabEngineGet(PETSC_MATLAB_ENGINE_(comm),(PetscObject)localF);CHKERRQ(ierr);
/*
Insert values into global vector
*/
ierr = DMLocalToGlobalBegin(da,localF,INSERT_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(da,localF,INSERT_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localX);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(da,&localF);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSetUp_QN(SNES snes)
{
SNES_QN *qn = (SNES_QN*)snes->data;
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
if (!snes->vec_sol) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dm,&snes->vec_sol);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->U);CHKERRQ(ierr);
if (qn->type != SNES_QN_BROYDEN) ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->V);CHKERRQ(ierr);
ierr = PetscMalloc4(qn->m,&qn->alpha,qn->m,&qn->beta,qn->m,&qn->dXtdF,qn->m,&qn->lambda);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = PetscMalloc3(qn->m*qn->m,&qn->dXdFmat,qn->m,&qn->dFtdX,qn->m,&qn->YtdX);CHKERRQ(ierr);
}
ierr = SNESSetWorkVecs(snes,4);CHKERRQ(ierr);
/* set method defaults */
if (qn->scale_type == SNES_QN_SCALE_DEFAULT) {
if (qn->type == SNES_QN_BADBROYDEN) {
qn->scale_type = SNES_QN_SCALE_NONE;
} else {
qn->scale_type = SNES_QN_SCALE_SHANNO;
}
}
if (qn->restart_type == SNES_QN_RESTART_DEFAULT) {
if (qn->type == SNES_QN_LBFGS) {
qn->restart_type = SNES_QN_RESTART_POWELL;
} else {
qn->restart_type = SNES_QN_RESTART_PERIODIC;
}
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
}
if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_DEFAULT) {snes->functype = SNES_FUNCTION_UNPRECONDITIONED;}
PetscFunctionReturn(0);
}
PetscErrorCode MyComputeFunction(SNES snes,Vec x,Vec F,void *ctx)
{
PetscErrorCode ierr;
Mat J;
DM dm;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMGetApplicationContext(dm,&J);CHKERRQ(ierr);
if (!J) {
ierr = DMCreateMatrix(dm,MATAIJ,&J);CHKERRQ(ierr);
ierr = MatSetDM(J, PETSC_NULL);CHKERRQ(ierr);
ierr = FormMatrix(dm,J);CHKERRQ(ierr);
ierr = DMSetApplicationContext(dm,J);CHKERRQ(ierr);
ierr = DMSetApplicationContextDestroy(dm,(PetscErrorCode (*)(void**))MatDestroy);CHKERRQ(ierr);
}
ierr = MatMult(J,x,F);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void
petscSetupDM (NonlinearSystem & nl) {
#if !PETSC_VERSION_LESS_THAN(3,3,0)
PetscErrorCode ierr;
PetscBool ismoose;
DM dm = PETSC_NULL;
// Initialize the part of the DM package that's packaged with Moose; in the PETSc source tree this call would be in DMInitializePackage()
ierr = DMMooseRegisterAll();
CHKERRABORT(nl.comm().get(),ierr);
// Create and set up the DM that will consume the split options and deal with block matrices.
PetscNonlinearSolver<Number> *petsc_solver = dynamic_cast<PetscNonlinearSolver<Number> *>(nl.sys().nonlinear_solver.get());
SNES snes = petsc_solver->snes();
// if there exists a DMMoose object, not to recreate a new one
ierr = SNESGetDM(snes, &dm);
CHKERRABORT(nl.comm().get(), ierr);
if (dm)
{
ierr = PetscObjectTypeCompare((PetscObject)dm, DMMOOSE, &ismoose);
CHKERRABORT(nl.comm().get(), ierr);
if (ismoose)
return;
}
ierr = DMCreateMoose(nl.comm().get(), nl, &dm);
CHKERRABORT(nl.comm().get(),ierr);
ierr = DMSetFromOptions(dm);
CHKERRABORT(nl.comm().get(),ierr);
ierr = DMSetUp(dm);
CHKERRABORT(nl.comm().get(),ierr);
ierr = SNESSetDM(snes,dm);
CHKERRABORT(nl.comm().get(),ierr);
ierr = DMDestroy(&dm);
CHKERRABORT(nl.comm().get(),ierr);
// We temporarily comment out this updating function because
// we lack an approach to check if the problem
// structure has been changed from the last iteration.
// The indices will be rebuilt for every timestep.
// TODO: figure out a way to check the structure changes of the
// matrix
// ierr = SNESSetUpdate(snes,SNESUpdateDMMoose);
// CHKERRABORT(nl.comm().get(),ierr);
#endif
}
static PetscErrorCode SNESTSFormJacobian_Theta(SNES snes,Vec x,Mat *A,Mat *B,MatStructure *str,TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
Vec Xdot;
DM dm,dmsave;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
/* th->Xdot has already been computed in SNESTSFormFunction_Theta (SNES guarantees this) */
ierr = TSThetaGetX0AndXdot(ts,dm,PETSC_NULL,&Xdot);CHKERRQ(ierr);
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIJacobian(ts,th->stage_time,x,Xdot,th->shift,A,B,str,PETSC_FALSE);CHKERRQ(ierr);
ts->dm = dmsave;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_Theta(SNES snes,Vec x,Vec y,TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
Vec X0,Xdot;
DM dm,dmsave;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
/* When using the endpoint variant, this is actually 1/Theta * Xdot */
ierr = TSThetaGetX0AndXdot(ts,dm,&X0,&Xdot);CHKERRQ(ierr);
ierr = VecAXPBYPCZ(Xdot,-th->shift,th->shift,0,X0,x);CHKERRQ(ierr);
/* DM monkey-business allows user code to call TSGetDM() inside of functions evaluated on levels of FAS */
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIFunction(ts,th->stage_time,x,Xdot,y,PETSC_FALSE);CHKERRQ(ierr);
ts->dm = dmsave;
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormJacobian_Theta(SNES snes,Vec x,Mat A,Mat B,TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscErrorCode ierr;
Vec Xdot;
DM dm,dmsave;
PetscReal shift = 1/(th->Theta*ts->time_step);
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
/* Xdot has already been computed in SNESTSFormFunction_Theta (SNES guarantees this) */
ierr = TSThetaGetX0AndXdot(ts,dm,NULL,&Xdot);CHKERRQ(ierr);
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIJacobian(ts,th->stage_time,x,Xdot,shift,A,B,PETSC_FALSE);CHKERRQ(ierr);
ts->dm = dmsave;
ierr = TSThetaRestoreX0AndXdot(ts,dm,NULL,&Xdot);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
// for call-back: tell SNESVI we want -infty < u <= psi
PetscErrorCode FormBounds(SNES snes, Vec Xl, Vec Xu) {
PetscErrorCode ierr;
DM da;
DMDALocalInfo info;
int i, j;
double **aXu, dx, dy, x, y;
ierr = VecSet(Xu,PETSC_NINFINITY);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
dx = 1.0 / (PetscReal)(info.mx-1);
dy = 1.0 / (PetscReal)(info.my-1);
ierr = DMDAVecGetArray(da, Xu, &aXu);CHKERRQ(ierr);
for (j=info.ys; j<info.ys+info.ym; j++) {
y = j * dy;
for (i=info.xs; i<info.xs+info.xm; i++) {
x = i * dx;
aXu[j][i] = psi(x,y);
}
}
ierr = DMDAVecRestoreArray(da, Xu, &aXu);CHKERRQ(ierr);
return 0;
}
PetscErrorCode Monitor(SNES snes,PetscInt its,PetscReal rnorm,void *dummy)
{
UserCtx *user;
PetscErrorCode ierr;
PetscInt m,N;
PetscScalar *w,*dw;
Vec u_lambda,U,F,Uexact;
DM packer;
PetscReal norm;
DM da;
PetscFunctionBeginUser;
ierr = SNESGetDM(snes,&packer);CHKERRQ(ierr);
ierr = DMGetApplicationContext(packer,&user);CHKERRQ(ierr);
ierr = SNESGetSolution(snes,&U);CHKERRQ(ierr);
ierr = DMCompositeGetAccess(packer,U,&w,&u_lambda);CHKERRQ(ierr);
ierr = VecView(u_lambda,user->u_lambda_viewer);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(packer,U,&w,&u_lambda);CHKERRQ(ierr);
ierr = SNESGetFunction(snes,&F,0,0);CHKERRQ(ierr);
ierr = DMCompositeGetAccess(packer,F,&w,&u_lambda);CHKERRQ(ierr);
/* ierr = VecView(u_lambda,user->fu_lambda_viewer); */
ierr = DMCompositeRestoreAccess(packer,U,&w,&u_lambda);CHKERRQ(ierr);
ierr = DMCompositeGetEntries(packer,&m,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&N,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = VecDuplicate(U,&Uexact);CHKERRQ(ierr);
ierr = ExactSolution(packer,Uexact);CHKERRQ(ierr);
ierr = VecAXPY(Uexact,-1.0,U);CHKERRQ(ierr);
ierr = DMCompositeGetAccess(packer,Uexact,&dw,&u_lambda);CHKERRQ(ierr);
ierr = VecStrideNorm(u_lambda,0,NORM_2,&norm);CHKERRQ(ierr);
norm = norm/PetscSqrtReal((PetscReal)N-1.);
if (dw) ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %g Error at x = 0 %g\n",(double)norm,(double)PetscRealPart(dw[0]));CHKERRQ(ierr);
ierr = VecView(u_lambda,user->fu_lambda_viewer);CHKERRQ(ierr);
ierr = DMCompositeRestoreAccess(packer,Uexact,&dw,&u_lambda);CHKERRQ(ierr);
ierr = VecDestroy(&Uexact);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_EIMEX(SNES snes,Vec X,Vec G,TS ts)
{
TS_EIMEX *ext = (TS_EIMEX*)ts->data;
PetscErrorCode ierr;
Vec Ydot,Z;
DM dm,dmsave;
PetscFunctionBegin;
ierr = VecZeroEntries(G);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = TSEIMEXGetVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
ierr = VecZeroEntries(Ydot);CHKERRQ(ierr);
dmsave = ts->dm;
ts->dm = dm;
ierr = TSComputeIFunction(ts,ext->ctime,X,Ydot,G,PETSC_FALSE);CHKERRQ(ierr);
/* PETSC_FALSE indicates non-imex, adding explicit RHS to the implicit I function. */
ierr = VecCopy(G,Ydot);CHKERRQ(ierr);
ts->dm = dmsave;
ierr = TSEIMEXRestoreVecs(ts,dm,&Z,&Ydot,NULL,NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
TaoDefaultComputeHessian - Computes the Hessian using finite differences.
Collective on Tao
Input Parameters:
+ tao - the Tao context
. V - compute Hessian at this point
- dummy - not used
Output Parameters:
+ H - Hessian matrix (not altered in this routine)
- B - newly computed Hessian matrix to use with preconditioner (generally the same as H)
Options Database Key:
. -tao_fd_hessian - activates TaoDefaultComputeHessian()
Level: advanced
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
TaoDefaultComputeHessian() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Hessian.
.seealso: TaoSetHessianRoutine(), TaoDefaultComputeHessianColor(), SNESComputeJacobianDefault(), TaoSetGradientRoutine(), TaoDefaultComputeGradient()
@*/
PetscErrorCode TaoDefaultComputeHessian(Tao tao,Vec V,Mat H,Mat B,void *dummy)
{
PetscErrorCode ierr;
Vec G;
SNES snes;
DM dm;
PetscFunctionBegin;
ierr = VecDuplicate(V,&G);CHKERRQ(ierr);
ierr = PetscInfo(tao,"TAO Using finite differences w/o coloring to compute Hessian matrix\n");CHKERRQ(ierr);
ierr = TaoComputeGradient(tao,V,G);CHKERRQ(ierr);
ierr = SNESCreate(PetscObjectComm((PetscObject)H),&snes);CHKERRQ(ierr);
ierr = SNESSetFunction(snes,G,Fsnes,tao);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMShellSetGlobalVector(dm,V);CHKERRQ(ierr);
ierr = SNESSetUp(snes);CHKERRQ(ierr);
if (H) {
PetscInt n,N;
ierr = VecGetSize(V,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(V,&n);CHKERRQ(ierr);
ierr = MatSetSizes(H,n,n,N,N);CHKERRQ(ierr);
ierr = MatSetUp(H);CHKERRQ(ierr);
}
if (B && B != H) {
PetscInt n,N;
ierr = VecGetSize(V,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(V,&n);CHKERRQ(ierr);
ierr = MatSetSizes(B,n,n,N,N);CHKERRQ(ierr);
ierr = MatSetUp(B);CHKERRQ(ierr);
}
ierr = SNESComputeJacobianDefault(snes,V,H,B,NULL);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&G);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DisplayLine(SNES snes,Vec X)
{
PetscInt r,i,j=0,k=0,xs,xm,ys,ym,zs,zm,mx,my,mz;
PetscErrorCode ierr;
Field ***x;
CoordField ***c;
DM da,cda;
Vec C;
PetscMPIInt size,rank;
PetscFunctionBegin;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&da);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&mx,&my,&mz,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(da,&cda);CHKERRQ(ierr);
ierr = DMGetCoordinates(da,&C);CHKERRQ(ierr);
j = my / 2;
k = mz / 2;
ierr = DMDAGetCorners(da,&xs,&ys,&zs,&xm,&ym,&zm);CHKERRQ(ierr);
ierr = DMDAVecGetArray(da,X,&x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(cda,C,&c);CHKERRQ(ierr);
for (r=0;r<size;r++) {
if (rank == r) {
if (j >= ys && j < ys+ym && k >= zs && k < zs+zm) {
for (i=xs; i<xs+xm; i++) {
ierr = PetscPrintf(PETSC_COMM_SELF,"%D %d %d: %f %f %f\n",i,0,0,(double)PetscRealPart(c[k][j][i][0] + x[k][j][i][0]),(double)PetscRealPart(c[k][j][i][1] + x[k][j][i][1]),(double)PetscRealPart(c[k][j][i][2] + x[k][j][i][2]));CHKERRQ(ierr);
}
}
}
ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
}
ierr = DMDAVecRestoreArray(da,X,&x);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(cda,C,&c);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode WaterFormFunction(SNES snes,Vec X, Vec F, void *user)
{
PetscErrorCode ierr;
DM networkdm;
Vec localX,localF;
const PetscInt *v,*e;
PetscInt nv,ne;
PetscFunctionBegin;
/* Get the DM attached with the SNES */
ierr = SNESGetDM(snes,&networkdm);CHKERRQ(ierr);
/* Get local vertices and edges */
ierr = DMNetworkGetSubnetworkInfo(networkdm,0,&nv,&ne,&v,&e);CHKERRQ(ierr);
/* Get local vectors */
ierr = DMGetLocalVector(networkdm,&localX);CHKERRQ(ierr);
ierr = DMGetLocalVector(networkdm,&localF);CHKERRQ(ierr);
/* Scatter values from global to local vector */
ierr = DMGlobalToLocalBegin(networkdm,X,INSERT_VALUES,localX);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(networkdm,X,INSERT_VALUES,localX);CHKERRQ(ierr);
/* Initialize residual */
ierr = VecSet(F,0.0);CHKERRQ(ierr);
ierr = VecSet(localF,0.0);CHKERRQ(ierr);
ierr = FormFunction_Water(networkdm,localX,localF,nv,ne,v,e,NULL);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(networkdm,&localX);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(networkdm,localF,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(networkdm,localF,ADD_VALUES,F);CHKERRQ(ierr);
ierr = DMRestoreLocalVector(networkdm,&localF);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESSolve_FAS(SNES snes)
{
PetscErrorCode ierr;
PetscInt i, maxits;
Vec X, F;
PetscReal fnorm;
SNES_FAS *fas = (SNES_FAS*)snes->data,*ffas;
DM dm;
PetscBool isFine;
PetscFunctionBegin;
ierr = PetscCitationsRegister(SNESCitation,&SNEScite);CHKERRQ(ierr);
maxits = snes->max_its; /* maximum number of iterations */
snes->reason = SNES_CONVERGED_ITERATING;
X = snes->vec_sol;
F = snes->vec_func;
ierr = SNESFASCycleIsFine(snes, &isFine);CHKERRQ(ierr);
/*norm setup */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
if (!snes->vec_func_init_set) {
if (fas->eventresidual) {ierr = PetscLogEventBegin(fas->eventresidual,0,0,0,0);CHKERRQ(ierr);}
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (fas->eventresidual) {ierr = PetscLogEventEnd(fas->eventresidual,0,0,0,0);CHKERRQ(ierr);}
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
} else snes->vec_func_init_set = PETSC_FALSE;
ierr = VecNorm(F, NORM_2, &fnorm);CHKERRQ(ierr); /* fnorm <- ||F|| */
if (PetscIsInfOrNanReal(fnorm)) {
snes->reason = SNES_DIVERGED_FNORM_NAN;
PetscFunctionReturn(0);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,fnorm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
if (isFine) {
/* propagate scale-dependent data up the hierarchy */
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
for (ffas=fas; ffas->next; ffas=(SNES_FAS*)ffas->next->data) {
DM dmcoarse;
ierr = SNESGetDM(ffas->next,&dmcoarse);CHKERRQ(ierr);
ierr = DMRestrict(dm,ffas->restrct,ffas->rscale,ffas->inject,dmcoarse);CHKERRQ(ierr);
dm = dmcoarse;
}
}
for (i = 0; i < maxits; i++) {
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
if (fas->fastype == SNES_FAS_MULTIPLICATIVE) {
ierr = SNESFASCycle_Multiplicative(snes, X);CHKERRQ(ierr);
} else if (fas->fastype == SNES_FAS_ADDITIVE) {
ierr = SNESFASCycle_Additive(snes, X);CHKERRQ(ierr);
} else if (fas->fastype == SNES_FAS_FULL) {
ierr = SNESFASCycle_Full(snes, X);CHKERRQ(ierr);
} else if (fas->fastype ==SNES_FAS_KASKADE) {
ierr = SNESFASCycle_Kaskade(snes, X);CHKERRQ(ierr);
} else {
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE,"Unsupported FAS type");
}
/* check for FAS cycle divergence */
if (snes->reason != SNES_CONVERGED_ITERATING) PetscFunctionReturn(0);
/* Monitor convergence */
ierr = PetscObjectSAWsTakeAccess((PetscObject)snes);CHKERRQ(ierr);
snes->iter = i+1;
ierr = PetscObjectSAWsGrantAccess((PetscObject)snes);CHKERRQ(ierr);
ierr = SNESLogConvergenceHistory(snes,snes->norm,0);CHKERRQ(ierr);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence */
if (isFine) {
ierr = (*snes->ops->converged)(snes,snes->iter,0.0,0.0,snes->norm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
}
if (i == maxits) {
ierr = PetscInfo1(snes, "Maximum number of iterations has been reached: %D\n", maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSetUp_Composite(SNES snes)
{
PetscErrorCode ierr;
DM dm;
SNES_Composite *jac = (SNES_Composite*)snes->data;
SNES_CompositeLink next = jac->head;
PetscInt n=0,i;
Vec F;
PetscFunctionBegin;
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
if (snes->ops->computevariablebounds) {
/* SNESVI only ever calls computevariablebounds once, so calling it once here is justified */
if (!snes->xl) {ierr = VecDuplicate(snes->vec_sol,&snes->xl);CHKERRQ(ierr);}
if (!snes->xu) {ierr = VecDuplicate(snes->vec_sol,&snes->xu);CHKERRQ(ierr);}
ierr = (*snes->ops->computevariablebounds)(snes,snes->xl,snes->xu);CHKERRQ(ierr);
}
while (next) {
n++;
ierr = SNESSetDM(next->snes,dm);CHKERRQ(ierr);
ierr = SNESSetApplicationContext(next->snes, snes->user);CHKERRQ(ierr);
if (snes->xl && snes->xu) {
if (snes->ops->computevariablebounds) {
ierr = SNESVISetComputeVariableBounds(next->snes, snes->ops->computevariablebounds);CHKERRQ(ierr);
} else {
ierr = SNESVISetVariableBounds(next->snes,snes->xl,snes->xu);CHKERRQ(ierr);
}
}
next = next->next;
}
jac->nsnes = n;
ierr = SNESGetFunction(snes,&F,NULL,NULL);CHKERRQ(ierr);
if (jac->type == SNES_COMPOSITE_ADDITIVEOPTIMAL) {
ierr = VecDuplicateVecs(F,jac->nsnes,&jac->Xes);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&jac->Fes);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&jac->fnorms);CHKERRQ(ierr);
next = jac->head;
i = 0;
while (next) {
ierr = SNESGetFunction(next->snes,&F,NULL,NULL);CHKERRQ(ierr);
jac->Fes[i] = F;
ierr = PetscObjectReference((PetscObject)F);CHKERRQ(ierr);
next = next->next;
i++;
}
/* allocate the subspace direct solve area */
jac->nrhs = 1;
jac->lda = jac->nsnes;
jac->ldb = jac->nsnes;
jac->n = jac->nsnes;
ierr = PetscMalloc1(jac->n*jac->n,&jac->h);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->beta);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->s);CHKERRQ(ierr);
ierr = PetscMalloc1(jac->n,&jac->g);CHKERRQ(ierr);
jac->lwork = 12*jac->n;
#if PETSC_USE_COMPLEX
ierr = PetscMalloc1(jac->lwork,&jac->rwork);CHKERRQ(ierr);
#endif
ierr = PetscMalloc1(jac->lwork,&jac->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
