/*@
TaoComputeObjective - Computes the objective function value at a given point
Collective on Tao
Input Parameters:
+ tao - the Tao context
- X - input vector
Output Parameter:
. f - Objective value at X
Notes: TaoComputeObjective() is typically used within minimization implementations,
so most users would not generally call this routine themselves.
Level: advanced
.seealso: TaoComputeGradient(), TaoComputeObjectiveAndGradient(), TaoSetObjectiveRoutine()
@*/
PetscErrorCode TaoComputeObjective(Tao tao, Vec X, PetscReal *f)
{
PetscErrorCode ierr;
Vec temp;
PetscFunctionBegin;
PetscValidHeaderSpecific(tao,TAO_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscCheckSameComm(tao,1,X,2);
if (tao->ops->computeobjective) {
ierr = PetscLogEventBegin(Tao_ObjectiveEval,tao,X,NULL,NULL);CHKERRQ(ierr);
PetscStackPush("Tao user objective evaluation routine");
ierr = (*tao->ops->computeobjective)(tao,X,f,tao->user_objP);CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_ObjectiveEval,tao,X,NULL,NULL);CHKERRQ(ierr);
tao->nfuncs++;
} else if (tao->ops->computeobjectiveandgradient) {
ierr = PetscInfo(tao,"Duplicating variable vector in order to call func/grad routine\n");CHKERRQ(ierr);
ierr = VecDuplicate(X,&temp);CHKERRQ(ierr);
ierr = PetscLogEventBegin(Tao_ObjGradientEval,tao,X,NULL,NULL);CHKERRQ(ierr);
PetscStackPush("Tao user objective/gradient evaluation routine");
ierr = (*tao->ops->computeobjectiveandgradient)(tao,X,f,temp,tao->user_objgradP);CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_ObjGradientEval,tao,X,NULL,NULL);CHKERRQ(ierr);
ierr = VecDestroy(&temp);CHKERRQ(ierr);
tao->nfuncgrads++;
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"TaoSetObjectiveRoutine() has not been called");
ierr = PetscInfo1(tao,"TAO Function evaluation: %14.12e\n",(double)(*f));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
TaoComputeGradient - Computes the gradient of the objective function
Collective on Tao
Input Parameters:
+ tao - the Tao context
- X - input vector
Output Parameter:
. G - gradient vector
Notes: TaoComputeGradient() is typically used within minimization implementations,
so most users would not generally call this routine themselves.
Level: advanced
.seealso: TaoComputeObjective(), TaoComputeObjectiveAndGradient(), TaoSetGradientRoutine()
@*/
PetscErrorCode TaoComputeGradient(Tao tao, Vec X, Vec G)
{
PetscErrorCode ierr;
PetscReal dummy;
PetscFunctionBegin;
PetscValidHeaderSpecific(tao,TAO_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(G,VEC_CLASSID,2);
PetscCheckSameComm(tao,1,X,2);
PetscCheckSameComm(tao,1,G,3);
if (tao->ops->computegradient) {
ierr = PetscLogEventBegin(Tao_GradientEval,tao,X,G,NULL);CHKERRQ(ierr);
PetscStackPush("Tao user gradient evaluation routine");
ierr = (*tao->ops->computegradient)(tao,X,G,tao->user_gradP);CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_GradientEval,tao,X,G,NULL);CHKERRQ(ierr);
tao->ngrads++;
} else if (tao->ops->computeobjectiveandgradient) {
ierr = PetscLogEventBegin(Tao_ObjGradientEval,tao,X,G,NULL);CHKERRQ(ierr);
PetscStackPush("Tao user objective/gradient evaluation routine");
ierr = (*tao->ops->computeobjectiveandgradient)(tao,X,&dummy,G,tao->user_objgradP);CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_ObjGradientEval,tao,X,G,NULL);CHKERRQ(ierr);
tao->nfuncgrads++;
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"TaoSetGradientRoutine() has not been called");
PetscFunctionReturn(0);
}
PetscErrorCode MatRARt_SeqAIJ_SeqAIJ(Mat A,Mat R,MatReuse scall,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
const char *algTypes[3] = {"matmatmatmult","matmattransposemult","coloring_rart"};
PetscInt alg=0; /* set default algorithm */
PetscFunctionBegin;
if (scall == MAT_INITIAL_MATRIX) {
ierr = PetscObjectOptionsBegin((PetscObject)A);CHKERRQ(ierr);
ierr = PetscOptionsEList("-matrart_via","Algorithmic approach","MatRARt",algTypes,3,algTypes[0],&alg,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogEventBegin(MAT_RARtSymbolic,A,R,0,0);CHKERRQ(ierr);
switch (alg) {
case 1:
/* via matmattransposemult: ARt=A*R^T, C=R*ARt - matrix coloring can be applied to A*R^T */
ierr = MatRARtSymbolic_SeqAIJ_SeqAIJ_matmattransposemult(A,R,fill,C);CHKERRQ(ierr);
break;
case 2:
/* via coloring_rart: apply coloring C = R*A*R^T */
ierr = MatRARtSymbolic_SeqAIJ_SeqAIJ_colorrart(A,R,fill,C);CHKERRQ(ierr);
break;
default:
/* via matmatmatmult: Rt=R^T, C=R*A*Rt - avoid inefficient sparse inner products */
ierr = MatRARtSymbolic_SeqAIJ_SeqAIJ(A,R,fill,C);CHKERRQ(ierr);
break;
}
ierr = PetscLogEventEnd(MAT_RARtSymbolic,A,R,0,0);CHKERRQ(ierr);
}
ierr = PetscLogEventBegin(MAT_RARtNumeric,A,R,0,0);CHKERRQ(ierr);
ierr = (*(*C)->ops->rartnumeric)(A,R,*C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_RARtNumeric,A,R,0,0);CHKERRQ(ierr);
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 MatPtAP_SeqAIJ_SeqAIJ(Mat A,Mat P,MatReuse scall,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
const char *algTypes[2] = {"scalable","nonscalable"};
PetscInt alg=0; /* set default algorithm */
PetscFunctionBegin;
if (scall == MAT_INITIAL_MATRIX) {
/*
Alg 'scalable' determines which implementations to be used:
"nonscalable": do dense axpy in MatPtAPNumeric() - fastest, but requires storage of struct A*P;
"scalable": do two sparse axpy in MatPtAPNumeric() - might slow, does not store structure of A*P.
*/
ierr = PetscObjectOptionsBegin((PetscObject)A);CHKERRQ(ierr);
ierr = PetscOptionsEList("-matptap_via","Algorithmic approach","MatPtAP",algTypes,2,algTypes[0],&alg,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogEventBegin(MAT_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr);
switch (alg) {
case 1:
ierr = MatPtAPSymbolic_SeqAIJ_SeqAIJ_DenseAxpy(A,P,fill,C);CHKERRQ(ierr);
break;
default:
ierr = MatPtAPSymbolic_SeqAIJ_SeqAIJ_SparseAxpy(A,P,fill,C);CHKERRQ(ierr);
break;
}
ierr = PetscLogEventEnd(MAT_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr);
}
ierr = PetscLogEventBegin(MAT_PtAPNumeric,A,P,0,0);CHKERRQ(ierr);
ierr = (*(*C)->ops->ptapnumeric)(A,P,*C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_PtAPNumeric,A,P,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);
}
/*
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 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);
}
/*@
TaoComputeObjectiveAndGradient - Computes the objective function value at a given point
Collective on Tao
Input Parameters:
+ tao - the Tao context
- X - input vector
Output Parameter:
+ f - Objective value at X
- g - Gradient vector at X
Notes: TaoComputeObjectiveAndGradient() is typically used within minimization implementations,
so most users would not generally call this routine themselves.
Level: advanced
.seealso: TaoComputeGradient(), TaoComputeObjectiveAndGradient(), TaoSetObjectiveRoutine()
@*/
PetscErrorCode TaoComputeObjectiveAndGradient(Tao tao, Vec X, PetscReal *f, Vec G)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(tao,TAO_CLASSID,1);
PetscValidHeaderSpecific(X,VEC_CLASSID,2);
PetscValidHeaderSpecific(G,VEC_CLASSID,4);
PetscCheckSameComm(tao,1,X,2);
PetscCheckSameComm(tao,1,G,4);
if (tao->ops->computeobjectiveandgradient) {
ierr = PetscLogEventBegin(Tao_ObjGradientEval,tao,X,G,NULL);
CHKERRQ(ierr);
PetscStackPush("Tao user objective/gradient evaluation routine");
ierr = (*tao->ops->computeobjectiveandgradient)(tao,X,f,G,tao->user_objgradP);
CHKERRQ(ierr);
PetscStackPop;
if (tao->ops->computegradient == TaoDefaultComputeGradient) {
/* Overwrite gradient with finite difference gradient */
ierr = TaoDefaultComputeGradient(tao,X,G,tao->user_objgradP);
CHKERRQ(ierr);
}
ierr = PetscLogEventEnd(Tao_ObjGradientEval,tao,X,G,NULL);
CHKERRQ(ierr);
tao->nfuncgrads++;
} else if (tao->ops->computeobjective && tao->ops->computegradient) {
ierr = PetscLogEventBegin(Tao_ObjectiveEval,tao,X,NULL,NULL);
CHKERRQ(ierr);
PetscStackPush("Tao user objective evaluation routine");
ierr = (*tao->ops->computeobjective)(tao,X,f,tao->user_objP);
CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_ObjectiveEval,tao,X,NULL,NULL);
CHKERRQ(ierr);
tao->nfuncs++;
ierr = PetscLogEventBegin(Tao_GradientEval,tao,X,G,NULL);
CHKERRQ(ierr);
PetscStackPush("Tao user gradient evaluation routine");
ierr = (*tao->ops->computegradient)(tao,X,G,tao->user_gradP);
CHKERRQ(ierr);
PetscStackPop;
ierr = PetscLogEventEnd(Tao_GradientEval,tao,X,G,NULL);
CHKERRQ(ierr);
tao->ngrads++;
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"TaoSetObjectiveRoutine() or TaoSetGradientRoutine() not set");
ierr = PetscInfo1(tao,"TAO Function evaluation: %14.12e\n",(double)(*f));
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatPtAP_SeqAIJ_SeqAIJ(Mat A,Mat P,MatReuse scall,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (scall == MAT_INITIAL_MATRIX) {
ierr = PetscLogEventBegin(MAT_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr);
ierr = MatPtAPSymbolic_SeqAIJ_SeqAIJ(A,P,fill,C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr);
}
ierr = PetscLogEventBegin(MAT_PtAPNumeric,A,P,0,0);CHKERRQ(ierr);
ierr = (*(*C)->ops->ptapnumeric)(A,P,*C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_PtAPNumeric,A,P,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatTransposeMatMult_SeqAIJ_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (scall == MAT_INITIAL_MATRIX) {
ierr = PetscLogEventBegin(MAT_TransposeMatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
ierr = MatTransposeMatMultSymbolic_SeqAIJ_SeqDense(A,B,fill,C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_TransposeMatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
}
ierr = PetscLogEventBegin(MAT_TransposeMatMultNumeric,A,B,0,0);CHKERRQ(ierr);
ierr = MatTransposeMatMultNumeric_SeqAIJ_SeqDense(A,B,*C);CHKERRQ(ierr);
ierr = PetscLogEventEnd(MAT_TransposeMatMultNumeric,A,B,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
MatColoringApply - Apply the coloring to the matrix, producing index
sets corresponding to a number of independent sets in the induced
graph.
Collective on MatColoring
Input Parameters:
. mc - the MatColoring context
Output Parameter:
. coloring - the ISColoring instance containing the coloring
Level: beginner
.keywords: Coloring, Apply
.seealso: MatColoring, MatColoringCreate()
@*/
PetscErrorCode MatColoringApply(MatColoring mc,ISColoring *coloring)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewerFormat format;
PetscViewer viewer;
PetscInt nc,ncolors;
PetscFunctionBegin;
PetscValidHeaderSpecific(mc,MAT_COLORING_CLASSID,1);
ierr = PetscLogEventBegin(Mat_Coloring_Apply,mc,0,0,0);CHKERRQ(ierr);
ierr = (*mc->ops->apply)(mc,coloring);CHKERRQ(ierr);
ierr = PetscLogEventEnd(Mat_Coloring_Apply,mc,0,0,0);CHKERRQ(ierr);
/* valid */
if (mc->valid) {
ierr = MatColoringTestValid(mc,*coloring);CHKERRQ(ierr);
}
/* view */
ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)mc),((PetscObject)mc)->prefix,"-mat_coloring_view",&viewer,&format,&flg);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) {
ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr);
ierr = MatColoringView(mc,viewer);CHKERRQ(ierr);
ierr = MatGetSize(mc->mat,NULL,&nc);CHKERRQ(ierr);
ierr = ISColoringGetIS(*coloring,&ncolors,NULL);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," Number of colors %d\n",ncolors);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," Number of total columns %d\n",nc);CHKERRQ(ierr);
if (nc <= 1000) {ierr = ISColoringView(*coloring,viewer);CHKERRQ(ierr);}
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/* do the actual message passing now */
PetscErrorCode DataExEnd(DataEx de)
{
PetscMPIInt i,np;
PetscInt total;
PetscInt *message_recv_offsets;
void *dest;
PetscInt length;
PetscErrorCode ierr;
PetscFunctionBegin;
if (de->communication_status != DEOBJECT_INITIALIZED) SETERRQ( de->comm, PETSC_ERR_ORDER, "Communication has not been initialized. Must call DataExInitialize() first." );
if (!de->recv_message) SETERRQ( de->comm, PETSC_ERR_ORDER, "recv_message has not been initialized. Must call DataExPackFinalize() first" );
ierr = PetscLogEventBegin(PTATIN_DataExchangerEnd,0,0,0,0);CHKERRQ(ierr);
np = de->n_neighbour_procs;
ierr = PetscMalloc1(np+1, &message_recv_offsets);CHKERRQ(ierr);
message_recv_offsets[0] = 0;
total = de->messages_to_be_recvieved[0];
for (i = 1; i < np; ++i) {
message_recv_offsets[i] = total;
total = total + de->messages_to_be_recvieved[i];
}
/* == NON BLOCKING == */
for (i = 0; i < np; ++i) {
length = de->messages_to_be_recvieved[i] * de->unit_message_size;
dest = ((char*)de->recv_message) + de->unit_message_size * message_recv_offsets[i];
ierr = MPI_Irecv( dest, length, MPI_CHAR, de->neighbour_procs[i], de->recv_tags[i], de->comm, &de->_requests[np+i] );CHKERRQ(ierr);
}
ierr = MPI_Waitall( 2*np, de->_requests, de->_stats );CHKERRQ(ierr);
ierr = PetscFree(message_recv_offsets);CHKERRQ(ierr);
de->communication_status = DEOBJECT_FINALIZED;
ierr = PetscLogEventEnd(PTATIN_DataExchangerEnd,0,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVMult - Computes Y = beta*Y + alpha*X*Q.
Logically Collective on BV
Input Parameters:
+ Y,X - basis vectors
. alpha,beta - scalars
- Q - a sequential dense matrix
Output Parameter:
. Y - the modified basis vectors
Notes:
X and Y must be different objects. The case X=Y can be addressed with
BVMultInPlace().
The matrix Q must be a sequential dense Mat, with all entries equal on
all processes (otherwise each process will compute a different update).
The dimensions of Q must be at least m,n where m is the number of active
columns of X and n is the number of active columns of Y.
The leading columns of Y are not modified. Also, if X has leading
columns specified, then these columns do not participate in the computation.
Hence, only rows (resp. columns) of Q starting from lx (resp. ly) are used,
where lx (resp. ly) is the number of leading columns of X (resp. Y).
Level: intermediate
.seealso: BVMultVec(), BVMultColumn(), BVMultInPlace(), BVSetActiveColumns()
@*/
PetscErrorCode BVMult(BV Y,PetscScalar alpha,PetscScalar beta,BV X,Mat Q)
{
PetscErrorCode ierr;
PetscBool match;
PetscInt m,n;
PetscFunctionBegin;
PetscValidHeaderSpecific(Y,BV_CLASSID,1);
PetscValidLogicalCollectiveScalar(Y,alpha,2);
PetscValidLogicalCollectiveScalar(Y,beta,3);
PetscValidHeaderSpecific(X,BV_CLASSID,4);
PetscValidHeaderSpecific(Q,MAT_CLASSID,5);
PetscValidType(Y,1);
BVCheckSizes(Y,1);
PetscValidType(X,4);
BVCheckSizes(X,4);
PetscValidType(Q,5);
PetscCheckSameTypeAndComm(Y,1,X,4);
if (X==Y) SETERRQ(PetscObjectComm((PetscObject)Y),PETSC_ERR_ARG_WRONG,"X and Y arguments must be different");
ierr = PetscObjectTypeCompare((PetscObject)Q,MATSEQDENSE,&match);CHKERRQ(ierr);
if (!match) SETERRQ(PetscObjectComm((PetscObject)Y),PETSC_ERR_SUP,"Mat argument must be of type seqdense");
ierr = MatGetSize(Q,&m,&n);CHKERRQ(ierr);
if (m<X->k) SETERRQ2(PetscObjectComm((PetscObject)Y),PETSC_ERR_ARG_SIZ,"Mat argument has %D rows, should have at least %D",m,X->k);
if (n<Y->k) SETERRQ2(PetscObjectComm((PetscObject)Y),PETSC_ERR_ARG_SIZ,"Mat argument has %D columns, should have at least %D",n,Y->k);
if (X->n!=Y->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Mismatching local dimension X %D, Y %D",X->n,Y->n);
if (!X->n) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(BV_Mult,X,Y,0,0);CHKERRQ(ierr);
ierr = (*Y->ops->mult)(Y,alpha,beta,X,Q);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_Mult,X,Y,0,0);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)Y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVMultInPlaceTranspose - Update a set of vectors as V(:,s:e-1) = V*Q'(:,s:e-1).
Logically Collective on BV
Input Parameters:
+ Q - a sequential dense matrix
. s - first column of V to be overwritten
- e - first column of V not to be overwritten
Input/Output Parameter:
+ V - basis vectors
Notes:
This is a variant of BVMultInPlace() where the conjugate transpose
of Q is used.
Level: intermediate
.seealso: BVMultInPlace()
@*/
PetscErrorCode BVMultInPlaceTranspose(BV V,Mat Q,PetscInt s,PetscInt e)
{
PetscErrorCode ierr;
PetscBool match;
PetscInt m,n;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidHeaderSpecific(Q,MAT_CLASSID,2);
PetscValidLogicalCollectiveInt(V,s,3);
PetscValidLogicalCollectiveInt(V,e,4);
PetscValidType(V,1);
BVCheckSizes(V,1);
PetscValidType(Q,2);
ierr = PetscObjectTypeCompare((PetscObject)Q,MATSEQDENSE,&match);CHKERRQ(ierr);
if (!match) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Mat argument must be of type seqdense");
if (s<V->l || s>V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument s has wrong value %D, should be between %D and %D",s,V->l,V->m);
if (e<V->l || e>V->m) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_OUTOFRANGE,"Argument e has wrong value %D, should be between %D and %D",e,V->l,V->m);
ierr = MatGetSize(Q,&m,&n);CHKERRQ(ierr);
if (n<V->k) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument has %D columns, should have at least %D",n,V->k);
if (e>m) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument only has %D rows, the requested value of e is larger: %D",m,e);
if (s>=e || !V->n) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(BV_Mult,V,Q,0,0);CHKERRQ(ierr);
ierr = (*V->ops->multinplacetrans)(V,Q,s,e);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_Mult,V,Q,0,0);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode CreateMesh(MPI_Comm comm, AppCtx *user, DM *dm)
{
PetscInt dim = user->dim;
PetscBool interpolate = user->interpolate;
PetscReal refinementLimit = user->refinementLimit;
const char *partitioner = user->partitioner;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = PetscLogEventBegin(user->createMeshEvent,0,0,0,0);CHKERRQ(ierr);
ierr = DMPlexCreateBoxMesh(comm, dim, interpolate, dm);CHKERRQ(ierr);
{
DM refinedMesh = NULL;
DM distributedMesh = NULL;
/* Refine mesh using a volume constraint */
ierr = DMPlexSetRefinementLimit(*dm, refinementLimit);CHKERRQ(ierr);
ierr = DMRefine(*dm, comm, &refinedMesh);CHKERRQ(ierr);
if (refinedMesh) {
ierr = DMDestroy(dm);CHKERRQ(ierr);
*dm = refinedMesh;
}
/* Distribute mesh over processes */
ierr = DMPlexDistribute(*dm, partitioner, 0, &distributedMesh);CHKERRQ(ierr);
if (distributedMesh) {
ierr = DMDestroy(dm);CHKERRQ(ierr);
*dm = distributedMesh;
}
}
ierr = DMSetFromOptions(*dm);CHKERRQ(ierr);
ierr = PetscLogEventEnd(user->createMeshEvent,0,0,0,0);CHKERRQ(ierr);
user->dm = *dm;
PetscFunctionReturn(0);
}
/*@
VecMTDotBegin - Starts a split phase transpose multiple dot product computation.
Input Parameters:
+ x - the first vector
. nv - number of vectors
. y - array of vectors
- result - where the result will go (can be PETSC_NULL)
Level: advanced
Notes:
Each call to VecMTDotBegin() should be paired with a call to VecMTDotEnd().
.seealso: VecMTDotEnd(), VecNormBegin(), VecNormEnd(), VecNorm(), VecDot(), VecMDot(),
VecDotBegin(), VecDotEnd(), VecMDotBegin(), VecMDotEnd(), PetscCommSplitReductionBegin()
@*/
PetscErrorCode VecMTDotBegin(Vec x,PetscInt nv,const Vec y[],PetscScalar result[])
{
PetscErrorCode ierr;
PetscSplitReduction *sr;
MPI_Comm comm;
int i;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)x,&comm);CHKERRQ(ierr);
ierr = PetscSplitReductionGet(comm,&sr);CHKERRQ(ierr);
if (sr->state != STATE_BEGIN) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Called before all VecxxxEnd() called");
for (i=0;i<nv;i++) {
if (sr->numopsbegin+i >= sr->maxops) {
ierr = PetscSplitReductionExtend(sr);CHKERRQ(ierr);
}
sr->reducetype[sr->numopsbegin+i] = REDUCE_SUM;
sr->invecs[sr->numopsbegin+i] = (void*)x;
}
if (!x->ops->mtdot_local) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Vector does not suppport local mdots");
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);CHKERRQ(ierr);
ierr = (*x->ops->mdot_local)(x,nv,y,sr->lvalues+sr->numopsbegin);CHKERRQ(ierr);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);CHKERRQ(ierr);
sr->numopsbegin += nv;
PetscFunctionReturn(0);
}
/*@
DMPlexInterpolate - Take in a cell-vertex mesh and return one with all intermediate faces, edges, etc.
Collective on DM
Input Parameter:
. dm - The DMPlex object with only cells and vertices
Output Parameter:
. dmInt - The complete DMPlex object
Level: intermediate
.keywords: mesh
.seealso: DMPlexUninterpolate(), DMPlexCreateFromCellList()
@*/
PetscErrorCode DMPlexInterpolate(DM dm, DM *dmInt)
{
DM idm, odm = dm;
PetscInt depth, dim, d;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLogEventBegin(DMPLEX_Interpolate,dm,0,0,0);CHKERRQ(ierr);
ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
if (dim <= 1) {
ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
idm = dm;
}
for (d = 1; d < dim; ++d) {
/* Create interpolated mesh */
ierr = DMCreate(PetscObjectComm((PetscObject)dm), &idm);CHKERRQ(ierr);
ierr = DMSetType(idm, DMPLEX);CHKERRQ(ierr);
ierr = DMPlexSetDimension(idm, dim);CHKERRQ(ierr);
if (depth > 0) {ierr = DMPlexInterpolateFaces_Internal(odm, 1, idm);CHKERRQ(ierr);}
if (odm != dm) {ierr = DMDestroy(&odm);CHKERRQ(ierr);}
odm = idm;
}
*dmInt = idm;
ierr = PetscLogEventEnd(DMPLEX_Interpolate,dm,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVOrthogonalize - Orthogonalize all columns (except leading ones), that is,
compute the QR decomposition.
Collective on BV
Input Parameter:
. V - basis vectors
Output Parameters:
+ V - the modified basis vectors
- R - a sequential dense matrix (or NULL)
Notes:
On input, matrix R must be a sequential dense Mat, with at least as many rows
and columns as the number of active columns of V. The output satisfies
V0 = V*R (where V0 represent the input V) and V'*V = I.
If V has leading columns, then they are not modified (are assumed to be already
orthonormal) and the corresponding part of R is not referenced.
Can pass NULL if R is not required.
Level: intermediate
.seealso: BVOrthogonalizeColumn(), BVOrthogonalizeVec(), BVSetActiveColumns()
@*/
PetscErrorCode BVOrthogonalize(BV V,Mat R)
{
PetscErrorCode ierr;
PetscBool match;
PetscInt m,n;
PetscFunctionBegin;
PetscValidHeaderSpecific(V,BV_CLASSID,1);
PetscValidType(V,1);
BVCheckSizes(V,1);
if (R) {
PetscValidHeaderSpecific(R,MAT_CLASSID,2);
PetscValidType(R,2);
ierr = PetscObjectTypeCompare((PetscObject)R,MATSEQDENSE,&match);CHKERRQ(ierr);
if (!match) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Mat argument must be of type seqdense");
ierr = MatGetSize(R,&m,&n);CHKERRQ(ierr);
if (m!=n) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat argument is not square, it has %D rows and %D columns",m,n);
if (n<V->k) SETERRQ2(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_SIZ,"Mat size %D is smaller than the number of BV active columns %D",n,V->k);
}
if (V->matrix) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Not implemented for non-standard inner product, use BVOrthogonalizeColumn() instead");
if (V->nc) SETERRQ(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Not implemented for BV with constraints, use BVOrthogonalizeColumn() instead");
ierr = PetscLogEventBegin(BV_Orthogonalize,V,R,0,0);CHKERRQ(ierr);
if (V->ops->orthogonalize) {
ierr = (*V->ops->orthogonalize)(V,R);CHKERRQ(ierr);
} else { /* no specific QR function available, so proceed column by column with Gram-Schmidt */
ierr = BVOrthogonalize_GS(V,R);CHKERRQ(ierr);
}
ierr = PetscLogEventEnd(BV_Orthogonalize,V,R,0,0);CHKERRQ(ierr);
ierr = PetscObjectStateIncrease((PetscObject)V);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVOrthogonalizeSomeColumn - Orthogonalize one of the column vectors with
respect to some of the previous ones.
Collective on BV
Input Parameters:
+ bv - the basis vectors context
. j - index of column to be orthogonalized
- which - logical array indicating selected columns
Output Parameters:
+ H - (optional) coefficients computed during orthogonalization
. norm - (optional) norm of the vector after being orthogonalized
- lindep - (optional) flag indicating that refinement did not improve the quality
of orthogonalization
Notes:
This function is similar to BVOrthogonalizeColumn(), but V[j] is
orthogonalized only against columns V[i] having which[i]=PETSC_TRUE.
The length of array which must be j at least.
The use of this operation is restricted to MGS orthogonalization type.
Level: advanced
.seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization()
@*/
PetscErrorCode BVOrthogonalizeSomeColumn(BV bv,PetscInt j,PetscBool *which,PetscScalar *H,PetscReal *norm,PetscBool *lindep)
{
PetscErrorCode ierr;
PetscInt i,ksave,lsave;
PetscFunctionBegin;
PetscValidHeaderSpecific(bv,BV_CLASSID,1);
PetscValidLogicalCollectiveInt(bv,j,2);
PetscValidPointer(which,3);
PetscValidType(bv,1);
BVCheckSizes(bv,1);
if (j<0) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
if (j>=bv->m) SETERRQ2(PetscObjectComm((PetscObject)bv),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,bv->m);
if (bv->orthog_type!=BV_ORTHOG_MGS) SETERRQ(PetscObjectComm((PetscObject)bv),PETSC_ERR_SUP,"Operation only available for MGS orthogonalization");
ierr = PetscLogEventBegin(BV_Orthogonalize,bv,0,0,0);CHKERRQ(ierr);
ksave = bv->k;
lsave = bv->l;
bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
ierr = BV_AllocateCoeffs(bv);CHKERRQ(ierr);
ierr = BV_AllocateSignature(bv);CHKERRQ(ierr);
ierr = BVOrthogonalizeMGS(bv,j,NULL,which,H,norm,lindep);CHKERRQ(ierr);
bv->k = ksave;
bv->l = lsave;
if (H) for (i=bv->l;i<j;i++) H[i-bv->l] = bv->h[bv->nc+i];
ierr = PetscLogEventEnd(BV_Orthogonalize,bv,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
BVOrthogonalizeVec - Orthogonalize a given vector with respect to all
active columns.
Collective on BV
Input Parameters:
+ bv - the basis vectors context
- v - the vector
Output Parameters:
+ H - (optional) coefficients computed during orthogonalization
. norm - (optional) norm of the vector after being orthogonalized
- lindep - (optional) flag indicating that refinement did not improve the quality
of orthogonalization
Notes:
This function is equivalent to BVOrthogonalizeColumn() but orthogonalizes
a vector as an argument rather than taking one of the BV columns. The
vector is orthogonalized against all active columns.
Level: advanced
.seealso: BVOrthogonalizeColumn(), BVSetOrthogonalization(), BVSetActiveColumns()
@*/
PetscErrorCode BVOrthogonalizeVec(BV bv,Vec v,PetscScalar *H,PetscReal *norm,PetscBool *lindep)
{
PetscErrorCode ierr;
PetscInt i,ksave,lsave;
PetscFunctionBegin;
PetscValidHeaderSpecific(bv,BV_CLASSID,1);
PetscValidHeaderSpecific(v,VEC_CLASSID,2);
PetscValidType(bv,1);
BVCheckSizes(bv,1);
PetscValidType(v,2);
PetscCheckSameComm(bv,1,v,2);
ierr = PetscLogEventBegin(BV_Orthogonalize,bv,0,0,0);CHKERRQ(ierr);
ksave = bv->k;
lsave = bv->l;
bv->l = -bv->nc; /* must also orthogonalize against constraints and leading columns */
ierr = BV_AllocateCoeffs(bv);CHKERRQ(ierr);
ierr = BV_AllocateSignature(bv);CHKERRQ(ierr);
switch (bv->orthog_type) {
case BV_ORTHOG_CGS:
ierr = BVOrthogonalizeCGS(bv,0,v,H,norm,lindep);CHKERRQ(ierr);
break;
case BV_ORTHOG_MGS:
ierr = BVOrthogonalizeMGS(bv,0,v,NULL,H,norm,lindep);CHKERRQ(ierr);
break;
}
bv->k = ksave;
bv->l = lsave;
if (H) for (i=bv->l;i<bv->k;i++) H[i-bv->l] = bv->h[bv->nc+i];
ierr = PetscLogEventEnd(BV_Orthogonalize,bv,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCGAMGgraph_GEO(PC pc,const Mat Amat,Mat *a_Gmat)
{
PetscErrorCode ierr;
PC_MG *mg = (PC_MG*)pc->data;
PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx;
const PetscInt verbose = pc_gamg->verbose;
const PetscReal vfilter = pc_gamg->threshold;
PetscMPIInt rank,size;
MPI_Comm comm;
Mat Gmat;
PetscBool set,flg,symm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
#if defined PETSC_USE_LOG
ierr = PetscLogEventBegin(PC_GAMGGgraph_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &size);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(Amat, &set, &flg);CHKERRQ(ierr);
symm = (PetscBool)!(set && flg);
ierr = PCGAMGCreateGraph(Amat, &Gmat);CHKERRQ(ierr);
ierr = PCGAMGFilterGraph(&Gmat, vfilter, symm, verbose);CHKERRQ(ierr);
*a_Gmat = Gmat;
#if defined PETSC_USE_LOG
ierr = PetscLogEventEnd(PC_GAMGGgraph_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
/*@
DMPlexDistributeField - Distribute field data to match a given PetscSF, usually the SF from mesh distribution
Collective on DM
Input Parameters:
+ dm - The DMPlex object
. pointSF - The PetscSF describing the communication pattern
. originalSection - The PetscSection for existing data layout
- originalVec - The existing data
Output Parameters:
+ newSection - The PetscSF describing the new data layout
- newVec - The new data
Level: developer
.seealso: DMPlexDistribute(), DMPlexDistributeData()
@*/
PetscErrorCode DMPlexDistributeField(DM dm, PetscSF pointSF, PetscSection originalSection, Vec originalVec, PetscSection newSection, Vec newVec)
{
PetscSF fieldSF;
PetscInt *remoteOffsets, fieldSize;
PetscScalar *originalValues, *newValues;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscLogEventBegin(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
ierr = PetscSFDistributeSection(pointSF, originalSection, &remoteOffsets, newSection);CHKERRQ(ierr);
ierr = PetscSectionGetStorageSize(newSection, &fieldSize);CHKERRQ(ierr);
ierr = VecSetSizes(newVec, fieldSize, PETSC_DETERMINE);CHKERRQ(ierr);
ierr = VecSetType(newVec,dm->vectype);CHKERRQ(ierr);
ierr = VecGetArray(originalVec, &originalValues);CHKERRQ(ierr);
ierr = VecGetArray(newVec, &newValues);CHKERRQ(ierr);
ierr = PetscSFCreateSectionSF(pointSF, originalSection, remoteOffsets, newSection, &fieldSF);CHKERRQ(ierr);
ierr = PetscSFBcastBegin(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
ierr = PetscSFBcastEnd(fieldSF, MPIU_SCALAR, originalValues, newValues);CHKERRQ(ierr);
ierr = PetscSFDestroy(&fieldSF);CHKERRQ(ierr);
ierr = VecRestoreArray(newVec, &newValues);CHKERRQ(ierr);
ierr = VecRestoreArray(originalVec, &originalValues);CHKERRQ(ierr);
ierr = PetscLogEventEnd(DMPLEX_DistributeField,dm,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
VecNormBegin - Starts a split phase norm computation.
Input Parameters:
+ x - the first vector
. ntype - norm type, one of NORM_1, NORM_2, NORM_MAX, NORM_1_AND_2
- result - where the result will go (can be PETSC_NULL)
Level: advanced
Notes:
Each call to VecNormBegin() should be paired with a call to VecNormEnd().
.seealso: VecNormEnd(), VecNorm(), VecDot(), VecMDot(), VecDotBegin(), VecDotEnd(), PetscCommSplitReductionBegin()
@*/
PetscErrorCode VecNormBegin(Vec x,NormType ntype,PetscReal *result)
{
PetscErrorCode ierr;
PetscSplitReduction *sr;
PetscReal lresult[2];
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)x,&comm);CHKERRQ(ierr);
ierr = PetscSplitReductionGet(comm,&sr);CHKERRQ(ierr);
if (sr->state != STATE_BEGIN) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"Called before all VecxxxEnd() called");
if (sr->numopsbegin >= sr->maxops || (sr->numopsbegin == sr->maxops-1 && ntype == NORM_1_AND_2)) {
ierr = PetscSplitReductionExtend(sr);CHKERRQ(ierr);
}
sr->invecs[sr->numopsbegin] = (void*)x;
if (!x->ops->norm_local) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Vector does not support local norms");
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);CHKERRQ(ierr);
ierr = (*x->ops->norm_local)(x,ntype,lresult);CHKERRQ(ierr);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);CHKERRQ(ierr);
if (ntype == NORM_2) lresult[0] = lresult[0]*lresult[0];
if (ntype == NORM_1_AND_2) lresult[1] = lresult[1]*lresult[1];
if (ntype == NORM_MAX) sr->reducetype[sr->numopsbegin] = REDUCE_MAX;
else sr->reducetype[sr->numopsbegin] = REDUCE_SUM;
sr->lvalues[sr->numopsbegin++] = lresult[0];
if (ntype == NORM_1_AND_2) {
sr->reducetype[sr->numopsbegin] = REDUCE_SUM;
sr->lvalues[sr->numopsbegin++] = lresult[1];
}
PetscFunctionReturn(0);
}
PetscErrorCode FluidFieldDivergence(FluidField f)
{
DALocalInfo info;
Vec u,v,w; // Local, ghosted vectors
PetscErrorCode ierr;
PetscFunctionBegin;
PetscLogEventBegin(EVENT_FluidFieldDivergence,0,0,0,0);
// PetscLogEventRegister(&EVENT_FluidFieldDivergence,"FluidFieldDivergence", 0);
ierr = DAGetLocalInfo(f->da,&info); CHKERRQ(ierr);
ierr = DAGetLocalVector(f->da,&u); CHKERRQ(ierr);
ierr = DAGetLocalVector(f->da,&v); CHKERRQ(ierr);
ierr = DAGlobalToLocalBegin(f->da,f->u,INSERT_VALUES,u); CHKERRQ(ierr);
ierr = DAGlobalToLocalEnd( f->da,f->u,INSERT_VALUES,u); CHKERRQ(ierr);
ierr = DAGlobalToLocalBegin(f->da,f->v,INSERT_VALUES,v); CHKERRQ(ierr);
//TODO: interleaving work with communication here a possible source of optimization?
ierr = DAGlobalToLocalEnd( f->da,f->v,INSERT_VALUES,v); CHKERRQ(ierr);
if( f->is3D )
{
ierr = DAGetLocalVector(f->da,&w); CHKERRQ(ierr);
ierr = DAGlobalToLocalBegin(f->da,f->w,INSERT_VALUES,w); CHKERRQ(ierr);
ierr = DAGlobalToLocalEnd( f->da,f->w,INSERT_VALUES,w); CHKERRQ(ierr);
FluidFieldDivergence_3D(info, f->d, u, v, w, f->div);
ierr = DARestoreLocalVector(f->da,&w); CHKERRQ(ierr);
} else {
FluidFieldDivergence_2D(info, f->d, u, v, f->div);
}
ierr = DARestoreLocalVector(f->da,&u); CHKERRQ(ierr);
ierr = DARestoreLocalVector(f->da,&v); CHKERRQ(ierr);
PetscLogEventEnd(EVENT_FluidFieldDivergence,0,0,0,0);
PetscFunctionReturn(0);
}
/*
Defines the action of the downsmoother
*/
PetscErrorCode SNESFASDownSmooth_Private(SNES snes, Vec B, Vec X, Vec F, PetscReal *fnorm)
{
PetscErrorCode ierr = 0;
SNESConvergedReason reason;
Vec FPC;
SNES smoothd;
SNES_FAS *fas = (SNES_FAS*) snes->data;
PetscFunctionBegin;
ierr = SNESFASCycleGetSmootherDown(snes, &smoothd);CHKERRQ(ierr);
ierr = SNESSetInitialFunction(smoothd, F);CHKERRQ(ierr);
if (fas->eventsmoothsolve) {ierr = PetscLogEventBegin(fas->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
ierr = SNESSolve(smoothd, B, X);CHKERRQ(ierr);
if (fas->eventsmoothsolve) {ierr = PetscLogEventEnd(fas->eventsmoothsolve,0,0,0,0);CHKERRQ(ierr);}
/* check convergence reason for the smoother */
ierr = SNESGetConvergedReason(smoothd,&reason);CHKERRQ(ierr);
if (reason < 0 && !(reason == SNES_DIVERGED_MAX_IT || reason == SNES_DIVERGED_LOCAL_MIN || reason == SNES_DIVERGED_LINE_SEARCH)) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
ierr = SNESGetFunction(smoothd, &FPC, NULL, NULL);CHKERRQ(ierr);
ierr = VecCopy(FPC, F);CHKERRQ(ierr);
if (fnorm) {ierr = VecNorm(F,NORM_2,fnorm);CHKERRQ(ierr);}
PetscFunctionReturn(0);
}
/*@
BVMultVec - Computes y = beta*y + alpha*X*q.
Logically Collective on BV and Vec
Input Parameters:
+ X - a basis vectors object
. alpha,beta - scalars
. y - a vector
- q - an array of scalars
Output Parameter:
. y - the modified vector
Notes:
This operation is the analogue of BVMult() but with a BV and a Vec,
instead of two BV. Note that arguments are listed in different order
with respect to BVMult().
If X has leading columns specified, then these columns do not participate
in the computation.
The length of array q must be equal to the number of active columns of X
minus the number of leading columns, i.e. the first entry of q multiplies
the first non-leading column.
Level: intermediate
.seealso: BVMult(), BVMultColumn(), BVMultInPlace(), BVSetActiveColumns()
@*/
PetscErrorCode BVMultVec(BV X,PetscScalar alpha,PetscScalar beta,Vec y,PetscScalar *q)
{
PetscErrorCode ierr;
PetscInt n,N;
PetscFunctionBegin;
PetscValidHeaderSpecific(X,BV_CLASSID,1);
PetscValidLogicalCollectiveScalar(X,alpha,2);
PetscValidLogicalCollectiveScalar(X,beta,3);
PetscValidHeaderSpecific(y,VEC_CLASSID,4);
PetscValidPointer(q,5);
PetscValidType(X,1);
BVCheckSizes(X,1);
PetscValidType(y,4);
PetscCheckSameComm(X,1,y,4);
ierr = VecGetSize(y,&N);CHKERRQ(ierr);
ierr = VecGetLocalSize(y,&n);CHKERRQ(ierr);
if (N!=X->N || n!=X->n) SETERRQ4(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_INCOMP,"Vec sizes (global %D, local %D) do not match BV sizes (global %D, local %D)",N,n,X->N,X->n);
if (!X->n) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(BV_Mult,X,y,0,0);CHKERRQ(ierr);
ierr = (*X->ops->multvec)(X,alpha,beta,y,q);CHKERRQ(ierr);
ierr = PetscLogEventEnd(BV_Mult,X,y,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
MatAXPY - Computes Y = a*X + Y.
Logically Collective on Mat
Input Parameters:
+ a - the scalar multiplier
. X - the first matrix
. Y - the second matrix
- str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN
or SUBSET_NONZERO_PATTERN (nonzeros of X is a subset of Y's)
Level: intermediate
.keywords: matrix, add
.seealso: MatAYPX()
@*/
PetscErrorCode MatAXPY(Mat Y,PetscScalar a,Mat X,MatStructure str)
{
PetscErrorCode ierr;
PetscInt m1,m2,n1,n2;
PetscFunctionBegin;
PetscValidHeaderSpecific(X,MAT_CLASSID,3);
PetscValidHeaderSpecific(Y,MAT_CLASSID,1);
PetscValidLogicalCollectiveScalar(Y,a,2);
ierr = MatGetSize(X,&m1,&n1);CHKERRQ(ierr);
ierr = MatGetSize(Y,&m2,&n2);CHKERRQ(ierr);
if (m1 != m2 || n1 != n2) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Non conforming matrix add: %D %D %D %D",m1,m2,n1,n2);
ierr = PetscLogEventBegin(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr);
if (Y->ops->axpy) {
ierr = (*Y->ops->axpy)(Y,a,X,str);CHKERRQ(ierr);
} else {
ierr = MatAXPY_Basic(Y,a,X,str);CHKERRQ(ierr);
}
ierr = PetscLogEventEnd(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr);
#if defined(PETSC_HAVE_CUSP)
if (Y->valid_GPU_matrix != PETSC_CUSP_UNALLOCATED) {
Y->valid_GPU_matrix = PETSC_CUSP_CPU;
}
#endif
PetscFunctionReturn(0);
}
/*@
BVMultColumn - Computes y = beta*y + alpha*X*q, where y is the j-th column
of X.
Logically Collective on BV
Input Parameters:
+ X - a basis vectors object
. alpha,beta - scalars
. j - the column index
- q - an array of scalars
Notes:
This operation is equivalent to BVMultVec() but it uses column j of X
rather than taking a Vec as an argument. The number of active columns of
X is set to j before the computation, and restored afterwards.
If X has leading columns specified, then these columns do not participate
in the computation. Therefore, the length of array q must be equal to j
minus the number of leading columns.
Level: advanced
.seealso: BVMult(), BVMultVec(), BVMultInPlace(), BVSetActiveColumns()
@*/
PetscErrorCode BVMultColumn(BV X,PetscScalar alpha,PetscScalar beta,PetscInt j,PetscScalar *q)
{
PetscErrorCode ierr;
PetscInt ksave;
Vec y;
PetscFunctionBegin;
PetscValidHeaderSpecific(X,BV_CLASSID,1);
PetscValidLogicalCollectiveScalar(X,alpha,2);
PetscValidLogicalCollectiveScalar(X,beta,3);
PetscValidLogicalCollectiveInt(X,j,4);
PetscValidPointer(q,5);
PetscValidType(X,1);
BVCheckSizes(X,1);
if (j<0) SETERRQ(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_OUTOFRANGE,"Index j must be non-negative");
if (j>=X->m) SETERRQ2(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_OUTOFRANGE,"Index j=%D but BV only has %D columns",j,X->m);
ierr = PetscLogEventBegin(BV_Mult,X,0,0,0);CHKERRQ(ierr);
ksave = X->k;
X->k = j;
ierr = BVGetColumn(X,j,&y);CHKERRQ(ierr);
ierr = (*X->ops->multvec)(X,alpha,beta,y,q);CHKERRQ(ierr);
ierr = BVRestoreColumn(X,j,&y);CHKERRQ(ierr);
X->k = ksave;
ierr = PetscLogEventEnd(BV_Mult,X,0,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}