/*
FormFunctionLocal - Evaluates nonlinear function, F(x).
*/
PetscErrorCode FormFunctionLocal(DMDALocalInfo *info,PetscScalar **x,PetscScalar **f,AppCtx *user)
{
DM coordDA;
Vec coordinates;
DMDACoor2d **coords;
PetscScalar u, ux, uy, uxx, uyy;
PetscReal D, K, hx, hy, hxdhy, hydhx;
PetscInt i,j;
PetscErrorCode ierr;
PetscFunctionBegin;
D = user->D;
K = user->K;
hx = 1.0/(PetscReal)(info->mx-1);
hy = 1.0/(PetscReal)(info->my-1);
hxdhy = hx/hy;
hydhx = hy/hx;
/*
Compute function over the locally owned part of the grid
*/
ierr = DMDAGetCoordinateDA(info->da, &coordDA);CHKERRQ(ierr);
ierr = DMDAGetCoordinates(info->da, &coordinates);CHKERRQ(ierr);
ierr = DMDAVecGetArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
if (i == 0 || j == 0 || i == info->mx-1 || j == info->my-1) {
f[j][i] = x[j][i];
} else {
u = x[j][i];
ux = (x[j][i+1] - x[j][i])/hx;
uy = (x[j+1][i] - x[j][i])/hy;
uxx = (2.0*u - x[j][i-1] - x[j][i+1])*hydhx;
uyy = (2.0*u - x[j-1][i] - x[j+1][i])*hxdhy;
f[j][i] = D*(uxx + uyy) - (K*funcA(x[j][i], user)*sqrt(ux*ux + uy*uy) + funcU(&coords[j][i]))*hx*hy;
if (PetscIsInfOrNanScalar(f[j][i])) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FP, "Invalid residual: %g", PetscRealPart(f[j][i]));
}
}
}
ierr = DMDAVecRestoreArray(coordDA, coordinates, &coords);CHKERRQ(ierr);
ierr = PetscLogFlops(11*info->ym*info->xm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
MatMFFDCompute_DS - Standard PETSc code for computing the
differencing paramter (h) for use with matrix-free finite differences.
Input Parameters:
+ ctx - the matrix free context
. U - the location at which you want the Jacobian
- a - the direction you want the derivative
Output Parameter:
. h - the scale computed
*/
static PetscErrorCode MatMFFDCompute_DS(MatMFFD ctx,Vec U,Vec a,PetscScalar *h,PetscBool *zeroa)
{
MatMFFD_DS *hctx = (MatMFFD_DS*)ctx->hctx;
PetscReal nrm,sum,umin = hctx->umin;
PetscScalar dot;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!(ctx->count % ctx->recomputeperiod)) {
/*
This algorithm requires 2 norms and 1 inner product. Rather than
use directly the VecNorm() and VecDot() routines (and thus have
three separate collective operations, we use the VecxxxBegin/End() routines
*/
ierr = VecDotBegin(U,a,&dot);CHKERRQ(ierr);
ierr = VecNormBegin(a,NORM_1,&sum);CHKERRQ(ierr);
ierr = VecNormBegin(a,NORM_2,&nrm);CHKERRQ(ierr);
ierr = VecDotEnd(U,a,&dot);CHKERRQ(ierr);
ierr = VecNormEnd(a,NORM_1,&sum);CHKERRQ(ierr);
ierr = VecNormEnd(a,NORM_2,&nrm);CHKERRQ(ierr);
if (nrm == 0.0) {
*zeroa = PETSC_TRUE;
PetscFunctionReturn(0);
}
*zeroa = PETSC_FALSE;
/*
Safeguard for step sizes that are "too small"
*/
if (PetscAbsScalar(dot) < umin*sum && PetscRealPart(dot) >= 0.0) dot = umin*sum;
else if (PetscAbsScalar(dot) < 0.0 && PetscRealPart(dot) > -umin*sum) dot = -umin*sum;
*h = ctx->error_rel*dot/(nrm*nrm);
if (PetscIsInfOrNanScalar(*h)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Differencing parameter is not a number sum = %g dot = %g norm = %g",(double)sum,(double)PetscRealPart(dot),(double)nrm);
} else {
*h = ctx->currenth;
}
ctx->count++;
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,delta,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,S,W;
KSP_CG *cg;
Mat Amat,Pmat;
PetscBool diagonalscale;
PetscFunctionBegin;
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);
cg = (KSP_CG*)ksp->data;
eigs = ksp->calc_sings;
stored_max_it = ksp->max_it;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
P = ksp->work[2];
if (cg->singlereduction) {
S = ksp->work[3];
W = ksp->work[4];
} else {
S = 0; /* unused */
W = Z;
}
#define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
dp = PetscSqrtReal(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = 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]);
}
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
if (ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
}
if (ksp->normtype != KSP_NORM_NATURAL) {
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
}
i = 0;
do {
ksp->its = i+1;
if (beta == 0.0) {
ksp->reason = KSP_CONVERGED_ATOL;
ierr = PetscInfo(ksp,"converged due to beta = 0\n");CHKERRQ(ierr);
break;
#if !defined(PETSC_USE_COMPLEX)
} else if ((i > 0) && (beta*betaold < 0.0)) {
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo(ksp,"diverging due to indefinite preconditioner\n");CHKERRQ(ierr);
break;
#endif
}
if (!i) {
ierr = VecCopy(Z,P);CHKERRQ(ierr); /* p <- z */
b = 0.0;
} else {
b = beta/betaold;
if (eigs) {
if (ksp->max_it != stored_max_it) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Can not change maxit AND calculate eigenvalues");
e[i] = PetscSqrtReal(PetscAbsScalar(b))/a;
}
ierr = VecAYPX(P,b,Z);CHKERRQ(ierr); /* p <- z + b* p */
}
dpiold = dpi;
if (!cg->singlereduction || !i) {
ierr = KSP_MatMult(ksp,Amat,P,W);CHKERRQ(ierr); /* w <- Ap */
ierr = VecXDot(P,W,&dpi);CHKERRQ(ierr); /* dpi <- p'w */
} else {
ierr = VecAYPX(W,beta/betaold,S);CHKERRQ(ierr); /* w <- Ap */
dpi = delta - beta*beta*dpiold/(betaold*betaold); /* dpi <- p'w */
}
betaold = beta;
if (PetscIsInfOrNanScalar(dpi)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
if ((dpi == 0.0) || ((i > 0) && (PetscRealPart(dpi*dpiold) <= 0.0))) {
ksp->reason = KSP_DIVERGED_INDEFINITE_MAT;
ierr = PetscInfo(ksp,"diverging due to indefinite or negative definite matrix\n");CHKERRQ(ierr);
break;
}
a = beta/dpi; /* a = beta/p'w */
if (eigs) d[i] = PetscSqrtReal(PetscAbsScalar(b))*e[i] + 1.0/a;
ierr = VecAXPY(X,a,P);CHKERRQ(ierr); /* x <- x + ap */
ierr = VecAXPY(R,-a,W);CHKERRQ(ierr); /* r <- r - aw */
if (ksp->normtype == KSP_NORM_PRECONDITIONED && ksp->chknorm < i+2) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
}
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED && ksp->chknorm < i+2) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- r'*z */
}
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
dp = PetscSqrtReal(PetscAbsScalar(beta));
} else {
dp = 0.0;
}
ksp->rnorm = dp;
CHKERRQ(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;
if ((ksp->normtype != KSP_NORM_PRECONDITIONED && (ksp->normtype != KSP_NORM_NATURAL)) || (ksp->chknorm >= i+2)) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
}
}
if ((ksp->normtype != KSP_NORM_NATURAL) || (ksp->chknorm >= i+2)) {
if (cg->singlereduction) {
PetscScalar tmp[2];
Vec vecs[2];
vecs[0] = S; vecs[1] = R;
ierr = VecMDot(Z,2,vecs,tmp);CHKERRQ(ierr);
delta = tmp[0]; beta = tmp[1];
} else {
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
}
if (PetscIsInfOrNanScalar(beta)) {
if (ksp->errorifnotconverged) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"KSPSolve has not converged due to Nan or Inf inner product");
else {
ksp->reason = KSP_DIVERGED_NANORINF;
PetscFunctionReturn(0);
}
}
}
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
PetscErrorCode SNESNGMRESFormCombinedSolution_Private(SNES snes,PetscInt l,Vec XM,Vec FM,PetscReal fMnorm,Vec X,Vec XA,Vec FA)
{
SNES_NGMRES *ngmres = (SNES_NGMRES*) snes->data;
PetscInt i,j;
Vec *Fdot = ngmres->Fdot;
Vec *Xdot = ngmres->Xdot;
PetscScalar *beta = ngmres->beta;
PetscScalar *xi = ngmres->xi;
PetscScalar alph_total = 0.;
PetscErrorCode ierr;
PetscReal nu;
Vec Y = snes->work[2];
PetscBool changed_y,changed_w;
PetscFunctionBegin;
nu = fMnorm*fMnorm;
/* construct the right hand side and xi factors */
ierr = VecMDot(FM,l,Fdot,xi);CHKERRQ(ierr);
for (i = 0; i < l; i++) beta[i] = nu - xi[i];
/* construct h */
for (j = 0; j < l; j++) {
for (i = 0; i < l; i++) {
H(i,j) = Q(i,j)-xi[i]-xi[j]+nu;
}
}
if (l == 1) {
/* simply set alpha[0] = beta[0] / H[0, 0] */
if (H(0,0) != 0.) beta[0] = beta[0]/H(0,0);
else beta[0] = 0.;
} else {
#if defined(PETSC_MISSING_LAPACK_GELSS)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"NGMRES with LS requires the LAPACK GELSS routine.");
#else
ierr = PetscBLASIntCast(l,&ngmres->m);CHKERRQ(ierr);
ierr = PetscBLASIntCast(l,&ngmres->n);CHKERRQ(ierr);
ngmres->info = 0;
ngmres->rcond = -1.;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("LAPACKgelss",LAPACKgelss_(&ngmres->m,&ngmres->n,&ngmres->nrhs,ngmres->h,&ngmres->lda,ngmres->beta,&ngmres->ldb,ngmres->s,&ngmres->rcond,&ngmres->rank,ngmres->work,&ngmres->lwork,ngmres->rwork,&ngmres->info));
#else
PetscStackCall("LAPACKgelss",LAPACKgelss_(&ngmres->m,&ngmres->n,&ngmres->nrhs,ngmres->h,&ngmres->lda,ngmres->beta,&ngmres->ldb,ngmres->s,&ngmres->rcond,&ngmres->rank,ngmres->work,&ngmres->lwork,&ngmres->info));
#endif
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (ngmres->info < 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"Bad argument to GELSS");
if (ngmres->info > 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD failed to converge");
#endif
}
for (i=0; i<l; i++) {
if (PetscIsInfOrNanScalar(beta[i])) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD generated inconsistent output");
}
alph_total = 0.;
for (i = 0; i < l; i++) alph_total += beta[i];
ierr = VecCopy(XM,XA);CHKERRQ(ierr);
ierr = VecScale(XA,1.-alph_total);CHKERRQ(ierr);
ierr = VecMAXPY(XA,l,beta,Xdot);CHKERRQ(ierr);
/* check the validity of the step */
ierr = VecCopy(XA,Y);CHKERRQ(ierr);
ierr = VecAXPY(Y,-1.0,X);CHKERRQ(ierr);
ierr = SNESLineSearchPostCheck(snes->linesearch,X,Y,XA,&changed_y,&changed_w);CHKERRQ(ierr);
if (!ngmres->approxfunc) {ierr = SNESComputeFunction(snes,XA,FA);CHKERRQ(ierr);}
else {
ierr = VecCopy(FM,FA);CHKERRQ(ierr);
ierr = VecScale(FA,1.-alph_total);CHKERRQ(ierr);
ierr = VecMAXPY(FA,l,beta,Fdot);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/* approximately solve the overdetermined system:
2*F(x_i)\cdot F(\x_j)\alpha_i = 0
\alpha_i = 1
Which minimizes the L2 norm of the linearization of:
||F(\sum_i \alpha_i*x_i)||^2
With the constraint that \sum_i\alpha_i = 1
Where x_i is the solution from the ith subsolver.
*/
static PetscErrorCode SNESCompositeApply_AdditiveOptimal(SNES snes,Vec X,Vec B,Vec F,PetscReal *fnorm)
{
PetscErrorCode ierr;
SNES_Composite *jac = (SNES_Composite*)snes->data;
SNES_CompositeLink next = jac->head;
Vec *Xes = jac->Xes,*Fes = jac->Fes;
PetscInt i,j;
PetscScalar tot,total,ftf;
PetscReal min_fnorm;
PetscInt min_i;
SNESConvergedReason reason;
PetscFunctionBegin;
if (!next) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_ARG_WRONGSTATE,"No composite SNESes supplied via SNESCompositeAddSNES() or -snes_composite_sneses");
if (snes->normschedule == SNES_NORM_ALWAYS) {
next = jac->head;
ierr = SNESSetInitialFunction(next->snes,F);CHKERRQ(ierr);
while (next->next) {
next = next->next;
ierr = SNESSetInitialFunction(next->snes,F);CHKERRQ(ierr);
}
}
next = jac->head;
i = 0;
ierr = VecCopy(X,Xes[i]);CHKERRQ(ierr);
ierr = SNESSolve(next->snes,B,Xes[i]);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next->snes,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
jac->innerFailures++;
if (jac->innerFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
}
while (next->next) {
i++;
next = next->next;
ierr = VecCopy(X,Xes[i]);CHKERRQ(ierr);
ierr = SNESSolve(next->snes,B,Xes[i]);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(next->snes,&reason);CHKERRQ(ierr);
if (reason < 0 && reason != SNES_DIVERGED_MAX_IT) {
jac->innerFailures++;
if (jac->innerFailures >= snes->maxFailures) {
snes->reason = SNES_DIVERGED_INNER;
PetscFunctionReturn(0);
}
}
}
/* all the solutions are collected; combine optimally */
for (i=0;i<jac->n;i++) {
for (j=0;j<i+1;j++) {
ierr = VecDotBegin(Fes[i],Fes[j],&jac->h[i + j*jac->n]);CHKERRQ(ierr);
}
ierr = VecDotBegin(Fes[i],F,&jac->g[i]);CHKERRQ(ierr);
}
for (i=0;i<jac->n;i++) {
for (j=0;j<i+1;j++) {
ierr = VecDotEnd(Fes[i],Fes[j],&jac->h[i + j*jac->n]);CHKERRQ(ierr);
if (i == j) jac->fnorms[i] = PetscSqrtReal(PetscRealPart(jac->h[i + j*jac->n]));
}
ierr = VecDotEnd(Fes[i],F,&jac->g[i]);CHKERRQ(ierr);
}
ftf = (*fnorm)*(*fnorm);
for (i=0; i<jac->n; i++) {
for (j=i+1;j<jac->n;j++) {
jac->h[i + j*jac->n] = jac->h[j + i*jac->n];
}
}
for (i=0; i<jac->n; i++) {
for (j=0; j<jac->n; j++) {
jac->h[i + j*jac->n] = jac->h[i + j*jac->n] - jac->g[j] - jac->g[i] + ftf;
}
jac->beta[i] = ftf - jac->g[i];
}
#if defined(PETSC_MISSING_LAPACK_GELSS)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"SNESCOMPOSITE with ADDITIVEOPTIMAL requires the LAPACK GELSS routine.");
#else
jac->info = 0;
jac->rcond = -1.;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("LAPACKgelss",LAPACKgelss_(&jac->n,&jac->n,&jac->nrhs,jac->h,&jac->lda,jac->beta,&jac->lda,jac->s,&jac->rcond,&jac->rank,jac->work,&jac->lwork,jac->rwork,&jac->info));
#else
PetscStackCall("LAPACKgelss",LAPACKgelss_(&jac->n,&jac->n,&jac->nrhs,jac->h,&jac->lda,jac->beta,&jac->lda,jac->s,&jac->rcond,&jac->rank,jac->work,&jac->lwork,&jac->info));
#endif
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (jac->info < 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"Bad argument to GELSS");
if (jac->info > 0) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD failed to converge");
#endif
tot = 0.;
total = 0.;
for (i=0; i<jac->n; i++) {
if (snes->errorifnotconverged && PetscIsInfOrNanScalar(jac->beta[i])) SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_LIB,"SVD generated inconsistent output");
ierr = PetscInfo2(snes,"%D: %g\n",i,(double)PetscRealPart(jac->beta[i]));CHKERRQ(ierr);
tot += jac->beta[i];
total += PetscAbsScalar(jac->beta[i]);
}
ierr = VecScale(X,(1. - tot));CHKERRQ(ierr);
ierr = VecMAXPY(X,jac->n,jac->beta,Xes);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->xl && snes->xu) {
ierr = SNESVIComputeInactiveSetFnorm(snes, F, X, fnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(F, NORM_2, fnorm);CHKERRQ(ierr);
}
/* take the minimum-normed candidate if it beats the combination by a factor of rtol or the combination has stagnated */
min_fnorm = jac->fnorms[0];
min_i = 0;
for (i=0; i<jac->n; i++) {
if (jac->fnorms[i] < min_fnorm) {
min_fnorm = jac->fnorms[i];
min_i = i;
}
}
/* stagnation or divergence restart to the solution of the solver that failed the least */
if (PetscRealPart(total) < jac->stol || min_fnorm*jac->rtol < *fnorm) {
ierr = VecCopy(jac->Xes[min_i],X);CHKERRQ(ierr);
ierr = VecCopy(jac->Fes[min_i],F);CHKERRQ(ierr);
*fnorm = min_fnorm;
}
PetscFunctionReturn(0);
}
/*
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);
}
PetscErrorCode KSPSolve_GROPPCG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar alpha,beta = 0.0,gamma,gammaNew,t;
PetscReal dp = 0.0;
Vec x,b,r,p,s,S,z,Z;
Mat Amat,Pmat;
PetscBool diagonalscale;
PetscFunctionBegin;
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];
p = ksp->work[1];
s = ksp->work[2];
S = ksp->work[3];
z = ksp->work[4];
Z = ksp->work[5];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,x,r);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(r,-1.0,b);CHKERRQ(ierr);
} else {
ierr = VecCopy(b,r);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,r,z);CHKERRQ(ierr); /* z <- Br */
ierr = VecCopy(z,p);CHKERRQ(ierr); /* p <- z */
ierr = VecDotBegin(r,z,&gamma);CHKERRQ(ierr); /* gamma <- z'*r */
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)r));CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,p,s);CHKERRQ(ierr); /* s <- Ap */
ierr = VecDotEnd(r,z,&gamma);CHKERRQ(ierr); /* gamma <- z'*r */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
/* This could be merged with the computation of gamma above */
ierr = VecNorm(z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
break;
case KSP_NORM_UNPRECONDITIONED:
/* This could be merged with the computation of gamma above */
ierr = VecNorm(r,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
break;
case KSP_NORM_NATURAL:
if (PetscIsInfOrNanScalar(gamma)) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- r'*z = r'*B*r = 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]);
}
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
i = 0;
do {
ksp->its = i+1;
i++;
ierr = VecDotBegin(p,s,&t);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)p));CHKERRQ(ierr);
ierr = KSP_PCApply(ksp,s,S);CHKERRQ(ierr); /* S <- Bs */
ierr = VecDotEnd(p,s,&t);CHKERRQ(ierr);
alpha = gamma / t;
ierr = VecAXPY(x, alpha,p);CHKERRQ(ierr); /* x <- x + alpha * p */
ierr = VecAXPY(r,-alpha,s);CHKERRQ(ierr); /* r <- r - alpha * s */
ierr = VecAXPY(z,-alpha,S);CHKERRQ(ierr); /* z <- z - alpha * S */
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormBegin(r,NORM_2,&dp);CHKERRQ(ierr);
} else if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormBegin(z,NORM_2,&dp);CHKERRQ(ierr);
}
ierr = VecDotBegin(r,z,&gammaNew);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(PetscObjectComm((PetscObject)r));CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,z,Z);CHKERRQ(ierr); /* Z <- Az */
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormEnd(r,NORM_2,&dp);CHKERRQ(ierr);
} else if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormEnd(z,NORM_2,&dp);CHKERRQ(ierr);
}
ierr = VecDotEnd(r,z,&gammaNew);CHKERRQ(ierr);
if (ksp->normtype == KSP_NORM_NATURAL) {
if (PetscIsInfOrNanScalar(gammaNew)) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = PetscSqrtReal(PetscAbsScalar(gammaNew)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
} else if (ksp->normtype == KSP_NORM_NONE) {
dp = 0.0;
}
ksp->rnorm = dp;
ierr = KSPLogResidualHistory(ksp,dp);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
beta = gammaNew / gamma;
gamma = gammaNew;
ierr = VecAYPX(p,beta,z);CHKERRQ(ierr); /* p <- z + beta * p */
ierr = VecAYPX(s,beta,Z);CHKERRQ(ierr); /* s <- Z + beta * s */
} while (i<ksp->max_it);
if (i >= ksp->max_it) ksp->reason = KSP_DIVERGED_ITS;
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_STCG(KSP ksp)
{
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP, "STCG is not available for complex systems");
#else
KSP_STCG *cg = (KSP_STCG*)ksp->data;
PetscErrorCode ierr;
MatStructure pflag;
Mat Qmat, Mmat;
Vec r, z, p, d;
PC pc;
PetscReal norm_r, norm_d, norm_dp1, norm_p, dMp;
PetscReal alpha, beta, kappa, rz, rzm1;
PetscReal rr, r2, step;
PetscInt max_cg_its;
PetscBool diagonalscale;
/***************************************************************************/
/* Check the arguments and parameters. */
/***************************************************************************/
PetscFunctionBegin;
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);
if (cg->radius < 0.0) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_OUTOFRANGE, "Input error: radius < 0");
/***************************************************************************/
/* Get the workspace vectors and initialize variables */
/***************************************************************************/
r2 = cg->radius * cg->radius;
r = ksp->work[0];
z = ksp->work[1];
p = ksp->work[2];
d = ksp->vec_sol;
pc = ksp->pc;
ierr = PCGetOperators(pc, &Qmat, &Mmat, &pflag);CHKERRQ(ierr);
ierr = VecGetSize(d, &max_cg_its);CHKERRQ(ierr);
max_cg_its = PetscMin(max_cg_its, ksp->max_it);
ksp->its = 0;
/***************************************************************************/
/* Initialize objective function and direction. */
/***************************************************************************/
cg->o_fcn = 0.0;
ierr = VecSet(d, 0.0);CHKERRQ(ierr); /* d = 0 */
cg->norm_d = 0.0;
/***************************************************************************/
/* Begin the conjugate gradient method. Check the right-hand side for */
/* numerical problems. The check for not-a-number and infinite values */
/* need be performed only once. */
/***************************************************************************/
ierr = VecCopy(ksp->vec_rhs, r);CHKERRQ(ierr); /* r = -grad */
ierr = VecDot(r, r, &rr);CHKERRQ(ierr); /* rr = r^T r */
if (PetscIsInfOrNanScalar(rr)) {
/*************************************************************************/
/* The right-hand side contains not-a-number or an infinite value. */
/* The gradient step does not work; return a zero value for the step. */
/*************************************************************************/
ksp->reason = KSP_DIVERGED_NANORINF;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: bad right-hand side: rr=%g\n", rr);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/***************************************************************************/
/* Check the preconditioner for numerical problems and for positive */
/* definiteness. The check for not-a-number and infinite values need be */
/* performed only once. */
/***************************************************************************/
ierr = KSP_PCApply(ksp, r, z);CHKERRQ(ierr); /* z = inv(M) r */
ierr = VecDot(r, z, &rz);CHKERRQ(ierr); /* rz = r^T inv(M) r */
if (PetscIsInfOrNanScalar(rz)) {
/*************************************************************************/
/* The preconditioner contains not-a-number or an infinite value. */
/* Return the gradient direction intersected with the trust region. */
/*************************************************************************/
ksp->reason = KSP_DIVERGED_NANORINF;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: bad preconditioner: rz=%g\n", rz);CHKERRQ(ierr);
if (cg->radius != 0) {
if (r2 >= rr) {
alpha = 1.0;
cg->norm_d = PetscSqrtReal(rr);
} else {
alpha = PetscSqrtReal(r2 / rr);
cg->norm_d = cg->radius;
}
ierr = VecAXPY(d, alpha, r);CHKERRQ(ierr); /* d = d + alpha r */
/***********************************************************************/
/* Compute objective function. */
/***********************************************************************/
ierr = KSP_MatMult(ksp, Qmat, d, z);CHKERRQ(ierr);
ierr = VecAYPX(z, -0.5, ksp->vec_rhs);CHKERRQ(ierr);
ierr = VecDot(d, z, &cg->o_fcn);CHKERRQ(ierr);
cg->o_fcn = -cg->o_fcn;
++ksp->its;
}
PetscFunctionReturn(0);
}
if (rz < 0.0) {
/*************************************************************************/
/* The preconditioner is indefinite. Because this is the first */
/* and we do not have a direction yet, we use the gradient step. Note */
/* that we cannot use the preconditioned norm when computing the step */
/* because the matrix is indefinite. */
/*************************************************************************/
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: indefinite preconditioner: rz=%g\n", rz);CHKERRQ(ierr);
if (cg->radius != 0.0) {
if (r2 >= rr) {
alpha = 1.0;
cg->norm_d = PetscSqrtReal(rr);
} else {
alpha = PetscSqrtReal(r2 / rr);
cg->norm_d = cg->radius;
}
ierr = VecAXPY(d, alpha, r);CHKERRQ(ierr); /* d = d + alpha r */
/***********************************************************************/
/* Compute objective function. */
/***********************************************************************/
ierr = KSP_MatMult(ksp, Qmat, d, z);CHKERRQ(ierr);
ierr = VecAYPX(z, -0.5, ksp->vec_rhs);CHKERRQ(ierr);
ierr = VecDot(d, z, &cg->o_fcn);CHKERRQ(ierr);
cg->o_fcn = -cg->o_fcn;
++ksp->its;
}
PetscFunctionReturn(0);
}
/***************************************************************************/
/* As far as we know, the preconditioner is positive semidefinite. */
/* Compute and log the residual. Check convergence because this */
/* initializes things, but do not terminate until at least one conjugate */
/* gradient iteration has been performed. */
/***************************************************************************/
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNorm(z, NORM_2, &norm_r);CHKERRQ(ierr); /* norm_r = |z| */
break;
case KSP_NORM_UNPRECONDITIONED:
norm_r = PetscSqrtReal(rr); /* norm_r = |r| */
break;
case KSP_NORM_NATURAL:
norm_r = PetscSqrtReal(rz); /* norm_r = |r|_M */
break;
default:
norm_r = 0.0;
break;
}
ierr = KSPLogResidualHistory(ksp, norm_r);CHKERRQ(ierr);
ierr = KSPMonitor(ksp, ksp->its, norm_r);CHKERRQ(ierr);
ksp->rnorm = norm_r;
ierr = (*ksp->converged)(ksp, ksp->its, norm_r, &ksp->reason, ksp->cnvP);CHKERRQ(ierr);
/***************************************************************************/
/* Compute the first direction and update the iteration. */
/***************************************************************************/
ierr = VecCopy(z, p);CHKERRQ(ierr); /* p = z */
ierr = KSP_MatMult(ksp, Qmat, p, z);CHKERRQ(ierr); /* z = Q * p */
++ksp->its;
/***************************************************************************/
/* Check the matrix for numerical problems. */
/***************************************************************************/
ierr = VecDot(p, z, &kappa);CHKERRQ(ierr); /* kappa = p^T Q p */
if (PetscIsInfOrNanScalar(kappa)) {
/*************************************************************************/
/* The matrix produced not-a-number or an infinite value. In this case, */
/* we must stop and use the gradient direction. This condition need */
/* only be checked once. */
/*************************************************************************/
ksp->reason = KSP_DIVERGED_NANORINF;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: bad matrix: kappa=%g\n", kappa);CHKERRQ(ierr);
if (cg->radius) {
if (r2 >= rr) {
alpha = 1.0;
cg->norm_d = PetscSqrtReal(rr);
} else {
alpha = PetscSqrtReal(r2 / rr);
cg->norm_d = cg->radius;
}
ierr = VecAXPY(d, alpha, r);CHKERRQ(ierr); /* d = d + alpha r */
/***********************************************************************/
/* Compute objective function. */
/***********************************************************************/
ierr = KSP_MatMult(ksp, Qmat, d, z);CHKERRQ(ierr);
ierr = VecAYPX(z, -0.5, ksp->vec_rhs);CHKERRQ(ierr);
ierr = VecDot(d, z, &cg->o_fcn);CHKERRQ(ierr);
cg->o_fcn = -cg->o_fcn;
++ksp->its;
}
PetscFunctionReturn(0);
}
/***************************************************************************/
/* Initialize variables for calculating the norm of the direction. */
/***************************************************************************/
dMp = 0.0;
norm_d = 0.0;
switch (cg->dtype) {
case STCG_PRECONDITIONED_DIRECTION:
norm_p = rz;
break;
default:
ierr = VecDot(p, p, &norm_p);CHKERRQ(ierr);
break;
}
/***************************************************************************/
/* Check for negative curvature. */
/***************************************************************************/
if (kappa <= 0.0) {
/*************************************************************************/
/* In this case, the matrix is indefinite and we have encountered a */
/* direction of negative curvature. Because negative curvature occurs */
/* during the first step, we must follow a direction. */
/*************************************************************************/
ksp->reason = KSP_CONVERGED_CG_NEG_CURVE;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: negative curvature: kappa=%g\n", kappa);CHKERRQ(ierr);
if (cg->radius != 0.0 && norm_p > 0.0) {
/***********************************************************************/
/* Follow direction of negative curvature to the boundary of the */
/* trust region. */
/***********************************************************************/
step = PetscSqrtReal(r2 / norm_p);
cg->norm_d = cg->radius;
ierr = VecAXPY(d, step, p);CHKERRQ(ierr); /* d = d + step p */
/***********************************************************************/
/* Update objective function. */
/***********************************************************************/
cg->o_fcn += step * (0.5 * step * kappa - rz);
} else if (cg->radius != 0.0) {
/***********************************************************************/
/* The norm of the preconditioned direction is zero; use the gradient */
/* step. */
/***********************************************************************/
if (r2 >= rr) {
alpha = 1.0;
cg->norm_d = PetscSqrtReal(rr);
} else {
alpha = PetscSqrtReal(r2 / rr);
cg->norm_d = cg->radius;
}
ierr = VecAXPY(d, alpha, r);CHKERRQ(ierr); /* d = d + alpha r */
/***********************************************************************/
/* Compute objective function. */
/***********************************************************************/
ierr = KSP_MatMult(ksp, Qmat, d, z);CHKERRQ(ierr);
ierr = VecAYPX(z, -0.5, ksp->vec_rhs);CHKERRQ(ierr);
ierr = VecDot(d, z, &cg->o_fcn);CHKERRQ(ierr);
cg->o_fcn = -cg->o_fcn;
++ksp->its;
}
PetscFunctionReturn(0);
}
/***************************************************************************/
/* Run the conjugate gradient method until either the problem is solved, */
/* we encounter the boundary of the trust region, or the conjugate */
/* gradient method breaks down. */
/***************************************************************************/
while (1) {
/*************************************************************************/
/* Know that kappa is nonzero, because we have not broken down, so we */
/* can compute the steplength. */
/*************************************************************************/
alpha = rz / kappa;
/*************************************************************************/
/* Compute the steplength and check for intersection with the trust */
/* region. */
/*************************************************************************/
norm_dp1 = norm_d + alpha*(2.0*dMp + alpha*norm_p);
if (cg->radius != 0.0 && norm_dp1 >= r2) {
/***********************************************************************/
/* In this case, the matrix is positive definite as far as we know. */
/* However, the full step goes beyond the trust region. */
/***********************************************************************/
ksp->reason = KSP_CONVERGED_CG_CONSTRAINED;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: constrained step: radius=%g\n", cg->radius);CHKERRQ(ierr);
if (norm_p > 0.0) {
/*********************************************************************/
/* Follow the direction to the boundary of the trust region. */
/*********************************************************************/
step = (PetscSqrtReal(dMp*dMp+norm_p*(r2-norm_d))-dMp)/norm_p;
cg->norm_d = cg->radius;
ierr = VecAXPY(d, step, p);CHKERRQ(ierr); /* d = d + step p */
/*********************************************************************/
/* Update objective function. */
/*********************************************************************/
cg->o_fcn += step * (0.5 * step * kappa - rz);
} else {
/*********************************************************************/
/* The norm of the direction is zero; there is nothing to follow. */
/*********************************************************************/
}
break;
}
/*************************************************************************/
/* Now we can update the direction and residual. */
/*************************************************************************/
ierr = VecAXPY(d, alpha, p);CHKERRQ(ierr); /* d = d + alpha p */
ierr = VecAXPY(r, -alpha, z);CHKERRQ(ierr); /* r = r - alpha Q p */
ierr = KSP_PCApply(ksp, r, z);CHKERRQ(ierr); /* z = inv(M) r */
switch (cg->dtype) {
case STCG_PRECONDITIONED_DIRECTION:
norm_d = norm_dp1;
break;
default:
ierr = VecDot(d, d, &norm_d);CHKERRQ(ierr);
break;
}
cg->norm_d = PetscSqrtReal(norm_d);
/*************************************************************************/
/* Update objective function. */
/*************************************************************************/
cg->o_fcn -= 0.5 * alpha * rz;
/*************************************************************************/
/* Check that the preconditioner appears positive semidefinite. */
/*************************************************************************/
rzm1 = rz;
ierr = VecDot(r, z, &rz);CHKERRQ(ierr); /* rz = r^T z */
if (rz < 0.0) {
/***********************************************************************/
/* The preconditioner is indefinite. */
/***********************************************************************/
ksp->reason = KSP_DIVERGED_INDEFINITE_PC;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: cg indefinite preconditioner: rz=%g\n", rz);CHKERRQ(ierr);
break;
}
/*************************************************************************/
/* As far as we know, the preconditioner is positive semidefinite. */
/* Compute the residual and check for convergence. */
/*************************************************************************/
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNorm(z, NORM_2, &norm_r);CHKERRQ(ierr); /* norm_r = |z| */
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNorm(r, NORM_2, &norm_r);CHKERRQ(ierr); /* norm_r = |r| */
break;
case KSP_NORM_NATURAL:
norm_r = PetscSqrtReal(rz); /* norm_r = |r|_M */
break;
default:
norm_r = 0.0;
break;
}
ierr = KSPLogResidualHistory(ksp, norm_r);CHKERRQ(ierr);
ierr = KSPMonitor(ksp, ksp->its, norm_r);CHKERRQ(ierr);
ksp->rnorm = norm_r;
ierr = (*ksp->converged)(ksp, ksp->its, norm_r, &ksp->reason, ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) {
/***********************************************************************/
/* The method has converged. */
/***********************************************************************/
ierr = PetscInfo2(ksp, "KSPSolve_STCG: truncated step: rnorm=%g, radius=%g\n", norm_r, cg->radius);CHKERRQ(ierr);
break;
}
/*************************************************************************/
/* We have not converged yet. Check for breakdown. */
/*************************************************************************/
beta = rz / rzm1;
if (fabs(beta) <= 0.0) {
/***********************************************************************/
/* Conjugate gradients has broken down. */
/***********************************************************************/
ksp->reason = KSP_DIVERGED_BREAKDOWN;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: breakdown: beta=%g\n", beta);CHKERRQ(ierr);
break;
}
/*************************************************************************/
/* Check iteration limit. */
/*************************************************************************/
if (ksp->its >= max_cg_its) {
ksp->reason = KSP_DIVERGED_ITS;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: iterlim: its=%d\n", ksp->its);CHKERRQ(ierr);
break;
}
/*************************************************************************/
/* Update p and the norms. */
/*************************************************************************/
ierr = VecAYPX(p, beta, z);CHKERRQ(ierr); /* p = z + beta p */
switch (cg->dtype) {
case STCG_PRECONDITIONED_DIRECTION:
dMp = beta*(dMp + alpha*norm_p);
norm_p = beta*(rzm1 + beta*norm_p);
break;
default:
ierr = VecDot(d, p, &dMp);CHKERRQ(ierr);
ierr = VecDot(p, p, &norm_p);CHKERRQ(ierr);
break;
}
/*************************************************************************/
/* Compute the new direction and update the iteration. */
/*************************************************************************/
ierr = KSP_MatMult(ksp, Qmat, p, z);CHKERRQ(ierr); /* z = Q * p */
ierr = VecDot(p, z, &kappa);CHKERRQ(ierr); /* kappa = p^T Q p */
++ksp->its;
/*************************************************************************/
/* Check for negative curvature. */
/*************************************************************************/
if (kappa <= 0.0) {
/***********************************************************************/
/* In this case, the matrix is indefinite and we have encountered */
/* a direction of negative curvature. Follow the direction to the */
/* boundary of the trust region. */
/***********************************************************************/
ksp->reason = KSP_CONVERGED_CG_NEG_CURVE;
ierr = PetscInfo1(ksp, "KSPSolve_STCG: negative curvature: kappa=%g\n", kappa);CHKERRQ(ierr);
if (cg->radius != 0.0 && norm_p > 0.0) {
/*********************************************************************/
/* Follow direction of negative curvature to boundary. */
/*********************************************************************/
step = (PetscSqrtReal(dMp*dMp+norm_p*(r2-norm_d))-dMp)/norm_p;
cg->norm_d = cg->radius;
ierr = VecAXPY(d, step, p);CHKERRQ(ierr); /* d = d + step p */
/*********************************************************************/
/* Update objective function. */
/*********************************************************************/
cg->o_fcn += step * (0.5 * step * kappa - rz);
} else if (cg->radius != 0.0) {
/*********************************************************************/
/* The norm of the direction is zero; there is nothing to follow. */
/*********************************************************************/
}
break;
}
}
PetscFunctionReturn(0);
#endif
}
/*
FormJacobianLocal - Evaluates Jacobian matrix.
*/
PetscErrorCode FormJacobianLocal(DMDALocalInfo *info,PetscScalar **x,Mat jac,AppCtx *user)
{
MatStencil col[5], row;
PetscScalar D, K, A, v[5], hx, hy, hxdhy, hydhx, ux, uy;
PetscReal normGradZ;
PetscInt i, j,k;
PetscErrorCode ierr;
PetscFunctionBegin;
D = user->D;
K = user->K;
hx = 1.0/(PetscReal)(info->mx-1);
hy = 1.0/(PetscReal)(info->my-1);
hxdhy = hx/hy;
hydhx = hy/hx;
/*
Compute entries for the locally owned part of the Jacobian.
- Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Here, we set all entries for a particular row at once.
- We can set matrix entries either using either
MatSetValuesLocal() or MatSetValues(), as discussed above.
*/
for (j=info->ys; j<info->ys+info->ym; j++) {
for (i=info->xs; i<info->xs+info->xm; i++) {
row.j = j; row.i = i;
if (i == 0 || j == 0 || i == info->mx-1 || j == info->my-1) {
/* boundary points */
v[0] = 1.0;
ierr = MatSetValuesStencil(jac,1,&row,1,&row,v,INSERT_VALUES);CHKERRQ(ierr);
} else {
/* interior grid points */
ux = (x[j][i+1] - x[j][i])/hx;
uy = (x[j+1][i] - x[j][i])/hy;
normGradZ = PetscRealPart(sqrt(ux*ux + uy*uy));
//PetscPrintf(PETSC_COMM_SELF, "i: %d j: %d normGradZ: %g\n", i, j, normGradZ);
if (normGradZ < 1.0e-8) {
normGradZ = 1.0e-8;
}
A = funcA(x[j][i], user);
v[0] = -D*hxdhy; col[0].j = j - 1; col[0].i = i;
v[1] = -D*hydhx; col[1].j = j; col[1].i = i-1;
v[2] = D*2.0*(hydhx + hxdhy) + K*(funcADer(x[j][i], user)*normGradZ - A/normGradZ)*hx*hy; col[2].j = row.j; col[2].i = row.i;
v[3] = -D*hydhx + K*A*hx*hy/(2.0*normGradZ); col[3].j = j; col[3].i = i+1;
v[4] = -D*hxdhy + K*A*hx*hy/(2.0*normGradZ); col[4].j = j + 1; col[4].i = i;
for(k = 0; k < 5; ++k) {
if (PetscIsInfOrNanScalar(v[k])) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FP, "Invalid residual: %g", PetscRealPart(v[k]));
}
ierr = MatSetValuesStencil(jac,1,&row,5,col,v,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd().
*/
ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Tell the matrix we will never add a new nonzero location to the
matrix. If we do, it will generate an error.
*/
ierr = MatSetOption(jac,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode SNESLineSearchApply_L2(SNESLineSearch linesearch)
{
PetscBool changed_y, changed_w;
PetscErrorCode ierr;
Vec X;
Vec F;
Vec Y;
Vec W;
SNES snes;
PetscReal gnorm;
PetscReal ynorm;
PetscReal xnorm;
PetscReal steptol, maxstep, rtol, atol, ltol;
PetscViewer monitor;
PetscBool domainerror;
PetscReal lambda, lambda_old, lambda_mid, lambda_update, delLambda;
PetscReal fnrm, fnrm_old, fnrm_mid;
PetscReal delFnrm, delFnrm_old, del2Fnrm;
PetscInt i, max_its;
PetscFunctionBegin;
ierr = SNESLineSearchGetVecs(linesearch, &X, &F, &Y, &W, PETSC_NULL);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = SNESLineSearchGetLambda(linesearch, &lambda);CHKERRQ(ierr);
ierr = SNESLineSearchGetSNES(linesearch, &snes);CHKERRQ(ierr);
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_TRUE);CHKERRQ(ierr);
ierr = SNESLineSearchGetTolerances(linesearch, &steptol, &maxstep, &rtol, &atol, <ol, &max_its);CHKERRQ(ierr);
ierr = SNESLineSearchGetMonitor(linesearch, &monitor);CHKERRQ(ierr);
/* precheck */
ierr = SNESLineSearchPreCheck(linesearch,X,Y,&changed_y);CHKERRQ(ierr);
lambda_old = 0.0;
fnrm_old = gnorm*gnorm;
lambda_mid = 0.5*(lambda + lambda_old);
for (i = 0; i < max_its; i++) {
/* compute the norm at the midpoint */
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -lambda_mid, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
if (linesearch->ops->vinorm) {
fnrm_mid = gnorm;
ierr = (*linesearch->ops->vinorm)(snes, F, W, &fnrm_mid);CHKERRQ(ierr);
} else {
ierr = VecNorm(F, NORM_2, &fnrm_mid);CHKERRQ(ierr);
}
fnrm_mid = fnrm_mid*fnrm_mid;
/* compute the norm at lambda */
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
if (linesearch->ops->vinorm) {
fnrm = gnorm;
ierr = (*linesearch->ops->vinorm)(snes, F, W, &fnrm);CHKERRQ(ierr);
} else {
ierr = VecNorm(F, NORM_2, &fnrm);CHKERRQ(ierr);
}
fnrm = fnrm*fnrm;
/* this gives us the derivatives at the endpoints -- compute them from here
a = x - a0
p_0(x) = (x / dA - 1)(2x / dA - 1)
p_1(x) = 4(x / dA)(1 - x / dA)
p_2(x) = (x / dA)(2x / dA - 1)
dp_0[0] / dx = 3 / dA
dp_1[0] / dx = -4 / dA
dp_2[0] / dx = 1 / dA
dp_0[dA] / dx = -1 / dA
dp_1[dA] / dx = 4 / dA
dp_2[dA] / dx = -3 / dA
d^2p_0[0] / dx^2 = 4 / dA^2
d^2p_1[0] / dx^2 = -8 / dA^2
d^2p_2[0] / dx^2 = 4 / dA^2
*/
delLambda = lambda - lambda_old;
delFnrm = (3.*fnrm - 4.*fnrm_mid + 1.*fnrm_old) / delLambda;
delFnrm_old = (-3.*fnrm_old + 4.*fnrm_mid -1.*fnrm) / delLambda;
del2Fnrm = (delFnrm - delFnrm_old) / delLambda;
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: lambdas = [%g, %g, %g], fnorms = [%g, %g, %g]\n",
lambda, lambda_mid, lambda_old, PetscSqrtReal(fnrm), PetscSqrtReal(fnrm_mid), PetscSqrtReal(fnrm_old));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
/* compute the search direction -- always go downhill */
if (del2Fnrm > 0.) {
lambda_update = lambda - delFnrm / del2Fnrm;
} else {
lambda_update = lambda + delFnrm / del2Fnrm;
}
if (lambda_update < steptol) {
lambda_update = 0.5*(lambda + lambda_old);
}
if (PetscIsInfOrNanScalar(lambda_update)) break;
if (lambda_update > maxstep) {
break;
}
/* compute the new state of the line search */
lambda_old = lambda;
lambda = lambda_update;
fnrm_old = fnrm;
lambda_mid = 0.5*(lambda + lambda_old);
}
/* construct the solution */
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
/* postcheck */
ierr = SNESLineSearchPostCheck(linesearch,X,Y,W,&changed_y,&changed_w);CHKERRQ(ierr);
if (changed_y) {
ierr = VecAXPY(X, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, X);CHKERRQ(ierr);
}
} else {
ierr = VecCopy(W, X);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = SNESLineSearchSetLambda(linesearch, lambda);CHKERRQ(ierr);
ierr = SNESLineSearchComputeNorms(linesearch);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search terminated: lambda = %g, fnorms = %g\n", lambda, gnorm);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
if (lambda <= steptol) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_PIPECG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i;
PetscScalar alpha = 0.0,beta = 0.0,gamma = 0.0,gammaold = 0.0,delta = 0.0;
PetscReal dp = 0.0;
Vec X,B,Z,P,W,Q,U,M,N,R,S;
Mat Amat,Pmat;
MatStructure pflag;
PetscBool diagonalscale;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
X = ksp->vec_sol;
B = ksp->vec_rhs;
M = ksp->work[0];
Z = ksp->work[1];
P = ksp->work[2];
N = ksp->work[3];
W = ksp->work[4];
Q = ksp->work[5];
U = ksp->work[6];
R = ksp->work[7];
S = ksp->work[8];
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
ierr = KSP_PCApply(ksp,R,U);CHKERRQ(ierr); /* u <- Br */
switch (ksp->normtype) {
case KSP_NORM_PRECONDITIONED:
ierr = VecNormBegin(U,NORM_2,&dp);CHKERRQ(ierr); /* dp <- u'*u = e'*A'*B'*B*A'*e' */
ierr = PetscCommSplitReductionBegin(((PetscObject)U)->comm);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,U,W);CHKERRQ(ierr); /* w <- Au */
ierr = VecNormEnd(U,NORM_2,&dp);CHKERRQ(ierr);
break;
case KSP_NORM_UNPRECONDITIONED:
ierr = VecNormBegin(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
ierr = PetscCommSplitReductionBegin(((PetscObject)R)->comm);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,U,W);CHKERRQ(ierr); /* w <- Au */
ierr = VecNormEnd(R,NORM_2,&dp);CHKERRQ(ierr);
break;
case KSP_NORM_NATURAL:
ierr = VecDotBegin(R,U,&gamma);CHKERRQ(ierr); /* gamma <- u'*r */
ierr = PetscCommSplitReductionBegin(((PetscObject)R)->comm);CHKERRQ(ierr);
ierr = KSP_MatMult(ksp,Amat,U,W);CHKERRQ(ierr); /* w <- Au */
ierr = VecDotEnd(R,U,&gamma);CHKERRQ(ierr);
if (PetscIsInfOrNanScalar(gamma)) SETERRQ(((PetscObject)ksp)->comm,PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = PetscSqrtReal(PetscAbsScalar(gamma)); /* dp <- r'*u = r'*B*r = e'*A'*B*A*e */
break;
case KSP_NORM_NONE:
ierr = KSP_MatMult(ksp,Amat,U,W);CHKERRQ(ierr);
dp = 0.0;
break;
default: SETERRQ1(((PetscObject)ksp)->comm,PETSC_ERR_SUP,"%s",KSPNormTypes[ksp->normtype]);
}
KSPLogResidualHistory(ksp,dp);
ierr = KSPMonitor(ksp,0,dp);CHKERRQ(ierr);
ksp->rnorm = dp;
ierr = (*ksp->converged)(ksp,0,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr); /* test for convergence */
if (ksp->reason) PetscFunctionReturn(0);
i = 0;
do {
if (i > 0 && ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormBegin(R,NORM_2,&dp);CHKERRQ(ierr);
} else if (i > 0 && ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormBegin(U,NORM_2,&dp);CHKERRQ(ierr);
} else if (! (i == 0 && ksp->normtype == KSP_NORM_NATURAL)) {
ierr = VecDotBegin(R,U,&gamma);CHKERRQ(ierr);
}
ierr = VecDotBegin(W,U,&delta);CHKERRQ(ierr);
ierr = PetscCommSplitReductionBegin(((PetscObject)R)->comm);CHKERRQ(ierr);
ierr = KSP_PCApply(ksp,W,M);CHKERRQ(ierr); /* m <- Bw */
ierr = KSP_MatMult(ksp,Amat,M,N);CHKERRQ(ierr); /* n <- Am */
if (i > 0 && ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNormEnd(R,NORM_2,&dp);CHKERRQ(ierr);
} else if (i > 0 && ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = VecNormEnd(U,NORM_2,&dp);CHKERRQ(ierr);
} else if (! (i == 0 && ksp->normtype == KSP_NORM_NATURAL)) {
ierr = VecDotEnd(R,U,&gamma);CHKERRQ(ierr);
}
ierr = VecDotEnd(W,U,&delta);CHKERRQ(ierr);
if (i > 0) {
if (ksp->normtype == KSP_NORM_NATURAL) {
dp = PetscSqrtReal(PetscAbsScalar(gamma));
} else if (ksp->normtype == KSP_NORM_NONE) {
dp = 0.0;
}
ksp->rnorm = dp;
KSPLogResidualHistory(ksp,dp);
ierr = KSPMonitor(ksp,i,dp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i,dp,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
}
if (i == 0) {
alpha = gamma / delta;
ierr = VecCopy(N,Z);CHKERRQ(ierr); /* z <- n */
ierr = VecCopy(M,Q);CHKERRQ(ierr); /* q <- m */
ierr = VecCopy(U,P);CHKERRQ(ierr); /* p <- u */
ierr = VecCopy(W,S);CHKERRQ(ierr); /* s <- w */
} else {
beta = gamma / gammaold;
alpha = gamma / ( delta - beta / alpha * gamma );
ierr = VecAYPX(Z,beta,N);CHKERRQ(ierr); /* z <- n + beta * z */
ierr = VecAYPX(Q,beta,M);CHKERRQ(ierr); /* q <- m + beta * q */
ierr = VecAYPX(P,beta,U);CHKERRQ(ierr); /* p <- u + beta * p */
ierr = VecAYPX(S,beta,W);CHKERRQ(ierr); /* s <- w + beta * s */
}
ierr = VecAXPY(X, alpha,P);CHKERRQ(ierr); /* x <- x + alpha * p */
ierr = VecAXPY(U,-alpha,Q);CHKERRQ(ierr); /* u <- u - alpha * q */
ierr = VecAXPY(W,-alpha,Z);CHKERRQ(ierr); /* w <- w - alpha * z */
ierr = VecAXPY(R,-alpha,S);CHKERRQ(ierr); /* r <- r - alpha * s */
gammaold = gamma;
i++;
ksp->its = i;
/* if (i%50 == 0) { */
/* ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /\* w <- b - Ax *\/ */
/* ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr); */
/* ierr = KSP_PCApply(ksp,R,U);CHKERRQ(ierr); */
/* ierr = KSP_MatMult(ksp,Amat,U,W);CHKERRQ(ierr); */
/* } */
} while (i<ksp->max_it);
if (i >= ksp->max_it) {
ksp->reason = KSP_DIVERGED_ITS;
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESLineSearchApply_CP(SNESLineSearch linesearch)
{
PetscBool changed_y, changed_w, domainerror;
PetscErrorCode ierr;
Vec X, Y, F, W;
SNES snes;
PetscReal xnorm, ynorm, gnorm, steptol, atol, rtol, ltol, maxstep;
PetscReal lambda, lambda_old, lambda_update, delLambda;
PetscScalar fty, fty_init, fty_old, fty_mid1, fty_mid2, s;
PetscInt i, max_its;
PetscViewer monitor;
PetscFunctionBegin;
ierr = SNESLineSearchGetVecs(linesearch, &X, &F, &Y, &W, NULL);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = SNESLineSearchGetSNES(linesearch, &snes);CHKERRQ(ierr);
ierr = SNESLineSearchGetLambda(linesearch, &lambda);CHKERRQ(ierr);
ierr = SNESLineSearchGetTolerances(linesearch, &steptol, &maxstep, &rtol, &atol, <ol, &max_its);CHKERRQ(ierr);
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_TRUE);CHKERRQ(ierr);
ierr = SNESLineSearchGetMonitor(linesearch, &monitor);CHKERRQ(ierr);
/* precheck */
ierr = SNESLineSearchPreCheck(linesearch,X,Y,&changed_y);CHKERRQ(ierr);
lambda_old = 0.0;
ierr = VecDot(F, Y, &fty_old);CHKERRQ(ierr);
fty_init = fty_old;
for (i = 0; i < max_its; i++) {
/* compute the norm at lambda */
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
ierr = VecDot(F, Y, &fty);CHKERRQ(ierr);
delLambda = lambda - lambda_old;
/* check for convergence */
if (PetscAbsReal(delLambda) < steptol*lambda) break;
if (PetscAbsScalar(fty) / PetscAbsScalar(fty_init) < rtol) break;
if (PetscAbsScalar(fty) < atol && i > 0) break;
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: lambdas = [%g, %g], ftys = [%g, %g]\n",(double)lambda, (double)lambda_old, (double)PetscRealPart(fty), (double)PetscRealPart(fty_old));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
/* compute the search direction */
if (linesearch->order == SNES_LINESEARCH_ORDER_LINEAR) {
s = (fty - fty_old) / delLambda;
} else if (linesearch->order == SNES_LINESEARCH_ORDER_QUADRATIC) {
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -0.5*(lambda + lambda_old), Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
ierr = VecDot(F, Y, &fty_mid1);CHKERRQ(ierr);
s = (3.*fty - 4.*fty_mid1 + fty_old) / delLambda;
} else {
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -0.5*(lambda + lambda_old), Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
ierr = VecDot(F, Y, &fty_mid1);CHKERRQ(ierr);
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -(lambda + 0.5*(lambda - lambda_old)), Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes, W, F);CHKERRQ(ierr);
ierr = VecDot(F, Y, &fty_mid2);CHKERRQ(ierr);
s = (2.*fty_mid2 + 3.*fty - 6.*fty_mid1 + fty_old) / (3.*delLambda);
}
/* if the solve is going in the wrong direction, fix it */
if (PetscRealPart(s) > 0.) s = -s;
lambda_update = lambda - PetscRealPart(fty / s);
/* switch directions if we stepped out of bounds */
if (lambda_update < steptol) lambda_update = lambda + PetscRealPart(fty / s);
if (PetscIsInfOrNanScalar(lambda_update)) break;
if (lambda_update > maxstep) break;
/* compute the new state of the line search */
lambda_old = lambda;
lambda = lambda_update;
fty_old = fty;
}
/* construct the solution */
ierr = VecCopy(X, W);CHKERRQ(ierr);
ierr = VecAXPY(W, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
/* postcheck */
ierr = SNESLineSearchPostCheck(linesearch,X,Y,W,&changed_y,&changed_w);CHKERRQ(ierr);
if (changed_y) {
ierr = VecAXPY(X, -lambda, Y);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, X);CHKERRQ(ierr);
}
} else {
ierr = VecCopy(W, X);CHKERRQ(ierr);
}
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = SNESLineSearchComputeNorms(linesearch);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = SNESLineSearchSetLambda(linesearch, lambda);CHKERRQ(ierr);
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search terminated: lambda = %g, fnorms = %g\n", (double)lambda, (double)gnorm);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
if (lambda <= steptol) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
#if PETSC_SCALAR_SIZE == 32
PetscInt digits = 7;
#elif PETSC_SCALAR_SIZE == 64
PetscInt digits = 14;
#else
PetscInt digits = 28;
#endif
const PetscReal epsilon = 10.*PETSC_MACHINE_EPSILON;
const PetscReal bounds[28] =
{
0.0, 1.0,
0.0, 1.0,
0.0, PETSC_PI/2.,
0.0, 1.0,
0.0, 1.0,
0.0, 1.0,
0.0, 1.0,
0.0, 1.0,
0.0, PETSC_PI/2.,
0.0, PETSC_PI/2.,
0.0, 1.0,
0.0, 1.0,
0.0, 1.0,
0.0, 1.0
};
const PetscReal analytic[14] =
{
0.250000000000000,
0.210657251225806988108092302182988001695680805674,
1.905238690482675827736517833351916563195085437332,
0.514041895890070761397629739576882871630921844127,
-.444444444444444444444444444444444444444444444444,
0.785398163397448309615660845819875721049292349843,
1.198140234735592207439922492280323878227212663216,
2.000000000000000000000000000000000000000000000000,
-1.08879304515180106525034444911880697366929185018,
2.221441469079183123507940495030346849307310844687,
1.570796326794896619231321691639751442098584699687,
1.772453850905516027298167483341145182797549456122,
1.253314137315500251207882642405522626503493370304,
0.500000000000000000000000000000000000000000000000
};
void (*funcs[14])(PetscReal, PetscReal *) = {func1, func2, func3, func4, func5, func6, func7, func8, func9, func10, func11, func12, func13, func14};
PetscInt f;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc, &argv, PETSC_NULL, help);CHKERRQ(ierr);
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,"","Test Options","none");CHKERRQ(ierr);
ierr = PetscOptionsInt("-digits", "The number of significant digits for the integral","ex3.c",digits,&digits,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
/* Integrate each function */
for (f = 0; f < 14; ++f) {
PetscReal integral;
ierr = PetscDTTanhSinhIntegrate(funcs[f], bounds[f*2+0], bounds[f*2+1], digits, &integral);CHKERRQ(ierr);
if (PetscAbsReal(integral - analytic[f]) > epsilon || PetscIsInfOrNanScalar(integral - analytic[f])) {
ierr = PetscPrintf(PETSC_COMM_SELF, "The integral of func%2d is wrong: %g (%g)\n", f+1, (double)integral, (double) PetscAbsReal(integral - analytic[f]));CHKERRQ(ierr);
}
}
#ifdef PETSC_HAVE_MPFR
for (f = 0; f < 14; ++f) {
PetscReal integral;
ierr = PetscDTTanhSinhIntegrateMPFR(funcs[f], bounds[f*2+0], bounds[f*2+1], digits, &integral);CHKERRQ(ierr);
if (PetscAbsReal(integral - analytic[f]) > epsilon) {
ierr = PetscPrintf(PETSC_COMM_SELF, "The integral of func%2d is wrong: %g (%g)\n", f+1, (double)integral, (double)PetscAbsReal(integral - analytic[f]));CHKERRQ(ierr);
}
}
#endif
PetscFinalize();
return 0;
}
PetscErrorCode KSPSolve_CG(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,stored_max_it,eigs;
PetscScalar dpi = 0.0,a = 1.0,beta,betaold = 1.0,b = 0,*e = 0,*d = 0,delta,dpiold;
PetscReal dp = 0.0;
Vec X,B,Z,R,P,S,W;
KSP_CG *cg;
Mat Amat,Pmat;
MatStructure pflag;
PetscTruth diagonalscale;
PetscFunctionBegin;
ierr = PCDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
cg = (KSP_CG*)ksp->data;
eigs = ksp->calc_sings;
stored_max_it = ksp->max_it;
X = ksp->vec_sol;
B = ksp->vec_rhs;
R = ksp->work[0];
Z = ksp->work[1];
P = ksp->work[2];
if (cg->singlereduction) {
S = ksp->work[3];
W = ksp->work[4];
} else {
S = 0; /* unused */
W = Z;
}
#if !defined(PETSC_USE_COMPLEX)
#define VecXDot(x,y,a) VecDot(x,y,a)
#else
#define VecXDot(x,y,a) (((cg->type) == (KSP_CG_HERMITIAN)) ? VecDot(x,y,a) : VecTDot(x,y,a))
#endif
if (eigs) {e = cg->e; d = cg->d; e[0] = 0.0; }
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ksp->its = 0;
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,R);CHKERRQ(ierr); /* r <- b - Ax */
ierr = VecAYPX(R,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,R);CHKERRQ(ierr); /* r <- b (x is 0) */
}
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
ierr = VecNorm(Z,NORM_2,&dp);CHKERRQ(ierr); /* dp <- z'*z = e'*A'*B'*B*A'*e' */
} else if (ksp->normtype == KSP_NORM_UNPRECONDITIONED) {
ierr = VecNorm(R,NORM_2,&dp);CHKERRQ(ierr); /* dp <- r'*r = e'*A'*A*e */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
ierr = KSP_PCApply(ksp,R,Z);CHKERRQ(ierr); /* z <- Br */
if (cg->singlereduction) {
ierr = KSP_MatMult(ksp,Amat,Z,S);CHKERRQ(ierr);
ierr = VecXDot(Z,S,&delta);CHKERRQ(ierr);
}
ierr = VecXDot(Z,R,&beta);CHKERRQ(ierr); /* beta <- z'*r */
if PetscIsInfOrNanScalar(beta) SETERRQ(PETSC_ERR_FP,"Infinite or not-a-number generated in dot product");
dp = sqrt(PetscAbsScalar(beta)); /* dp <- r'*z = r'*B*r = e'*A'*B*A*e */
} else dp = 0.0;
PETSC_EXTERN PetscBool PETSC_STDCALL petscisinfornanscalar_(PetscScalar *v)
{
return (PetscBool) PetscIsInfOrNanScalar(*v);
}
/*@C
KSPConvergedDefault - Determines convergence of
the iterative solvers (default code).
Collective on KSP
Input Parameters:
+ ksp - iterative context
. n - iteration number
. rnorm - 2-norm residual value (may be estimated)
- ctx - convergence context which must be created by KSPConvergedDefaultCreate()
reason is set to:
+ positive - if the iteration has converged;
. negative - if residual norm exceeds divergence threshold;
- 0 - otherwise.
Notes:
KSPConvergedDefault() reaches convergence when
$ rnorm < MAX (rtol * rnorm_0, abstol);
Divergence is detected if
$ rnorm > dtol * rnorm_0,
where
+ rtol = relative tolerance,
. abstol = absolute tolerance.
. dtol = divergence tolerance,
- rnorm_0 is the two norm of the right hand side. When initial guess is non-zero you
can call KSPConvergedDefaultSetUIRNorm() to use the norm of (b - A*(initial guess))
as the starting point for relative norm convergence testing.
Use KSPSetTolerances() to alter the defaults for rtol, abstol, dtol.
The precise values of reason are macros such as KSP_CONVERGED_RTOL, which
are defined in petscksp.h.
Level: intermediate
.keywords: KSP, default, convergence, residual
.seealso: KSPSetConvergenceTest(), KSPSetTolerances(), KSPConvergedSkip(), KSPConvergedReason, KSPGetConvergedReason(),
KSPConvergedDefaultSetUIRNorm(), KSPConvergedDefaultSetUMIRNorm(), KSPConvergedDefaultCreate(), KSPConvergedDefaultDestroy()
@*/
PetscErrorCode KSPConvergedDefault(KSP ksp,PetscInt n,PetscReal rnorm,KSPConvergedReason *reason,void *ctx)
{
PetscErrorCode ierr;
KSPConvergedDefaultCtx *cctx = (KSPConvergedDefaultCtx*) ctx;
KSPNormType normtype;
PetscFunctionBegin;
PetscValidHeaderSpecific(ksp,KSP_CLASSID,1);
PetscValidPointer(reason,4);
*reason = KSP_CONVERGED_ITERATING;
ierr = KSPGetNormType(ksp,&normtype);CHKERRQ(ierr);
if (normtype == KSP_NORM_NONE) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_WRONGSTATE,"Use KSPConvergedSkip() with KSPNormType of KSP_NORM_NONE");
if (!cctx) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_NULL,"Convergence context must have been created with KSPConvergedDefaultCreate()");
if (!n) {
/* if user gives initial guess need to compute norm of b */
if (!ksp->guess_zero && !cctx->initialrtol) {
PetscReal snorm;
if (ksp->normtype == KSP_NORM_UNPRECONDITIONED || ksp->pc_side == PC_RIGHT) {
ierr = PetscInfo(ksp,"user has provided nonzero initial guess, computing 2-norm of RHS\n");CHKERRQ(ierr);
ierr = VecNorm(ksp->vec_rhs,NORM_2,&snorm);CHKERRQ(ierr); /* <- b'*b */
} else {
Vec z;
/* Should avoid allocating the z vector each time but cannot stash it in cctx because if KSPReset() is called the vector size might change */
ierr = VecDuplicate(ksp->vec_rhs,&z);CHKERRQ(ierr);
ierr = KSP_PCApply(ksp,ksp->vec_rhs,z);CHKERRQ(ierr);
if (ksp->normtype == KSP_NORM_PRECONDITIONED) {
ierr = PetscInfo(ksp,"user has provided nonzero initial guess, computing 2-norm of preconditioned RHS\n");CHKERRQ(ierr);
ierr = VecNorm(z,NORM_2,&snorm);CHKERRQ(ierr); /* dp <- b'*B'*B*b */
} else if (ksp->normtype == KSP_NORM_NATURAL) {
PetscScalar norm;
ierr = PetscInfo(ksp,"user has provided nonzero initial guess, computing natural norm of RHS\n");CHKERRQ(ierr);
ierr = VecDot(ksp->vec_rhs,z,&norm);CHKERRQ(ierr);
snorm = PetscSqrtReal(PetscAbsScalar(norm)); /* dp <- b'*B*b */
}
ierr = VecDestroy(&z);CHKERRQ(ierr);
}
/* handle special case of zero RHS and nonzero guess */
if (!snorm) {
ierr = PetscInfo(ksp,"Special case, user has provided nonzero initial guess and zero RHS\n");CHKERRQ(ierr);
snorm = rnorm;
}
if (cctx->mininitialrtol) ksp->rnorm0 = PetscMin(snorm,rnorm);
else ksp->rnorm0 = snorm;
} else {
ksp->rnorm0 = rnorm;
}
ksp->ttol = PetscMax(ksp->rtol*ksp->rnorm0,ksp->abstol);
}
if (n <= ksp->chknorm) PetscFunctionReturn(0);
if (PetscIsInfOrNanScalar(rnorm)) {
ierr = PetscInfo(ksp,"Linear solver has created a not a number (NaN) as the residual norm, declaring divergence \n");CHKERRQ(ierr);
*reason = KSP_DIVERGED_NANORINF;
} else if (rnorm <= ksp->ttol) {
if (rnorm < ksp->abstol) {
ierr = PetscInfo3(ksp,"Linear solver has converged. Residual norm %14.12e is less than absolute tolerance %14.12e at iteration %D\n",(double)rnorm,(double)ksp->abstol,n);CHKERRQ(ierr);
*reason = KSP_CONVERGED_ATOL;
} else {
if (cctx->initialrtol) {
ierr = PetscInfo4(ksp,"Linear solver has converged. Residual norm %14.12e is less than relative tolerance %14.12e times initial residual norm %14.12e at iteration %D\n",(double)rnorm,(double)ksp->rtol,(double)ksp->rnorm0,n);CHKERRQ(ierr);
} else {
ierr = PetscInfo4(ksp,"Linear solver has converged. Residual norm %14.12e is less than relative tolerance %14.12e times initial right hand side norm %14.12e at iteration %D\n",(double)rnorm,(double)ksp->rtol,(double)ksp->rnorm0,n);CHKERRQ(ierr);
}
*reason = KSP_CONVERGED_RTOL;
}
} else if (rnorm >= ksp->divtol*ksp->rnorm0) {
ierr = PetscInfo3(ksp,"Linear solver is diverging. Initial right hand size norm %14.12e, current residual norm %14.12e at iteration %D\n",(double)ksp->rnorm0,(double)rnorm,n);CHKERRQ(ierr);
*reason = KSP_DIVERGED_DTOL;
}
PetscFunctionReturn(0);
}
