static PetscErrorCode PCApply_Composite_Multiplicative(PC pc,Vec x,Vec y)
{
PetscErrorCode ierr;
PC_Composite *jac = (PC_Composite*)pc->data;
PC_CompositeLink next = jac->head;
Mat mat = pc->pmat;
PetscFunctionBegin;
if (!next) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"No composite preconditioners supplied via PCCompositeAddPC() or -pc_composite_pcs");
if (next->next && !jac->work2) { /* allocate second work vector */
ierr = VecDuplicate(jac->work1,&jac->work2);CHKERRQ(ierr);
}
if (pc->useAmat) mat = pc->mat;
ierr = PCApply(next->pc,x,y);CHKERRQ(ierr); /* y <- B x */
while (next->next) {
next = next->next;
ierr = MatMult(mat,y,jac->work1);CHKERRQ(ierr); /* work1 <- A y */
ierr = VecWAXPY(jac->work2,-1.0,jac->work1,x);CHKERRQ(ierr); /* work2 <- x - work1 */
ierr = VecSet(jac->work1,0.0);CHKERRQ(ierr); /* zero since some PC's may not set all entries in the result */
ierr = PCApply(next->pc,jac->work2,jac->work1);CHKERRQ(ierr); /* work1 <- C work2 */
ierr = VecAXPY(y,1.0,jac->work1);CHKERRQ(ierr); /* y <- y + work1 = B x + C (x - A B x) = (B + C (1 - A B)) x */
}
if (jac->type == PC_COMPOSITE_SYMMETRIC_MULTIPLICATIVE) {
while (next->previous) {
next = next->previous;
ierr = MatMult(mat,y,jac->work1);CHKERRQ(ierr);
ierr = VecWAXPY(jac->work2,-1.0,jac->work1,x);CHKERRQ(ierr);
ierr = VecSet(jac->work1,0.0);CHKERRQ(ierr); /* zero since some PC's may not set all entries in the result */
ierr = PCApply(next->pc,jac->work2,jac->work1);CHKERRQ(ierr);
ierr = VecAXPY(y,1.0,jac->work1);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSAlpha_StageVecs(TS ts,Vec X)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
Vec X1 = X, V1 = th->V1, A1 = th->A1;
Vec Xa = th->Xa, Va = th->Va, Aa = th->Aa;
Vec X0 = th->X0, V0 = th->V0, A0 = th->A0;
PetscReal dt = ts->time_step;
PetscReal Alpha_m = th->Alpha_m;
PetscReal Alpha_f = th->Alpha_f;
PetscReal Gamma = th->Gamma;
PetscReal Beta = th->Beta;
PetscErrorCode ierr;
PetscFunctionBegin;
/* A1 = ... */
ierr = VecWAXPY(A1,-1.0,X0,X1);CHKERRQ(ierr);
ierr = VecAXPY (A1,-dt,V0);CHKERRQ(ierr);
ierr = VecAXPBY(A1,-(1-2*Beta)/(2*Beta),1/(dt*dt*Beta),A0);CHKERRQ(ierr);
/* V1 = ... */
ierr = VecWAXPY(V1,(1.0-Gamma)/Gamma,A0,A1);CHKERRQ(ierr);
ierr = VecAYPX (V1,dt*Gamma,V0);CHKERRQ(ierr);
/* Xa = X0 + Alpha_f*(X1-X0) */
ierr = VecWAXPY(Xa,-1.0,X0,X1);CHKERRQ(ierr);
ierr = VecAYPX (Xa,Alpha_f,X0);CHKERRQ(ierr);
/* Va = V0 + Alpha_f*(V1-V0) */
ierr = VecWAXPY(Va,-1.0,V0,V1);CHKERRQ(ierr);
ierr = VecAYPX (Va,Alpha_f,V0);CHKERRQ(ierr);
/* Aa = A0 + Alpha_m*(A1-A0) */
ierr = VecWAXPY(Aa,-1.0,A0,A1);CHKERRQ(ierr);
ierr = VecAYPX (Aa,Alpha_m,A0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void PetscVecTools::WAXPY(Vec w, double a, Vec x, Vec y)
{
#if (PETSC_VERSION_MAJOR == 2 && PETSC_VERSION_MINOR == 2) //PETSc 2.2
PETSCEXCEPT( VecWAXPY(&a, x, y, w) );
#else
PETSCEXCEPT( VecWAXPY(w, a, x, y) );
#endif
}
PetscErrorCode ComputeShearStress(UserContext *uc)
{
PetscErrorCode ierr;
Vec u2, v2;
PetscReal scale = VISCOSITY / DELTA_Z;
// mu * (u^2 + v^2)^0.5 / dz
PetscFunctionBegin;
PetscLogEventBegin(EVENT_ComputeShearStress,0,0,0,0);
VecDuplicate(uc->v, &uc->ss);
VecDuplicate(uc->v, &u2);
VecDuplicate(uc->v, &v2);
VecPointwiseMult( u2, uc->u, uc->u);
VecPointwiseMult( v2, uc->v, uc->v);
VecWAXPY(uc->ss, one, u2, v2);
VecSqrt(uc->ss);
VecScale(uc->ss, scale);
VecDestroy(u2);
VecDestroy(v2);
PetscLogEventEnd(EVENT_ComputeShearStress,0,0,0,0);
PetscFunctionReturn(0);
}
PetscErrorCode VecWAXPY_MultiVec(Vec w, PetscScalar alpha, Vec x, Vec y)
{
#if !defined(NDEBUG)
TBOX_ASSERT(w);
TBOX_ASSERT(x);
TBOX_ASSERT(y);
#endif
Vec_MultiVec* mw = static_cast<Vec_MultiVec*>(w->data);
Vec_MultiVec* mx = static_cast<Vec_MultiVec*>(x->data);
Vec_MultiVec* my = static_cast<Vec_MultiVec*>(y->data);
#if !defined(NDEBUG)
TBOX_ASSERT(mw);
TBOX_ASSERT(mx);
TBOX_ASSERT(my);
TBOX_ASSERT(mw->n == mx->n);
TBOX_ASSERT(mw->n == my->n);
#endif
PetscErrorCode ierr;
for (PetscInt k = 0; k < mw->n; ++k)
{
ierr = VecWAXPY(mw->array[k], alpha, mx->array[k], my->array[k]);
CHKERRQ(ierr);
}
ierr = PetscObjectStateIncrease(reinterpret_cast<PetscObject>(w));
CHKERRQ(ierr);
PetscFunctionReturn(0);
} // VecWAXPY_MultiVec
/*
F(U,V) = U - V
*/
PetscErrorCode F(PetscReal t,Vec U,Vec V,Vec F)
{
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = VecWAXPY(F,-1.0,V,U);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode NavierStokesSolver::projectionStep()
{
// q = q^* - B^N Q \lambda
PetscErrorCode ierr;
ierr = MatMult(BNQ, lambda, temp); CHKERRQ(ierr);
ierr = VecWAXPY(q, -1.0, temp, qStar); CHKERRQ(ierr);
return 0;
}
PetscErrorCode NavierStokesSolver::generateRHS1()
{
PetscErrorCode ierr;
ierr = VecWAXPY(rhs1, 1.0, rn, bc1); CHKERRQ(ierr);
ierr = VecPointwiseMult(rhs1, MHat, rhs1); CHKERRQ(ierr);
return 0;
}
PetscErrorCode TSAlphaAdaptDefault(TS ts,PetscReal t,Vec X,Vec Xdot, PetscReal *nextdt,PetscBool *ok,void *ctx)
{
TS_Alpha *th;
SNESConvergedReason snesreason;
PetscReal dt,normX,normE,Emax,scale;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
#if PETSC_USE_DEBUG
{
PetscBool match;
ierr = PetscObjectTypeCompare((PetscObject)ts,TSALPHA,&match);CHKERRQ(ierr);
if (!match) SETERRQ(((PetscObject)ts)->comm,1,"Only for TSALPHA");
}
#endif
th = (TS_Alpha*)ts->data;
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
if (snesreason < 0) {
*ok = PETSC_FALSE;
*nextdt *= th->scale_min;
goto finally;
}
/* first-order aproximation to the local error */
/* E = (X0 + dt*Xdot) - X */
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
if (!th->E) {ierr = VecDuplicate(th->X0,&th->E);CHKERRQ(ierr);}
ierr = VecWAXPY(th->E,dt,Xdot,th->X0);CHKERRQ(ierr);
ierr = VecAXPY(th->E,-1,X);CHKERRQ(ierr);
ierr = VecNorm(th->E,NORM_2,&normE);CHKERRQ(ierr);
/* compute maximum allowable error */
ierr = VecNorm(X,NORM_2,&normX);CHKERRQ(ierr);
if (normX == 0) {ierr = VecNorm(th->X0,NORM_2,&normX);CHKERRQ(ierr);}
Emax = th->rtol * normX + th->atol;
/* compute next time step */
if (normE > 0) {
scale = th->rho * PetscRealPart(PetscSqrtScalar((PetscScalar)(Emax/normE)));
scale = PetscMax(scale,th->scale_min);
scale = PetscMin(scale,th->scale_max);
if (!(*ok))
scale = PetscMin(1.0,scale);
*nextdt *= scale;
}
/* accept or reject step */
if (normE <= Emax)
*ok = PETSC_TRUE;
else
*ok = PETSC_FALSE;
finally:
*nextdt = PetscMax(*nextdt,th->dt_min);
*nextdt = PetscMin(*nextdt,th->dt_max);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C;
Vec u,x,b,e;
PetscInt i,n = 10,midx[3];
PetscErrorCode ierr;
PetscScalar v[3];
PetscReal omega = 1.0,norm;
PetscInitialize(&argc,&args,(char*)0,help);
ierr = PetscOptionsGetReal(NULL,"-omega",&omega,NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(NULL,"-n",&n,NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_SELF,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,n,n,n,n);CHKERRQ(ierr);
ierr = MatSetType(C,MATSEQDENSE);CHKERRQ(ierr);
ierr = MatSetUp(C);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&b);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&x);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&u);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,n,&e);CHKERRQ(ierr);
ierr = VecSet(u,1.0);CHKERRQ(ierr);
ierr = VecSet(x,0.0);CHKERRQ(ierr);
v[0] = -1.; v[1] = 2.; v[2] = -1.;
for (i=1; i<n-1; i++) {
midx[0] = i-1; midx[1] = i; midx[2] = i+1;
ierr = MatSetValues(C,1,&i,3,midx,v,INSERT_VALUES);CHKERRQ(ierr);
}
i = 0; midx[0] = 0; midx[1] = 1;
v[0] = 2.0; v[1] = -1.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
i = n-1; midx[0] = n-2; midx[1] = n-1;
v[0] = -1.0; v[1] = 2.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatMult(C,u,b);CHKERRQ(ierr);
for (i=0; i<n; i++) {
ierr = MatSOR(C,b,omega,SOR_FORWARD_SWEEP,0.0,1,1,x);CHKERRQ(ierr);
ierr = VecWAXPY(e,-1.0,x,u);CHKERRQ(ierr);
ierr = VecNorm(e,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_SELF,"2-norm of error %g\n",(double)norm);CHKERRQ(ierr);
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&e);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode CalculateError(Vec solution,Vec u,Vec r,PetscReal *e)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecNorm(r,NORM_2,e+2);CHKERRQ(ierr);
ierr = VecWAXPY(r,-1.0,u,solution);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_2,e);CHKERRQ(ierr);
ierr = VecNorm(r,NORM_1,e+1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TSInterpolate_Theta(TS ts,PetscReal t,Vec X)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscReal dt = t - ts->ptime;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr);
if (th->endpoint) dt *= th->Theta;
ierr = VecWAXPY(X,dt,th->Xdot,th->X);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESTSFormFunction_Alpha(SNES snes,Vec x,Vec y,TS ts)
{
TS_Alpha *th = (TS_Alpha*)ts->data;
Vec X0 = th->X0, V0 = th->V0;
Vec X1 = x, V1 = th->V1, R = y;
PetscErrorCode ierr;
PetscFunctionBegin;
/* V1 = (1-1/Gamma)*V0 + 1/(Gamma*dT)*(X1-X0) */
ierr = VecWAXPY(V1,-1,X0,X1);CHKERRQ(ierr);
ierr = VecAXPBY(V1,1-1/th->Gamma,1/(th->Gamma*ts->time_step),V0);CHKERRQ(ierr);
/* Xa = X0 + Alpha_f*(X1-X0) */
ierr = VecWAXPY(th->Xa,-1,X0,X1);CHKERRQ(ierr);
ierr = VecAYPX(th->Xa,th->Alpha_f,X0);CHKERRQ(ierr);
/* Va = V0 + Alpha_m*(V1-V0) */
ierr = VecWAXPY(th->Va,-1,V0,V1);CHKERRQ(ierr);
ierr = VecAYPX(th->Va,th->Alpha_m,V0);CHKERRQ(ierr);
/* F = Function(ta,Xa,Va) */
ierr = TSComputeIFunction(ts,th->stage_time,th->Xa,th->Va,R,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(R,1/th->Alpha_f);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESLineSearchNo - This routine is not a line search at all;
it simply uses the full Newton step. Thus, this routine is intended
to serve as a template and is not recommended for general use.
Collective on SNES and Vec
Input Parameters:
+ snes - nonlinear context
. lsctx - optional context for line search (not used here)
. x - current iterate
. f - residual evaluated at x
. y - search direction
. fnorm - 2-norm of f
- xnorm - norm of x if known, otherwise 0
Output Parameters:
+ g - residual evaluated at new iterate y
. w - new iterate
. gnorm - 2-norm of g
. ynorm - 2-norm of search length
- flag - PETSC_TRUE on success, PETSC_FALSE on failure
Options Database Key:
. -snes_ls basic - Activates SNESLineSearchNo()
Level: advanced
.keywords: SNES, nonlinear, line search, cubic
.seealso: SNESLineSearchCubic(), SNESLineSearchQuadratic(),
SNESLineSearchSet(), SNESLineSearchNoNorms()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT SNESLineSearchNo(SNES snes,void *lsctx,Vec x,Vec f,Vec g,Vec y,Vec w,PetscReal fnorm,PetscReal xnorm,PetscReal *ynorm,PetscReal *gnorm,PetscTruth *flag)
{
PetscErrorCode ierr;
SNES_LS *neP = (SNES_LS*)snes->data;
PetscTruth changed_w = PETSC_FALSE,changed_y = PETSC_FALSE;
PetscFunctionBegin;
*flag = PETSC_TRUE;
ierr = PetscLogEventBegin(SNES_LineSearch,snes,x,f,g);CHKERRQ(ierr);
ierr = VecNorm(y,NORM_2,ynorm);CHKERRQ(ierr); /* ynorm = || y || */
ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr); /* w <- x - y */
if (neP->postcheckstep) {
ierr = (*neP->postcheckstep)(snes,x,y,w,neP->postcheck,&changed_y,&changed_w);CHKERRQ(ierr);
}
if (changed_y) {
ierr = VecWAXPY(w,-1.0,y,x);CHKERRQ(ierr); /* w <- x - y */
}
ierr = SNESComputeFunction(snes,w,g);CHKERRQ(ierr);
if (!snes->domainerror) {
ierr = VecNorm(g,NORM_2,gnorm);CHKERRQ(ierr); /* gnorm = || g || */
if PetscIsInfOrNanReal(*gnorm) SETERRQ(PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
}
static PetscErrorCode CompareGhostedCoords(Vec gc1,Vec gc2)
{
PetscErrorCode ierr;
PetscReal nrm,gnrm;
Vec tmp;
PetscFunctionBegin;
ierr = VecDuplicate(gc1,&tmp);CHKERRQ(ierr);
ierr = VecWAXPY(tmp,-1.0,gc1,gc2);CHKERRQ(ierr);
ierr = VecNorm(tmp,NORM_INFINITY,&nrm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&nrm,&gnrm,1,MPIU_REAL,MPIU_MAX,PETSC_COMM_WORLD);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"norm of difference of ghosted coordinates %8.2e\n",gnrm);CHKERRQ(ierr);
ierr = VecDestroy(&tmp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
KSPFGMRESResidual - This routine computes the initial residual (NOT PRECONDITIONED)
*/
static PetscErrorCode KSPFGMRESResidual(KSP ksp)
{
KSP_FGMRES *fgmres = (KSP_FGMRES*)(ksp->data);
Mat Amat,Pmat;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
/* put A*x into VEC_TEMP */
ierr = KSP_MatMult(ksp,Amat,ksp->vec_sol,VEC_TEMP);CHKERRQ(ierr);
/* now put residual (-A*x + f) into vec_vv(0) */
ierr = VecWAXPY(VEC_VV(0),-1.0,VEC_TEMP,ksp->vec_rhs);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode CheckProblem1(Mat A, Vec b, Vec u)
{
Vec errorVec;
PetscReal norm, error;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = VecDuplicate(b, &errorVec);CHKERRQ(ierr);
ierr = VecWAXPY(errorVec, -1.0, b, u);CHKERRQ(ierr);
ierr = VecNorm(errorVec, NORM_2, &error);CHKERRQ(ierr);
ierr = VecNorm(b, NORM_2, &norm);CHKERRQ(ierr);
if (error/norm > 1e-12) SETERRQ1(((PetscObject) A)->comm, PETSC_ERR_ARG_WRONG, "Relative error %g is too large", error/norm);
ierr = VecDestroy(&errorVec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatMultTransposeAdd_Shell(Mat A,Vec x,Vec y,Vec z)
{
Mat_Shell *shell = (Mat_Shell*)A->data;
PetscErrorCode ierr;
PetscFunctionBegin;
if (y == z) {
if (!shell->left_add_work) {ierr = VecDuplicate(z,&shell->left_add_work);CHKERRQ(ierr);}
ierr = MatMultTranspose(A,x,shell->left_add_work);CHKERRQ(ierr);
ierr = VecWAXPY(z,1.0,shell->left_add_work,y);CHKERRQ(ierr);
} else {
ierr = MatMultTranspose(A,x,z);CHKERRQ(ierr);
ierr = VecAXPY(z,1.0,y);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSStep_Theta(TS ts)
{
TS_Theta *th = (TS_Theta*)ts->data;
PetscInt its,lits;
PetscReal next_time_step;
SNESConvergedReason snesreason;
PetscErrorCode ierr;
PetscFunctionBegin;
next_time_step = ts->time_step;
th->stage_time = ts->ptime + (th->endpoint ? 1. : th->Theta)*ts->time_step;
th->shift = 1./(th->Theta*ts->time_step);
ierr = TSPreStep(ts);CHKERRQ(ierr);
ierr = TSPreStage(ts,th->stage_time);CHKERRQ(ierr);
if (th->endpoint) { /* This formulation assumes linear time-independent mass matrix */
ierr = VecZeroEntries(th->Xdot);CHKERRQ(ierr);
if (!th->affine) {ierr = VecDuplicate(ts->vec_sol,&th->affine);CHKERRQ(ierr);}
ierr = TSComputeIFunction(ts,ts->ptime,ts->vec_sol,th->Xdot,th->affine,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecScale(th->affine,(th->Theta-1.)/th->Theta);CHKERRQ(ierr);
}
if (th->extrapolate) {
ierr = VecWAXPY(th->X,1./th->shift,th->Xdot,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecCopy(ts->vec_sol,th->X);CHKERRQ(ierr);
}
ierr = SNESSolve(ts->snes,th->affine,th->X);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(ts->snes,&its);CHKERRQ(ierr);
ierr = SNESGetLinearSolveIterations(ts->snes,&lits);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(ts->snes,&snesreason);CHKERRQ(ierr);
ts->snes_its += its; ts->ksp_its += lits;
if (snesreason < 0 && ts->max_snes_failures > 0 && ++ts->num_snes_failures >= ts->max_snes_failures) {
ts->reason = TS_DIVERGED_NONLINEAR_SOLVE;
ierr = PetscInfo2(ts,"Step=%D, nonlinear solve solve failures %D greater than current TS allowed, stopping solve\n",ts->steps,ts->num_snes_failures);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (th->endpoint) {
ierr = VecCopy(th->X,ts->vec_sol);CHKERRQ(ierr);
} else {
ierr = VecAXPBYPCZ(th->Xdot,-th->shift,th->shift,0,ts->vec_sol,th->X);CHKERRQ(ierr);
ierr = VecAXPY(ts->vec_sol,ts->time_step,th->Xdot);CHKERRQ(ierr);
}
ts->ptime += ts->time_step;
ts->time_step = next_time_step;
ts->steps++;
PetscFunctionReturn(0);
}
static PetscErrorCode VecWAXPY_Nest(Vec w,PetscScalar alpha,Vec x,Vec y)
{
Vec_Nest *bx = (Vec_Nest*)x->data;
Vec_Nest *by = (Vec_Nest*)y->data;
Vec_Nest *bw = (Vec_Nest*)w->data;
PetscInt i,nr;
PetscErrorCode ierr;
PetscFunctionBegin;
VecNestCheckCompatible3(w,1,x,3,y,4);
nr = bx->nb;
for (i=0; i<nr; i++) {
ierr = VecWAXPY(bw->v[i],alpha,bx->v[i],by->v[i]);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode TSEvaluateStep_Theta(TS ts,PetscInt order,Vec U,PetscBool *done)
{
PetscErrorCode ierr;
TS_Theta *th = (TS_Theta*)ts->data;
PetscFunctionBegin;
if (order == 0) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_USER,"No time-step adaptivity implemented for 1st order theta method; Run with -ts_adapt_type none");
if (order == th->order) {
if (th->endpoint) {
ierr = VecCopy(th->X,U);CHKERRQ(ierr);
} else {
PetscReal shift = 1./(th->Theta*ts->time_step);
ierr = VecAXPBYPCZ(th->Xdot,-shift,shift,0,U,th->X);CHKERRQ(ierr);
ierr = VecAXPY(U,ts->time_step,th->Xdot);CHKERRQ(ierr);
}
} else if (order == th->order-1 && order) {
ierr = VecWAXPY(U,ts->time_step,th->Xdot,th->X0);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode PressurePoissonUpdate( )
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscLogEventBegin(EVENT_PressurePoissonUpdate,0,0,0,0);
// PetscLogEventRegister(&EVENT_PressurePoissonUpdate,"PressurePoissonUpdate", 0);
VecSet(rhsC->v, 0.); // TODO: this is important when reusing vecs, need to reset back to zero after time step
ierr = IIMComputeCorrection2D(iim,JumpConditionPressure,ls,rhsC); CHKERRQ(ierr);
IIMDiscreteCompatabilityCondition(ls, rhsC);
ierr = KSPSolve(ksp, rhsC->v, p->v); CHKERRQ(ierr);
IrregularNodeListWrite(ls,t);
ierr = IIMPressureGradient(ls,p,px,py); CHKERRQ(ierr);
ierr = IIMComputeCorrection2D(iim,JumpConditionXVelocity,ls,px); CHKERRQ(ierr);
px->v2[d1/2][d2/2] = 0.;
ierr = KSPSolve(ksp, px->v, u->v); CHKERRQ(ierr);
ierr = IIMComputeCorrection2D(iim,JumpConditionYVelocity,ls,py); CHKERRQ(ierr);
py->v2[d1/2][d2/2] = 0.;
ierr = KSPSolve(ksp, py->v, v->v); CHKERRQ(ierr);
VecPointwiseMult(u2, u->v, u->v);
VecPointwiseMult(v2, u->v, u->v);
VecWAXPY(magVel, 1, u2, v2);
VecSqrt( magVel );
VecNorm(magVel, NORM_INFINITY, &maxVel);
dt = PetscMin(1/(2*maxVel),.1);
LevelSetAdvect2D(dt, u, v, ls, lstemp);
printf("\tmaxVel: %f",maxVel);
printf("\tdt: %f\n",dt);
PetscLogEventEnd(EVENT_PressurePoissonUpdate,0,0,0,0);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPPGMRESBuildSoln(PetscScalar *nrs,Vec vguess,Vec vdest,KSP ksp,PetscInt it)
{
PetscScalar tt;
PetscErrorCode ierr;
PetscInt k,j;
KSP_PGMRES *pgmres = (KSP_PGMRES*)(ksp->data);
PetscFunctionBegin;
/* Solve for solution vector that minimizes the residual */
if (it < 0) { /* no pgmres steps have been performed */
ierr = VecCopy(vguess,vdest);CHKERRQ(ierr); /* VecCopy() is smart, exits immediately if vguess == vdest */
PetscFunctionReturn(0);
}
/* solve the upper triangular system - RS is the right side and HH is
the upper triangular matrix - put soln in nrs */
if (*HH(it,it) != 0.0) nrs[it] = *RS(it) / *HH(it,it);
else nrs[it] = 0.0;
for (k=it-1; k>=0; k--) {
tt = *RS(k);
for (j=k+1; j<=it; j++) tt -= *HH(k,j) * nrs[j];
nrs[k] = tt / *HH(k,k);
}
/* Accumulate the correction to the solution of the preconditioned problem in TEMP */
ierr = VecZeroEntries(VEC_TEMP);CHKERRQ(ierr);
ierr = VecMAXPY(VEC_TEMP,it+1,nrs,&VEC_VV(0));CHKERRQ(ierr);
ierr = KSPUnwindPreconditioner(ksp,VEC_TEMP,VEC_TEMP_MATOP);CHKERRQ(ierr);
/* add solution to previous solution */
if (vdest == vguess) {
ierr = VecAXPY(vdest,1.0,VEC_TEMP);CHKERRQ(ierr);
} else {
ierr = VecWAXPY(vdest,1.0,VEC_TEMP,vguess);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPFischerGuessUpdate_Method1(KSPFischerGuess_Method1 *itg,Vec x)
{
PetscReal norm;
PetscErrorCode ierr;
int curl = itg->curl,i;
PetscFunctionBegin;
PetscValidHeaderSpecific(x,VEC_CLASSID,2);
PetscValidPointer(itg,3);
if (curl == itg->maxl) {
ierr = KSP_MatMult(itg->ksp,itg->mat,x,itg->btilde[0]);CHKERRQ(ierr);
ierr = VecNormalize(itg->btilde[0],&norm);CHKERRQ(ierr);
ierr = VecCopy(x,itg->xtilde[0]);CHKERRQ(ierr);
ierr = VecScale(itg->xtilde[0],1.0/norm);CHKERRQ(ierr);
itg->curl = 1;
} else {
if (!curl) {
ierr = VecCopy(x,itg->xtilde[curl]);CHKERRQ(ierr);
} else {
ierr = VecWAXPY(itg->xtilde[curl],-1.0,itg->guess,x);CHKERRQ(ierr);
}
ierr = KSP_MatMult(itg->ksp,itg->mat,itg->xtilde[curl],itg->btilde[curl]);CHKERRQ(ierr);
ierr = VecMDot(itg->btilde[curl],curl,itg->btilde,itg->alpha);CHKERRQ(ierr);
for (i=0; i<curl; i++) itg->alpha[i] = -itg->alpha[i];
ierr = VecMAXPY(itg->btilde[curl],curl,itg->alpha,itg->btilde);CHKERRQ(ierr);
ierr = VecMAXPY(itg->xtilde[curl],curl,itg->alpha,itg->xtilde);CHKERRQ(ierr);
ierr = VecNormalize(itg->btilde[curl],&norm);CHKERRQ(ierr);
if (norm) {
ierr = VecScale(itg->xtilde[curl],1.0/norm);CHKERRQ(ierr);
itg->curl++;
} else {
ierr = PetscInfo(itg->ksp,"Not increasing dimension of Fischer space because new direction is identical to previous\n");CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_PIPEFCG_cycle(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,j,k,idx,kdx,mi;
KSP_PIPEFCG *pipefcg;
PetscScalar alpha=0.0,gamma,*betas,*dots;
PetscReal dp=0.0, delta,*eta,*etas;
Vec B,R,Z,X,Qcurr,W,ZETAcurr,M,N,Pcurr,Scurr,*redux;
Mat Amat,Pmat;
PetscFunctionBegin;
/* We have not checked these routines for use with complex numbers. The inner products
are likely not defined correctly for that case */
#if (defined(PETSC_USE_COMPLEX) && !defined(PETSC_SKIP_COMPLEX))
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP,"PIPEFGMRES has not been implemented for use with complex scalars");
#endif
#define VecXDot(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDot (x,y,a) : VecTDot (x,y,a))
#define VecXDotBegin(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotBegin (x,y,a) : VecTDotBegin (x,y,a))
#define VecXDotEnd(x,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecDotEnd (x,y,a) : VecTDotEnd (x,y,a))
#define VecMXDot(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDot (x,n,y,a) : VecMTDot (x,n,y,a))
#define VecMXDotBegin(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotBegin (x,n,y,a) : VecMTDotBegin (x,n,y,a))
#define VecMXDotEnd(x,n,y,a) (((pipefcg->type) == (KSP_CG_HERMITIAN)) ? VecMDotEnd (x,n,y,a) : VecMTDotEnd (x,n,y,a))
pipefcg = (KSP_PIPEFCG*)ksp->data;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
W = ksp->work[2];
M = ksp->work[3];
N = ksp->work[4];
redux = pipefcg->redux;
dots = pipefcg->dots;
etas = pipefcg->etas;
betas = dots; /* dots takes the result of all dot products of which the betas are a subset */
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
/* Compute cycle initial residual */
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr);
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); /* r <- b - Ax */
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
Pcurr = pipefcg->Pvecs[0];
Scurr = pipefcg->Svecs[0];
Qcurr = pipefcg->Qvecs[0];
ZETAcurr = pipefcg->ZETAvecs[0];
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,Pcurr,Scurr);CHKERRQ(ierr); /* S = Ap */
ierr = VecCopy(Scurr,W);CHKERRQ(ierr); /* w = s = Az */
/* Initial state of pipelining intermediates */
redux[0] = R;
redux[1] = W;
ierr = VecMXDotBegin(Z,2,redux,dots);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = KSP_PCApply(ksp,W,M);CHKERRQ(ierr); /* m = B(w) */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr); /* q = m */
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr); /* zeta = n */
ierr = VecMXDotEnd(Z,2,redux,dots);CHKERRQ(ierr);
gamma = dots[0];
delta = PetscRealPart(dots[1]);
etas[0] = delta;
alpha = gamma/delta;
i = 0;
do {
ksp->its++;
/* Update X, R, Z, W */
ierr = VecAXPY(X,+alpha,Pcurr);CHKERRQ(ierr); /* x <- x + alpha * pi */
ierr = VecAXPY(R,-alpha,Scurr);CHKERRQ(ierr); /* r <- r - alpha * si */
ierr = VecAXPY(Z,-alpha,Qcurr);CHKERRQ(ierr); /* z <- z - alpha * qi */
ierr = VecAXPY(W,-alpha,ZETAcurr);CHKERRQ(ierr); /* w <- w - alpha * zetai */
/* Compute norm for convergence check */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(z'*z) = sqrt(e'*A'*B'*B*A*e) */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- sqrt(r'*r) = sqrt(e'*A'*A*e) */
break;
case KSP_NORM_NATURAL:
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- sqrt(r'*z) = sqrt(e'*A'*B*A*e) */
break;
case KSP_NORM_NONE:
dp = 0.0;
break;
default: SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
/* Check for convergence */
ksp->rnorm = dp;
KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
/* Computations of current iteration done */
++i;
/* If needbe, allocate a new chunk of vectors in P and C */
ierr = KSPAllocateVectors_PIPEFCG(ksp,i+1,pipefcg->vecb);CHKERRQ(ierr);
/* Note that we wrap around and start clobbering old vectors */
idx = i % (pipefcg->mmax+1);
Pcurr = pipefcg->Pvecs[idx];
Scurr = pipefcg->Svecs[idx];
Qcurr = pipefcg->Qvecs[idx];
ZETAcurr = pipefcg->ZETAvecs[idx];
eta = pipefcg->etas+idx;
/* number of old directions to orthogonalize against */
switch(pipefcg->truncstrat){
case KSP_FCD_TRUNC_TYPE_STANDARD:
mi = pipefcg->mmax;
break;
case KSP_FCD_TRUNC_TYPE_NOTAY:
mi = ((i-1) % pipefcg->mmax)+1;
break;
default:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unrecognized Truncation Strategy");
}
/* Pick old p,s,q,zeta in a way suitable for VecMDot */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
pipefcg->Pold[j] = pipefcg->Pvecs[kdx];
pipefcg->Sold[j] = pipefcg->Svecs[kdx];
pipefcg->Qold[j] = pipefcg->Qvecs[kdx];
pipefcg->ZETAold[j] = pipefcg->ZETAvecs[kdx];
redux[j] = pipefcg->Svecs[kdx];
}
redux[j] = R; /* If the above loop is not executed redux contains only R => all beta_k = 0, only gamma, delta != 0 */
redux[j+1] = W;
ierr = VecMXDotBegin(Z,j+2,redux,betas);CHKERRQ(ierr); /* Start split reductions for beta_k = (z,s_k), gamma = (z,r), delta = (z,w) */
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)Z));CHKERRQ(ierr); /* perform asynchronous reduction */
ierr = VecWAXPY(N,-1.0,R,W);CHKERRQ(ierr); /* m = u + B(w-r): (a) ntmp = w-r */
ierr = KSP_PCApply(ksp,N,M);CHKERRQ(ierr); /* m = u + B(w-r): (b) mtmp = B(ntmp) = B(w-r) */
ierr = VecAXPY(M,1.0,Z);CHKERRQ(ierr); /* m = u + B(w-r): (c) m = z + mtmp */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n = Am */
ierr = VecMXDotEnd(Z,j+2,redux,betas);CHKERRQ(ierr); /* Finish split reductions */
gamma = betas[j];
delta = PetscRealPart(betas[j+1]);
*eta = 0.;
for(k=PetscMax(0,i-mi),j=0;k<i;++j,++k){
kdx = k % (pipefcg->mmax+1);
betas[j] /= -etas[kdx]; /* betak /= etak */
*eta -= ((PetscReal)(PetscAbsScalar(betas[j])*PetscAbsScalar(betas[j]))) * etas[kdx];
/* etaitmp = -betaik^2 * etak */
}
*eta += delta; /* etai = delta -betaik^2 * etak */
if(*eta < 0.) {
pipefcg->norm_breakdown = PETSC_TRUE;
ierr = PetscInfo1(ksp,"Restart due to square root breakdown at it = \n",ksp->its);CHKERRQ(ierr);
break;
} else {
alpha= gamma/(*eta); /* alpha = gamma/etai */
}
/* project out stored search directions using classical G-S */
ierr = VecCopy(Z,Pcurr);CHKERRQ(ierr);
ierr = VecCopy(W,Scurr);CHKERRQ(ierr);
ierr = VecCopy(M,Qcurr);CHKERRQ(ierr);
ierr = VecCopy(N,ZETAcurr);CHKERRQ(ierr);
ierr = VecMAXPY(Pcurr ,j,betas,pipefcg->Pold);CHKERRQ(ierr); /* pi <- ui - sum_k beta_k p_k */
ierr = VecMAXPY(Scurr ,j,betas,pipefcg->Sold);CHKERRQ(ierr); /* si <- wi - sum_k beta_k s_k */
ierr = VecMAXPY(Qcurr ,j,betas,pipefcg->Qold);CHKERRQ(ierr); /* qi <- m - sum_k beta_k q_k */
ierr = VecMAXPY(ZETAcurr,j,betas,pipefcg->ZETAold);CHKERRQ(ierr); /* zetai <- n - sum_k beta_k zeta_k */
} while (ksp->its < ksp->max_it);
PetscFunctionReturn(0);
}
PetscErrorCode efs_solve(efs *slv)
{
PetscErrorCode ierr;
PetscInt i, j, k, xs, ys, zs, xm, ym, zm;
PetscInt ngx,ngy,ngz;
DMBoundaryType bx, by, bz;
slv->ts++;
ierr = KSPSolve(slv->ksp, NULL, NULL);CHKERRQ(ierr);
if (efs_log(slv, EFS_LOG_STATUS)) {
ierr = ef_io_print(slv->comm, "Solve completed");CHKERRQ(ierr);
}
ierr = KSPGetSolution(slv->ksp, &slv->x);CHKERRQ(ierr);
ierr = DMDAGetInfo(slv->dm, 0, &ngx, &ngy, &ngz,0,0,0,0,0, &bx, &by, &bz,0);CHKERRQ(ierr);
if (efs_log(slv, EFS_LOG_PROBLEM)) {
PetscViewer xout;
ierr = PetscViewerASCIIOpen(slv->comm, "x.txt", &xout);CHKERRQ(ierr);
ierr = VecView(slv->x, xout);CHKERRQ(ierr);
}
ierr = DMDAGetCorners(slv->dm, &xs, &ys, &zs, &xm, &ym, &zm);CHKERRQ(ierr);
if (slv->grid.nd == 2) {
Vec loc_x;
PetscScalar **xvec;
double **phi;
ierr = ef_dmap_get(slv->dmap, slv->state.phi, &phi);CHKERRQ(ierr);
ierr = DMGetLocalVector(slv->dm, &loc_x);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(slv->dm, slv->x, INSERT_VALUES, loc_x);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(slv->dm, slv->x, INSERT_VALUES, loc_x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(slv->dm, loc_x, &xvec);CHKERRQ(ierr);
if ((by == DM_BOUNDARY_PERIODIC) && (ys + ym == ngy)) {
for (i = xs; i < xs + xm; i++) {
xvec[ngy-1][i] = xvec[ngy][i];
}
}
if ((bx == DM_BOUNDARY_PERIODIC) && (xs + xm == ngx)) {
for (j = ys; j < ys + ym; j++) {
xvec[j][ngx-1] = xvec[j][ngx];
}
}
for (j = ys; j < ys + ym; j++) {
for (i = xs; i < xs + xm; i++) {
phi[j][i] = xvec[j][i];
}
}
ierr = ef_dmap_restore(slv->dmap, &phi);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(slv->dm, loc_x, &xvec);CHKERRQ(ierr);
if (efs_log(slv, EFS_LOG_VTK)) {
ierr = DMLocalToGlobalBegin(slv->dm, loc_x, INSERT_VALUES, slv->x);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(slv->dm, loc_x, INSERT_VALUES, slv->x);CHKERRQ(ierr);
ierr = ef_io_vtkwrite(slv->dm, slv->x, "phi", slv->grid.id, slv->ts);CHKERRQ(ierr);
}
} else if (slv->grid.nd == 3) {
PetscScalar ***xvec;
double ***phi;
Vec loc_x;
ierr = ef_dmap_get(slv->dmap, slv->state.phi, &phi);CHKERRQ(ierr);
ierr = DMGetLocalVector(slv->dm, &loc_x);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(slv->dm, slv->x, INSERT_VALUES, loc_x);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(slv->dm, slv->x, INSERT_VALUES, loc_x);CHKERRQ(ierr);
ierr = DMDAVecGetArray(slv->dm, loc_x, &xvec);CHKERRQ(ierr);
if ((bz == DM_BOUNDARY_PERIODIC) && (zs + zm == ngz)) {
for (j = ys; j < ys + ym; j++) {
for (i = xs; i < xs + xm; i++) {
xvec[ngz-1][j][i] = xvec[ngz][j][i];
}
}
}
if ((by == DM_BOUNDARY_PERIODIC) && (ys + ym == ngy)) {
for (k = zs; k < zs + zm; k++) {
for (i = xs; i < xs + xm; i++) {
xvec[k][ngy-1][i] = xvec[k][ngy][i];
}
}
}
if ((bx == DM_BOUNDARY_PERIODIC) && (xs + xm == ngx)) {
for (k = zs; k < zs + zm; k++) {
for (j = ys; j < ys + ym; j++) {
xvec[k][j][ngx-1] = xvec[k][j][ngx];
}
}
}
for (k = zs; k < zs + zm; k++) {
for (j = ys; j < ys + ym; j++) {
for (i = xs; i < xs + xm; i++) {
phi[k][j][i] = xvec[k][j][i];
}
}
}
ierr = ef_dmap_restore(slv->dmap, &phi);CHKERRQ(ierr);
ierr = DMDAVecRestoreArray(slv->dm, loc_x, &xvec);CHKERRQ(ierr);
if (efs_log(slv, EFS_LOG_VTK)) {
ierr = DMLocalToGlobalBegin(slv->dm, loc_x, INSERT_VALUES, slv->x);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(slv->dm, loc_x, INSERT_VALUES, slv->x);CHKERRQ(ierr);
ierr = ef_io_vtkwrite(slv->dm, slv->x, "phi", slv->grid.id, slv->ts);CHKERRQ(ierr);
}
}
if (efs_log(slv, EFS_LOG_VTK)) {
if (slv->state.sol) {
ierr = ef_io_vtkwrite(slv->dm, slv->sol, "sol", slv->grid.id, 0);CHKERRQ(ierr);
Vec err;
ierr = VecDuplicate(slv->sol, &err);CHKERRQ(ierr);
ierr = VecWAXPY(err, -1, slv->x, slv->sol);CHKERRQ(ierr);
ierr = ef_io_vtkwrite(slv->dm, err, "err", slv->grid.id, 0);CHKERRQ(ierr);
ierr = VecDestroy(&err);CHKERRQ(ierr);
}
}
if (efs_log(slv, EFS_LOG_EIGS)) {
PetscInt n, neig;
PetscReal *r, *c;
n = ngx*ngy;
r = (PetscReal*) malloc(n*sizeof(PetscReal));
c = (PetscReal*) malloc(n*sizeof(PetscReal));
ierr = KSPComputeEigenvalues(slv->ksp, n, r, c, &neig);CHKERRQ(ierr);
ierr = ef_io_eigwrite(r, c, neig);CHKERRQ(ierr);
}
return 0;
}
// PETSc 3.3.0+
PetscErrorCode dampedCheck(SNESLineSearch /* linesearch */, Vec x, Vec y, Vec w, PetscBool * /*changed_y*/, PetscBool * changed_w, void *lsctx)
#endif
{
// From SNESLineSearchSetPostCheck docs:
// + x - old solution vector
// . y - search direction vector
// . w - new solution vector w = x-y
// . changed_y - indicates that the line search changed y
// . changed_w - indicates that the line search changed w
int ierr = 0;
Real damping = 1.0;
FEProblem & problem = *static_cast<FEProblem *>(lsctx);
TransientNonlinearImplicitSystem & system = problem.getNonlinearSystem().sys();
// The whole deal here is that we need ghosted versions of vectors y and w (they are parallel, but not ghosted).
// So to do that I'm going to duplicate current_local_solution (which has the ghosting we want).
// Then stuff values into the duplicates
// Then "close()" the vectors which updates their ghosted vaulues.
{
// cls is a PetscVector wrapper around the Vec in current_local_solution
PetscVector<Number> cls(static_cast<PetscVector<Number> *>(system.current_local_solution.get())->vec(), problem.comm());
// Create new NumericVectors with the right ghosting - note: these will be destroyed
// when this function exits, so nobody better hold pointers to them any more!
UniquePtr<NumericVector<Number> > ghosted_y_aptr( cls.zero_clone() );
UniquePtr<NumericVector<Number> > ghosted_w_aptr( cls.zero_clone() );
// Create PetscVector wrappers around the Vecs.
PetscVector<Number> ghosted_y( static_cast<PetscVector<Number> *>(ghosted_y_aptr.get())->vec(), problem.comm());
PetscVector<Number> ghosted_w( static_cast<PetscVector<Number> *>(ghosted_w_aptr.get())->vec(), problem.comm());
ierr = VecCopy(y, ghosted_y.vec()); CHKERRABORT(problem.comm().get(),ierr);
ierr = VecCopy(w, ghosted_w.vec()); CHKERRABORT(problem.comm().get(),ierr);
ghosted_y.close();
ghosted_w.close();
damping = problem.computeDamping(ghosted_w, ghosted_y);
if (damping < 1.0)
{
//recalculate w=-damping*y + x
ierr = VecWAXPY(w, -damping, y, x); CHKERRABORT(problem.comm().get(),ierr);
*changed_w = PETSC_TRUE;
}
if (problem.shouldUpdateSolution())
{
//Update the ghosted copy of w
if (*changed_w == PETSC_TRUE)
{
ierr = VecCopy(w, ghosted_w.vec()); CHKERRABORT(problem.comm().get(),ierr);
ghosted_w.close();
}
//Create vector to directly modify w
PetscVector<Number> vec_w(w, problem.comm());
bool updatedSolution = problem.updateSolution(vec_w, ghosted_w);
if (updatedSolution)
*changed_w = PETSC_TRUE;
}
}
return ierr;
}
/*
MatMult_MFFD - Default matrix-free form for Jacobian-vector product, y = F'(u)*a:
y ~= (F(u + ha) - F(u))/h,
where F = nonlinear function, as set by SNESSetFunction()
u = current iterate
h = difference interval
*/
static PetscErrorCode MatMult_MFFD(Mat mat,Vec a,Vec y)
{
MatMFFD ctx = (MatMFFD)mat->data;
PetscScalar h;
Vec w,U,F;
PetscErrorCode ierr;
PetscBool zeroa;
PetscFunctionBegin;
if (!ctx->current_u) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONGSTATE,"MatMFFDSetBase() has not been called, this is often caused by forgetting to call \n\t\tMatAssemblyBegin/End on the first Mat in the SNES compute function");
/* We log matrix-free matrix-vector products separately, so that we can
separate the performance monitoring from the cases that use conventional
storage. We may eventually modify event logging to associate events
with particular objects, hence alleviating the more general problem. */
ierr = PetscLogEventBegin(MATMFFD_Mult,a,y,0,0);CHKERRQ(ierr);
w = ctx->w;
U = ctx->current_u;
F = ctx->current_f;
/*
Compute differencing parameter
*/
if (!((PetscObject)ctx)->type_name) {
ierr = MatMFFDSetType(mat,MATMFFD_WP);CHKERRQ(ierr);
ierr = MatSetFromOptions(mat);CHKERRQ(ierr);
}
ierr = (*ctx->ops->compute)(ctx,U,a,&h,&zeroa);CHKERRQ(ierr);
if (zeroa) {
ierr = VecSet(y,0.0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (mat->erroriffailure && PetscIsInfOrNanScalar(h)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Computed Nan differencing parameter h");
if (ctx->checkh) {
ierr = (*ctx->checkh)(ctx->checkhctx,U,a,&h);CHKERRQ(ierr);
}
/* keep a record of the current differencing parameter h */
ctx->currenth = h;
#if defined(PETSC_USE_COMPLEX)
ierr = PetscInfo2(mat,"Current differencing parameter: %g + %g i\n",(double)PetscRealPart(h),(double)PetscImaginaryPart(h));CHKERRQ(ierr);
#else
ierr = PetscInfo1(mat,"Current differencing parameter: %15.12e\n",h);CHKERRQ(ierr);
#endif
if (ctx->historyh && ctx->ncurrenth < ctx->maxcurrenth) {
ctx->historyh[ctx->ncurrenth] = h;
}
ctx->ncurrenth++;
#if defined(PETSC_USE_COMPLEX)
if (ctx->usecomplex) h = PETSC_i*h;
#endif
/* w = u + ha */
if (ctx->drscale) {
ierr = VecPointwiseMult(ctx->drscale,a,U);CHKERRQ(ierr);
ierr = VecAYPX(U,h,w);CHKERRQ(ierr);
} else {
ierr = VecWAXPY(w,h,a,U);CHKERRQ(ierr);
}
/* compute func(U) as base for differencing; only needed first time in and not when provided by user */
if (ctx->ncurrenth == 1 && ctx->current_f_allocated) {
ierr = (*ctx->func)(ctx->funcctx,U,F);CHKERRQ(ierr);
}
ierr = (*ctx->func)(ctx->funcctx,w,y);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
if (ctx->usecomplex) {
ierr = VecImaginaryPart(y);CHKERRQ(ierr);
h = PetscImaginaryPart(h);
} else {
ierr = VecAXPY(y,-1.0,F);CHKERRQ(ierr);
}
#else
ierr = VecAXPY(y,-1.0,F);CHKERRQ(ierr);
#endif
ierr = VecScale(y,1.0/h);CHKERRQ(ierr);
ierr = VecAXPBY(y,ctx->vshift,ctx->vscale,a);CHKERRQ(ierr);
if (ctx->dlscale) {
ierr = VecPointwiseMult(y,ctx->dlscale,y);CHKERRQ(ierr);
}
if (ctx->dshift) {
if (!ctx->dshiftw) {
ierr = VecDuplicate(y,&ctx->dshiftw);CHKERRQ(ierr);
}
ierr = VecPointwiseMult(ctx->dshift,a,ctx->dshiftw);CHKERRQ(ierr);
ierr = VecAXPY(y,1.0,ctx->dshiftw);CHKERRQ(ierr);
}
if (mat->nullsp) {ierr = MatNullSpaceRemove(mat->nullsp,y);CHKERRQ(ierr);}
ierr = PetscLogEventEnd(MATMFFD_Mult,a,y,0,0);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSolve_CGS(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar rho,rhoold,a,s,b;
Vec X,B,V,P,R,RP,T,Q,U,AUQ;
PetscReal dp = 0.0;
PetscBool diagonalscale;
PetscFunctionBegin;
/* not sure what residual norm it does use, should use for right preconditioning */
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
RP = ksp->work[1];
V = ksp->work[2];
T = ksp->work[3];
Q = ksp->work[4];
P = ksp->work[5];
U = ksp->work[6];
AUQ = V;
/* Compute initial preconditioned residual */
ierr = KSPInitialResidual(ksp,X,V,T,R,B);CHKERRQ(ierr);
/* Test for nothing to do */
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr);
if (ksp->normtype == KSP_NORM_NATURAL) dp *= dp;
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = dp;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
/* Make the initial Rp == R */
ierr = VecCopy(R,RP);CHKERRQ(ierr);
/* added for Fidap */
/* Penalize Startup - Isaac Hasbani Trick for CGS
Since most initial conditions result in a mostly 0 residual,
we change all the 0 values in the vector RP to the maximum.
*/
if (ksp->normtype == KSP_NORM_NATURAL) {
PetscReal vr0max;
PetscScalar *tmp_RP=0;
PetscInt numnp =0, *max_pos=0;
ierr = VecMax(RP, max_pos, &vr0max);CHKERRQ(ierr);
ierr = VecGetArray(RP, &tmp_RP);CHKERRQ(ierr);
ierr = VecGetLocalSize(RP, &numnp);CHKERRQ(ierr);
for (i=0; i<numnp; i++) {
if (tmp_RP[i] == 0.0) tmp_RP[i] = vr0max;
}
ierr = VecRestoreArray(RP, &tmp_RP);CHKERRQ(ierr);
}
/* end of addition for Fidap */
/* Set the initial conditions */
ierr = VecDot(R,RP,&rhoold);CHKERRQ(ierr); /* rhoold = (r,rp) */
ierr = VecCopy(R,U);CHKERRQ(ierr);
ierr = VecCopy(R,P);CHKERRQ(ierr);
ierr = KSP_PCApplyBAorAB(ksp,P,V,T);CHKERRQ(ierr);
i = 0;
do {
ierr = VecDot(V,RP,&s);CHKERRQ(ierr); /* s <- (v,rp) */
a = rhoold / s; /* a <- rho / s */
ierr = VecWAXPY(Q,-a,V,U);CHKERRQ(ierr); /* q <- u - a v */
ierr = VecWAXPY(T,1.0,U,Q);CHKERRQ(ierr); /* t <- u + q */
ierr = VecAXPY(X,a,T);CHKERRQ(ierr); /* x <- x + a (u + q) */
ierr = KSP_PCApplyBAorAB(ksp,T,AUQ,U);CHKERRQ(ierr);
ierr = VecAXPY(R,-a,AUQ);CHKERRQ(ierr); /* r <- r - a K (u + q) */
ierr = VecDot(R,RP,&rho);CHKERRQ(ierr); /* rho <- (r,rp) */
if (ksp->normtype == KSP_NORM_NATURAL) {
dp = PetscAbsScalar(rho);
} else {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = dp;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
b = rho / rhoold; /* b <- rho / rhoold */
ierr = VecWAXPY(U,b,Q,R);CHKERRQ(ierr); /* u <- r + b q */
ierr = VecAXPY(Q,b,P);CHKERRQ(ierr);
ierr = VecWAXPY(P,b,Q,U);CHKERRQ(ierr); /* p <- u + b(q + b p) */
ierr = KSP_PCApplyBAorAB(ksp,P,V,Q);CHKERRQ(ierr); /* v <- K p */
rhoold = rho;
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
ierr = KSPUnwindPreconditioner(ksp,X,T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_FBCGSR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,j,N;
PetscScalar tau,sigma,alpha,omega,beta;
PetscReal rho;
PetscScalar xi1,xi2,xi3,xi4;
Vec X,B,P,P2,RP,R,V,S,T,S2;
PetscScalar *PETSC_RESTRICT rp, *PETSC_RESTRICT r, *PETSC_RESTRICT p;
PetscScalar *PETSC_RESTRICT v, *PETSC_RESTRICT s, *PETSC_RESTRICT t, *PETSC_RESTRICT s2;
PetscScalar insums[4],outsums[4];
KSP_BCGS *bcgs = (KSP_BCGS*)ksp->data;
PC pc;
PetscFunctionBegin;
if (!ksp->vec_rhs->petscnative) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Only coded for PETSc vectors");
ierr = VecGetLocalSize(ksp->vec_sol,&N);
CHKERRQ(ierr);
X = ksp->vec_sol;
B = ksp->vec_rhs;
P2 = ksp->work[0];
/* The followings are involved in modified inner product calculations and vector updates */
RP = ksp->work[1];
ierr = VecGetArray(RP,(PetscScalar**)&rp);
CHKERRQ(ierr);
ierr = VecRestoreArray(RP,NULL);
CHKERRQ(ierr);
R = ksp->work[2];
ierr = VecGetArray(R,(PetscScalar**)&r);
CHKERRQ(ierr);
ierr = VecRestoreArray(R,NULL);
CHKERRQ(ierr);
P = ksp->work[3];
ierr = VecGetArray(P,(PetscScalar**)&p);
CHKERRQ(ierr);
ierr = VecRestoreArray(P,NULL);
CHKERRQ(ierr);
V = ksp->work[4];
ierr = VecGetArray(V,(PetscScalar**)&v);
CHKERRQ(ierr);
ierr = VecRestoreArray(V,NULL);
CHKERRQ(ierr);
S = ksp->work[5];
ierr = VecGetArray(S,(PetscScalar**)&s);
CHKERRQ(ierr);
ierr = VecRestoreArray(S,NULL);
CHKERRQ(ierr);
T = ksp->work[6];
ierr = VecGetArray(T,(PetscScalar**)&t);
CHKERRQ(ierr);
ierr = VecRestoreArray(T,NULL);
CHKERRQ(ierr);
S2 = ksp->work[7];
ierr = VecGetArray(S2,(PetscScalar**)&s2);
CHKERRQ(ierr);
ierr = VecRestoreArray(S2,NULL);
CHKERRQ(ierr);
/* Only supports right preconditioning */
if (ksp->pc_side != PC_RIGHT) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"KSP fbcgsr does not support %s",PCSides[ksp->pc_side]);
if (!ksp->guess_zero) {
if (!bcgs->guess) {
ierr = VecDuplicate(X,&bcgs->guess);
CHKERRQ(ierr);
}
ierr = VecCopy(X,bcgs->guess);
CHKERRQ(ierr);
} else {
ierr = VecSet(X,0.0);
CHKERRQ(ierr);
}
/* Compute initial residual */
ierr = KSPGetPC(ksp,&pc);
CHKERRQ(ierr);
ierr = PCSetUp(pc);
CHKERRQ(ierr);
if (!ksp->guess_zero) {
ierr = MatMult(pc->mat,X,P2);
CHKERRQ(ierr); /* P2 is used as temporary storage */
ierr = VecCopy(B,R);
CHKERRQ(ierr);
ierr = VecAXPY(R,-1.0,P2);
CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);
CHKERRQ(ierr);
}
/* Test for nothing to do */
if (ksp->normtype != KSP_NORM_NONE) {
ierr = VecNorm(R,NORM_2,&rho);
CHKERRQ(ierr);
}
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);
CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = rho;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);
CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rho);
CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,rho);
CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,rho,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
/* Initialize iterates */
ierr = VecCopy(R,RP);
CHKERRQ(ierr); /* rp <- r */
ierr = VecCopy(R,P);
CHKERRQ(ierr); /* p <- r */
/* Big loop */
for (i=0; i<ksp->max_it; i++) {
/* matmult and pc */
ierr = PCApply(pc,P,P2);
CHKERRQ(ierr); /* p2 <- K p */
ierr = MatMult(pc->mat,P2,V);
CHKERRQ(ierr); /* v <- A p2 */
/* inner prodcuts */
if (i==0) {
tau = rho*rho;
ierr = VecDot(V,RP,&sigma);
CHKERRQ(ierr); /* sigma <- (v,rp) */
} else {
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
tau = sigma = 0.0;
for (j=0; j<N; j++) {
tau += r[j]*rp[j]; /* tau <- (r,rp) */
sigma += v[j]*rp[j]; /* sigma <- (v,rp) */
}
PetscLogFlops(4.0*N);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
insums[0] = tau;
insums[1] = sigma;
ierr = PetscLogEventBarrierBegin(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = MPI_Allreduce(insums,outsums,2,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = PetscLogEventBarrierEnd(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
tau = outsums[0];
sigma = outsums[1];
}
/* scalar update */
alpha = tau / sigma;
/* vector update */
ierr = VecWAXPY(S,-alpha,V,R);
CHKERRQ(ierr); /* s <- r - alpha v */
/* matmult and pc */
ierr = PCApply(pc,S,S2);
CHKERRQ(ierr); /* s2 <- K s */
ierr = MatMult(pc->mat,S2,T);
CHKERRQ(ierr); /* t <- A s2 */
/* inner prodcuts */
ierr = PetscLogEventBegin(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
xi1 = xi2 = xi3 = xi4 = 0.0;
for (j=0; j<N; j++) {
xi1 += s[j]*s[j]; /* xi1 <- (s,s) */
xi2 += t[j]*s[j]; /* xi2 <- (t,s) */
xi3 += t[j]*t[j]; /* xi3 <- (t,t) */
xi4 += t[j]*rp[j]; /* xi4 <- (t,rp) */
}
PetscLogFlops(8.0*N);
ierr = PetscLogEventEnd(VEC_ReduceArithmetic,0,0,0,0);
CHKERRQ(ierr);
insums[0] = xi1;
insums[1] = xi2;
insums[2] = xi3;
insums[3] = xi4;
ierr = PetscLogEventBarrierBegin(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = MPI_Allreduce(insums,outsums,4,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
ierr = PetscLogEventBarrierEnd(VEC_ReduceBarrier,0,0,0,0,PetscObjectComm((PetscObject)ksp));
CHKERRQ(ierr);
xi1 = outsums[0];
xi2 = outsums[1];
xi3 = outsums[2];
xi4 = outsums[3];
/* test denominator */
if (xi3 == 0.0) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_PLIB,"Divide by zero");
if (sigma == 0.0) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_PLIB,"Divide by zero");
/* scalar updates */
omega = xi2 / xi3;
beta = -xi4 / sigma;
rho = PetscSqrtReal(PetscAbsScalar(xi1 - omega * xi2)); /* residual norm */
/* vector updates */
ierr = VecAXPBYPCZ(X,alpha,omega,1.0,P2,S2);
CHKERRQ(ierr); /* x <- alpha * p2 + omega * s2 + x */
/* convergence test */
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);
CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = rho;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);
CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rho);
CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rho);
CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rho,&ksp->reason,ksp->cnvP);
CHKERRQ(ierr);
if (ksp->reason) break;
/* vector updates */
ierr = PetscLogEventBegin(VEC_Ops,0,0,0,0);
CHKERRQ(ierr);
for (j=0; j<N; j++) {
r[j] = s[j] - omega * t[j]; /* r <- s - omega t */
p[j] = r[j] + beta * (p[j] - omega * v[j]); /* p <- r + beta * (p - omega v) */
}
PetscLogFlops(6.0*N);
ierr = PetscLogEventEnd(VEC_Ops,0,0,0,0);
CHKERRQ(ierr);
}
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
