static PetscReal LINPACKcgpthy(PetscReal *a,PetscReal *b)
{
/* System generated locals */
PetscReal ret_val,d__1,d__2,d__3;
/* Local variables */
PetscReal p,r,s,t,u;
PetscFunctionBegin;
/* FINDS DSQRT(A**2+B**2) WITHOUT OVERFLOW OR DESTRUCTIVE UNDERFLOW */
/* Computing MAX */
d__1 = PetscAbsReal(*a);
d__2 = PetscAbsReal(*b);
p = PetscMax(d__1,d__2);
if (!p) goto L20;
/* Computing MIN */
d__2 = PetscAbsReal(*a);
d__3 = PetscAbsReal(*b);
/* Computing 2nd power */
d__1 = PetscMin(d__2,d__3) / p;
r = d__1 * d__1;
L10:
t = r + 4.;
if (t == 4.) goto L20;
s = r / t;
u = s * 2. + 1.;
p = u * p;
/* Computing 2nd power */
d__1 = s / u;
r = d__1 * d__1 * r;
goto L10;
L20:
ret_val = p;
PetscFunctionReturn(ret_val);
} /* cgpthy_ */
PetscErrorCode KSPView_FCG(KSP ksp,PetscViewer viewer)
{
KSP_FCG *fcg = (KSP_FCG*)ksp->data;
PetscErrorCode ierr;
PetscBool iascii,isstring;
const char *truncstr;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERSTRING,&isstring);CHKERRQ(ierr);
if (fcg->truncstrat == KSP_FCG_TRUNC_TYPE_STANDARD) truncstr = "Using standard truncation strategy";
else if (fcg->truncstrat == KSP_FCG_TRUNC_TYPE_NOTAY) truncstr = "Using Notay's truncation strategy";
else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Undefined FCG truncation strategy");
if (iascii) {
ierr = PetscViewerASCIIPrintf(viewer," FCG: m_max=%D\n",fcg->mmax);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," FCG: preallocated %D directions\n",PetscMin(fcg->nprealloc,fcg->mmax+1));CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," FCG: %s\n",truncstr);CHKERRQ(ierr);
} else if (isstring) {
ierr = PetscViewerStringSPrintf(viewer,"m_max %D nprealloc %D %s",fcg->mmax,fcg->nprealloc,truncstr);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode VecPointwiseMin_Seq(Vec win,Vec xin,Vec yin)
{
Vec_Seq *w = (Vec_Seq *)win->data;
PetscErrorCode ierr;
PetscInt n = win->map->n,i;
PetscScalar *ww = w->array,*xx,*yy;
PetscFunctionBegin;
ierr = VecGetArray(xin,&xx);CHKERRQ(ierr);
if (xin != yin) {
ierr = VecGetArray(yin,&yy);CHKERRQ(ierr);
} else {
yy = xx;
}
for (i=0; i<n; i++) {
ww[i] = PetscMin(PetscRealPart(xx[i]),PetscRealPart(yy[i]));
}
ierr = VecRestoreArray(xin,&xx);CHKERRQ(ierr);
if (xin != yin) {
ierr = VecRestoreArray(yin,&yy);CHKERRQ(ierr);
}
ierr = PetscLogFlops(n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TaoLineSearchApply_MT(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
PetscErrorCode ierr;
TaoLineSearch_MT *mt;
PetscReal xtrapf = 4.0;
PetscReal finit, width, width1, dginit, fm, fxm, fym, dgm, dgxm, dgym;
PetscReal dgx, dgy, dg, dg2, fx, fy, stx, sty, dgtest;
PetscReal ftest1=0.0, ftest2=0.0;
PetscInt i, stage1,n1,n2,nn1,nn2;
PetscReal bstepmin1, bstepmin2, bstepmax;
PetscBool g_computed=PETSC_FALSE; /* to prevent extra gradient computation */
PetscFunctionBegin;
PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
PetscValidHeaderSpecific(x,VEC_CLASSID,2);
PetscValidScalarPointer(f,3);
PetscValidHeaderSpecific(g,VEC_CLASSID,4);
PetscValidHeaderSpecific(s,VEC_CLASSID,5);
/* comm,type,size checks are done in interface TaoLineSearchApply */
mt = (TaoLineSearch_MT*)(ls->data);
ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
/* Check work vector */
if (!mt->work) {
ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
mt->x = x;
ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
} else if (x != mt->x) {
ierr = VecDestroy(&mt->work);CHKERRQ(ierr);
ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)mt->x);CHKERRQ(ierr);
mt->x = x;
ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
}
if (ls->bounded) {
/* Compute step length needed to make all variables equal a bound */
/* Compute the smallest steplength that will make one nonbinding variable
equal the bound */
ierr = VecGetLocalSize(ls->upper,&n1);CHKERRQ(ierr);
ierr = VecGetLocalSize(mt->x, &n2);CHKERRQ(ierr);
ierr = VecGetSize(ls->upper,&nn1);CHKERRQ(ierr);
ierr = VecGetSize(mt->x,&nn2);CHKERRQ(ierr);
if (n1 != n2 || nn1 != nn2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Variable vector not compatible with bounds vector");
ierr = VecScale(s,-1.0);CHKERRQ(ierr);
ierr = VecBoundGradientProjection(s,x,ls->lower,ls->upper,s);CHKERRQ(ierr);
ierr = VecScale(s,-1.0);CHKERRQ(ierr);
ierr = VecStepBoundInfo(x,s,ls->lower,ls->upper,&bstepmin1,&bstepmin2,&bstepmax);CHKERRQ(ierr);
ls->stepmax = PetscMin(bstepmax,1.0e15);
}
ierr = VecDot(g,s,&dginit);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(dginit)) {
ierr = PetscInfo1(ls,"Initial Line Search step * g is Inf or Nan (%g)\n",(double)dginit);CHKERRQ(ierr);
ls->reason=TAOLINESEARCH_FAILED_INFORNAN;
PetscFunctionReturn(0);
}
if (dginit >= 0.0) {
ierr = PetscInfo1(ls,"Initial Line Search step * g is not descent direction (%g)\n",(double)dginit);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_FAILED_ASCENT;
PetscFunctionReturn(0);
}
/* Initialization */
mt->bracket = 0;
stage1 = 1;
finit = *f;
dgtest = ls->ftol * dginit;
width = ls->stepmax - ls->stepmin;
width1 = width * 2.0;
ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
/* Variable dictionary:
stx, fx, dgx - the step, function, and derivative at the best step
sty, fy, dgy - the step, function, and derivative at the other endpoint
of the interval of uncertainty
step, f, dg - the step, function, and derivative at the current step */
stx = 0.0;
fx = finit;
dgx = dginit;
sty = 0.0;
fy = finit;
dgy = dginit;
ls->step=ls->initstep;
for (i=0; i< ls->max_funcs; i++) {
/* Set min and max steps to correspond to the interval of uncertainty */
if (mt->bracket) {
ls->stepmin = PetscMin(stx,sty);
ls->stepmax = PetscMax(stx,sty);
} else {
ls->stepmin = stx;
ls->stepmax = ls->step + xtrapf * (ls->step - stx);
}
/* Force the step to be within the bounds */
ls->step = PetscMax(ls->step,ls->stepmin);
ls->step = PetscMin(ls->step,ls->stepmax);
/* If an unusual termination is to occur, then let step be the lowest
point obtained thus far */
if ((stx!=0) && (((mt->bracket) && (ls->step <= ls->stepmin || ls->step >= ls->stepmax)) || ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol * ls->stepmax)) ||
((ls->nfeval+ls->nfgeval) >= ls->max_funcs - 1) || (mt->infoc == 0))) {
ls->step = stx;
}
ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
ierr = VecAXPY(mt->work,ls->step,s);CHKERRQ(ierr); /* W = X + step*S */
if (ls->bounded) {
ierr = VecMedian(ls->lower, mt->work, ls->upper, mt->work);CHKERRQ(ierr);
}
if (ls->usegts) {
ierr = TaoLineSearchComputeObjectiveAndGTS(ls,mt->work,f,&dg);CHKERRQ(ierr);
g_computed=PETSC_FALSE;
} else {
ierr = TaoLineSearchComputeObjectiveAndGradient(ls,mt->work,f,g);CHKERRQ(ierr);
g_computed=PETSC_TRUE;
if (ls->bounded) {
ierr = VecDot(g,x,&dg);CHKERRQ(ierr);
ierr = VecDot(g,mt->work,&dg2);CHKERRQ(ierr);
dg = (dg2 - dg)/ls->step;
} else {
ierr = VecDot(g,s,&dg);CHKERRQ(ierr);
}
}
if (0 == i) {
ls->f_fullstep=*f;
}
if (PetscIsInfOrNanReal(*f) || PetscIsInfOrNanReal(dg)) {
/* User provided compute function generated Not-a-Number, assume
domain violation and set function value and directional
derivative to infinity. */
*f = PETSC_INFINITY;
dg = PETSC_INFINITY;
}
ftest1 = finit + ls->step * dgtest;
if (ls->bounded) {
ftest2 = finit + ls->step * dgtest * ls->ftol;
}
/* Convergence testing */
if (((*f - ftest1 <= 1.0e-10 * PetscAbsReal(finit)) && (PetscAbsReal(dg) + ls->gtol*dginit <= 0.0))) {
ierr = PetscInfo(ls, "Line search success: Sufficient decrease and directional deriv conditions hold\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_SUCCESS;
break;
}
/* Check Armijo if beyond the first breakpoint */
if (ls->bounded && (*f <= ftest2) && (ls->step >= bstepmin2)) {
ierr = PetscInfo(ls,"Line search success: Sufficient decrease.\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_SUCCESS;
break;
}
/* Checks for bad cases */
if (((mt->bracket) && (ls->step <= ls->stepmin||ls->step >= ls->stepmax)) || (!mt->infoc)) {
ierr = PetscInfo(ls,"Rounding errors may prevent further progress. May not be a step satisfying\n");CHKERRQ(ierr);
ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_OTHER;
break;
}
if ((ls->step == ls->stepmax) && (*f <= ftest1) && (dg <= dgtest)) {
ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
break;
}
if ((ls->step == ls->stepmin) && (*f >= ftest1) && (dg >= dgtest)) {
ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
break;
}
if ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_RTOL;
break;
}
/* In the first stage, we seek a step for which the modified function
has a nonpositive value and nonnegative derivative */
if ((stage1) && (*f <= ftest1) && (dg >= dginit * PetscMin(ls->ftol, ls->gtol))) {
stage1 = 0;
}
/* A modified function is used to predict the step only if we
have not obtained a step for which the modified function has a
nonpositive function value and nonnegative derivative, and if a
lower function value has been obtained but the decrease is not
sufficient */
if ((stage1) && (*f <= fx) && (*f > ftest1)) {
fm = *f - ls->step * dgtest; /* Define modified function */
fxm = fx - stx * dgtest; /* and derivatives */
fym = fy - sty * dgtest;
dgm = dg - dgtest;
dgxm = dgx - dgtest;
dgym = dgy - dgtest;
/* if (dgxm * (ls->step - stx) >= 0.0) */
/* Update the interval of uncertainty and compute the new step */
ierr = Tao_mcstep(ls,&stx,&fxm,&dgxm,&sty,&fym,&dgym,&ls->step,&fm,&dgm);CHKERRQ(ierr);
fx = fxm + stx * dgtest; /* Reset the function and */
fy = fym + sty * dgtest; /* gradient values */
dgx = dgxm + dgtest;
dgy = dgym + dgtest;
} else {
/* Update the interval of uncertainty and compute the new step */
ierr = Tao_mcstep(ls,&stx,&fx,&dgx,&sty,&fy,&dgy,&ls->step,f,&dg);CHKERRQ(ierr);
}
/* Force a sufficient decrease in the interval of uncertainty */
if (mt->bracket) {
if (PetscAbsReal(sty - stx) >= 0.66 * width1) ls->step = stx + 0.5*(sty - stx);
width1 = width;
width = PetscAbsReal(sty - stx);
}
}
if ((ls->nfeval+ls->nfgeval) > ls->max_funcs) {
ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",(ls->nfeval+ls->nfgeval),ls->max_funcs);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
}
/* Finish computations */
ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",(ls->nfeval+ls->nfgeval),(double)ls->step);CHKERRQ(ierr);
/* Set new solution vector and compute gradient if needed */
ierr = VecCopy(mt->work,x);CHKERRQ(ierr);
if (!g_computed) {
ierr = TaoLineSearchComputeGradient(ls,mt->work,g);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main( int argc, char **argv )
{
PetscErrorCode ierr;
Mat A; /* Grcar matrix */
SVD svd; /* singular value solver context */
PetscInt N=30, Istart, Iend, i, col[5], nconv1, nconv2;
PetscScalar value[] = { -1, 1, 1, 1, 1 };
PetscReal sigma_1, sigma_n;
SlepcInitialize(&argc,&argv,(char*)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nEstimate the condition number of a Grcar matrix, n=%d\n\n",N);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Generate the matrix
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,N,N);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for( i=Istart; i<Iend; i++ ) {
col[0]=i-1; col[1]=i; col[2]=i+1; col[3]=i+2; col[4]=i+3;
if (i==0) {
ierr = MatSetValues(A,1,&i,4,col+1,value+1,INSERT_VALUES);CHKERRQ(ierr);
}
else {
ierr = MatSetValues(A,1,&i,PetscMin(5,N-i+1),col,value,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the singular value solver and set the solution method
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create singular value context
*/
ierr = SVDCreate(PETSC_COMM_WORLD,&svd);CHKERRQ(ierr);
/*
Set operator
*/
ierr = SVDSetOperator(svd,A);CHKERRQ(ierr);
/*
Set solver parameters at runtime
*/
ierr = SVDSetFromOptions(svd);CHKERRQ(ierr);
ierr = SVDSetDimensions(svd,1,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the eigensystem
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
First request an eigenvalue from one end of the spectrum
*/
ierr = SVDSetWhichSingularTriplets(svd,SVD_LARGEST);CHKERRQ(ierr);
ierr = SVDSolve(svd);CHKERRQ(ierr);
/*
Get number of converged singular values
*/
ierr = SVDGetConverged(svd,&nconv1);CHKERRQ(ierr);
/*
Get converged singular values: largest singular value is stored in sigma_1.
In this example, we are not interested in the singular vectors
*/
if (nconv1 > 0) {
ierr = SVDGetSingularTriplet(svd,0,&sigma_1,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD," Unable to compute large singular value!\n\n");CHKERRQ(ierr);
}
/*
Request an eigenvalue from the other end of the spectrum
*/
ierr = SVDSetWhichSingularTriplets(svd,SVD_SMALLEST);CHKERRQ(ierr);
ierr = SVDSolve(svd);CHKERRQ(ierr);
/*
Get number of converged eigenpairs
*/
ierr = SVDGetConverged(svd,&nconv2);CHKERRQ(ierr);
/*
Get converged singular values: smallest singular value is stored in sigma_n.
As before, we are not interested in the singular vectors
*/
if (nconv2 > 0) {
ierr = SVDGetSingularTriplet(svd,0,&sigma_n,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD," Unable to compute small singular value!\n\n");CHKERRQ(ierr);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Display solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
if (nconv1 > 0 && nconv2 > 0) {
ierr = PetscPrintf(PETSC_COMM_WORLD," Computed singular values: sigma_1=%6f, sigma_n=%6f\n",sigma_1,sigma_n);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Estimated condition number: sigma_1/sigma_n=%6f\n\n",sigma_1/sigma_n);CHKERRQ(ierr);
}
/*
Free work space
*/
ierr = SVDDestroy(svd);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = SlepcFinalize();CHKERRQ(ierr);
return 0;
}
PetscErrorCode KSPFGMRESCycle(PetscInt *itcount,KSP ksp)
{
KSP_FGMRES *fgmres = (KSP_FGMRES*)(ksp->data);
PetscReal res_norm;
PetscReal hapbnd,tt;
PetscBool hapend = PETSC_FALSE; /* indicates happy breakdown ending */
PetscErrorCode ierr;
PetscInt loc_it; /* local count of # of dir. in Krylov space */
PetscInt max_k = fgmres->max_k; /* max # of directions Krylov space */
Mat Amat,Pmat;
MatStructure pflag;
PetscFunctionBegin;
/* Number of pseudo iterations since last restart is the number
of prestart directions */
loc_it = 0;
/* note: (fgmres->it) is always set one less than (loc_it) It is used in
KSPBUILDSolution_FGMRES, where it is passed to KSPFGMRESBuildSoln.
Note that when KSPFGMRESBuildSoln is called from this function,
(loc_it -1) is passed, so the two are equivalent */
fgmres->it = (loc_it - 1);
/* initial residual is in VEC_VV(0) - compute its norm*/
ierr = VecNorm(VEC_VV(0),NORM_2,&res_norm);CHKERRQ(ierr);
/* first entry in right-hand-side of hessenberg system is just
the initial residual norm */
*RS(0) = res_norm;
ksp->rnorm = res_norm;
ierr = KSPLogResidualHistory(ksp,res_norm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,res_norm);CHKERRQ(ierr);
/* check for the convergence - maybe the current guess is good enough */
ierr = (*ksp->converged)(ksp,ksp->its,res_norm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) {
if (itcount) *itcount = 0;
PetscFunctionReturn(0);
}
/* scale VEC_VV (the initial residual) */
ierr = VecScale(VEC_VV(0),1.0/res_norm);CHKERRQ(ierr);
/* MAIN ITERATION LOOP BEGINNING*/
/* keep iterating until we have converged OR generated the max number
of directions OR reached the max number of iterations for the method */
while (!ksp->reason && loc_it < max_k && ksp->its < ksp->max_it) {
if (loc_it) {
ierr = KSPLogResidualHistory(ksp,res_norm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,ksp->its,res_norm);CHKERRQ(ierr);
}
fgmres->it = (loc_it - 1);
/* see if more space is needed for work vectors */
if (fgmres->vv_allocated <= loc_it + VEC_OFFSET + 1) {
ierr = KSPFGMRESGetNewVectors(ksp,loc_it+1);CHKERRQ(ierr);
/* (loc_it+1) is passed in as number of the first vector that should
be allocated */
}
/* CHANGE THE PRECONDITIONER? */
/* ModifyPC is the callback function that can be used to
change the PC or its attributes before its applied */
(*fgmres->modifypc)(ksp,ksp->its,loc_it,res_norm,fgmres->modifyctx);
/* apply PRECONDITIONER to direction vector and store with
preconditioned vectors in prevec */
ierr = KSP_PCApply(ksp,VEC_VV(loc_it),PREVEC(loc_it));CHKERRQ(ierr);
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
/* Multiply preconditioned vector by operator - put in VEC_VV(loc_it+1) */
ierr = MatMult(Amat,PREVEC(loc_it),VEC_VV(1+loc_it));CHKERRQ(ierr);
/* update hessenberg matrix and do Gram-Schmidt - new direction is in
VEC_VV(1+loc_it)*/
ierr = (*fgmres->orthog)(ksp,loc_it);CHKERRQ(ierr);
/* new entry in hessenburg is the 2-norm of our new direction */
ierr = VecNorm(VEC_VV(loc_it+1),NORM_2,&tt);CHKERRQ(ierr);
*HH(loc_it+1,loc_it) = tt;
*HES(loc_it+1,loc_it) = tt;
/* Happy Breakdown Check */
hapbnd = PetscAbsScalar((tt) / *RS(loc_it));
/* RS(loc_it) contains the res_norm from the last iteration */
hapbnd = PetscMin(fgmres->haptol,hapbnd);
if (tt > hapbnd) {
/* scale new direction by its norm */
ierr = VecScale(VEC_VV(loc_it+1),1.0/tt);CHKERRQ(ierr);
} else {
/* This happens when the solution is exactly reached. */
/* So there is no new direction... */
ierr = VecSet(VEC_TEMP,0.0);CHKERRQ(ierr); /* set VEC_TEMP to 0 */
hapend = PETSC_TRUE;
}
/* note that for FGMRES we could get HES(loc_it+1, loc_it) = 0 and the
current solution would not be exact if HES was singular. Note that
HH non-singular implies that HES is no singular, and HES is guaranteed
to be nonsingular when PREVECS are linearly independent and A is
nonsingular (in GMRES, the nonsingularity of A implies the nonsingularity
of HES). So we should really add a check to verify that HES is nonsingular.*/
/* Now apply rotations to new col of hessenberg (and right side of system),
calculate new rotation, and get new residual norm at the same time*/
ierr = KSPFGMRESUpdateHessenberg(ksp,loc_it,hapend,&res_norm);CHKERRQ(ierr);
if (ksp->reason) break;
loc_it++;
fgmres->it = (loc_it-1); /* Add this here in case it has converged */
ierr = PetscObjectSAWsTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = res_norm;
ierr = PetscObjectSAWsGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,ksp->its,res_norm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
/* Catch error in happy breakdown and signal convergence and break from loop */
if (hapend) {
if (!ksp->reason) {
if (ksp->errorifnotconverged) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_NOT_CONVERGED,"You reached the happy break down, but convergence was not indicated. Residual norm = %G",res_norm);
else {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
}
}
}
/* END OF ITERATION LOOP */
ierr = KSPLogResidualHistory(ksp,res_norm);CHKERRQ(ierr);
/*
Monitor if we know that we will not return for a restart */
if (loc_it && (ksp->reason || ksp->its >= ksp->max_it)) {
ierr = KSPMonitor(ksp,ksp->its,res_norm);CHKERRQ(ierr);
}
if (itcount) *itcount = loc_it;
/*
Down here we have to solve for the "best" coefficients of the Krylov
columns, add the solution values together, and possibly unwind the
preconditioning from the solution
*/
/* Form the solution (or the solution so far) */
/* Note: must pass in (loc_it-1) for iteration count so that KSPFGMRESBuildSoln
properly navigates */
ierr = KSPFGMRESBuildSoln(RS(0),ksp->vec_sol,ksp->vec_sol,ksp,loc_it-1);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
FormInitialGuess - Forms initial approximation.
Input Parameters:
user - user-defined application context
X - vector
Output Parameter:
X - vector
*/
int FormInitialGuess(AppCtx *user,Vec X)
{
int i,j,row,mx,my,ierr;
PetscReal one = 1.0,lambda,temp1,temp,hx,hy,hxdhy,hydhx,sc;
PetscScalar *x;
/*
Process 0 has to wait for all other processes to get here
before proceeding to write in the shared vector
*/
ierr = PetscBarrier((PetscObject)X);CHKERRQ(ierr);
if (user->rank) {
/*
All the non-busy processors have to wait here for process 0 to finish
evaluating the function; otherwise they will start using the vector values
before they have been computed
*/
ierr = PetscBarrier((PetscObject)X);CHKERRQ(ierr);
return 0;
}
mx = user->mx; my = user->my; lambda = user->param;
hx = one/(PetscReal)(mx-1); hy = one/(PetscReal)(my-1);
sc = hx*hy*lambda; hxdhy = hx/hy; hydhx = hy/hx;
temp1 = lambda/(lambda + one);
/*
Get a pointer to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
/*
Compute initial guess over the locally owned part of the grid
*/
#pragma arl(4)
#pragma distinct (*x,*f)
#pragma no side effects (sqrt)
for (j=0; j<my; j++) {
temp = (PetscReal)(PetscMin(j,my-j-1))*hy;
for (i=0; i<mx; i++) {
row = i + j*mx;
if (i == 0 || j == 0 || i == mx-1 || j == my-1) {
x[row] = 0.0;
continue;
}
x[row] = temp1*PetscSqrtReal(PetscMin((PetscReal)(PetscMin(i,mx-i-1))*hx,temp));
}
}
/*
Restore vector
*/
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
ierr = PetscBarrier((PetscObject)X);CHKERRQ(ierr);
return 0;
}
PetscErrorCode VecView_MPI_Draw_DA1d(Vec xin,PetscViewer v)
{
DM da;
PetscErrorCode ierr;
PetscMPIInt rank,size,tag1,tag2;
PetscInt i,n,N,step,istart,isize,j,nbounds;
MPI_Status status;
PetscReal coors[4],ymin,ymax,min,max,xmin = 0.0,xmax = 0.0,tmp = 0.0,xgtmp = 0.0;
const PetscScalar *array,*xg;
PetscDraw draw;
PetscBool isnull,showpoints = PETSC_FALSE;
MPI_Comm comm;
PetscDrawAxis axis;
Vec xcoor;
DMBoundaryType bx;
const PetscReal *bounds;
PetscInt *displayfields;
PetscInt k,ndisplayfields;
PetscBool hold;
PetscFunctionBegin;
ierr = PetscViewerDrawGetDraw(v,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); if (isnull) PetscFunctionReturn(0);
ierr = PetscViewerDrawGetBounds(v,&nbounds,&bounds);CHKERRQ(ierr);
ierr = VecGetDM(xin,&da);CHKERRQ(ierr);
if (!da) SETERRQ(PetscObjectComm((PetscObject)xin),PETSC_ERR_ARG_WRONG,"Vector not generated from a DMDA");
ierr = PetscOptionsGetBool(NULL,"-draw_vec_mark_points",&showpoints,NULL);CHKERRQ(ierr);
ierr = DMDAGetInfo(da,0,&N,0,0,0,0,0,&step,0,&bx,0,0,0);CHKERRQ(ierr);
ierr = DMDAGetCorners(da,&istart,0,0,&isize,0,0);CHKERRQ(ierr);
ierr = VecGetArrayRead(xin,&array);CHKERRQ(ierr);
ierr = VecGetLocalSize(xin,&n);CHKERRQ(ierr);
n = n/step;
/* get coordinates of nodes */
ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr);
if (!xcoor) {
ierr = DMDASetUniformCoordinates(da,0.0,1.0,0.0,0.0,0.0,0.0);CHKERRQ(ierr);
ierr = DMGetCoordinates(da,&xcoor);CHKERRQ(ierr);
}
ierr = VecGetArrayRead(xcoor,&xg);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)xin,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
/*
Determine the min and max x coordinate in plot
*/
if (!rank) {
xmin = PetscRealPart(xg[0]);
}
if (rank == size-1) {
xmax = PetscRealPart(xg[n-1]);
}
ierr = MPI_Bcast(&xmin,1,MPIU_REAL,0,comm);CHKERRQ(ierr);
ierr = MPI_Bcast(&xmax,1,MPIU_REAL,size-1,comm);CHKERRQ(ierr);
ierr = DMDASelectFields(da,&ndisplayfields,&displayfields);CHKERRQ(ierr);
for (k=0; k<ndisplayfields; k++) {
j = displayfields[k];
ierr = PetscViewerDrawGetDraw(v,k,&draw);CHKERRQ(ierr);
ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr);
/*
Determine the min and max y coordinate in plot
*/
min = 1.e20; max = -1.e20;
for (i=0; i<n; i++) {
if (PetscRealPart(array[j+i*step]) < min) min = PetscRealPart(array[j+i*step]);
if (PetscRealPart(array[j+i*step]) > max) max = PetscRealPart(array[j+i*step]);
}
if (min + 1.e-10 > max) {
min -= 1.e-5;
max += 1.e-5;
}
if (j < nbounds) {
min = PetscMin(min,bounds[2*j]);
max = PetscMax(max,bounds[2*j+1]);
}
ierr = MPI_Reduce(&min,&ymin,1,MPIU_REAL,MPIU_MIN,0,comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&max,&ymax,1,MPIU_REAL,MPIU_MAX,0,comm);CHKERRQ(ierr);
ierr = PetscViewerDrawGetHold(v,&hold);CHKERRQ(ierr);
if (!hold) {
ierr = PetscDrawSynchronizedClear(draw);CHKERRQ(ierr);
}
ierr = PetscViewerDrawGetDrawAxis(v,k,&axis);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)draw,(PetscObject)axis);CHKERRQ(ierr);
if (!rank) {
const char *title;
ierr = PetscDrawAxisSetLimits(axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(axis);CHKERRQ(ierr);
ierr = PetscDrawGetCoordinates(draw,coors,coors+1,coors+2,coors+3);CHKERRQ(ierr);
ierr = DMDAGetFieldName(da,j,&title);CHKERRQ(ierr);
if (title) {ierr = PetscDrawSetTitle(draw,title);CHKERRQ(ierr);}
}
ierr = MPI_Bcast(coors,4,MPIU_REAL,0,comm);CHKERRQ(ierr);
if (rank) {
ierr = PetscDrawSetCoordinates(draw,coors[0],coors[1],coors[2],coors[3]);CHKERRQ(ierr);
}
/* draw local part of vector */
ierr = PetscObjectGetNewTag((PetscObject)xin,&tag1);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)xin,&tag2);CHKERRQ(ierr);
if (rank < size-1) { /*send value to right */
ierr = MPI_Send((void*)&array[j+(n-1)*step],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr);
ierr = MPI_Send((void*)&xg[n-1],1,MPIU_REAL,rank+1,tag1,comm);CHKERRQ(ierr);
}
if (!rank && bx == DM_BOUNDARY_PERIODIC && size > 1) { /* first processor sends first value to last */
ierr = MPI_Send((void*)&array[j],1,MPIU_REAL,size-1,tag2,comm);CHKERRQ(ierr);
}
for (i=1; i<n; i++) {
ierr = PetscDrawLine(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PetscRealPart(xg[i]),PetscRealPart(array[j+step*i]),PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,PetscRealPart(xg[i-1]),PetscRealPart(array[j+step*(i-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
if (rank) { /* receive value from left */
ierr = MPI_Recv(&tmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr);
ierr = MPI_Recv(&xgtmp,1,MPIU_REAL,rank-1,tag1,comm,&status);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,xgtmp,tmp,PetscRealPart(xg[0]),PetscRealPart(array[j]),PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,xgtmp,tmp,PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
if (rank == size-1 && bx == DM_BOUNDARY_PERIODIC && size > 1) {
ierr = MPI_Recv(&tmp,1,MPIU_REAL,0,tag2,comm,&status);CHKERRQ(ierr);
/* If the mesh is not uniform we do not know the mesh spacing between the last point on the right and the first ghost point */
ierr = PetscDrawLine(draw,PetscRealPart(xg[n-1]),PetscRealPart(array[j+step*(n-1)]),PetscRealPart(xg[n-1]+(xg[n-1]-xg[n-2])),tmp,PETSC_DRAW_RED);CHKERRQ(ierr);
if (showpoints) {
ierr = PetscDrawPoint(draw,PetscRealPart(xg[n-2]),PetscRealPart(array[j+step*(n-1)]),PETSC_DRAW_BLACK);CHKERRQ(ierr);
}
}
ierr = PetscDrawSynchronizedFlush(draw);CHKERRQ(ierr);
ierr = PetscDrawPause(draw);CHKERRQ(ierr);
}
ierr = PetscFree(displayfields);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xcoor,&xg);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(xin,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMPlexVTKWriteCells_ASCII(DM dm, FILE *fp, PetscInt *totalCells)
{
MPI_Comm comm;
DMLabel label;
IS globalVertexNumbers = NULL;
const PetscInt *gvertex;
PetscInt dim;
PetscInt numCorners = 0, totCorners = 0, maxCorners, *corners;
PetscInt numCells = 0, totCells = 0, maxCells, cellHeight;
PetscInt numLabelCells, maxLabelCells, cMax, cStart, cEnd, c, vStart, vEnd, v;
PetscMPIInt numProcs, rank, proc, tag;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscCommGetNewTag(comm, &tag);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
ierr = DMPlexGetLabel(dm, "vtk", &label);CHKERRQ(ierr);
ierr = DMPlexGetStratumSize(dm, "vtk", 1, &numLabelCells);CHKERRQ(ierr);
ierr = MPI_Allreduce(&numLabelCells, &maxLabelCells, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
if (!maxLabelCells) label = NULL;
for (c = cStart; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) ++numCorners;
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
++numCells;
}
maxCells = numCells;
ierr = MPI_Reduce(&numCells, &totCells, 1, MPIU_INT, MPI_SUM, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCells, &maxCells, 1, MPIU_INT, MPI_MAX, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCorners, &totCorners, 1, MPIU_INT, MPI_SUM, 0, comm);CHKERRQ(ierr);
ierr = MPI_Reduce(&numCorners, &maxCorners, 1, MPIU_INT, MPI_MAX, 0, comm);CHKERRQ(ierr);
ierr = DMPlexGetVertexNumbering(dm, &globalVertexNumbers);CHKERRQ(ierr);
ierr = ISGetIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
ierr = PetscMalloc1(maxCells, &corners);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "CELLS %d %d\n", totCells, totCorners+totCells);CHKERRQ(ierr);
if (!rank) {
PetscInt *remoteVertices;
int *vertices;
ierr = PetscMalloc1(maxCorners, &vertices);CHKERRQ(ierr);
for (c = cStart, numCells = 0; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value, nC = 0;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) {
const PetscInt gv = gvertex[closure[v] - vStart];
vertices[nC++] = gv < 0 ? -(gv+1) : gv;
}
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
corners[numCells++] = nC;
ierr = PetscFPrintf(comm, fp, "%d ", nC);CHKERRQ(ierr);
ierr = DMPlexInvertCell(dim, nC, vertices);CHKERRQ(ierr);
for (v = 0; v < nC; ++v) {
ierr = PetscFPrintf(comm, fp, " %d", vertices[v]);CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
if (numProcs > 1) {ierr = PetscMalloc1(maxCorners+maxCells, &remoteVertices);CHKERRQ(ierr);}
for (proc = 1; proc < numProcs; ++proc) {
MPI_Status status;
ierr = MPI_Recv(&numCorners, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
ierr = MPI_Recv(remoteVertices, numCorners, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
for (c = 0; c < numCorners;) {
PetscInt nC = remoteVertices[c++];
for (v = 0; v < nC; ++v, ++c) {
vertices[v] = remoteVertices[c];
}
ierr = DMPlexInvertCell(dim, nC, vertices);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d ", nC);CHKERRQ(ierr);
for (v = 0; v < nC; ++v) {
ierr = PetscFPrintf(comm, fp, " %d", vertices[v]);CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
}
if (numProcs > 1) {ierr = PetscFree(remoteVertices);CHKERRQ(ierr);}
ierr = PetscFree(vertices);CHKERRQ(ierr);
} else {
PetscInt *localVertices, numSend = numCells+numCorners, k = 0;
ierr = PetscMalloc1(numSend, &localVertices);CHKERRQ(ierr);
for (c = cStart, numCells = 0; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize, value, nC = 0;
if (label) {
ierr = DMLabelGetValue(label, c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) {
const PetscInt gv = gvertex[closure[v] - vStart];
closure[nC++] = gv < 0 ? -(gv+1) : gv;
}
}
corners[numCells++] = nC;
localVertices[k++] = nC;
for (v = 0; v < nC; ++v, ++k) {
localVertices[k] = closure[v];
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
}
if (k != numSend) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB, "Invalid number of vertices to send %d should be %d", k, numSend);
ierr = MPI_Send(&numSend, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = MPI_Send(localVertices, numSend, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = PetscFree(localVertices);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(globalVertexNumbers, &gvertex);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "CELL_TYPES %d\n", totCells);CHKERRQ(ierr);
if (!rank) {
PetscInt cellType;
for (c = 0; c < numCells; ++c) {
ierr = DMPlexVTKGetCellType(dm, dim, corners[c], &cellType);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d\n", cellType);CHKERRQ(ierr);
}
for (proc = 1; proc < numProcs; ++proc) {
MPI_Status status;
ierr = MPI_Recv(&numCells, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
ierr = MPI_Recv(corners, numCells, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
for (c = 0; c < numCells; ++c) {
ierr = DMPlexVTKGetCellType(dm, dim, corners[c], &cellType);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "%d\n", cellType);CHKERRQ(ierr);
}
}
} else {
ierr = MPI_Send(&numCells, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = MPI_Send(corners, numCells, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
}
ierr = PetscFree(corners);CHKERRQ(ierr);
*totalCells = totCells;
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatISSetMPIXAIJPreallocation_Private(Mat A, Mat B, PetscBool maxreduce)
{
Mat_IS *matis = (Mat_IS*)(A->data);
PetscInt *my_dnz,*my_onz,*dnz,*onz,*mat_ranges,*row_ownership;
const PetscInt *global_indices_r,*global_indices_c;
PetscInt i,j,bs,rows,cols;
PetscInt lrows,lcols;
PetscInt local_rows,local_cols;
PetscMPIInt nsubdomains;
PetscBool isdense,issbaij;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)A),&nsubdomains);CHKERRQ(ierr);
ierr = MatGetSize(A,&rows,&cols);CHKERRQ(ierr);
ierr = MatGetBlockSize(A,&bs);CHKERRQ(ierr);
ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingGetIndices(A->rmap->mapping,&global_indices_r);CHKERRQ(ierr);
if (A->rmap->mapping != A->cmap->mapping) {
ierr = ISLocalToGlobalMappingGetIndices(A->rmap->mapping,&global_indices_c);CHKERRQ(ierr);
} else {
global_indices_c = global_indices_r;
}
if (issbaij) {
ierr = MatGetRowUpperTriangular(matis->A);CHKERRQ(ierr);
}
/*
An SF reduce is needed to sum up properly on shared rows.
Note that generally preallocation is not exact, since it overestimates nonzeros
*/
if (!matis->sf) { /* setup SF if not yet created and allocate rootdata and leafdata */
ierr = MatISComputeSF_Private(A);CHKERRQ(ierr);
}
ierr = MatGetLocalSize(A,&lrows,&lcols);CHKERRQ(ierr);
ierr = MatPreallocateInitialize(PetscObjectComm((PetscObject)A),lrows,lcols,dnz,onz);CHKERRQ(ierr);
/* All processes need to compute entire row ownership */
ierr = PetscMalloc1(rows,&row_ownership);CHKERRQ(ierr);
ierr = MatGetOwnershipRanges(A,(const PetscInt**)&mat_ranges);CHKERRQ(ierr);
for (i=0;i<nsubdomains;i++) {
for (j=mat_ranges[i];j<mat_ranges[i+1];j++) {
row_ownership[j] = i;
}
}
/*
my_dnz and my_onz contains exact contribution to preallocation from each local mat
then, they will be summed up properly. This way, preallocation is always sufficient
*/
ierr = PetscCalloc2(local_rows,&my_dnz,local_rows,&my_onz);CHKERRQ(ierr);
/* preallocation as a MATAIJ */
if (isdense) { /* special case for dense local matrices */
for (i=0;i<local_rows;i++) {
PetscInt index_row = global_indices_r[i];
for (j=i;j<local_rows;j++) {
PetscInt owner = row_ownership[index_row];
PetscInt index_col = global_indices_c[j];
if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
my_dnz[i] += 1;
} else { /* offdiag block */
my_onz[i] += 1;
}
/* same as before, interchanging rows and cols */
if (i != j) {
owner = row_ownership[index_col];
if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
my_dnz[j] += 1;
} else {
my_onz[j] += 1;
}
}
}
}
} else { /* TODO: this could be optimized using MatGetRowIJ */
for (i=0;i<local_rows;i++) {
const PetscInt *cols;
PetscInt ncols,index_row = global_indices_r[i];
ierr = MatGetRow(matis->A,i,&ncols,&cols,NULL);CHKERRQ(ierr);
for (j=0;j<ncols;j++) {
PetscInt owner = row_ownership[index_row];
PetscInt index_col = global_indices_c[cols[j]];
if (index_col > mat_ranges[owner]-1 && index_col < mat_ranges[owner+1] ) { /* diag block */
my_dnz[i] += 1;
} else { /* offdiag block */
my_onz[i] += 1;
}
/* same as before, interchanging rows and cols */
if (issbaij && index_col != index_row) {
owner = row_ownership[index_col];
if (index_row > mat_ranges[owner]-1 && index_row < mat_ranges[owner+1] ) {
my_dnz[cols[j]] += 1;
} else {
my_onz[cols[j]] += 1;
}
}
}
ierr = MatRestoreRow(matis->A,i,&ncols,&cols,NULL);CHKERRQ(ierr);
}
}
ierr = ISLocalToGlobalMappingRestoreIndices(A->rmap->mapping,&global_indices_r);CHKERRQ(ierr);
if (global_indices_c != global_indices_r) {
ierr = ISLocalToGlobalMappingRestoreIndices(A->rmap->mapping,&global_indices_c);CHKERRQ(ierr);
}
ierr = PetscFree(row_ownership);CHKERRQ(ierr);
/* Reduce my_dnz and my_onz */
if (maxreduce) {
ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,my_dnz,dnz,MPI_MAX);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,my_dnz,dnz,MPI_MAX);CHKERRQ(ierr);
ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,my_onz,onz,MPI_MAX);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,my_onz,onz,MPI_MAX);CHKERRQ(ierr);
} else {
ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,my_dnz,dnz,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,my_dnz,dnz,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,my_onz,onz,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,my_onz,onz,MPI_SUM);CHKERRQ(ierr);
}
ierr = PetscFree2(my_dnz,my_onz);CHKERRQ(ierr);
/* Resize preallocation if overestimated */
for (i=0;i<lrows;i++) {
dnz[i] = PetscMin(dnz[i],lcols);
onz[i] = PetscMin(onz[i],cols-lcols);
}
/* set preallocation */
ierr = MatMPIAIJSetPreallocation(B,0,dnz,0,onz);CHKERRQ(ierr);
for (i=0;i<lrows/bs;i++) {
dnz[i] = dnz[i*bs]/bs;
onz[i] = onz[i*bs]/bs;
}
ierr = MatMPIBAIJSetPreallocation(B,bs,0,dnz,0,onz);CHKERRQ(ierr);
ierr = MatMPISBAIJSetPreallocation(B,bs,0,dnz,0,onz);CHKERRQ(ierr);
ierr = MatPreallocateFinalize(dnz,onz);CHKERRQ(ierr);
if (issbaij) {
ierr = MatRestoreRowUpperTriangular(matis->A);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode EPSSolve_Lanczos(EPS eps)
{
EPS_LANCZOS *lanczos = (EPS_LANCZOS*)eps->data;
PetscErrorCode ierr;
PetscInt nconv,i,j,k,l,x,n,*perm,restart,ncv=eps->ncv,r,ld;
Vec vi,vj,w;
Mat U;
PetscScalar *Y,*ritz,stmp;
PetscReal *d,*e,*bnd,anorm,beta,norm,rtmp,resnorm;
PetscBool breakdown;
char *conv,ctmp;
PetscFunctionBegin;
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
ierr = PetscMalloc4(ncv,&ritz,ncv,&bnd,ncv,&perm,ncv,&conv);CHKERRQ(ierr);
/* The first Lanczos vector is the normalized initial vector */
ierr = EPSGetStartVector(eps,0,NULL);CHKERRQ(ierr);
anorm = -1.0;
nconv = 0;
/* Restart loop */
while (eps->reason == EPS_CONVERGED_ITERATING) {
eps->its++;
/* Compute an ncv-step Lanczos factorization */
n = PetscMin(nconv+eps->mpd,ncv);
ierr = DSGetArrayReal(eps->ds,DS_MAT_T,&d);CHKERRQ(ierr);
e = d + ld;
ierr = EPSBasicLanczos(eps,d,e,nconv,&n,&breakdown,anorm);CHKERRQ(ierr);
beta = e[n-1];
ierr = DSRestoreArrayReal(eps->ds,DS_MAT_T,&d);CHKERRQ(ierr);
ierr = DSSetDimensions(eps->ds,n,0,nconv,0);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
ierr = BVSetActiveColumns(eps->V,nconv,n);CHKERRQ(ierr);
/* Solve projected problem */
ierr = DSSolve(eps->ds,ritz,NULL);CHKERRQ(ierr);
ierr = DSSort(eps->ds,ritz,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/* Estimate ||A|| */
for (i=nconv;i<n;i++)
anorm = PetscMax(anorm,PetscAbsReal(PetscRealPart(ritz[i])));
/* Compute residual norm estimates as beta*abs(Y(m,:)) + eps*||A|| */
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
for (i=nconv;i<n;i++) {
resnorm = beta*PetscAbsScalar(Y[n-1+i*ld]) + PETSC_MACHINE_EPSILON*anorm;
ierr = (*eps->converged)(eps,ritz[i],eps->eigi[i],resnorm,&bnd[i],eps->convergedctx);CHKERRQ(ierr);
if (bnd[i]<eps->tol) conv[i] = 'C';
else conv[i] = 'N';
}
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
/* purge repeated ritz values */
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
for (i=nconv+1;i<n;i++) {
if (conv[i] == 'C' && PetscAbsScalar((ritz[i]-ritz[i-1])/ritz[i]) < eps->tol) conv[i] = 'R';
}
}
/* Compute restart vector */
if (breakdown) {
ierr = PetscInfo2(eps,"Breakdown in Lanczos method (it=%D norm=%g)\n",eps->its,(double)beta);CHKERRQ(ierr);
} else {
restart = nconv;
while (restart<n && conv[restart] != 'N') restart++;
if (restart >= n) {
breakdown = PETSC_TRUE;
} else {
for (i=restart+1;i<n;i++) {
if (conv[i] == 'N') {
ierr = SlepcSCCompare(eps->sc,ritz[restart],0.0,ritz[i],0.0,&r);CHKERRQ(ierr);
if (r>0) restart = i;
}
}
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
ierr = BVMultColumn(eps->V,1.0,0.0,n,Y+restart*ld+nconv);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
}
}
/* Count and put converged eigenvalues first */
for (i=nconv;i<n;i++) perm[i] = i;
for (k=nconv;k<n;k++) {
if (conv[perm[k]] != 'C') {
j = k + 1;
while (j<n && conv[perm[j]] != 'C') j++;
if (j>=n) break;
l = perm[k]; perm[k] = perm[j]; perm[j] = l;
}
}
/* Sort eigenvectors according to permutation */
ierr = DSGetArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
for (i=nconv;i<k;i++) {
x = perm[i];
if (x != i) {
j = i + 1;
while (perm[j] != i) j++;
/* swap eigenvalues i and j */
stmp = ritz[x]; ritz[x] = ritz[i]; ritz[i] = stmp;
rtmp = bnd[x]; bnd[x] = bnd[i]; bnd[i] = rtmp;
ctmp = conv[x]; conv[x] = conv[i]; conv[i] = ctmp;
perm[j] = x; perm[i] = i;
/* swap eigenvectors i and j */
for (l=0;l<n;l++) {
stmp = Y[l+x*ld]; Y[l+x*ld] = Y[l+i*ld]; Y[l+i*ld] = stmp;
}
}
}
ierr = DSRestoreArray(eps->ds,DS_MAT_Q,&Y);CHKERRQ(ierr);
/* compute converged eigenvectors */
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,nconv,k);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
/* purge spurious ritz values */
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL) {
for (i=nconv;i<k;i++) {
ierr = BVGetColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = VecNorm(vi,NORM_2,&norm);CHKERRQ(ierr);
ierr = VecScale(vi,1.0/norm);CHKERRQ(ierr);
w = eps->work[0];
ierr = STApply(eps->st,vi,w);CHKERRQ(ierr);
ierr = VecAXPY(w,-ritz[i],vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = VecNorm(w,NORM_2,&norm);CHKERRQ(ierr);
ierr = (*eps->converged)(eps,ritz[i],eps->eigi[i],norm,&bnd[i],eps->convergedctx);CHKERRQ(ierr);
if (bnd[i]>=eps->tol) conv[i] = 'S';
}
for (i=nconv;i<k;i++) {
if (conv[i] != 'C') {
j = i + 1;
while (j<k && conv[j] != 'C') j++;
if (j>=k) break;
/* swap eigenvalues i and j */
stmp = ritz[j]; ritz[j] = ritz[i]; ritz[i] = stmp;
rtmp = bnd[j]; bnd[j] = bnd[i]; bnd[i] = rtmp;
ctmp = conv[j]; conv[j] = conv[i]; conv[i] = ctmp;
/* swap eigenvectors i and j */
ierr = BVGetColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(eps->V,j,&vj);CHKERRQ(ierr);
ierr = VecSwap(vi,vj);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(eps->V,j,&vj);CHKERRQ(ierr);
}
}
k = i;
}
/* store ritz values and estimated errors */
for (i=nconv;i<n;i++) {
eps->eigr[i] = ritz[i];
eps->errest[i] = bnd[i];
}
ierr = EPSMonitor(eps,eps->its,nconv,eps->eigr,eps->eigi,eps->errest,n);CHKERRQ(ierr);
nconv = k;
if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
if (nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
if (eps->reason == EPS_CONVERGED_ITERATING) { /* copy restart vector */
ierr = BVCopyColumn(eps->V,n,nconv);CHKERRQ(ierr);
if (lanczos->reorthog == EPS_LANCZOS_REORTHOG_LOCAL && !breakdown) {
/* Reorthonormalize restart vector */
ierr = BVOrthogonalizeColumn(eps->V,nconv,NULL,&norm,&breakdown);CHKERRQ(ierr);
ierr = BVScaleColumn(eps->V,nconv,1.0/norm);CHKERRQ(ierr);
}
if (breakdown) {
/* Use random vector for restarting */
ierr = PetscInfo(eps,"Using random vector for restart\n");CHKERRQ(ierr);
ierr = EPSGetStartVector(eps,nconv,&breakdown);CHKERRQ(ierr);
}
if (breakdown) { /* give up */
eps->reason = EPS_DIVERGED_BREAKDOWN;
ierr = PetscInfo(eps,"Unable to generate more start vectors\n");CHKERRQ(ierr);
}
}
}
eps->nconv = nconv;
ierr = PetscFree4(ritz,bnd,perm,conv);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/***********************************ivec.c*************************************/
PetscErrorCode PCTFS_ivec_min( PetscInt *arg1, PetscInt *arg2, PetscInt n)
{
PetscFunctionBegin;
while (n--) {*(arg1) = PetscMin(*arg1,*arg2); arg1++; arg2++;}
PetscFunctionReturn(0);
}
PetscErrorCode EPSSolve_Arnoldi(EPS eps)
{
PetscErrorCode ierr;
PetscInt k,nv,ld;
Mat U;
PetscScalar *H,*X;
PetscReal beta,gamma=1.0;
PetscBool breakdown,harmonic,refined;
BVOrthogRefineType orthog_ref;
EPS_ARNOLDI *arnoldi = (EPS_ARNOLDI*)eps->data;
PetscFunctionBegin;
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
ierr = DSGetRefined(eps->ds,&refined);CHKERRQ(ierr);
harmonic = (eps->extraction==EPS_HARMONIC || eps->extraction==EPS_REFINED_HARMONIC)?PETSC_TRUE:PETSC_FALSE;
ierr = BVGetOrthogonalization(eps->V,NULL,&orthog_ref,NULL);CHKERRQ(ierr);
/* Get the starting Arnoldi vector */
ierr = EPSGetStartVector(eps,0,NULL);CHKERRQ(ierr);
/* Restart loop */
while (eps->reason == EPS_CONVERGED_ITERATING) {
eps->its++;
/* Compute an nv-step Arnoldi factorization */
nv = PetscMin(eps->nconv+eps->mpd,eps->ncv);
ierr = DSSetDimensions(eps->ds,nv,0,eps->nconv,0);CHKERRQ(ierr);
ierr = DSGetArray(eps->ds,DS_MAT_A,&H);CHKERRQ(ierr);
if (!arnoldi->delayed) {
ierr = EPSBasicArnoldi(eps,PETSC_FALSE,H,ld,eps->nconv,&nv,&beta,&breakdown);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)eps),1,"Not implemented");
/*if (orthog_ref == BV_ORTHOG_REFINE_NEVER) {
ierr = EPSDelayedArnoldi1(eps,H,ld,eps->V,eps->nconv,&nv,f,&beta,&breakdown);CHKERRQ(ierr);
} else {
ierr = EPSDelayedArnoldi(eps,H,ld,eps->V,eps->nconv,&nv,f,&beta,&breakdown);CHKERRQ(ierr);
}*/
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&H);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_INTERMEDIATE);CHKERRQ(ierr);
ierr = BVSetActiveColumns(eps->V,eps->nconv,nv);CHKERRQ(ierr);
/* Compute translation of Krylov decomposition if harmonic extraction used */
if (harmonic) {
ierr = DSTranslateHarmonic(eps->ds,eps->target,beta,PETSC_FALSE,NULL,&gamma);CHKERRQ(ierr);
}
/* Solve projected problem */
ierr = DSSolve(eps->ds,eps->eigr,eps->eigi);CHKERRQ(ierr);
ierr = DSSort(eps->ds,eps->eigr,eps->eigi,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = DSUpdateExtraRow(eps->ds);CHKERRQ(ierr);
/* Check convergence */
ierr = EPSKrylovConvergence(eps,PETSC_FALSE,eps->nconv,nv-eps->nconv,beta,gamma,&k);CHKERRQ(ierr);
if (refined) {
ierr = DSGetArray(eps->ds,DS_MAT_X,&X);CHKERRQ(ierr);
ierr = BVMultColumn(eps->V,1.0,0.0,k,X+k*ld);CHKERRQ(ierr);
ierr = DSRestoreArray(eps->ds,DS_MAT_X,&X);CHKERRQ(ierr);
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,eps->nconv,nv);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
ierr = BVOrthogonalizeColumn(eps->V,k,NULL,NULL,NULL);CHKERRQ(ierr);
} else {
ierr = DSGetMat(eps->ds,DS_MAT_Q,&U);CHKERRQ(ierr);
ierr = BVMultInPlace(eps->V,U,eps->nconv,nv);CHKERRQ(ierr);
ierr = MatDestroy(&U);CHKERRQ(ierr);
}
eps->nconv = k;
ierr = EPSMonitor(eps,eps->its,eps->nconv,eps->eigr,eps->eigi,eps->errest,nv);CHKERRQ(ierr);
if (breakdown && k<eps->nev) {
ierr = PetscInfo2(eps,"Breakdown in Arnoldi method (it=%D norm=%g)\n",eps->its,(double)beta);CHKERRQ(ierr);
ierr = EPSGetStartVector(eps,k,&breakdown);CHKERRQ(ierr);
if (breakdown) {
eps->reason = EPS_DIVERGED_BREAKDOWN;
ierr = PetscInfo(eps,"Unable to generate more start vectors\n");CHKERRQ(ierr);
}
}
if (eps->its >= eps->max_it) eps->reason = EPS_DIVERGED_ITS;
if (eps->nconv >= eps->nev) eps->reason = EPS_CONVERGED_TOL;
}
/* truncate Schur decomposition and change the state to raw so that
PSVectors() computes eigenvectors from scratch */
ierr = DSSetDimensions(eps->ds,eps->nconv,0,0,0);CHKERRQ(ierr);
ierr = DSSetState(eps->ds,DS_STATE_RAW);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESDiffParameterCompute_More(SNES snes,void *nePv,Vec x,Vec p,double *fnoise,double *hopt)
{
DIFFPAR_MORE *neP = (DIFFPAR_MORE*)nePv;
Vec w, xp, fvec; /* work vectors to use in computing h */
double zero = 0.0, hl, hu, h, fnoise_s, fder2_s;
PetscScalar alpha;
PetscScalar fval[7], tab[7][7], eps[7], f = -1;
double rerrf = -1., fder2;
PetscErrorCode ierr;
PetscInt iter, k, i, j, info;
PetscInt nf = 7; /* number of function evaluations */
PetscInt fcount;
MPI_Comm comm;
FILE *fp;
PetscBool noise_test = PETSC_FALSE;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)snes,&comm);CHKERRQ(ierr);
/* Call to SNESSetUp() just to set data structures in SNES context */
if (!snes->setupcalled) {ierr = SNESSetUp(snes);CHKERRQ(ierr);}
w = neP->workv[0];
xp = neP->workv[1];
fvec = neP->workv[2];
fp = neP->fp;
/* Initialize parameters */
hl = zero;
hu = zero;
h = neP->h_first_try;
fnoise_s = zero;
fder2_s = zero;
fcount = neP->function_count;
/* We have 5 tries to attempt to compute a good hopt value */
ierr = SNESGetIterationNumber(snes,&i);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"\n ------- SNES iteration %D ---------\n",i);CHKERRQ(ierr);
for (iter=0; iter<5; iter++) {
neP->h_first_try = h;
/* Compute the nf function values needed to estimate the noise from
the difference table */
for (k=0; k<nf; k++) {
alpha = h * (k+1 - (nf+1)/2);
ierr = VecWAXPY(xp,alpha,p,x);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,xp,fvec);CHKERRQ(ierr);
neP->function_count++;
ierr = VecDot(fvec,w,&fval[k]);CHKERRQ(ierr);
}
f = fval[(nf+1)/2 - 1];
/* Construct the difference table */
for (i=0; i<nf; i++) tab[i][0] = fval[i];
for (j=0; j<6; j++) {
for (i=0; i<nf-j; i++) {
tab[i][j+1] = tab[i+1][j] - tab[i][j];
}
}
/* Print the difference table */
ierr = PetscFPrintf(comm,fp,"Difference Table: iter = %D\n",iter);CHKERRQ(ierr);
for (i=0; i<nf; i++) {
for (j=0; j<nf-i; j++) {
ierr = PetscFPrintf(comm,fp," %10.2e ",tab[i][j]);CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm,fp,"\n");CHKERRQ(ierr);
}
/* Call the noise estimator */
ierr = SNESNoise_dnest_(&nf,fval,&h,fnoise,&fder2,hopt,&info,eps);CHKERRQ(ierr);
/* Output statements */
rerrf = *fnoise/PetscAbsScalar(f);
if (info == 1) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise detected");CHKERRQ(ierr);}
if (info == 2) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too small");CHKERRQ(ierr);}
if (info == 3) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise not detected; h is too large");CHKERRQ(ierr);}
if (info == 4) {ierr = PetscFPrintf(comm,fp,"%s\n","Noise detected, but unreliable hopt");CHKERRQ(ierr);}
ierr = PetscFPrintf(comm,fp,"Approximate epsfcn %g %g %g %g %g %g\n",(double)eps[0],(double)eps[1],(double)eps[2],(double)eps[3],(double)eps[4],(double)eps[5]);CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"h = %g, fnoise = %g, fder2 = %g, rerrf = %g, hopt = %g\n\n",(double)h, (double)*fnoise, (double)fder2, (double)rerrf, (double)*hopt);CHKERRQ(ierr);
/* Save fnoise and fder2. */
if (*fnoise) fnoise_s = *fnoise;
if (fder2) fder2_s = fder2;
/* Check for noise detection. */
if (fnoise_s && fder2_s) {
*fnoise = fnoise_s;
fder2 = fder2_s;
*hopt = 1.68*sqrt(*fnoise/PetscAbsScalar(fder2));
goto theend;
} else {
/* Update hl and hu, and determine new h */
if (info == 2 || info == 4) {
hl = h;
if (hu == zero) h = 100*h;
else h = PetscMin(100*h,0.1*hu);
} else if (info == 3) {
hu = h;
h = PetscMax(1.0e-3,sqrt(hl/hu))*hu;
}
}
}
theend:
if (*fnoise < neP->fnoise_min) {
ierr = PetscFPrintf(comm,fp,"Resetting fnoise: fnoise1 = %g, fnoise_min = %g\n",(double)*fnoise,(double)neP->fnoise_min);CHKERRQ(ierr);
*fnoise = neP->fnoise_min;
neP->fnoise_resets++;
}
if (*hopt < neP->hopt_min) {
ierr = PetscFPrintf(comm,fp,"Resetting hopt: hopt1 = %g, hopt_min = %g\n",(double)*hopt,(double)neP->hopt_min);CHKERRQ(ierr);
*hopt = neP->hopt_min;
neP->hopt_resets++;
}
ierr = PetscFPrintf(comm,fp,"Errors in derivative:\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm,fp,"f = %g, fnoise = %g, fder2 = %g, hopt = %g\n",(double)f,(double)*fnoise,(double)fder2,(double)*hopt);CHKERRQ(ierr);
/* For now, compute h **each** MV Mult!! */
/*
ierr = PetscOptionsHasName(NULL,"-matrix_free_jorge_each_mvp",&flg);CHKERRQ(ierr);
if (!flg) {
Mat mat;
ierr = SNESGetJacobian(snes,&mat,NULL,NULL);CHKERRQ(ierr);
ierr = SNESDefaultMatrixFreeSetParameters2(mat,PETSC_DEFAULT,PETSC_DEFAULT,*hopt);CHKERRQ(ierr);
}
*/
fcount = neP->function_count - fcount;
ierr = PetscInfo5(snes,"fct_now = %D, fct_cum = %D, rerrf=%g, sqrt(noise)=%g, h_more=%g\n",fcount,neP->function_count,(double)rerrf,(double)PetscSqrtReal(*fnoise),(double)*hopt);CHKERRQ(ierr);
ierr = PetscOptionsGetBool(NULL,"-noise_test",&noise_test,NULL);CHKERRQ(ierr);
if (noise_test) {
ierr = JacMatMultCompare(snes,x,p,*hopt);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@
PetscDrawBarDraw - Redraws a bar graph.
Collective on PetscDrawBar
Input Parameter:
. bar - The bar graph context
Level: intermediate
.seealso: PetscDrawBar, PetscDrawBarCreate(), PetscDrawBarSetData()
@*/
PetscErrorCode PetscDrawBarDraw(PetscDrawBar bar)
{
PetscDraw draw;
PetscBool isnull;
PetscReal xmin,xmax,ymin,ymax,*values,binLeft,binRight;
PetscInt numValues,i,bcolor,color,idx,*perm,nplot;
PetscMPIInt rank;
PetscErrorCode ierr;
char **labels;
PetscFunctionBegin;
PetscValidHeaderSpecific(bar,PETSC_DRAWBAR_CLASSID,1);
ierr = PetscDrawIsNull(bar->win,&isnull);CHKERRQ(ierr);
if (isnull) PetscFunctionReturn(0);
ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)bar),&rank);CHKERRQ(ierr);
if (bar->numBins < 1) PetscFunctionReturn(0);
color = bar->color;
if (color == PETSC_DRAW_ROTATE) bcolor = PETSC_DRAW_BLACK+1;
else bcolor = color;
numValues = bar->numBins;
values = bar->values;
if (bar->ymin == bar->ymax) {
/* user has not set bounds on bars so set them based on the data */
ymin = PETSC_MAX_REAL;
ymax = PETSC_MIN_REAL;
for (i=0; i<numValues; i++) {
ymin = PetscMin(ymin,values[i]);
ymax = PetscMax(ymax,values[i]);
}
} else {
ymin = bar->ymin;
ymax = bar->ymax;
}
nplot = numValues; /* number of points to actually plot; if some are lower than requested tolerance */
xmin = 0.0;
xmax = nplot;
labels = bar->labels;
if (bar->sort) {
ierr = PetscMalloc1(numValues,&perm);CHKERRQ(ierr);
for (i=0; i<numValues;i++) perm[i] = i;
ierr = PetscSortRealWithPermutation(numValues,values,perm);CHKERRQ(ierr);
if (bar->sorttolerance) {
for (i=0; i<numValues;i++) {
if (values[perm[numValues - i - 1]] < bar->sorttolerance) {
nplot = i;
break;
}
}
}
}
draw = bar->win;
ierr = PetscDrawCheckResizedWindow(draw);CHKERRQ(ierr);
ierr = PetscDrawClear(draw);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLimits(bar->axis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(bar->axis);CHKERRQ(ierr);
ierr = PetscDrawCollectiveBegin(draw);CHKERRQ(ierr);
if (!rank) { /* Draw bins */
for (i=0; i<nplot; i++) {
idx = (bar->sort ? perm[numValues - i - 1] : i);
binLeft = xmin + i;
binRight = xmin + i + 1;
ierr = PetscDrawRectangle(draw,binLeft,ymin,binRight,values[idx],bcolor,bcolor,bcolor,bcolor);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binLeft,ymin,binLeft,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binRight,ymin,binRight,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
ierr = PetscDrawLine(draw,binLeft,values[idx],binRight,values[idx],PETSC_DRAW_BLACK);CHKERRQ(ierr);
if (labels) {
PetscReal h;
ierr = PetscDrawStringGetSize(draw,NULL,&h);CHKERRQ(ierr);
ierr = PetscDrawStringCentered(draw,.5*(binLeft+binRight),ymin - 1.5*h,bcolor,labels[idx]);CHKERRQ(ierr);
}
if (color == PETSC_DRAW_ROTATE) bcolor++;
if (bcolor > PETSC_DRAW_BASIC_COLORS-1) bcolor = PETSC_DRAW_BLACK+1;
}
}
ierr = PetscDrawCollectiveEnd(draw);CHKERRQ(ierr);
if (bar->sort) {ierr = PetscFree(perm);CHKERRQ(ierr);}
ierr = PetscDrawFlush(draw);CHKERRQ(ierr);
ierr = PetscDrawPause(draw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMPlexVTKWriteSection_ASCII(DM dm, PetscSection section, PetscSection globalSection, Vec v, FILE *fp, PetscInt enforceDof, PetscInt precision, PetscReal scale)
{
MPI_Comm comm;
const MPI_Datatype mpiType = MPIU_SCALAR;
PetscScalar *array;
PetscInt numDof = 0, maxDof;
PetscInt numLabelCells, cellHeight, cMax, cStart, cEnd, numLabelVertices, vMax, vStart, vEnd, pStart, pEnd, p;
PetscMPIInt numProcs, rank, proc, tag;
PetscBool hasLabel;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidHeaderSpecific(v,VEC_CLASSID,4);
if (precision < 0) precision = 6;
ierr = PetscCommGetNewTag(comm, &tag);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &numProcs);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
/* VTK only wants the values at cells or vertices */
ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, &vMax);CHKERRQ(ierr);
if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
if (vMax >= 0) vEnd = PetscMin(vEnd, vMax);
pStart = PetscMax(PetscMin(cStart, vStart), pStart);
pEnd = PetscMin(PetscMax(cEnd, vEnd), pEnd);
ierr = DMPlexGetStratumSize(dm, "vtk", 1, &numLabelCells);CHKERRQ(ierr);
ierr = DMPlexGetStratumSize(dm, "vtk", 2, &numLabelVertices);CHKERRQ(ierr);
hasLabel = numLabelCells > 0 || numLabelVertices > 0 ? PETSC_TRUE : PETSC_FALSE;
for (p = pStart; p < pEnd; ++p) {
/* Reject points not either cells or vertices */
if (((p < cStart) || (p >= cEnd)) && ((p < vStart) || (p >= vEnd))) continue;
if (hasLabel) {
PetscInt value;
if (((p >= cStart) && (p < cEnd) && numLabelCells) ||
((p >= vStart) && (p < vEnd) && numLabelVertices)) {
ierr = DMPlexGetLabelValue(dm, "vtk", p, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
}
ierr = PetscSectionGetDof(section, p, &numDof);CHKERRQ(ierr);
if (numDof) break;
}
ierr = MPI_Allreduce(&numDof, &maxDof, 1, MPIU_INT, MPI_MAX, comm);CHKERRQ(ierr);
enforceDof = PetscMax(enforceDof, maxDof);
ierr = VecGetArray(v, &array);CHKERRQ(ierr);
if (!rank) {
char formatString[8];
ierr = PetscSNPrintf(formatString, 8, "%%.%de", precision);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
/* Here we lose a way to filter points by keeping them out of the Numbering */
PetscInt dof, off, goff, d;
/* Reject points not either cells or vertices */
if (((p < cStart) || (p >= cEnd)) && ((p < vStart) || (p >= vEnd))) continue;
if (hasLabel) {
PetscInt value;
if (((p >= cStart) && (p < cEnd) && numLabelCells) ||
((p >= vStart) && (p < vEnd) && numLabelVertices)) {
ierr = DMPlexGetLabelValue(dm, "vtk", p, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
}
ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(globalSection, p, &goff);CHKERRQ(ierr);
if (dof && goff >= 0) {
for (d = 0; d < dof; d++) {
if (d > 0) {
ierr = PetscFPrintf(comm, fp, " ");CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, formatString, PetscRealPart(array[off+d])*scale);CHKERRQ(ierr);
}
for (d = dof; d < enforceDof; d++) {
ierr = PetscFPrintf(comm, fp, " 0.0");CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
}
for (proc = 1; proc < numProcs; ++proc) {
PetscScalar *remoteValues;
PetscInt size = 0, d;
MPI_Status status;
ierr = MPI_Recv(&size, 1, MPIU_INT, proc, tag, comm, &status);CHKERRQ(ierr);
ierr = PetscMalloc1(size, &remoteValues);CHKERRQ(ierr);
ierr = MPI_Recv(remoteValues, size, mpiType, proc, tag, comm, &status);CHKERRQ(ierr);
for (p = 0; p < size/maxDof; ++p) {
for (d = 0; d < maxDof; ++d) {
if (d > 0) {
ierr = PetscFPrintf(comm, fp, " ");CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, formatString, PetscRealPart(remoteValues[p*maxDof+d])*scale);CHKERRQ(ierr);
}
for (d = maxDof; d < enforceDof; ++d) {
ierr = PetscFPrintf(comm, fp, " 0.0");CHKERRQ(ierr);
}
ierr = PetscFPrintf(comm, fp, "\n");CHKERRQ(ierr);
}
ierr = PetscFree(remoteValues);CHKERRQ(ierr);
}
} else {
PetscScalar *localValues;
PetscInt size, k = 0;
ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
ierr = PetscMalloc1(size, &localValues);CHKERRQ(ierr);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof, off, goff, d;
/* Reject points not either cells or vertices */
if (((p < cStart) || (p >= cEnd)) && ((p < vStart) || (p >= vEnd))) continue;
if (hasLabel) {
PetscInt value;
if (((p >= cStart) && (p < cEnd) && numLabelCells) ||
((p >= vStart) && (p < vEnd) && numLabelVertices)) {
ierr = DMPlexGetLabelValue(dm, "vtk", p, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
}
ierr = PetscSectionGetDof(section, p, &dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(section, p, &off);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(globalSection, p, &goff);CHKERRQ(ierr);
if (goff >= 0) {
for (d = 0; d < dof; ++d) {
localValues[k++] = array[off+d];
}
}
}
ierr = MPI_Send(&k, 1, MPIU_INT, 0, tag, comm);CHKERRQ(ierr);
ierr = MPI_Send(localValues, k, mpiType, 0, tag, comm);CHKERRQ(ierr);
ierr = PetscFree(localValues);CHKERRQ(ierr);
}
ierr = VecRestoreArray(v, &array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode DMPlexVTKWriteAll_ASCII(DM dm, PetscViewer viewer)
{
MPI_Comm comm;
PetscViewer_VTK *vtk = (PetscViewer_VTK*) viewer->data;
FILE *fp;
PetscViewerVTKObjectLink link;
PetscSection coordSection, globalCoordSection;
PetscLayout vLayout;
Vec coordinates;
PetscReal lengthScale;
PetscInt vMax, totVertices, totCells;
PetscBool hasPoint = PETSC_FALSE, hasCell = PETSC_FALSE, writePartition = PETSC_FALSE;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)dm,&comm);CHKERRQ(ierr);
ierr = PetscFOpen(comm, vtk->filename, "wb", &fp);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "# vtk DataFile Version 2.0\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "Simplicial Mesh Example\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "ASCII\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "DATASET UNSTRUCTURED_GRID\n");CHKERRQ(ierr);
/* Vertices */
ierr = DMPlexGetScale(dm, PETSC_UNIT_LENGTH, &lengthScale);CHKERRQ(ierr);
ierr = DMGetCoordinateSection(dm, &coordSection);CHKERRQ(ierr);
ierr = PetscSectionCreateGlobalSection(coordSection, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalCoordSection);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, NULL, NULL, NULL, &vMax);CHKERRQ(ierr);
if (vMax >= 0) {
PetscInt pStart, pEnd, p, localSize = 0;
ierr = PetscSectionGetChart(globalCoordSection, &pStart, &pEnd);CHKERRQ(ierr);
pEnd = PetscMin(pEnd, vMax);
for (p = pStart; p < pEnd; ++p) {
PetscInt dof;
ierr = PetscSectionGetDof(globalCoordSection, p, &dof);CHKERRQ(ierr);
if (dof > 0) ++localSize;
}
ierr = PetscLayoutCreate(PetscObjectComm((PetscObject)dm), &vLayout);CHKERRQ(ierr);
ierr = PetscLayoutSetLocalSize(vLayout, localSize);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(vLayout, 1);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(vLayout);CHKERRQ(ierr);
} else {
ierr = PetscSectionGetPointLayout(PetscObjectComm((PetscObject)dm), globalCoordSection, &vLayout);CHKERRQ(ierr);
}
ierr = PetscLayoutGetSize(vLayout, &totVertices);CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "POINTS %d double\n", totVertices);CHKERRQ(ierr);
ierr = DMPlexVTKWriteSection_ASCII(dm, coordSection, globalCoordSection, coordinates, fp, 3, PETSC_DETERMINE, lengthScale);CHKERRQ(ierr);
/* Cells */
ierr = DMPlexVTKWriteCells_ASCII(dm, fp, &totCells);CHKERRQ(ierr);
/* Vertex fields */
for (link = vtk->link; link; link = link->next) {
if ((link->ft == PETSC_VTK_POINT_FIELD) || (link->ft == PETSC_VTK_POINT_VECTOR_FIELD)) hasPoint = PETSC_TRUE;
if ((link->ft == PETSC_VTK_CELL_FIELD) || (link->ft == PETSC_VTK_CELL_VECTOR_FIELD)) hasCell = PETSC_TRUE;
}
if (hasPoint) {
ierr = PetscFPrintf(comm, fp, "POINT_DATA %d\n", totVertices);CHKERRQ(ierr);
for (link = vtk->link; link; link = link->next) {
Vec X = (Vec) link->vec;
DM dmX;
PetscSection section, globalSection, newSection = NULL;
const char *name;
PetscInt enforceDof = PETSC_DETERMINE;
if ((link->ft != PETSC_VTK_POINT_FIELD) && (link->ft != PETSC_VTK_POINT_VECTOR_FIELD)) continue;
if (link->ft == PETSC_VTK_POINT_VECTOR_FIELD) enforceDof = 3;
ierr = PetscObjectGetName(link->vec, &name);CHKERRQ(ierr);
ierr = VecGetDM(X, &dmX);CHKERRQ(ierr);
if (dmX) {
DMLabel subpointMap, subpointMapX;
PetscInt dim, dimX, pStart, pEnd, qStart, qEnd;
ierr = DMGetDefaultSection(dmX, §ion);CHKERRQ(ierr);
/* Here is where we check whether dmX is a submesh of dm */
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMGetDimension(dmX, &dimX);CHKERRQ(ierr);
ierr = DMPlexGetChart(dm, &pStart, &pEnd);CHKERRQ(ierr);
ierr = DMPlexGetChart(dmX, &qStart, &qEnd);CHKERRQ(ierr);
ierr = DMPlexGetSubpointMap(dm, &subpointMap);CHKERRQ(ierr);
ierr = DMPlexGetSubpointMap(dmX, &subpointMapX);CHKERRQ(ierr);
if (((dim != dimX) || ((pEnd-pStart) < (qEnd-qStart))) && subpointMap && !subpointMapX) {
const PetscInt *ind = NULL;
IS subpointIS;
PetscInt n = 0, q;
ierr = PetscSectionGetChart(section, &qStart, &qEnd);CHKERRQ(ierr);
ierr = DMPlexCreateSubpointIS(dm, &subpointIS);CHKERRQ(ierr);
if (subpointIS) {
ierr = ISGetLocalSize(subpointIS, &n);CHKERRQ(ierr);
ierr = ISGetIndices(subpointIS, &ind);CHKERRQ(ierr);
}
ierr = PetscSectionCreate(comm, &newSection);CHKERRQ(ierr);
ierr = PetscSectionSetChart(newSection, pStart, pEnd);CHKERRQ(ierr);
for (q = qStart; q < qEnd; ++q) {
PetscInt dof, off, p;
ierr = PetscSectionGetDof(section, q, &dof);CHKERRQ(ierr);
if (dof) {
ierr = PetscFindInt(q, n, ind, &p);CHKERRQ(ierr);
if (p >= pStart) {
ierr = PetscSectionSetDof(newSection, p, dof);CHKERRQ(ierr);
ierr = PetscSectionGetOffset(section, q, &off);CHKERRQ(ierr);
ierr = PetscSectionSetOffset(newSection, p, off);CHKERRQ(ierr);
}
}
}
if (subpointIS) {
ierr = ISRestoreIndices(subpointIS, &ind);CHKERRQ(ierr);
ierr = ISDestroy(&subpointIS);CHKERRQ(ierr);
}
/* No need to setup section */
section = newSection;
}
} else {
ierr = PetscObjectQuery(link->vec, "section", (PetscObject*) §ion);CHKERRQ(ierr);
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
}
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscSectionCreateGlobalSection(section, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
ierr = DMPlexVTKWriteField_ASCII(dm, section, globalSection, X, name, fp, enforceDof, PETSC_DETERMINE, 1.0);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
if (newSection) {ierr = PetscSectionDestroy(&newSection);CHKERRQ(ierr);}
}
}
/* Cell Fields */
ierr = PetscOptionsGetBool(((PetscObject) dm)->prefix, "-dm_view_partition", &writePartition, NULL);CHKERRQ(ierr);
if (hasCell || writePartition) {
ierr = PetscFPrintf(comm, fp, "CELL_DATA %d\n", totCells);CHKERRQ(ierr);
for (link = vtk->link; link; link = link->next) {
Vec X = (Vec) link->vec;
DM dmX;
PetscSection section, globalSection;
const char *name;
PetscInt enforceDof = PETSC_DETERMINE;
if ((link->ft != PETSC_VTK_CELL_FIELD) && (link->ft != PETSC_VTK_CELL_VECTOR_FIELD)) continue;
if (link->ft == PETSC_VTK_CELL_VECTOR_FIELD) enforceDof = 3;
ierr = PetscObjectGetName(link->vec, &name);CHKERRQ(ierr);
ierr = VecGetDM(X, &dmX);CHKERRQ(ierr);
if (dmX) {
ierr = DMGetDefaultSection(dmX, §ion);CHKERRQ(ierr);
} else {
PetscContainer c;
ierr = PetscObjectQuery(link->vec, "section", (PetscObject*) &c);CHKERRQ(ierr);
if (!c) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscContainerGetPointer(c, (void**) §ion);CHKERRQ(ierr);
}
if (!section) SETERRQ1(PetscObjectComm((PetscObject)dm), PETSC_ERR_ARG_WRONG, "Vector %s had no PetscSection composed with it", name);
ierr = PetscSectionCreateGlobalSection(section, dm->sf, PETSC_FALSE, PETSC_FALSE, &globalSection);CHKERRQ(ierr);
ierr = DMPlexVTKWriteField_ASCII(dm, section, globalSection, X, name, fp, enforceDof, PETSC_DETERMINE, 1.0);CHKERRQ(ierr);
ierr = PetscSectionDestroy(&globalSection);CHKERRQ(ierr);
}
if (writePartition) {
ierr = PetscFPrintf(comm, fp, "SCALARS partition int 1\n");CHKERRQ(ierr);
ierr = PetscFPrintf(comm, fp, "LOOKUP_TABLE default\n");CHKERRQ(ierr);
ierr = DMPlexVTKWritePartition_ASCII(dm, fp);CHKERRQ(ierr);
}
}
/* Cleanup */
ierr = PetscSectionDestroy(&globalCoordSection);CHKERRQ(ierr);
ierr = PetscLayoutDestroy(&vLayout);CHKERRQ(ierr);
ierr = PetscFClose(comm, fp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PEPBuildDiagonalScaling - compute two diagonal matrices to be applied for balancing
in polynomial eigenproblems.
*/
PetscErrorCode PEPBuildDiagonalScaling(PEP pep)
{
PetscErrorCode ierr;
PetscInt it,i,j,k,nmat,nr,e,nz,lst,lend,nc=0,*cols,emax,emin,emaxl,eminl;
const PetscInt *cidx,*ridx;
Mat M,*T,A;
PetscMPIInt n;
PetscBool cont=PETSC_TRUE,flg=PETSC_FALSE;
PetscScalar *array,*Dr,*Dl,t;
PetscReal l2,d,*rsum,*aux,*csum,w=1.0;
MatStructure str;
MatInfo info;
PetscFunctionBegin;
l2 = 2*PetscLogReal(2.0);
nmat = pep->nmat;
ierr = PetscMPIIntCast(pep->n,&n);
ierr = STGetMatStructure(pep->st,&str);CHKERRQ(ierr);
ierr = PetscMalloc1(nmat,&T);CHKERRQ(ierr);
for (k=0;k<nmat;k++) {
ierr = STGetTOperators(pep->st,k,&T[k]);CHKERRQ(ierr);
}
/* Form local auxiliar matrix M */
ierr = PetscObjectTypeCompareAny((PetscObject)T[0],&cont,MATMPIAIJ,MATSEQAIJ);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]),PETSC_ERR_SUP,"Only for MPIAIJ or SEQAIJ matrix types");
ierr = PetscObjectTypeCompare((PetscObject)T[0],MATMPIAIJ,&cont);CHKERRQ(ierr);
if (cont) {
ierr = MatMPIAIJGetLocalMat(T[0],MAT_INITIAL_MATRIX,&M);CHKERRQ(ierr);
flg = PETSC_TRUE;
} else {
ierr = MatDuplicate(T[0],MAT_COPY_VALUES,&M);CHKERRQ(ierr);
}
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
for (k=1;k<nmat;k++) {
if (flg) {
ierr = MatMPIAIJGetLocalMat(T[k],MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
} else {
if (str==SAME_NONZERO_PATTERN) {
ierr = MatCopy(T[k],A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
ierr = MatDuplicate(T[k],MAT_COPY_VALUES,&A);CHKERRQ(ierr);
}
}
ierr = MatGetInfo(A,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr);
w *= pep->slambda*pep->slambda*pep->sfactor;
ierr = MatAXPY(M,w,A,str);CHKERRQ(ierr);
if (flg || str!=SAME_NONZERO_PATTERN || k==nmat-2) {
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
}
ierr = MatGetRowIJ(M,0,PETSC_FALSE,PETSC_FALSE,&nr,&ridx,&cidx,&cont);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]), PETSC_ERR_SUP,"It is not possible to compute scaling diagonals for these PEP matrices");
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = VecGetOwnershipRange(pep->Dl,&lst,&lend);CHKERRQ(ierr);
ierr = PetscMalloc4(nr,&rsum,pep->n,&csum,pep->n,&aux,PetscMin(pep->n-lend+lst,nz),&cols);CHKERRQ(ierr);
ierr = VecSet(pep->Dr,1.0);CHKERRQ(ierr);
ierr = VecSet(pep->Dl,1.0);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dl,&Dl);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) {
/* Search non-zero columns outsize lst-lend */
if (aux[cidx[j]]==0 && (cidx[j]<lst || lend<=cidx[j])) cols[nc++] = cidx[j];
/* Local column sums */
aux[cidx[j]] += PetscAbsScalar(array[j]);
}
for (it=0;it<pep->sits && cont;it++) {
emaxl = 0; eminl = 0;
/* Column sum */
if (it>0) { /* it=0 has been already done*/
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) aux[cidx[j]] += PetscAbsScalar(array[j]);
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
}
ierr = MPI_Allreduce(aux,csum,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)pep->Dr));
/* Update Dr */
for (j=lst;j<lend;j++) {
d = PetscLogReal(csum[j])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dr[j-lst] *= d;
aux[j] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
for (j=0;j<nc;j++) {
d = PetscLogReal(csum[cols[j]])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
aux[cols[j]] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
/* Scale M */
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (j=0;j<nz;j++) {
array[j] *= aux[cidx[j]];
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Row sum */
ierr = PetscMemzero(rsum,nr*sizeof(PetscReal));CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nr;i++) {
for (j=ridx[i];j<ridx[i+1];j++) rsum[i] += PetscAbsScalar(array[j]);
/* Update Dl */
d = PetscLogReal(rsum[i])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dl[i] *= d;
/* Scale M */
for (j=ridx[i];j<ridx[i+1];j++) array[j] *= d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Compute global max and min */
ierr = MPI_Allreduce(&emaxl,&emax,1,MPIU_INT,MPIU_MAX,PetscObjectComm((PetscObject)pep->Dl));
ierr = MPI_Allreduce(&eminl,&emin,1,MPIU_INT,MPIU_MIN,PetscObjectComm((PetscObject)pep->Dl));
if (emax<=emin+2) cont = PETSC_FALSE;
}
ierr = VecRestoreArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = VecRestoreArray(pep->Dl,&Dl);CHKERRQ(ierr);
/* Free memory*/
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = PetscFree4(rsum,csum,aux,cols);CHKERRQ(ierr);
ierr = PetscFree(T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PCGAMGCreateGraph - create simple scaled scalar graph from matrix
Input Parameter:
. Amat - matrix
Output Parameter:
. a_Gmaat - eoutput scalar graph (symmetric?)
*/
PetscErrorCode PCGAMGCreateGraph(Mat Amat, Mat *a_Gmat)
{
PetscErrorCode ierr;
PetscInt Istart,Iend,Ii,jj,kk,ncols,nloc,NN,MM,bs;
MPI_Comm comm;
Mat Gmat;
MatType mtype;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetSize(Amat, &MM, &NN);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
if (bs > 1) {
const PetscScalar *vals;
const PetscInt *idx;
PetscInt *d_nnz, *o_nnz,*w0,*w1,*w2;
PetscBool ismpiaij,isseqaij;
/*
Determine the preallocation needed for the scalar matrix derived from the vector matrix.
*/
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
ierr = PetscObjectBaseTypeCompare((PetscObject)Amat,MATMPIAIJ,&ismpiaij);CHKERRQ(ierr);
ierr = PetscMalloc2(nloc, &d_nnz,isseqaij ? 0 : nloc, &o_nnz);CHKERRQ(ierr);
if (isseqaij) {
PetscInt max_d_nnz;
/*
Determine exact preallocation count for (sequential) scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Amat,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend; Ii += bs, jj++) {
ierr = MatCollapseRows(Amat,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
} else if (ismpiaij) {
Mat Daij,Oaij;
const PetscInt *garray;
PetscInt max_d_nnz;
ierr = MatMPIAIJGetSeqAIJ(Amat,&Daij,&Oaij,&garray);CHKERRQ(ierr);
/*
Determine exact preallocation count for diagonal block portion of scalar matrix
*/
ierr = MatSeqAIJGetMaxRowNonzeros(Daij,&max_d_nnz);CHKERRQ(ierr);
max_d_nnz = PetscMin(nloc,bs*max_d_nnz);CHKERRQ(ierr);
ierr = PetscMalloc3(max_d_nnz, &w0,max_d_nnz, &w1,max_d_nnz, &w2);CHKERRQ(ierr);
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
ierr = MatCollapseRows(Daij,Ii,bs,w0,w1,w2,&d_nnz[jj],NULL);CHKERRQ(ierr);
}
ierr = PetscFree3(w0,w1,w2);CHKERRQ(ierr);
/*
Over estimate (usually grossly over), preallocation count for off-diagonal portion of scalar matrix
*/
for (Ii = 0, jj = 0; Ii < Iend - Istart; Ii += bs, jj++) {
o_nnz[jj] = 0;
for (kk=0; kk<bs; kk++) { /* rows that get collapsed to a single row */
ierr = MatGetRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
o_nnz[jj] += ncols;
ierr = MatRestoreRow(Oaij,Ii+kk,&ncols,0,0);CHKERRQ(ierr);
}
if (o_nnz[jj] > (NN/bs-nloc)) o_nnz[jj] = NN/bs-nloc;
}
} else SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"Require AIJ matrix type");
/* get scalar copy (norms) of matrix */
ierr = MatGetType(Amat,&mtype);CHKERRQ(ierr);
ierr = MatCreate(comm, &Gmat);CHKERRQ(ierr);
ierr = MatSetSizes(Gmat,nloc,nloc,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Gmat, 1, 1);CHKERRQ(ierr);
ierr = MatSetType(Gmat, mtype);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Gmat,0,d_nnz);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Gmat,0,d_nnz,0,o_nnz);CHKERRQ(ierr);
ierr = PetscFree2(d_nnz,o_nnz);CHKERRQ(ierr);
for (Ii = Istart; Ii < Iend; Ii++) {
PetscInt dest_row = Ii/bs;
ierr = MatGetRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
for (jj=0; jj<ncols; jj++) {
PetscInt dest_col = idx[jj]/bs;
PetscScalar sv = PetscAbs(PetscRealPart(vals[jj]));
ierr = MatSetValues(Gmat,1,&dest_row,1,&dest_col,&sv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRow(Amat,Ii,&ncols,&idx,&vals);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(Gmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
} else {
/* just copy scalar matrix - abs() not taken here but scaled later */
ierr = MatDuplicate(Amat, MAT_COPY_VALUES, &Gmat);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[GRAPH],0,0,0,0);CHKERRQ(ierr);
#endif
*a_Gmat = Gmat;
PetscFunctionReturn(0);
}
static PetscErrorCode TestCellShape(DM dm)
{
PetscMPIInt rank;
PetscInt dim, c, cStart, cEnd, count = 0;
ex1_stats_t stats, globalStats;
PetscReal *J, *invJ, min = 0, max = 0, mean = 0, stdev = 0;
MPI_Comm comm = PetscObjectComm((PetscObject)dm);
DM dmCoarse;
PetscErrorCode ierr;
PetscFunctionBegin;
stats.min = PETSC_MAX_REAL;
stats.max = PETSC_MIN_REAL;
stats.sum = stats.squaresum = 0.;
stats.count = 0;
ierr = DMGetDimension(dm,&dim);CHKERRQ(ierr);
ierr = PetscMalloc2(dim * dim, &J, dim * dim, &invJ);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm,0,&cStart,&cEnd);CHKERRQ(ierr);
for (c = cStart; c < cEnd; c++) {
PetscInt i;
PetscReal frobJ = 0., frobInvJ = 0., cond2, cond, detJ;
ierr = DMPlexComputeCellGeometryAffineFEM(dm,c,NULL,J,invJ,&detJ);CHKERRQ(ierr);
for (i = 0; i < dim * dim; i++) {
frobJ += J[i] * J[i];
frobInvJ += invJ[i] * invJ[i];
}
cond2 = frobJ * frobInvJ;
cond = PetscSqrtReal(cond2);
stats.min = PetscMin(stats.min,cond);
stats.max = PetscMax(stats.max,cond);
stats.sum += cond;
stats.squaresum += cond2;
stats.count++;
}
{
PetscMPIInt blockLengths[2] = {4,1};
MPI_Aint blockOffsets[2] = {offsetof(ex1_stats_t,min),offsetof(ex1_stats_t,count)};
MPI_Datatype blockTypes[2] = {MPIU_REAL,MPIU_INT}, statType;
MPI_Op statReduce;
ierr = MPI_Type_create_struct(2,blockLengths,blockOffsets,blockTypes,&statType);CHKERRQ(ierr);
ierr = MPI_Type_commit(&statType);CHKERRQ(ierr);
ierr = MPI_Op_create(ex1_stats_reduce, PETSC_TRUE, &statReduce);CHKERRQ(ierr);
ierr = MPI_Reduce(&stats,&globalStats,1,statType,statReduce,0,comm);CHKERRQ(ierr);
ierr = MPI_Op_free(&statReduce);CHKERRQ(ierr);
ierr = MPI_Type_free(&statType);CHKERRQ(ierr);
}
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (!rank) {
count = globalStats.count;
min = globalStats.min;
max = globalStats.max;
mean = globalStats.sum / globalStats.count;
stdev = PetscSqrtReal(globalStats.squaresum / globalStats.count - mean * mean);
}
ierr = PetscPrintf(comm,"Mesh with %d cells, shape condition numbers: min = %g, max = %g, mean = %g, stddev = %g\n", count, (double) min, (double) max, (double) mean, (double) stdev);
ierr = PetscFree2(J,invJ);CHKERRQ(ierr);
ierr = DMGetCoarseDM(dm,&dmCoarse);CHKERRQ(ierr);
if (dmCoarse) {
ierr = TestCellShape(dmCoarse);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
. it - column of the Hessenberg that is complete, PGMRES is actually computing two columns ahead of this
*/
static PetscErrorCode KSPPGMRESUpdateHessenberg(KSP ksp,PetscInt it,PetscBool *hapend,PetscReal *res)
{
PetscScalar *hh,*cc,*ss,*rs;
PetscInt j;
PetscReal hapbnd;
KSP_PGMRES *pgmres = (KSP_PGMRES*)(ksp->data);
PetscErrorCode ierr;
PetscFunctionBegin;
hh = HH(0,it); /* pointer to beginning of column to update */
cc = CC(0); /* beginning of cosine rotations */
ss = SS(0); /* beginning of sine rotations */
rs = RS(0); /* right hand side of least squares system */
/* The Hessenberg matrix is now correct through column it, save that form for possible spectral analysis */
for (j=0; j<=it+1; j++) *HES(j,it) = hh[j];
/* check for the happy breakdown */
hapbnd = PetscMin(PetscAbsScalar(hh[it+1] / rs[it]),pgmres->haptol);
if (PetscAbsScalar(hh[it+1]) < hapbnd) {
ierr = PetscInfo4(ksp,"Detected happy breakdown, current hapbnd = %14.12e H(%D,%D) = %14.12e\n",(double)hapbnd,it+1,it,(double)PetscAbsScalar(*HH(it+1,it)));CHKERRQ(ierr);
*hapend = PETSC_TRUE;
}
/* Apply all the previously computed plane rotations to the new column
of the Hessenberg matrix */
/* Note: this uses the rotation [conj(c) s ; -s c], c= cos(theta), s= sin(theta),
and some refs have [c s ; -conj(s) c] (don't be confused!) */
for (j=0; j<it; j++) {
PetscScalar hhj = hh[j];
hh[j] = PetscConj(cc[j])*hhj + ss[j]*hh[j+1];
hh[j+1] = -ss[j] *hhj + cc[j]*hh[j+1];
}
/*
compute the new plane rotation, and apply it to:
1) the right-hand-side of the Hessenberg system (RS)
note: it affects RS(it) and RS(it+1)
2) the new column of the Hessenberg matrix
note: it affects HH(it,it) which is currently pointed to
by hh and HH(it+1, it) (*(hh+1))
thus obtaining the updated value of the residual...
*/
/* compute new plane rotation */
if (!*hapend) {
PetscReal delta = PetscSqrtReal(PetscSqr(PetscAbsScalar(hh[it])) + PetscSqr(PetscAbsScalar(hh[it+1])));
if (delta == 0.0) {
ksp->reason = KSP_DIVERGED_NULL;
PetscFunctionReturn(0);
}
cc[it] = hh[it] / delta; /* new cosine value */
ss[it] = hh[it+1] / delta; /* new sine value */
hh[it] = PetscConj(cc[it])*hh[it] + ss[it]*hh[it+1];
rs[it+1] = -ss[it]*rs[it];
rs[it] = PetscConj(cc[it])*rs[it];
*res = PetscAbsScalar(rs[it+1]);
} else { /* happy breakdown: HH(it+1, it) = 0, therefore we don't need to apply
another rotation matrix (so RH doesn't change). The new residual is
always the new sine term times the residual from last time (RS(it)),
but now the new sine rotation would be zero...so the residual should
be zero...so we will multiply "zero" by the last residual. This might
not be exactly what we want to do here -could just return "zero". */
*res = 0.0;
}
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
}
PetscErrorCode MINPACKslo(PetscInt *n,PetscInt * indrow,PetscInt * jpntr,PetscInt * indcol, PetscInt *ipntr, PetscInt *ndeg,PetscInt * list,
PetscInt * maxclq,PetscInt *iwa1,PetscInt * iwa2,PetscInt * iwa3,PetscInt * iwa4)
{
/* System generated locals */
PetscInt i__1, i__2, i__3, i__4;
/* Local variables */
PetscInt jcol, ic, ip, jp, ir, mindeg, numdeg, numord;
/* Given the sparsity pattern of an m by n matrix A, this */
/* subroutine determines the smallest-last ordering of the */
/* columns of A. */
/* The smallest-last ordering is defined for the loopless */
/* graph G with vertices a(j), j = 1,2,...,n where a(j) is the */
/* j-th column of A and with edge (a(i),a(j)) if and only if */
/* columns i and j have a non-zero in the same row position. */
/* The smallest-last ordering is determined recursively by */
/* letting list(k), k = n,...,1 be a column with least degree */
/* in the subgraph spanned by the un-ordered columns. */
/* Note that the value of m is not needed by slo and is */
/* therefore not present in the subroutine statement. */
/* The subroutine statement is */
/* subroutine slo(n,indrow,jpntr,indcol,ipntr,ndeg,list, */
/* maxclq,iwa1,iwa2,iwa3,iwa4) */
/* where */
/* n is a positive integer input variable set to the number */
/* of columns of A. */
/* indrow is an integer input array which contains the row */
/* indices for the non-zeroes in the matrix A. */
/* jpntr is an integer input array of length n + 1 which */
/* specifies the locations of the row indices in indrow. */
/* The row indices for column j are */
/* indrow(k), k = jpntr(j),...,jpntr(j+1)-1. */
/* Note that jpntr(n+1)-1 is then the number of non-zero */
/* elements of the matrix A. */
/* indcol is an integer input array which contains the */
/* column indices for the non-zeroes in the matrix A. */
/* ipntr is an integer input array of length m + 1 which */
/* specifies the locations of the column indices in indcol. */
/* The column indices for row i are */
/* indcol(k), k = ipntr(i),...,ipntr(i+1)-1. */
/* Note that ipntr(m+1)-1 is then the number of non-zero */
/* elements of the matrix A. */
/* ndeg is an integer input array of length n which specifies */
/* the degree sequence. The degree of the j-th column */
/* of A is ndeg(j). */
/* list is an integer output array of length n which specifies */
/* the smallest-last ordering of the columns of A. The j-th */
/* column in this order is list(j). */
/* maxclq is an integer output variable set to the size */
/* of the largest clique found during the ordering. */
/* iwa1,iwa2,iwa3, and iwa4 are integer work arrays of length n. */
/* Subprograms called */
/* FORTRAN-supplied ... min */
/* Argonne National Laboratory. MINPACK Project. August 1984. */
/* Thomas F. Coleman, Burton S. Garbow, Jorge J. More' */
PetscFunctionBegin;
/* Parameter adjustments */
--iwa4;
--iwa3;
--iwa2;
--list;
--ndeg;
--ipntr;
--indcol;
--jpntr;
--indrow;
/* Function Body */
mindeg = *n;
i__1 = *n;
for (jp = 1; jp <= i__1; ++jp) {
iwa1[jp - 1] = 0;
iwa4[jp] = *n;
list[jp] = ndeg[jp];
/* Computing MIN */
i__2 = mindeg, i__3 = ndeg[jp];
mindeg = PetscMin(i__2,i__3);
}
/* Create a doubly-linked list to access the degrees of the */
/* columns. The pointers for the linked list are as follows. */
/* Each un-ordered column ic is in a list (the degree list) */
/* of columns with the same degree. */
/* iwa1(numdeg) is the first column in the numdeg list */
/* unless iwa1(numdeg) = 0. In this case there are */
/* no columns in the numdeg list. */
/* iwa2(ic) is the column before ic in the degree list */
/* unless iwa2(ic) = 0. In this case ic is the first */
/* column in this degree list. */
/* iwa3(ic) is the column after ic in the degree list */
/* unless iwa3(ic) = 0. In this case ic is the last */
/* column in this degree list. */
/* If ic is an un-ordered column, then list(ic) is the */
/* degree of ic in the graph induced by the un-ordered */
/* columns. If jcol is an ordered column, then list(jcol) */
/* is the smallest-last order of column jcol. */
i__1 = *n;
for (jp = 1; jp <= i__1; ++jp) {
numdeg = ndeg[jp];
iwa2[jp] = 0;
iwa3[jp] = iwa1[numdeg];
if (iwa1[numdeg] > 0) {
iwa2[iwa1[numdeg]] = jp;
}
iwa1[numdeg] = jp;
}
*maxclq = 0;
numord = *n;
/* Beginning of iteration loop. */
L30:
/* Choose a column jcol of minimal degree mindeg. */
L40:
jcol = iwa1[mindeg];
if (jcol > 0) {
goto L50;
}
++mindeg;
goto L40;
L50:
list[jcol] = numord;
/* Mark the size of the largest clique */
/* found during the ordering. */
if (mindeg + 1 == numord && !*maxclq) {
*maxclq = numord;
}
/* Termination test. */
--numord;
if (!numord) {
goto L80;
}
/* Delete column jcol from the mindeg list. */
iwa1[mindeg] = iwa3[jcol];
if (iwa3[jcol] > 0) {
iwa2[iwa3[jcol]] = 0;
}
/* Find all columns adjacent to column jcol. */
iwa4[jcol] = 0;
/* Determine all positions (ir,jcol) which correspond */
/* to non-zeroes in the matrix. */
i__1 = jpntr[jcol + 1] - 1;
for (jp = jpntr[jcol]; jp <= i__1; ++jp) {
ir = indrow[jp];
/* For each row ir, determine all positions (ir,ic) */
/* which correspond to non-zeroes in the matrix. */
i__2 = ipntr[ir + 1] - 1;
for (ip = ipntr[ir]; ip <= i__2; ++ip) {
ic = indcol[ip];
/* Array iwa4 marks columns which are adjacent to */
/* column jcol. */
if (iwa4[ic] > numord) {
iwa4[ic] = numord;
/* Update the pointers to the current degree lists. */
numdeg = list[ic];
--list[ic];
/* Computing MIN */
i__3 = mindeg, i__4 = list[ic];
mindeg = PetscMin(i__3,i__4);
/* Delete column ic from the numdeg list. */
if (!iwa2[ic]) {
iwa1[numdeg] = iwa3[ic];
} else {
iwa3[iwa2[ic]] = iwa3[ic];
}
if (iwa3[ic] > 0) {
iwa2[iwa3[ic]] = iwa2[ic];
}
/* Add column ic to the numdeg-1 list. */
iwa2[ic] = 0;
iwa3[ic] = iwa1[numdeg - 1];
if (iwa1[numdeg - 1] > 0) {
iwa2[iwa1[numdeg - 1]] = ic;
}
iwa1[numdeg - 1] = ic;
}
}
}
/* End of iteration loop. */
goto L30;
L80:
/* Invert the array list. */
i__1 = *n;
for (jcol = 1; jcol <= i__1; ++jcol) {
iwa2[list[jcol]] = jcol;
}
i__1 = *n;
for (jp = 1; jp <= i__1; ++jp) {
list[jp] = iwa2[jp];
}
PetscFunctionReturn(0);
}
PetscErrorCode TSEventHandler(TS ts)
{
PetscErrorCode ierr;
TSEvent event;
PetscReal t;
Vec U;
PetscInt i;
PetscReal dt,dt_min;
PetscInt rollback=0,in[2],out[2];
PetscInt fvalue_sign,fvalueprev_sign;
PetscFunctionBegin;
PetscValidHeaderSpecific(ts,TS_CLASSID,1);
if (!ts->event) PetscFunctionReturn(0);
event = ts->event;
ierr = TSGetTime(ts,&t);CHKERRQ(ierr);
ierr = TSGetTimeStep(ts,&dt);CHKERRQ(ierr);
ierr = TSGetSolution(ts,&U);CHKERRQ(ierr);
if (event->status == TSEVENT_NONE) {
if (ts->steps == 1) /* After first successful step */
event->timestep_orig = ts->ptime - ts->ptime_prev;
event->timestep_prev = dt;
}
if (event->status == TSEVENT_RESET_NEXTSTEP) {
/* Restore time step */
dt = PetscMin(event->timestep_orig,event->timestep_prev);
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->status = TSEVENT_NONE;
}
if (event->status == TSEVENT_NONE) {
event->ptime_end = t;
}
ierr = VecLockPush(U);CHKERRQ(ierr);
ierr = (*event->eventhandler)(ts,t,U,event->fvalue,event->ctx);CHKERRQ(ierr);
ierr = VecLockPop(U);CHKERRQ(ierr);
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->status = TSEVENT_ZERO;
event->fvalue_right[i] = event->fvalue[i];
continue;
}
fvalue_sign = PetscSign(PetscRealPart(event->fvalue[i]));
fvalueprev_sign = PetscSign(PetscRealPart(event->fvalue_prev[i]));
if (fvalueprev_sign != 0 && (fvalue_sign != fvalueprev_sign) && (PetscAbsScalar(event->fvalue_prev[i]) > event->vtol[i])) {
switch (event->direction[i]) {
case -1:
if (fvalue_sign < 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 1:
if (fvalue_sign > 0) {
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
}
break;
case 0:
rollback = 1;
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Event %D interval detected [%g - %g]\n",event->iterctr,i,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->fvalue_right[i] = event->fvalue[i];
event->side[i] = 1;
if (!event->iterctr) event->zerocrossing[i] = PETSC_TRUE;
event->status = TSEVENT_LOCATED_INTERVAL;
break;
}
}
}
in[0] = event->status; in[1] = rollback;
ierr = MPIU_Allreduce(in,out,2,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
event->status = (TSEventStatus)out[0]; rollback = out[1];
if (rollback) event->status = TSEVENT_LOCATED_INTERVAL;
event->nevents_zero = 0;
if (event->status == TSEVENT_ZERO) {
for (i=0; i < event->nevents; i++) {
if (PetscAbsScalar(event->fvalue[i]) < event->vtol[i]) {
event->events_zero[event->nevents_zero++] = i;
if (event->monitor) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: Event %D zero crossing at time %g located in %D iterations\n",i,(double)t,event->iterctr);CHKERRQ(ierr);
}
event->zerocrossing[i] = PETSC_FALSE;
}
event->side[i] = 0;
}
ierr = TSPostEvent(ts,t,U);CHKERRQ(ierr);
dt = event->ptime_end - t;
if (PetscAbsReal(dt) < PETSC_SMALL) { /* we hit the event, continue with the candidate time step */
dt = event->timestep_prev;
event->status = TSEVENT_NONE;
}
ierr = TSSetTimeStep(ts,dt);CHKERRQ(ierr);
event->iterctr = 0;
PetscFunctionReturn(0);
}
if (event->status == TSEVENT_LOCATED_INTERVAL) {
ierr = TSRollBack(ts);CHKERRQ(ierr);
ierr = TSSetConvergedReason(ts,TS_CONVERGED_ITERATING);CHKERRQ(ierr);
event->status = TSEVENT_PROCESSING;
event->ptime_right = t;
} else {
for (i=0; i < event->nevents; i++) {
if (event->status == TSEVENT_PROCESSING && event->zerocrossing[i]) {
/* Compute new time step */
dt = TSEventComputeStepSize(event->ptime_prev,t,event->ptime_right,event->fvalue_prev[i],event->fvalue[i],event->fvalue_right[i],event->side[i],dt);
event->side[i] = -1;
}
event->fvalue_prev[i] = event->fvalue[i];
}
if (event->monitor && event->status == TSEVENT_PROCESSING) {
ierr = PetscViewerASCIIPrintf(event->monitor,"TSEvent: iter %D - Stepping forward as no event detected in interval [%g - %g]\n",event->iterctr,(double)event->ptime_prev,(double)t);CHKERRQ(ierr);
}
event->ptime_prev = t;
}
if (event->status == TSEVENT_PROCESSING) event->iterctr++;
ierr = MPIU_Allreduce(&dt,&dt_min,1,MPIU_REAL,MPIU_MIN,PetscObjectComm((PetscObject)ts));CHKERRQ(ierr);
ierr = TSSetTimeStep(ts,dt_min);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESView_FAS(SNES snes, PetscViewer viewer)
{
SNES_FAS *fas = (SNES_FAS*) snes->data;
PetscBool isFine,iascii,isdraw;
PetscInt i;
PetscErrorCode ierr;
SNES smoothu, smoothd, levelsnes;
PetscFunctionBegin;
ierr = SNESFASCycleIsFine(snes, &isFine);CHKERRQ(ierr);
if (isFine) {
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
if (iascii) {
ierr = PetscViewerASCIIPrintf(viewer, "FAS: type is %s, levels=%D, cycles=%D\n", SNESFASTypes[fas->fastype], fas->levels, fas->n_cycles);CHKERRQ(ierr);
if (fas->galerkin) {
ierr = PetscViewerASCIIPrintf(viewer," Using Galerkin computed coarse grid function evaluation\n");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," Not using Galerkin computed coarse grid function evaluation\n");CHKERRQ(ierr);
}
for (i=0; i<fas->levels; i++) {
ierr = SNESFASGetCycleSNES(snes, i, &levelsnes);CHKERRQ(ierr);
ierr = SNESFASCycleGetSmootherUp(levelsnes, &smoothu);CHKERRQ(ierr);
ierr = SNESFASCycleGetSmootherDown(levelsnes, &smoothd);CHKERRQ(ierr);
if (!i) {
ierr = PetscViewerASCIIPrintf(viewer,"Coarse grid solver -- level %D -------------------------------\n",i);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Down solver (pre-smoother) on level %D -------------------------------\n",i);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
if (smoothd) {
ierr = SNESView(smoothd,viewer);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Not yet available\n");CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
if (i && (smoothd == smoothu)) {
ierr = PetscViewerASCIIPrintf(viewer,"Up solver (post-smoother) same as down solver (pre-smoother)\n");CHKERRQ(ierr);
} else if (i) {
ierr = PetscViewerASCIIPrintf(viewer,"Up solver (post-smoother) on level %D -------------------------------\n",i);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
if (smoothu) {
ierr = SNESView(smoothu,viewer);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Not yet available\n");CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
}
} else if (isdraw) {
PetscDraw draw;
PetscReal x,w,y,bottom,th,wth;
SNES_FAS *curfas = fas;
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawGetCurrentPoint(draw,&x,&y);CHKERRQ(ierr);
ierr = PetscDrawStringGetSize(draw,&wth,&th);CHKERRQ(ierr);
bottom = y - th;
while (curfas) {
if (!curfas->smoothu) {
ierr = PetscDrawPushCurrentPoint(draw,x,bottom);CHKERRQ(ierr);
if (curfas->smoothd) ierr = SNESView(curfas->smoothd,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
} else {
w = 0.5*PetscMin(1.0-x,x);
ierr = PetscDrawPushCurrentPoint(draw,x-w,bottom);CHKERRQ(ierr);
if (curfas->smoothd) ierr = SNESView(curfas->smoothd,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
ierr = PetscDrawPushCurrentPoint(draw,x+w,bottom);CHKERRQ(ierr);
if (curfas->smoothu) ierr = SNESView(curfas->smoothu,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
}
/* this is totally bogus but we have no way of knowing how low the previous one was draw to */
bottom -= 5*th;
if (curfas->next) curfas = (SNES_FAS*)curfas->next->data;
else curfas = NULL;
}
}
}
PetscFunctionReturn(0);
}
static PetscErrorCode TaoLineSearchApply_GPCG(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
TaoLineSearch_GPCG *neP = (TaoLineSearch_GPCG *)ls->data;
PetscErrorCode ierr;
PetscInt i;
PetscBool g_computed=PETSC_FALSE; /* to prevent extra gradient computation */
PetscReal d1,finit,actred,prered,rho, gdx;
PetscFunctionBegin;
/* ls->stepmin - lower bound for step */
/* ls->stepmax - upper bound for step */
/* ls->rtol - relative tolerance for an acceptable step */
/* ls->ftol - tolerance for sufficient decrease condition */
/* ls->gtol - tolerance for curvature condition */
/* ls->nfeval - number of function evaluations */
/* ls->nfeval - number of function/gradient evaluations */
/* ls->max_funcs - maximum number of function evaluations */
ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
ls->step = ls->initstep;
if (!neP->W2) {
ierr = VecDuplicate(x,&neP->W2);CHKERRQ(ierr);
ierr = VecDuplicate(x,&neP->W1);CHKERRQ(ierr);
ierr = VecDuplicate(x,&neP->Gold);CHKERRQ(ierr);
neP->x = x;
ierr = PetscObjectReference((PetscObject)neP->x);CHKERRQ(ierr);
} else if (x != neP->x) {
ierr = VecDestroy(&neP->x);CHKERRQ(ierr);
ierr = VecDestroy(&neP->W1);CHKERRQ(ierr);
ierr = VecDestroy(&neP->W2);CHKERRQ(ierr);
ierr = VecDestroy(&neP->Gold);CHKERRQ(ierr);
ierr = VecDuplicate(x,&neP->W1);CHKERRQ(ierr);
ierr = VecDuplicate(x,&neP->W2);CHKERRQ(ierr);
ierr = VecDuplicate(x,&neP->Gold);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)neP->x);CHKERRQ(ierr);
neP->x = x;
ierr = PetscObjectReference((PetscObject)neP->x);CHKERRQ(ierr);
}
ierr = VecDot(g,s,&gdx);CHKERRQ(ierr);
if (gdx > 0) {
ierr = PetscInfo1(ls,"Line search error: search direction is not descent direction. dot(g,s) = %g\n",(double)gdx);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_FAILED_ASCENT;
PetscFunctionReturn(0);
}
ierr = VecCopy(x,neP->W2);CHKERRQ(ierr);
ierr = VecCopy(g,neP->Gold);CHKERRQ(ierr);
if (ls->bounded) {
/* Compute the smallest steplength that will make one nonbinding variable equal the bound */
ierr = VecStepBoundInfo(x,s,ls->lower,ls->upper,&rho,&actred,&d1);CHKERRQ(ierr);
ls->step = PetscMin(ls->step,d1);
}
rho=0; actred=0;
if (ls->step < 0) {
ierr = PetscInfo1(ls,"Line search error: initial step parameter %g< 0\n",(double)ls->step);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_OTHER;
PetscFunctionReturn(0);
}
/* Initialization */
finit = *f;
for (i=0; i< ls->max_funcs; i++) {
/* Force the step to be within the bounds */
ls->step = PetscMax(ls->step,ls->stepmin);
ls->step = PetscMin(ls->step,ls->stepmax);
ierr = VecCopy(x,neP->W2);CHKERRQ(ierr);
ierr = VecAXPY(neP->W2,ls->step,s);CHKERRQ(ierr);
if (ls->bounded) {
/* Make sure new vector is numerically within bounds */
ierr = VecMedian(neP->W2,ls->lower,ls->upper,neP->W2);CHKERRQ(ierr);
}
/* Gradient is not needed here. Unless there is a separate
gradient routine, compute it here anyway to prevent recomputing at
the end of the line search */
if (ls->hasobjective) {
ierr = TaoLineSearchComputeObjective(ls,neP->W2,f);CHKERRQ(ierr);
g_computed=PETSC_FALSE;
} else if (ls->usegts){
ierr = TaoLineSearchComputeObjectiveAndGTS(ls,neP->W2,f,&gdx);CHKERRQ(ierr);
g_computed=PETSC_FALSE;
} else {
ierr = TaoLineSearchComputeObjectiveAndGradient(ls,neP->W2,f,g);CHKERRQ(ierr);
g_computed=PETSC_TRUE;
}
if (0 == i) {
ls->f_fullstep = *f;
}
actred = *f - finit;
ierr = VecCopy(neP->W2,neP->W1);CHKERRQ(ierr);
ierr = VecAXPY(neP->W1,-1.0,x);CHKERRQ(ierr); /* W1 = W2 - X */
ierr = VecDot(neP->W1,neP->Gold,&prered);CHKERRQ(ierr);
if (fabs(prered)<1.0e-100) prered=1.0e-12;
rho = actred/prered;
/*
If sufficient progress has been obtained, accept the
point. Otherwise, backtrack.
*/
if (actred > 0) {
ierr = PetscInfo(ls,"Step resulted in ascent, rejecting.\n");CHKERRQ(ierr);
ls->step = (ls->step)/2;
} else if (rho > ls->ftol){
break;
} else{
ls->step = (ls->step)/2;
}
/* Convergence testing */
if (ls->step <= ls->stepmin || ls->step >= ls->stepmax) {
ls->reason = TAOLINESEARCH_HALTED_OTHER;
ierr = PetscInfo(ls,"Rounding errors may prevent further progress. May not be a step satisfying\n");CHKERRQ(ierr);
ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n");CHKERRQ(ierr);
break;
}
if (ls->step == ls->stepmax) {
ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
break;
}
if (ls->step == ls->stepmin) {
ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
break;
}
if ((ls->nfeval+ls->nfgeval) >= ls->max_funcs) {
ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",ls->nfeval+ls->nfgeval,ls->max_funcs);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
break;
}
if ((neP->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_RTOL;
break;
}
}
ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",ls->nfeval+ls->nfgeval,(double)ls->step);CHKERRQ(ierr);
/* set new solution vector and compute gradient if necessary */
ierr = VecCopy(neP->W2, x);CHKERRQ(ierr);
if (ls->reason == TAOLINESEARCH_CONTINUE_ITERATING) {
ls->reason = TAOLINESEARCH_SUCCESS;
}
if (!g_computed) {
ierr = TaoLineSearchComputeGradient(ls,x,g);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode Tao_mcstep(TaoLineSearch ls,PetscReal *stx,PetscReal *fx,PetscReal *dx,PetscReal *sty,PetscReal *fy,PetscReal *dy,PetscReal *stp,PetscReal *fp,PetscReal *dp)
{
TaoLineSearch_MT *mtP = (TaoLineSearch_MT *) ls->data;
PetscReal gamma1, p, q, r, s, sgnd, stpc, stpf, stpq, theta;
PetscInt bound;
PetscFunctionBegin;
/* Check the input parameters for errors */
mtP->infoc = 0;
if (mtP->bracket && (*stp <= PetscMin(*stx,*sty) || (*stp >= PetscMax(*stx,*sty)))) SETERRQ(PETSC_COMM_SELF,1,"bad stp in bracket");
if (*dx * (*stp-*stx) >= 0.0) SETERRQ(PETSC_COMM_SELF,1,"dx * (stp-stx) >= 0.0");
if (ls->stepmax < ls->stepmin) SETERRQ(PETSC_COMM_SELF,1,"stepmax > stepmin");
/* Determine if the derivatives have opposite sign */
sgnd = *dp * (*dx / PetscAbsReal(*dx));
if (*fp > *fx) {
/* Case 1: a higher function value.
The minimum is bracketed. If the cubic step is closer
to stx than the quadratic step, the cubic step is taken,
else the average of the cubic and quadratic steps is taken. */
mtP->infoc = 1;
bound = 1;
theta = 3 * (*fx - *fp) / (*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp < *stx) gamma1 = -gamma1;
/* Can p be 0? Check */
p = (gamma1 - *dx) + theta;
q = ((gamma1 - *dx) + gamma1) + *dp;
r = p/q;
stpc = *stx + r*(*stp - *stx);
stpq = *stx + ((*dx/((*fx-*fp)/(*stp-*stx)+*dx))*0.5) * (*stp - *stx);
if (PetscAbsReal(stpc-*stx) < PetscAbsReal(stpq-*stx)) {
stpf = stpc;
} else {
stpf = stpc + 0.5*(stpq - stpc);
}
mtP->bracket = 1;
} else if (sgnd < 0.0) {
/* Case 2: A lower function value and derivatives of
opposite sign. The minimum is bracketed. If the cubic
step is closer to stx than the quadratic (secant) step,
the cubic step is taken, else the quadratic step is taken. */
mtP->infoc = 2;
bound = 0;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dx;
r = p/q;
stpc = *stp + r*(*stx - *stp);
stpq = *stp + (*dp/(*dp-*dx))*(*stx - *stp);
if (PetscAbsReal(stpc-*stp) > PetscAbsReal(stpq-*stp)) {
stpf = stpc;
} else {
stpf = stpq;
}
mtP->bracket = 1;
} else if (PetscAbsReal(*dp) < PetscAbsReal(*dx)) {
/* Case 3: A lower function value, derivatives of the
same sign, and the magnitude of the derivative decreases.
The cubic step is only used if the cubic tends to infinity
in the direction of the step or if the minimum of the cubic
is beyond stp. Otherwise the cubic step is defined to be
either stepmin or stepmax. The quadratic (secant) step is also
computed and if the minimum is bracketed then the step
closest to stx is taken, else the step farthest away is taken. */
mtP->infoc = 3;
bound = 1;
theta = 3*(*fx - *fp)/(*stp - *stx) + *dx + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dx));
s = PetscMax(s,PetscAbsReal(*dp));
/* The case gamma1 = 0 only arises if the cubic does not tend
to infinity in the direction of the step. */
gamma1 = s*PetscSqrtScalar(PetscMax(0.0,PetscPowScalar(theta/s,2.0) - (*dx/s)*(*dp/s)));
if (*stp > *stx) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = (gamma1 + (*dx - *dp)) + gamma1;
r = p/q;
if (r < 0.0 && gamma1 != 0.0) stpc = *stp + r*(*stx - *stp);
else if (*stp > *stx) stpc = ls->stepmax;
else stpc = ls->stepmin;
stpq = *stp + (*dp/(*dp-*dx)) * (*stx - *stp);
if (mtP->bracket) {
if (PetscAbsReal(*stp-stpc) < PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
} else {
if (PetscAbsReal(*stp-stpc) > PetscAbsReal(*stp-stpq)) {
stpf = stpc;
} else {
stpf = stpq;
}
}
} else {
/* Case 4: A lower function value, derivatives of the
same sign, and the magnitude of the derivative does
not decrease. If the minimum is not bracketed, the step
is either stpmin or stpmax, else the cubic step is taken. */
mtP->infoc = 4;
bound = 0;
if (mtP->bracket) {
theta = 3*(*fp - *fy)/(*sty - *stp) + *dy + *dp;
s = PetscMax(PetscAbsReal(theta),PetscAbsReal(*dy));
s = PetscMax(s,PetscAbsReal(*dp));
gamma1 = s*PetscSqrtScalar(PetscPowScalar(theta/s,2.0) - (*dy/s)*(*dp/s));
if (*stp > *sty) gamma1 = -gamma1;
p = (gamma1 - *dp) + theta;
q = ((gamma1 - *dp) + gamma1) + *dy;
r = p/q;
stpc = *stp + r*(*sty - *stp);
stpf = stpc;
} else if (*stp > *stx) {
stpf = ls->stepmax;
} else {
stpf = ls->stepmin;
}
}
/* Update the interval of uncertainty. This update does not
depend on the new step or the case analysis above. */
if (*fp > *fx) {
*sty = *stp;
*fy = *fp;
*dy = *dp;
} else {
if (sgnd < 0.0) {
*sty = *stx;
*fy = *fx;
*dy = *dx;
}
*stx = *stp;
*fx = *fp;
*dx = *dp;
}
/* Compute the new step and safeguard it. */
stpf = PetscMin(ls->stepmax,stpf);
stpf = PetscMax(ls->stepmin,stpf);
*stp = stpf;
if (mtP->bracket && bound) {
if (*sty > *stx) {
*stp = PetscMin(*stx+0.66*(*sty-*stx),*stp);
} else {
*stp = PetscMax(*stx+0.66*(*sty-*stx),*stp);
}
}
PetscFunctionReturn(0);
}
/* This interpolates faces for cells at some stratum */
static PetscErrorCode DMPlexInterpolateFaces_Internal(DM dm, PetscInt cellDepth, DM idm)
{
PetscHashIJKL faceTable;
PetscInt *pStart, *pEnd;
PetscInt cellDim, depth, faceDepth = cellDepth, numPoints = 0, faceSizeAll = 0, face, c, d;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMPlexGetDimension(dm, &cellDim);CHKERRQ(ierr);
ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
++depth;
++cellDepth;
cellDim -= depth - cellDepth;
ierr = PetscMalloc2(depth+1,PetscInt,&pStart,depth+1,PetscInt,&pEnd);CHKERRQ(ierr);
for (d = depth-1; d >= faceDepth; --d) {
ierr = DMPlexGetDepthStratum(dm, d, &pStart[d+1], &pEnd[d+1]);CHKERRQ(ierr);
}
ierr = DMPlexGetDepthStratum(dm, -1, NULL, &pStart[faceDepth]);CHKERRQ(ierr);
pEnd[faceDepth] = pStart[faceDepth];
for (d = faceDepth-1; d >= 0; --d) {
ierr = DMPlexGetDepthStratum(dm, d, &pStart[d], &pEnd[d]);CHKERRQ(ierr);
}
if (pEnd[cellDepth] > pStart[cellDepth]) {ierr = DMPlexGetFaces_Internal(dm, cellDim, pStart[cellDepth], NULL, &faceSizeAll, NULL);CHKERRQ(ierr);}
if (faceSizeAll > 4) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Do not support interpolation of meshes with faces of %D vertices", faceSizeAll);
ierr = PetscHashIJKLCreate(&faceTable);CHKERRQ(ierr);
ierr = PetscHashIJKLSetMultivalued(faceTable, PETSC_FALSE);CHKERRQ(ierr);
for (c = pStart[cellDepth], face = pStart[faceDepth]; c < pEnd[cellDepth]; ++c) {
const PetscInt *cellFaces;
PetscInt numCellFaces, faceSize, cf, f;
ierr = DMPlexGetFaces_Internal(dm, cellDim, c, &numCellFaces, &faceSize, &cellFaces);CHKERRQ(ierr);
if (faceSize != faceSizeAll) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistent face for cell %D of size %D != %D", c, faceSize, faceSizeAll);
for (cf = 0; cf < numCellFaces; ++cf) {
const PetscInt *cellFace = &cellFaces[cf*faceSize];
PetscHashIJKLKey key;
if (faceSize == 2) {
key.i = PetscMin(cellFace[0], cellFace[1]);
key.j = PetscMax(cellFace[0], cellFace[1]);
} else {
key.i = cellFace[0]; key.j = cellFace[1]; key.k = cellFace[2]; key.l = faceSize > 3 ? cellFace[3] : 0;
ierr = PetscSortInt(faceSize, (PetscInt *) &key);
}
ierr = PetscHashIJKLGet(faceTable, key, &f);CHKERRQ(ierr);
if (f < 0) {
ierr = PetscHashIJKLAdd(faceTable, key, face);CHKERRQ(ierr);
f = face++;
}
}
}
pEnd[faceDepth] = face;
ierr = PetscHashIJKLDestroy(&faceTable);CHKERRQ(ierr);
/* Count new points */
for (d = 0; d <= depth; ++d) {
numPoints += pEnd[d]-pStart[d];
}
ierr = DMPlexSetChart(idm, 0, numPoints);CHKERRQ(ierr);
/* Set cone sizes */
for (d = 0; d <= depth; ++d) {
PetscInt coneSize, p;
if (d == faceDepth) {
for (p = pStart[d]; p < pEnd[d]; ++p) {
/* I see no way to do this if we admit faces of different shapes */
ierr = DMPlexSetConeSize(idm, p, faceSizeAll);CHKERRQ(ierr);
}
} else if (d == cellDepth) {
for (p = pStart[d]; p < pEnd[d]; ++p) {
/* Number of cell faces may be different from number of cell vertices*/
ierr = DMPlexGetFaces_Internal(dm, cellDim, p, &coneSize, NULL, NULL);CHKERRQ(ierr);
ierr = DMPlexSetConeSize(idm, p, coneSize);CHKERRQ(ierr);
}
} else {
for (p = pStart[d]; p < pEnd[d]; ++p) {
ierr = DMPlexGetConeSize(dm, p, &coneSize);CHKERRQ(ierr);
ierr = DMPlexSetConeSize(idm, p, coneSize);CHKERRQ(ierr);
}
}
}
ierr = DMSetUp(idm);CHKERRQ(ierr);
/* Get face cones from subsets of cell vertices */
if (faceSizeAll > 4) SETERRQ1(PetscObjectComm((PetscObject) dm), PETSC_ERR_ARG_WRONG, "Do not support interpolation of meshes with faces of %D vertices", faceSizeAll);
ierr = PetscHashIJKLCreate(&faceTable);CHKERRQ(ierr);
ierr = PetscHashIJKLSetMultivalued(faceTable, PETSC_FALSE);CHKERRQ(ierr);
for (d = depth; d > cellDepth; --d) {
const PetscInt *cone;
PetscInt p;
for (p = pStart[d]; p < pEnd[d]; ++p) {
ierr = DMPlexGetCone(dm, p, &cone);CHKERRQ(ierr);
ierr = DMPlexSetCone(idm, p, cone);CHKERRQ(ierr);
ierr = DMPlexGetConeOrientation(dm, p, &cone);CHKERRQ(ierr);
ierr = DMPlexSetConeOrientation(idm, p, cone);CHKERRQ(ierr);
}
}
for (c = pStart[cellDepth], face = pStart[faceDepth]; c < pEnd[cellDepth]; ++c) {
const PetscInt *cellFaces;
PetscInt numCellFaces, faceSize, cf, f;
ierr = DMPlexGetFaces_Internal(dm, cellDim, c, &numCellFaces, &faceSize, &cellFaces);CHKERRQ(ierr);
if (faceSize != faceSizeAll) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistent face for cell %D of size %D != %D", c, faceSize, faceSizeAll);
for (cf = 0; cf < numCellFaces; ++cf) {
const PetscInt *cellFace = &cellFaces[cf*faceSize];
PetscHashIJKLKey key;
if (faceSize == 2) {
key.i = PetscMin(cellFace[0], cellFace[1]);
key.j = PetscMax(cellFace[0], cellFace[1]);
} else {
key.i = cellFace[0]; key.j = cellFace[1]; key.k = cellFace[2]; key.l = faceSize > 3 ? cellFace[3] : 0;
ierr = PetscSortInt(faceSize, (PetscInt *) &key);
}
ierr = PetscHashIJKLGet(faceTable, key, &f);CHKERRQ(ierr);
if (f < 0) {
ierr = DMPlexSetCone(idm, face, cellFace);CHKERRQ(ierr);
ierr = PetscHashIJKLAdd(faceTable, key, face);CHKERRQ(ierr);
f = face++;
ierr = DMPlexInsertCone(idm, c, cf, f);CHKERRQ(ierr);
} else {
const PetscInt *cone;
PetscInt coneSize, ornt, i, j;
ierr = DMPlexInsertCone(idm, c, cf, f);CHKERRQ(ierr);
/* Orient face */
ierr = DMPlexGetConeSize(idm, f, &coneSize);CHKERRQ(ierr);
ierr = DMPlexGetCone(idm, f, &cone);CHKERRQ(ierr);
if (coneSize != faceSize) SETERRQ3(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Invalid number of face vertices %D for face %D should be %D", coneSize, f, faceSize);
/* - First find the initial vertex */
for (i = 0; i < faceSize; ++i) if (cellFace[0] == cone[i]) break;
/* - Try forward comparison */
for (j = 0; j < faceSize; ++j) if (cellFace[j] != cone[(i+j)%faceSize]) break;
if (j == faceSize) {
if ((faceSize == 2) && (i == 1)) ornt = -2;
else ornt = i;
} else {
/* - Try backward comparison */
for (j = 0; j < faceSize; ++j) if (cellFace[j] != cone[(i+faceSize-j)%faceSize]) break;
if (j == faceSize) ornt = -(i+1);
else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_PLIB, "Could not determine face orientation");
}
ierr = DMPlexInsertConeOrientation(idm, c, cf, ornt);CHKERRQ(ierr);
}
}
}
if (face != pEnd[faceDepth]) SETERRQ2(PetscObjectComm((PetscObject) dm), PETSC_ERR_PLIB, "Invalid number of faces %D should be %D", face-pStart[faceDepth], pEnd[faceDepth]-pStart[faceDepth]);
ierr = PetscFree2(pStart,pEnd);CHKERRQ(ierr);
ierr = PetscHashIJKLDestroy(&faceTable);CHKERRQ(ierr);
ierr = DMPlexSymmetrize(idm);CHKERRQ(ierr);
ierr = DMPlexStratify(idm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCView_MG(PC pc,PetscViewer viewer)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_MG_Levels **mglevels = mg->levels;
PetscErrorCode ierr;
PetscInt levels = mglevels ? mglevels[0]->levels : 0,i;
PetscBool iascii,isbinary,isdraw;
PetscFunctionBegin;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
if (iascii) {
const char *cyclename = levels ? (mglevels[0]->cycles == PC_MG_CYCLE_V ? "v" : "w") : "unknown";
ierr = PetscViewerASCIIPrintf(viewer," MG: type is %s, levels=%D cycles=%s\n", PCMGTypes[mg->am],levels,cyclename);CHKERRQ(ierr);
if (mg->am == PC_MG_MULTIPLICATIVE) {
ierr = PetscViewerASCIIPrintf(viewer," Cycles per PCApply=%d\n",mg->cyclesperpcapply);CHKERRQ(ierr);
}
if (mg->galerkin) {
ierr = PetscViewerASCIIPrintf(viewer," Using Galerkin computed coarse grid matrices\n");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer," Not using Galerkin computed coarse grid matrices\n");CHKERRQ(ierr);
}
if (mg->view){
ierr = (*mg->view)(pc,viewer);CHKERRQ(ierr);
}
for (i=0; i<levels; i++) {
if (!i) {
ierr = PetscViewerASCIIPrintf(viewer,"Coarse grid solver -- level -------------------------------\n",i);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"Down solver (pre-smoother) on level %D -------------------------------\n",i);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = KSPView(mglevels[i]->smoothd,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
if (i && mglevels[i]->smoothd == mglevels[i]->smoothu) {
ierr = PetscViewerASCIIPrintf(viewer,"Up solver (post-smoother) same as down solver (pre-smoother)\n");CHKERRQ(ierr);
} else if (i) {
ierr = PetscViewerASCIIPrintf(viewer,"Up solver (post-smoother) on level %D -------------------------------\n",i);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = KSPView(mglevels[i]->smoothu,viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
}
}
} else if (isbinary) {
for (i=levels-1; i>=0; i--) {
ierr = KSPView(mglevels[i]->smoothd,viewer);CHKERRQ(ierr);
if (i && mglevels[i]->smoothd != mglevels[i]->smoothu) {
ierr = KSPView(mglevels[i]->smoothu,viewer);CHKERRQ(ierr);
}
}
} else if (isdraw) {
PetscDraw draw;
PetscReal x,w,y,bottom,th;
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawGetCurrentPoint(draw,&x,&y);CHKERRQ(ierr);
ierr = PetscDrawStringGetSize(draw,NULL,&th);CHKERRQ(ierr);
bottom = y - th;
for (i=levels-1; i>=0; i--) {
if (!mglevels[i]->smoothu || (mglevels[i]->smoothu == mglevels[i]->smoothd)) {
ierr = PetscDrawPushCurrentPoint(draw,x,bottom);CHKERRQ(ierr);
ierr = KSPView(mglevels[i]->smoothd,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
} else {
w = 0.5*PetscMin(1.0-x,x);
ierr = PetscDrawPushCurrentPoint(draw,x+w,bottom);CHKERRQ(ierr);
ierr = KSPView(mglevels[i]->smoothd,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
ierr = PetscDrawPushCurrentPoint(draw,x-w,bottom);CHKERRQ(ierr);
ierr = KSPView(mglevels[i]->smoothu,viewer);CHKERRQ(ierr);
ierr = PetscDrawPopCurrentPoint(draw);CHKERRQ(ierr);
}
ierr = PetscDrawGetBoundingBox(draw,NULL,&bottom,NULL,NULL);CHKERRQ(ierr);
bottom -= th;
}
}
PetscFunctionReturn(0);
}
static int TaoSolve_BNLS(TAO_SOLVER tao, void*solver){
TAO_BNLS *bnls = (TAO_BNLS *)solver;
int info;
TaoInt lsflag,iter=0;
TaoTerminateReason reason=TAO_CONTINUE_ITERATING;
double f,f_full,gnorm,gdx,stepsize=1.0;
TaoTruth success;
TaoVec *XU, *XL;
TaoVec *X, *G=bnls->G, *PG=bnls->PG;
TaoVec *R=bnls->R, *DXFree=bnls->DXFree;
TaoVec *DX=bnls->DX, *Work=bnls->Work;
TaoMat *H, *Hsub=bnls->Hsub;
TaoIndexSet *FreeVariables = bnls->FreeVariables;
TaoFunctionBegin;
/* Check if upper bound greater than lower bound. */
info = TaoGetSolution(tao,&X);CHKERRQ(info); bnls->X=X;
info = TaoGetVariableBounds(tao,&XL,&XU);CHKERRQ(info);
info = TaoEvaluateVariableBounds(tao,XL,XU); CHKERRQ(info);
info = TaoGetHessian(tao,&H);CHKERRQ(info); bnls->H=H;
/* Project the current point onto the feasible set */
info = X->Median(XL,X,XU); CHKERRQ(info);
TaoLinearSolver *tls;
// Modify the linear solver to a conjugate gradient method
info = TaoGetLinearSolver(tao, &tls); CHKERRQ(info);
TaoLinearSolverPetsc *pls;
pls = dynamic_cast <TaoLinearSolverPetsc *> (tls);
// set trust radius to zero
// PETSc ignores this case and should return the negative curvature direction
// at its current default length
pls->SetTrustRadius(0.0);
if(!bnls->M) bnls->M = new TaoLMVMMat(X);
TaoLMVMMat *M = bnls->M;
KSP pksp = pls->GetKSP();
// we will want to provide an initial guess in case neg curvature on the first iteration
info = KSPSetInitialGuessNonzero(pksp,PETSC_TRUE); CHKERRQ(info);
PC ppc;
// Modify the preconditioner to use the bfgs approximation
info = KSPGetPC(pksp, &ppc); CHKERRQ(info);
PetscTruth BFGSPreconditioner=PETSC_FALSE;// debug flag
info = PetscOptionsGetTruth(PETSC_NULL,"-bnls_pc_bfgs",
&BFGSPreconditioner,PETSC_NULL); CHKERRQ(info);
if( BFGSPreconditioner)
{
info=PetscInfo(tao,"TaoSolve_BNLS: using bfgs preconditioner\n");
info = KSPSetNormType(pksp, KSP_NORM_PRECONDITIONED); CHKERRQ(info);
info = PCSetType(ppc, PCSHELL); CHKERRQ(info);
info = PCShellSetName(ppc, "bfgs"); CHKERRQ(info);
info = PCShellSetContext(ppc, M); CHKERRQ(info);
info = PCShellSetApply(ppc, bfgs_apply); CHKERRQ(info);
}
else
{// default to none
info=PetscInfo(tao,"TaoSolve_BNLS: using no preconditioner\n");
info = PCSetType(ppc, PCNONE); CHKERRQ(info);
}
info = TaoComputeMeritFunctionGradient(tao,X,&f,G);CHKERRQ(info);
info = PG->BoundGradientProjection(G,XL,X,XU);CHKERRQ(info);
info = PG->Norm2(&gnorm); CHKERRQ(info);
// Set initial scaling for the function
if (f != 0.0) {
info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
}
else {
info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
}
while (reason==TAO_CONTINUE_ITERATING){
/* Project the gradient and calculate the norm */
info = PG->BoundGradientProjection(G,XL,X,XU);CHKERRQ(info);
info = PG->Norm2(&gnorm); CHKERRQ(info);
info = M->Update(X, PG); CHKERRQ(info);
PetscScalar ewAtol = PetscMin(0.5,gnorm)*gnorm;
info = KSPSetTolerances(pksp,PETSC_DEFAULT,ewAtol,
PETSC_DEFAULT, PETSC_DEFAULT); CHKERRQ(info);
info=PetscInfo1(tao,"TaoSolve_BNLS: gnorm =%g\n",gnorm);
pksp->printreason = PETSC_TRUE;
info = KSPView(pksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(info);
M->View();
info = TaoMonitor(tao,iter++,f,gnorm,0.0,stepsize,&reason);
CHKERRQ(info);
if (reason!=TAO_CONTINUE_ITERATING) break;
info = FreeVariables->WhichEqual(PG,G); CHKERRQ(info);
info = TaoComputeHessian(tao,X,H);CHKERRQ(info);
/* Create a reduced linear system */
info = R->SetReducedVec(G,FreeVariables);CHKERRQ(info);
info = R->Negate();CHKERRQ(info);
/* Use gradient as initial guess */
PetscTruth UseGradientIG=PETSC_FALSE;// debug flag
info = PetscOptionsGetTruth(PETSC_NULL,"-bnls_use_gradient_ig",
&UseGradientIG,PETSC_NULL); CHKERRQ(info);
if(UseGradientIG)
info = DX->CopyFrom(G);
else
{
info=PetscInfo(tao,"TaoSolve_BNLS: use bfgs init guess \n");
info = M->Solve(G, DX, &success);
}
CHKERRQ(info);
info = DXFree->SetReducedVec(DX,FreeVariables);CHKERRQ(info);
info = DXFree->Negate(); CHKERRQ(info);
info = Hsub->SetReducedMatrix(H,FreeVariables,FreeVariables);CHKERRQ(info);
bnls->gamma_factor /= 2;
success = TAO_FALSE;
while (success==TAO_FALSE) {
/* Approximately solve the reduced linear system */
info = TaoPreLinearSolve(tao,Hsub);CHKERRQ(info);
info = TaoLinearSolve(tao,Hsub,R,DXFree,&success);CHKERRQ(info);
info = DX->SetToZero(); CHKERRQ(info);
info = DX->ReducedXPY(DXFree,FreeVariables);CHKERRQ(info);
info = DX->Dot(G,&gdx); CHKERRQ(info);
if (gdx>=0 || success==TAO_FALSE) { /* use bfgs direction */
info = M->Solve(G, DX, &success); CHKERRQ(info);
info = DX->BoundGradientProjection(DX,XL,X,XU); CHKERRQ(info);
info = DX->Negate(); CHKERRQ(info);
// Check for success (descent direction)
info = DX->Dot(G,&gdx); CHKERRQ(info);
if (gdx >= 0) {
// Step is not descent or solve was not successful
// Use steepest descent direction (scaled)
if (f != 0.0) {
info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
}
else {
info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
}
info = M->Reset(); CHKERRQ(info);
info = M->Update(X, G); CHKERRQ(info);
info = DX->CopyFrom(G);
info = DX->Negate(); CHKERRQ(info);
info = DX->Dot(G,&gdx); CHKERRQ(info);
info=PetscInfo1(tao,"LMVM Solve Fail use steepest descent, gdx %22.12e \n",gdx);
}
else {
info=PetscInfo1(tao,"Newton Solve Fail use BFGS direction, gdx %22.12e \n",gdx);
}
success = TAO_TRUE;
// bnls->gamma_factor *= 2;
// bnls->gamma = bnls->gamma_factor*(gnorm);
//#if !defined(PETSC_USE_COMPLEX)
// info=PetscInfo2(tao,"TaoSolve_NLS: modify diagonal (assume same nonzero structure), gamma_factor=%g, gamma=%g\n",bnls->gamma_factor,bnls->gamma);
// CHKERRQ(info);
//#else
// info=PetscInfo3(tao,"TaoSolve_NLS: modify diagonal (asuume same nonzero structure), gamma_factor=%g, gamma=%g, gdx %22.12e \n",
// bnls->gamma_factor,PetscReal(bnls->gamma),gdx);CHKERRQ(info);
//#endif
// info = Hsub->ShiftDiagonal(bnls->gamma);CHKERRQ(info);
// if (f != 0.0) {
// info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
// }
// else {
// info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
// }
// info = M->Reset(); CHKERRQ(info);
// info = M->Update(X, G); CHKERRQ(info);
// success = TAO_FALSE;
} else {
info=PetscInfo1(tao,"Newton Solve is descent direction, gdx %22.12e \n",gdx);
success = TAO_TRUE;
}
}
stepsize=1.0;
info = TaoLineSearchApply(tao,X,G,DX,Work,
&f,&f_full,&stepsize,&lsflag);
CHKERRQ(info);
} /* END MAIN LOOP */
TaoFunctionReturn(0);
}
