PetscErrorCode SNESMonitorJacUpdateSpectrum(SNES snes,PetscInt it,PetscReal fnorm,void *ctx)
{
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#elif defined(PETSC_HAVE_ESSL)
SETERRQ(PetscObjectComm((PetscObject)snes),PETSC_ERR_SUP,"GEEV - No support for ESSL Lapack Routines");
#else
Vec X;
Mat J,dJ,dJdense;
PetscErrorCode ierr;
PetscErrorCode (*func)(SNES,Vec,Mat*,Mat*,MatStructure*,void*);
PetscInt n,i;
PetscBLASInt nb,lwork;
PetscReal *eigr,*eigi;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscScalar *work;
PetscScalar *a;
PetscFunctionBegin;
if (it == 0) PetscFunctionReturn(0);
/* create the difference between the current update and the current jacobian */
ierr = SNESGetSolution(snes,&X);CHKERRQ(ierr);
ierr = SNESGetJacobian(snes,&J,NULL,&func,NULL);CHKERRQ(ierr);
ierr = MatDuplicate(J,MAT_COPY_VALUES,&dJ);CHKERRQ(ierr);
ierr = SNESComputeJacobian(snes,X,&dJ,&dJ,&flg);CHKERRQ(ierr);
ierr = MatAXPY(dJ,-1.0,J,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
/* compute the spectrum directly */
ierr = MatConvert(dJ,MATSEQDENSE,MAT_INITIAL_MATRIX,&dJdense);CHKERRQ(ierr);
ierr = MatGetSize(dJ,&n,NULL);CHKERRQ(ierr);
ierr = PetscBLASIntCast(n,&nb);CHKERRQ(ierr);
lwork = 3*nb;
ierr = PetscMalloc(n*sizeof(PetscReal),&eigr);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscReal),&eigi);CHKERRQ(ierr);
ierr = PetscMalloc(lwork*sizeof(PetscScalar),&work);CHKERRQ(ierr);
ierr = MatDenseGetArray(dJdense,&a);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
{
PetscBLASInt lierr;
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCall("LAPACKgeev",LAPACKgeev_("N","N",&nb,a,&nb,eigr,eigi,NULL,&nb,NULL,&nb,work,&lwork,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"geev() error %d",lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#else
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not coded for complex");
#endif
PetscPrintf(PetscObjectComm((PetscObject)snes),"Eigenvalues of J_%d - J_%d:\n",it,it-1);CHKERRQ(ierr);
for (i=0;i<n;i++) {
PetscPrintf(PetscObjectComm((PetscObject)snes),"%5d: %20.5g + %20.5gi\n",i,eigr[i],eigi[i]);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(dJdense,&a);CHKERRQ(ierr);
ierr = MatDestroy(&dJ);CHKERRQ(ierr);
ierr = MatDestroy(&dJdense);CHKERRQ(ierr);
ierr = PetscFree(eigr);CHKERRQ(ierr);
ierr = PetscFree(eigi);CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
PetscErrorCode SNESUnSetMatrixFreeParameter(SNES snes)
{
MFCtx_Private *ctx;
PetscErrorCode ierr;
Mat mat;
PetscFunctionBegin;
ierr = SNESGetJacobian(snes,&mat,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatShellGetContext(mat,(void**)&ctx);CHKERRQ(ierr);
if (ctx) ctx->need_h = PETSC_TRUE;
PetscFunctionReturn(0);
}
PetscErrorCode MatMultASPIN(Mat m,Vec X,Vec Y)
{
PetscErrorCode ierr;
void *ctx;
SNES snes;
PetscInt n,i;
VecScatter *oscatter;
SNES *subsnes;
PetscBool match;
MPI_Comm comm;
KSP ksp;
Vec *x,*b;
Vec W;
SNES npc;
Mat subJ,subpJ;
PetscFunctionBegin;
ierr = MatShellGetContext(m,&ctx);CHKERRQ(ierr);
snes = (SNES)ctx;
ierr = SNESGetNPC(snes,&npc);CHKERRQ(ierr);
ierr = SNESGetFunction(npc,&W,NULL,NULL);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)npc,SNESNASM,&match);CHKERRQ(ierr);
if (!match) {
ierr = PetscObjectGetComm((PetscObject)snes,&comm);
SETERRQ(comm,PETSC_ERR_ARG_WRONGSTATE,"MatMultASPIN requires that the nonlinear preconditioner be Nonlinear additive Schwarz");
}
ierr = SNESNASMGetSubdomains(npc,&n,&subsnes,NULL,&oscatter,NULL);CHKERRQ(ierr);
ierr = SNESNASMGetSubdomainVecs(npc,&n,&x,&b,NULL,NULL);CHKERRQ(ierr);
ierr = VecSet(Y,0);CHKERRQ(ierr);
ierr = MatMult(npc->jacobian_pre,X,W);CHKERRQ(ierr);
for (i=0;i<n;i++) {
ierr = VecScatterBegin(oscatter[i],W,b[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
for (i=0;i<n;i++) {
ierr = VecScatterEnd(oscatter[i],W,b[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecSet(x[i],0.);CHKERRQ(ierr);
ierr = SNESGetJacobian(subsnes[i],&subJ,&subpJ,NULL,NULL);CHKERRQ(ierr);
ierr = SNESGetKSP(subsnes[i],&ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,subJ,subpJ);CHKERRQ(ierr);
ierr = KSPSolve(ksp,b[i],x[i]);CHKERRQ(ierr);
ierr = VecScatterBegin(oscatter[i],x[i],Y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
for (i=0;i<n;i++) {
ierr = VecScatterEnd(oscatter[i],x[i],Y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode JacMatMultCompare(SNES snes,Vec x,Vec p,double hopt)
{
Vec yy1, yy2; /* work vectors */
PetscViewer view2; /* viewer */
Mat J; /* analytic Jacobian (set as preconditioner matrix) */
Mat Jmf; /* matrix-free Jacobian (set as true system matrix) */
double h; /* differencing parameter */
Vec f;
PetscScalar alpha;
PetscReal yy1n,yy2n,enorm;
PetscErrorCode ierr;
PetscInt i;
PetscBool printv = PETSC_FALSE;
char filename[32];
MPI_Comm comm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
/* Compute function and analytic Jacobian at x */
ierr = SNESGetJacobian(snes,&Jmf,&J,NULL,NULL);CHKERRQ(ierr);
ierr = SNESComputeJacobian(snes,x,Jmf,J);CHKERRQ(ierr);
ierr = SNESGetFunction(snes,&f,NULL,NULL);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,x,f);CHKERRQ(ierr);
/* Duplicate work vectors */
ierr = VecDuplicate(x,&yy2);CHKERRQ(ierr);
ierr = VecDuplicate(x,&yy1);CHKERRQ(ierr);
/* Compute true matrix-vector product */
ierr = MatMult(J,p,yy1);CHKERRQ(ierr);
ierr = VecNorm(yy1,NORM_2,&yy1n);CHKERRQ(ierr);
/* View product vector if desired */
ierr = PetscOptionsGetBool(NULL,"-print_vecs",&printv,NULL);CHKERRQ(ierr);
if (printv) {
ierr = PetscViewerASCIIOpen(comm,"y1.out",&view2);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = VecView(yy1,view2);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&view2);CHKERRQ(ierr);
}
/* Test Jacobian-vector product computation */
alpha = -1.0;
h = 0.01 * hopt;
for (i=0; i<5; i++) {
/* Set differencing parameter for matrix-free multiplication */
ierr = SNESDefaultMatrixFreeSetParameters2(Jmf,PETSC_DEFAULT,PETSC_DEFAULT,h);CHKERRQ(ierr);
/* Compute matrix-vector product via differencing approximation */
ierr = MatMult(Jmf,p,yy2);CHKERRQ(ierr);
ierr = VecNorm(yy2,NORM_2,&yy2n);CHKERRQ(ierr);
/* View product vector if desired */
if (printv) {
sprintf(filename,"y2.%d.out",(int)i);
ierr = PetscViewerASCIIOpen(comm,filename,&view2);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(view2,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = VecView(yy2,view2);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&view2);CHKERRQ(ierr);
}
/* Compute relative error */
ierr = VecAXPY(yy2,alpha,yy1);CHKERRQ(ierr);
ierr = VecNorm(yy2,NORM_2,&enorm);CHKERRQ(ierr);
enorm = enorm/yy1n;
ierr = PetscFPrintf(comm,stdout,"h = %g: relative error = %g\n",(double)h,(double)enorm);CHKERRQ(ierr);
h *= 10.0;
}
PetscFunctionReturn(0);
}
PetscErrorCode TSMonitorSPEig(TS ts,PetscInt step,PetscReal ptime,Vec v,void *monctx)
{
TSMonitorSPEigCtx ctx = (TSMonitorSPEigCtx) monctx;
PetscErrorCode ierr;
KSP ksp = ctx->ksp;
PetscInt n,N,nits,neig,i,its = 200;
PetscReal *r,*c,time_step_save;
PetscDrawSP drawsp = ctx->drawsp;
Mat A,B;
Vec xdot;
SNES snes;
PetscFunctionBegin;
if (!step) PetscFunctionReturn(0);
if (((ctx->howoften > 0) && (!(step % ctx->howoften))) || ((ctx->howoften == -1) && ts->reason)) {
ierr = VecDuplicate(v,&xdot);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetJacobian(snes,&A,&B,NULL,NULL);CHKERRQ(ierr);
ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&B);CHKERRQ(ierr);
/*
This doesn't work because methods keep and use internal information about the shift so it
seems we would need code for each method to trick the correct Jacobian in being computed.
*/
time_step_save = ts->time_step;
ts->time_step = PETSC_MAX_REAL;
ierr = SNESComputeJacobian(snes,v,A,B);CHKERRQ(ierr);
ts->time_step = time_step_save;
ierr = KSPSetOperators(ksp,B,B);CHKERRQ(ierr);
ierr = VecGetSize(v,&n);CHKERRQ(ierr);
if (n < 200) its = n;
ierr = KSPSetTolerances(ksp,1.e-10,PETSC_DEFAULT,PETSC_DEFAULT,its);CHKERRQ(ierr);
ierr = VecSetRandom(xdot,ctx->rand);CHKERRQ(ierr);
ierr = KSPSolve(ksp,xdot,xdot);CHKERRQ(ierr);
ierr = VecDestroy(&xdot);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&nits);CHKERRQ(ierr);
N = nits+2;
if (nits) {
PetscDraw draw;
PetscReal pause;
PetscDrawAxis axis;
PetscReal xmin,xmax,ymin,ymax;
ierr = PetscDrawSPReset(drawsp);CHKERRQ(ierr);
ierr = PetscDrawSPSetLimits(drawsp,ctx->xmin,ctx->xmax,ctx->ymin,ctx->ymax);CHKERRQ(ierr);
ierr = PetscMalloc2(PetscMax(n,N),&r,PetscMax(n,N),&c);CHKERRQ(ierr);
if (ctx->computeexplicitly) {
ierr = KSPComputeEigenvaluesExplicitly(ksp,n,r,c);CHKERRQ(ierr);
neig = n;
} else {
ierr = KSPComputeEigenvalues(ksp,N,r,c,&neig);CHKERRQ(ierr);
}
/* We used the positive operator to be able to reuse KSPs that require positive definiteness, now flip the spectrum as is conventional for ODEs */
for (i=0; i<neig; i++) r[i] = -r[i];
for (i=0; i<neig; i++) {
if (ts->ops->linearstability) {
PetscReal fr,fi;
ierr = TSComputeLinearStability(ts,r[i],c[i],&fr,&fi);CHKERRQ(ierr);
if ((fr*fr + fi*fi) > 1.0) {
ierr = PetscPrintf(ctx->comm,"Linearized Eigenvalue %g + %g i linear stability function %g norm indicates unstable scheme \n",(double)r[i],(double)c[i],(double)(fr*fr + fi*fi));CHKERRQ(ierr);
}
}
ierr = PetscDrawSPAddPoint(drawsp,r+i,c+i);CHKERRQ(ierr);
}
ierr = PetscFree2(r,c);CHKERRQ(ierr);
ierr = PetscDrawSPGetDraw(drawsp,&draw);CHKERRQ(ierr);
ierr = PetscDrawGetPause(draw,&pause);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw,0.0);CHKERRQ(ierr);
ierr = PetscDrawSPDraw(drawsp,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscDrawSetPause(draw,pause);CHKERRQ(ierr);
if (ts->ops->linearstability) {
ierr = PetscDrawSPGetAxis(drawsp,&axis);CHKERRQ(ierr);
ierr = PetscDrawAxisGetLimits(axis,&xmin,&xmax,&ymin,&ymax);CHKERRQ(ierr);
ierr = PetscDrawIndicatorFunction(draw,xmin,xmax,ymin,ymax,PETSC_DRAW_CYAN,(PetscErrorCode (*)(void*,PetscReal,PetscReal,PetscBool*))TSLinearStabilityIndicator,ts);CHKERRQ(ierr);
ierr = PetscDrawSPDraw(drawsp,PETSC_FALSE);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&B);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESLineSearchApply_BT(SNESLineSearch linesearch)
{
PetscBool changed_y,changed_w;
PetscErrorCode ierr;
Vec X,F,Y,W,G;
SNES snes;
PetscReal fnorm, xnorm, ynorm, gnorm;
PetscReal lambda,lambdatemp,lambdaprev,minlambda,maxstep,initslope,alpha,stol;
PetscReal t1,t2,a,b,d;
PetscReal f;
PetscReal g,gprev;
PetscBool domainerror;
PetscViewer monitor;
PetscInt max_its,count;
SNESLineSearch_BT *bt;
Mat jac;
PetscErrorCode (*objective)(SNES,Vec,PetscReal*,void*);
PetscFunctionBegin;
ierr = SNESLineSearchGetVecs(linesearch, &X, &F, &Y, &W, &G);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(linesearch, &xnorm, &fnorm, &ynorm);CHKERRQ(ierr);
ierr = SNESLineSearchGetLambda(linesearch, &lambda);CHKERRQ(ierr);
ierr = SNESLineSearchGetSNES(linesearch, &snes);CHKERRQ(ierr);
ierr = SNESLineSearchGetMonitor(linesearch, &monitor);CHKERRQ(ierr);
ierr = SNESLineSearchGetTolerances(linesearch,&minlambda,&maxstep,NULL,NULL,NULL,&max_its);CHKERRQ(ierr);
ierr = SNESGetTolerances(snes,NULL,NULL,&stol,NULL,NULL);CHKERRQ(ierr);
ierr = SNESGetObjective(snes,&objective,NULL);CHKERRQ(ierr);
bt = (SNESLineSearch_BT*)linesearch->data;
alpha = bt->alpha;
ierr = SNESGetJacobian(snes, &jac, NULL, NULL, NULL);CHKERRQ(ierr);
if (!jac && !objective) SETERRQ(PetscObjectComm((PetscObject)linesearch), PETSC_ERR_USER, "SNESLineSearchBT requires a Jacobian matrix");
/* precheck */
ierr = SNESLineSearchPreCheck(linesearch,X,Y,&changed_y);CHKERRQ(ierr);
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_TRUE);CHKERRQ(ierr);
ierr = VecNormBegin(Y, NORM_2, &ynorm);CHKERRQ(ierr);
ierr = VecNormBegin(X, NORM_2, &xnorm);CHKERRQ(ierr);
ierr = VecNormEnd(Y, NORM_2, &ynorm);CHKERRQ(ierr);
ierr = VecNormEnd(X, NORM_2, &xnorm);CHKERRQ(ierr);
if (ynorm == 0.0) {
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: Initial direction and size is 0\n");CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
ierr = VecCopy(X,W);CHKERRQ(ierr);
ierr = VecCopy(F,G);CHKERRQ(ierr);
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (ynorm > maxstep) { /* Step too big, so scale back */
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: Scaling step by %14.12e old ynorm %14.12e\n", (double)(maxstep/ynorm),(double)ynorm);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
ierr = VecScale(Y,maxstep/(ynorm));CHKERRQ(ierr);
ynorm = maxstep;
}
/* if the SNES has an objective set, use that instead of the function value */
if (objective) {
ierr = SNESComputeObjective(snes,X,&f);CHKERRQ(ierr);
} else {
f = fnorm*fnorm;
}
/* compute the initial slope */
if (objective) {
/* slope comes from the function (assumed to be the gradient of the objective */
ierr = VecDotRealPart(Y,F,&initslope);CHKERRQ(ierr);
} else {
/* slope comes from the normal equations */
ierr = MatMult(jac,Y,W);CHKERRQ(ierr);
ierr = VecDotRealPart(F,W,&initslope);CHKERRQ(ierr);
if (initslope > 0.0) initslope = -initslope;
if (initslope == 0.0) initslope = -1.0;
}
ierr = VecWAXPY(W,-lambda,Y,X);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
if (snes->nfuncs >= snes->max_funcs) {
ierr = PetscInfo(snes,"Exceeded maximum function evaluations, while checking full step length!\n");CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (objective) {
ierr = SNESComputeObjective(snes,W,&g);CHKERRQ(ierr);
} else {
ierr = (*linesearch->ops->snesfunc)(snes,W,G);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (linesearch->ops->vinorm) {
gnorm = fnorm;
ierr = (*linesearch->ops->vinorm)(snes, G, W, &gnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(G,NORM_2,&gnorm);CHKERRQ(ierr);
}
g = PetscSqr(gnorm);
}
if (PetscIsInfOrNanReal(g)) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscInfo(monitor,"Aborted due to Nan or Inf in function evaluation\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (!objective) {
ierr = PetscInfo2(snes,"Initial fnorm %14.12e gnorm %14.12e\n", (double)fnorm, (double)gnorm);CHKERRQ(ierr);
}
if (.5*g <= .5*f + lambda*alpha*initslope) { /* Sufficient reduction or step tolerance convergence */
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
if (!objective) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Using full step: fnorm %14.12e gnorm %14.12e\n", (double)fnorm, (double)gnorm);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Using full step: obj0 %14.12e obj %14.12e\n", (double)f, (double)g);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
} else {
/* Since the full step didn't work and the step is tiny, quit */
if (stol*xnorm > ynorm) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscInfo2(monitor,"Aborted due to ynorm < stol*xnorm (%14.12e < %14.12e) and inadequate full step.\n",ynorm,stol*xnorm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Fit points with quadratic */
lambdatemp = -initslope/(g - f - 2.0*lambda*initslope);
lambdaprev = lambda;
gprev = g;
if (lambdatemp > .5*lambda) lambdatemp = .5*lambda;
if (lambdatemp <= .1*lambda) lambda = .1*lambda;
else lambda = lambdatemp;
ierr = VecWAXPY(W,-lambda,Y,X);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
if (snes->nfuncs >= snes->max_funcs) {
ierr = PetscInfo1(snes,"Exceeded maximum function evaluations, while attempting quadratic backtracking! %D \n",snes->nfuncs);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (objective) {
ierr = SNESComputeObjective(snes,W,&g);CHKERRQ(ierr);
} else {
ierr = (*linesearch->ops->snesfunc)(snes,W,G);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) PetscFunctionReturn(0);
if (linesearch->ops->vinorm) {
gnorm = fnorm;
ierr = (*linesearch->ops->vinorm)(snes, G, W, &gnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(G,NORM_2,&gnorm);CHKERRQ(ierr);
g = gnorm*gnorm;
}
}
if (PetscIsInfOrNanReal(g)) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscInfo(monitor,"Aborted due to Nan or Inf in function evaluation\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
if (!objective) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: gnorm after quadratic fit %14.12e\n",(double)gnorm);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: obj after quadratic fit %14.12e\n",(double)g);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
if (.5*g < .5*f + lambda*alpha*initslope) { /* sufficient reduction */
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: Quadratically determined step, lambda=%18.16e\n",(double)lambda);CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
} else {
/* Fit points with cubic */
for (count = 0; count < max_its; count++) {
if (lambda <= minlambda) {
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(monitor," Line search: unable to find good step length! After %D tries \n",count);CHKERRQ(ierr);
if (!objective) {
ierr = PetscViewerASCIIPrintf(monitor,
" Line search: fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, minlambda=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",
(double)fnorm, (double)gnorm, (double)ynorm, (double)minlambda, (double)lambda, (double)initslope);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor,
" Line search: obj(0)=%18.16e, obj=%18.16e, ynorm=%18.16e, minlambda=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",
(double)f, (double)g, (double)ynorm, (double)minlambda, (double)lambda, (double)initslope);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (linesearch->order == SNES_LINESEARCH_ORDER_CUBIC) {
t1 = .5*(g - f) - lambda*initslope;
t2 = .5*(gprev - f) - lambdaprev*initslope;
a = (t1/(lambda*lambda) - t2/(lambdaprev*lambdaprev))/(lambda-lambdaprev);
b = (-lambdaprev*t1/(lambda*lambda) + lambda*t2/(lambdaprev*lambdaprev))/(lambda-lambdaprev);
d = b*b - 3*a*initslope;
if (d < 0.0) d = 0.0;
if (a == 0.0) lambdatemp = -initslope/(2.0*b);
else lambdatemp = (-b + PetscSqrtReal(d))/(3.0*a);
} else if (linesearch->order == SNES_LINESEARCH_ORDER_QUADRATIC) {
lambdatemp = -initslope/(g - f - 2.0*initslope);
} else SETERRQ(PetscObjectComm((PetscObject)linesearch), PETSC_ERR_SUP, "unsupported line search order for type bt");
lambdaprev = lambda;
gprev = g;
if (lambdatemp > .5*lambda) lambdatemp = .5*lambda;
if (lambdatemp <= .1*lambda) lambda = .1*lambda;
else lambda = lambdatemp;
ierr = VecWAXPY(W,-lambda,Y,X);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes,W);CHKERRQ(ierr);
}
if (snes->nfuncs >= snes->max_funcs) {
ierr = PetscInfo1(snes,"Exceeded maximum function evaluations, while looking for good step length! %D \n",count);CHKERRQ(ierr);
if (!objective) {
ierr = PetscInfo5(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lambda=%18.16e, initial slope=%18.16e\n",
(double)fnorm,(double)gnorm,(double)ynorm,(double)lambda,(double)initslope);CHKERRQ(ierr);
}
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_FUNCTION_COUNT;
PetscFunctionReturn(0);
}
if (objective) {
ierr = SNESComputeObjective(snes,W,&g);CHKERRQ(ierr);
} else {
ierr = (*linesearch->ops->snesfunc)(snes,W,G);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (linesearch->ops->vinorm) {
gnorm = fnorm;
ierr = (*linesearch->ops->vinorm)(snes, G, W, &gnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(G,NORM_2,&gnorm);CHKERRQ(ierr);
g = gnorm*gnorm;
}
}
if (PetscIsInfOrNanReal(gnorm)) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscInfo(monitor,"Aborted due to Nan or Inf in function evaluation\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (.5*g < .5*f + lambda*alpha*initslope) { /* is reduction enough? */
if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
if (!objective) {
if (linesearch->order == SNES_LINESEARCH_ORDER_CUBIC) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Cubically determined step, current gnorm %14.12e lambda=%18.16e\n",(double)gnorm,(double)lambda);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Quadratically determined step, current gnorm %14.12e lambda=%18.16e\n",(double)gnorm,(double)lambda);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
} else {
if (linesearch->order == SNES_LINESEARCH_ORDER_CUBIC) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Cubically determined step, obj %14.12e lambda=%18.16e\n",(double)g,(double)lambda);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Quadratically determined step, obj %14.12e lambda=%18.16e\n",(double)g,(double)lambda);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
}
break;
} else if (monitor) {
ierr = PetscViewerASCIIAddTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
if (!objective) {
if (linesearch->order == SNES_LINESEARCH_ORDER_CUBIC) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Cubic step no good, shrinking lambda, current gnorm %12.12e lambda=%18.16e\n",(double)gnorm,(double)lambda);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Quadratic step no good, shrinking lambda, current gnorm %12.12e lambda=%18.16e\n",(double)gnorm,(double)lambda);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
} else {
if (linesearch->order == SNES_LINESEARCH_ORDER_CUBIC) {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Cubic step no good, shrinking lambda, obj %12.12e lambda=%18.16e\n",(double)g,(double)lambda);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(monitor," Line search: Quadratic step no good, shrinking lambda, obj %12.12e lambda=%18.16e\n",(double)g,(double)lambda);CHKERRQ(ierr);
}
ierr = PetscViewerASCIISubtractTab(monitor,((PetscObject)linesearch)->tablevel);CHKERRQ(ierr);
}
}
}
}
}
/* postcheck */
ierr = SNESLineSearchPostCheck(linesearch,X,Y,W,&changed_y,&changed_w);CHKERRQ(ierr);
if (changed_y) {
ierr = VecWAXPY(W,-lambda,Y,X);CHKERRQ(ierr);
if (linesearch->ops->viproject) {
ierr = (*linesearch->ops->viproject)(snes, W);CHKERRQ(ierr);
}
}
if (changed_y || changed_w || objective) { /* recompute the function norm if the step has changed or the objective isn't the norm */
ierr = (*linesearch->ops->snesfunc)(snes,W,G);CHKERRQ(ierr);
ierr = SNESGetFunctionDomainError(snes, &domainerror);CHKERRQ(ierr);
if (domainerror) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
if (linesearch->ops->vinorm) {
gnorm = fnorm;
ierr = (*linesearch->ops->vinorm)(snes, G, W, &gnorm);CHKERRQ(ierr);
} else {
ierr = VecNorm(G,NORM_2,&gnorm);CHKERRQ(ierr);
}
ierr = VecNorm(Y,NORM_2,&ynorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(gnorm)) {
ierr = SNESLineSearchSetSuccess(linesearch, PETSC_FALSE);CHKERRQ(ierr);
ierr = PetscInfo(monitor,"Aborted due to Nan or Inf in function evaluation\n");CHKERRQ(ierr);
PetscFunctionReturn(0);
}
}
/* copy the solution over */
ierr = VecCopy(W, X);CHKERRQ(ierr);
ierr = VecCopy(G, F);CHKERRQ(ierr);
ierr = VecNorm(X, NORM_2, &xnorm);CHKERRQ(ierr);
ierr = SNESLineSearchSetLambda(linesearch, lambda);CHKERRQ(ierr);
ierr = SNESLineSearchSetNorms(linesearch, xnorm, gnorm, ynorm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESQNApply_Broyden(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold, Vec D, Vec Dold)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *U = qn->U;
Vec *V = qn->V;
KSPConvergedReason kspreason;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscInt k,i,lits;
PetscInt m = qn->m;
PetscScalar gdot;
PetscInt l = m;
Mat jac,jac_pre;
PetscFunctionBegin;
if (it < m) l = it;
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESGetJacobian(snes,&jac,&jac_pre,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,jac,jac_pre,flg);CHKERRQ(ierr);
ierr = SNES_KSPSolve(snes,snes->ksp,D,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W,Y);CHKERRQ(ierr);
} else {
ierr = VecCopy(D,Y);CHKERRQ(ierr);
ierr = VecScale(Y,qn->scaling);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
if (it > 1) {
for (i = 0; i < l-1; i++) {
k = (it+i-l)%l;
ierr = VecDot(U[k],Y,&gdot);CHKERRQ(ierr);
ierr = VecAXPY(Y,gdot,V[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d gdot: %14.12e\n", it, k, PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
}
if (it < m) l = it;
/* set W to be the last step, post-linesearch */
ierr = VecCopy(Xold,W);CHKERRQ(ierr);
ierr = VecAXPY(W,-1.0,X);CHKERRQ(ierr);
if (l > 0) {
k = (it-1)%l;
ierr = VecCopy(W,U[k]);CHKERRQ(ierr);
ierr = VecAXPY(W,-1.0,Y);CHKERRQ(ierr);
ierr = VecDot(U[k],W,&gdot);CHKERRQ(ierr);
ierr = VecCopy(Y,V[k]);CHKERRQ(ierr);
ierr = VecScale(V[k],1.0/gdot);CHKERRQ(ierr);
ierr = VecDot(U[k],Y,&gdot);CHKERRQ(ierr);
ierr = VecAXPY(Y,gdot,V[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "update: %d k: %d gdot: %14.12e\n", it, k, PetscRealPart(gdot));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESQNApply_LBFGS(SNES snes,PetscInt it,Vec Y,Vec X,Vec Xold,Vec D,Vec Dold)
{
PetscErrorCode ierr;
SNES_QN *qn = (SNES_QN*)snes->data;
Vec W = snes->work[3];
Vec *dX = qn->U;
Vec *dF = qn->V;
PetscScalar *alpha = qn->alpha;
PetscScalar *beta = qn->beta;
PetscScalar *dXtdF = qn->dXtdF;
PetscScalar *dFtdX = qn->dFtdX;
PetscScalar *YtdX = qn->YtdX;
/* ksp thing for jacobian scaling */
KSPConvergedReason kspreason;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscInt k,i,j,g,lits;
PetscInt m = qn->m;
PetscScalar t;
PetscInt l = m;
Mat jac,jac_pre;
PetscFunctionBegin;
if (it < m) l = it;
if (it > 0) {
k = (it - 1) % l;
ierr = VecCopy(D, dF[k]);CHKERRQ(ierr);
ierr = VecAXPY(dF[k], -1.0, Dold);CHKERRQ(ierr);
ierr = VecCopy(X, dX[k]);CHKERRQ(ierr);
ierr = VecAXPY(dX[k], -1.0, Xold);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = VecMDot(dF[k], l, dX, dXtdF);CHKERRQ(ierr);
ierr = VecMDot(dX[k], l, dF, dFtdX);CHKERRQ(ierr);
for (j = 0; j < l; j++) {
H(k, j) = dFtdX[j];
H(j, k) = dXtdF[j];
}
/* copy back over to make the computation of alpha and beta easier */
for (j = 0; j < l; j++) {
dXtdF[j] = H(j, j);
}
} else {
ierr = VecDot(dX[k], dF[k], &dXtdF[k]);CHKERRQ(ierr);
}
if (qn->scale_type == SNES_QN_SCALE_SHANNO) {
PetscReal dFtdF;
ierr = VecDotRealPart(dF[k],dF[k],&dFtdF);CHKERRQ(ierr);
qn->scaling = PetscRealPart(dXtdF[k])/dFtdF;
} else if (qn->scale_type == SNES_QN_SCALE_LINESEARCH) {
ierr = SNESLineSearchGetLambda(snes->linesearch,&qn->scaling);CHKERRQ(ierr);
}
}
ierr = VecCopy(D,Y);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = VecMDot(Y,l,dX,YtdX);CHKERRQ(ierr);
}
/* outward recursion starting at iteration k's update and working back */
for (i=0;i<l;i++) {
k = (it-i-1)%l;
if (qn->singlereduction) {
/* construct t = dX[k] dot Y as Y_0 dot dX[k] + sum(-alpha[j]dX[k]dF[j]) */
t = YtdX[k];
for (j=0;j<i;j++) {
g = (it-j-1)%l;
t += -alpha[g]*H(g, k);
}
alpha[k] = t/H(k,k);
} else {
ierr = VecDot(dX[k],Y,&t);CHKERRQ(ierr);
alpha[k] = t/dXtdF[k];
}
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d alpha: %14.12e\n", it, k, PetscRealPart(alpha[k]));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
ierr = VecAXPY(Y,-alpha[k],dF[k]);CHKERRQ(ierr);
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESGetJacobian(snes, &jac, &jac_pre, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
ierr = KSPSetOperators(snes->ksp,jac,jac_pre,flg);CHKERRQ(ierr);
ierr = SNES_KSPSolve(snes,snes->ksp,Y,W);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
PetscFunctionReturn(0);
}
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = VecCopy(W, Y);CHKERRQ(ierr);
} else {
ierr = VecScale(Y, qn->scaling);CHKERRQ(ierr);
}
if (qn->singlereduction) {
ierr = VecMDot(Y,l,dF,YtdX);CHKERRQ(ierr);
}
/* inward recursion starting at the first update and working forward */
for (i = 0; i < l; i++) {
k = (it + i - l) % l;
if (qn->singlereduction) {
t = YtdX[k];
for (j = 0; j < i; j++) {
g = (it + j - l) % l;
t += (alpha[g] - beta[g])*H(k, g);
}
beta[k] = t / H(k, k);
} else {
ierr = VecDot(dF[k], Y, &t);CHKERRQ(ierr);
beta[k] = t / dXtdF[k];
}
ierr = VecAXPY(Y, (alpha[k] - beta[k]), dX[k]);CHKERRQ(ierr);
if (qn->monitor) {
ierr = PetscViewerASCIIAddTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(qn->monitor, "it: %d k: %d alpha - beta: %14.12e\n", it, k, PetscRealPart(alpha[k] - beta[k]));CHKERRQ(ierr);
ierr = PetscViewerASCIISubtractTab(qn->monitor,((PetscObject)snes)->tablevel+2);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
