static int CVSpbcgSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight,
N_Vector ynow, N_Vector fnow)
{
realtype bnorm, res_norm;
CVSpilsMem cvspils_mem;
SpbcgMem spbcg_mem;
int nli_inc, nps_inc, retval;
cvspils_mem = (CVSpilsMem) lmem;
spbcg_mem = (SpbcgMem) spils_mem;
/* Test norm(b); if small, return x = 0 or x = b */
deltar = delt * tq[4];
bnorm = N_VWrmsNorm(b, weight);
if (bnorm <= deltar) {
if (mnewt > 0) N_VConst(ZERO, b);
return(0);
}
/* Set vectors ycur and fcur for use by the Atimes and Psolve routines */
ycur = ynow;
fcur = fnow;
/* Set inputs delta and initial guess x = 0 to SpbcgSolve */
delta = deltar * sqrtN;
N_VConst(ZERO, x);
/* Call SpbcgSolve and copy x to b */
retval = SpbcgSolve(spbcg_mem, cv_mem, x, b, pretype, delta,
cv_mem, weight, weight, CVSpilsAtimes, CVSpilsPSolve,
&res_norm, &nli_inc, &nps_inc);
N_VScale(ONE, x, b);
/* Increment counters nli, nps, and ncfl */
nli += nli_inc;
nps += nps_inc;
if (retval != SPBCG_SUCCESS) ncfl++;
/* Interpret return value from SpbcgSolve */
last_flag = retval;
switch(retval) {
case SPBCG_SUCCESS:
return(0);
break;
case SPBCG_RES_REDUCED:
if (mnewt == 0) return(0);
else return(1);
break;
case SPBCG_CONV_FAIL:
return(1);
break;
case SPBCG_PSOLVE_FAIL_REC:
return(1);
break;
case SPBCG_ATIMES_FAIL_REC:
return(1);
break;
case SPBCG_MEM_NULL:
return(-1);
break;
case SPBCG_ATIMES_FAIL_UNREC:
CVProcessError(cv_mem, SPBCG_ATIMES_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_JTIMES_FAILED);
return(-1);
break;
case SPBCG_PSOLVE_FAIL_UNREC:
CVProcessError(cv_mem, SPBCG_PSOLVE_FAIL_UNREC, "CVSPBCG", "CVSpbcgSolve", MSGS_PSOLVE_FAILED);
return(-1);
break;
}
return(0);
}
static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight,
N_Vector yy_now, N_Vector yp_now, N_Vector rr_now)
{
IDASpilsMem idaspils_mem;
SpbcgMem spbcg_mem;
int pretype, nli_inc, nps_inc, retval;
realtype res_norm;
idaspils_mem = (IDASpilsMem) lmem;
spbcg_mem = (SpbcgMem)spils_mem;
/* Set SpbcgSolve convergence test constant epslin, in terms of the
Newton convergence test constant epsNewt and safety factors. The factor
sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the
WRMS norm of the residual vector, rather than the weighted L2 norm. */
epslin = sqrtN*eplifac*epsNewt;
/* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */
ycur = yy_now;
ypcur = yp_now;
rcur = rr_now;
/* Set SpbcgSolve inputs pretype and initial guess xx = 0 */
pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT;
N_VConst(ZERO, xx);
/* Call SpbcgSolve and copy xx to bb */
retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin,
IDA_mem, weight, weight, IDASpilsAtimes,
IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc);
last_flag = retval;
if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb);
else N_VScale(ONE, xx, bb);
/* Increment counters nli, nps, and return if successful */
nli += nli_inc;
nps += nps_inc;
if (retval != SPBCG_SUCCESS) ncfl++;
/* Interpret return value from SpbcgSolve */
last_flag = retval;
switch(retval) {
case SPBCG_SUCCESS:
return(0);
break;
case SPBCG_RES_REDUCED:
return(1);
break;
case SPBCG_CONV_FAIL:
return(1);
break;
case SPBCG_PSOLVE_FAIL_REC:
return(1);
break;
case SPBCG_ATIMES_FAIL_REC:
return(1);
break;
case SPBCG_MEM_NULL:
return(-1);
break;
case SPBCG_ATIMES_FAIL_UNREC:
IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED);
return(-1);
break;
case SPBCG_PSOLVE_FAIL_UNREC:
IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED);
return(-1);
break;
}
return(0);
}
/*---------------------------------------------------------------
ARKMassSpbcgSolve:
This routine handles the call to the generic solver SpbcgSolve
for the solution of the mass matrix system Mx = b with the SPBCG
method. The solution x is returned in the vector b.
We set the tolerance parameter and initial guess (x = 0), call
SpbcgSolve, and copy the solution x into b. The
x-scaling and b-scaling arrays are both equal to weight.
The counters nli, nps, and ncfl are incremented, and the return
value is set according to the success of SpbcgSolve.
---------------------------------------------------------------*/
static int ARKMassSpbcgSolve(ARKodeMem ark_mem, N_Vector b,
N_Vector weight)
{
realtype res_norm;
ARKSpilsMassMem arkspils_mem;
SpbcgMem spbcg_mem;
int nli_inc, nps_inc, retval;
arkspils_mem = (ARKSpilsMassMem) ark_mem->ark_mass_mem;
spbcg_mem = (SpbcgMem) arkspils_mem->s_spils_mem;
/* Set inputs delta and initial guess x = 0 to SpbcgSolve */
arkspils_mem->s_deltar = arkspils_mem->s_eplifac * ark_mem->ark_eLTE;
arkspils_mem->s_delta = arkspils_mem->s_deltar * arkspils_mem->s_sqrtN;
N_VConst(ZERO, arkspils_mem->s_x);
/* Call SpbcgSolve and copy x to b */
retval = SpbcgSolve(spbcg_mem, ark_mem, arkspils_mem->s_x, b,
arkspils_mem->s_pretype, arkspils_mem->s_delta,
ark_mem, weight, weight, ARKSpilsMtimes,
ARKSpilsMPSolve, &res_norm, &nli_inc, &nps_inc);
N_VScale(ONE, arkspils_mem->s_x, b);
/* Increment counters nli, nps, and ncfl */
arkspils_mem->s_nli += nli_inc;
arkspils_mem->s_nps += nps_inc;
if (retval != SPBCG_SUCCESS) arkspils_mem->s_ncfl++;
/* Log solver statistics to diagnostics file (if requested) */
if (ark_mem->ark_report)
fprintf(ark_mem->ark_diagfp, " mass %19.16g %i %i\n",
res_norm, nli_inc, nps_inc);
/* Interpret return value from SpbcgSolve */
arkspils_mem->s_last_flag = retval;
switch(retval) {
case SPBCG_SUCCESS:
return(0);
break;
case SPBCG_RES_REDUCED:
return(1);
break;
case SPBCG_CONV_FAIL:
return(1);
break;
case SPBCG_PSOLVE_FAIL_REC:
return(1);
break;
case SPBCG_ATIMES_FAIL_REC:
return(1);
break;
case SPBCG_MEM_NULL:
return(-1);
break;
case SPBCG_ATIMES_FAIL_UNREC:
arkProcessError(ark_mem, SPBCG_ATIMES_FAIL_UNREC, "ARKSPBCG",
"ARKMassSpbcgSolve", MSGS_MTIMES_FAILED);
return(-1);
break;
case SPBCG_PSOLVE_FAIL_UNREC:
arkProcessError(ark_mem, SPBCG_PSOLVE_FAIL_UNREC, "ARKSPBCG",
"ARKMassSpbcgSolve", MSGS_PSOLVE_FAILED);
return(-1);
break;
}
return(0);
}
static int KINSpbcgSolve(KINMem kin_mem, N_Vector xx, N_Vector bb,
realtype *res_norm)
{
KINSpilsMem kinspils_mem;
SpbcgMem spbcg_mem;
int ret, nli_inc, nps_inc;
kinspils_mem = (KINSpilsMem) lmem;
spbcg_mem = (SpbcgMem) spils_mem;
/* Set initial guess to xx = 0. bb is set, by the routine
calling KINSpbcgSolve, to the RHS vector for the system
to be solved. */
N_VConst(ZERO, xx);
new_uu = TRUE; /* set flag required for user Jacobian routine */
/* call SpbcgSolve */
ret = SpbcgSolve(spbcg_mem, kin_mem, xx, bb, pretype, eps,
kin_mem, fscale, fscale, KINSpilsAtimes,
KINSpilsPSolve, res_norm, &nli_inc, &nps_inc);
/* increment counters nli, nps, and ncfl
(nni is updated in the KINSol main iteration loop) */
nli = nli + (long int) nli_inc;
nps = nps + (long int) nps_inc;
if (printfl > 2)
KINPrintInfo(kin_mem, PRNT_NLI, "KINSPBCG", "KINSpbcgSolve", INFO_NLI, nli_inc);
if (ret != 0) ncfl++;
/* Compute the terms sJpnorm and sfdotJp for use in the global strategy
routines and in KINForcingTerm. Both of these terms are subsequently
corrected if the step is reduced by constraints or the line search.
sJpnorm is the norm of the scaled product (scaled by fscale) of
the current Jacobian matrix J and the step vector p.
sfdotJp is the dot product of the scaled f vector and the scaled
vector J*p, where the scaling uses fscale. */
ret = KINSpilsAtimes(kin_mem, xx, bb);
if (ret == 0) ret = SPBCG_SUCCESS;
else if (ret > 0) ret = SPBCG_ATIMES_FAIL_REC;
else if (ret < 0) ret = SPBCG_ATIMES_FAIL_UNREC;
sJpnorm = N_VWL2Norm(bb,fscale);
N_VProd(bb, fscale, bb);
N_VProd(bb, fscale, bb);
sfdotJp = N_VDotProd(fval, bb);
if (printfl > 2)
KINPrintInfo(kin_mem, PRNT_EPS, "KINSPBCG", "KINSpbcgSolve", INFO_EPS, *res_norm, eps);
/* Interpret return value from SpbcgSolve */
last_flag = ret;
switch(ret) {
case SPBCG_SUCCESS:
case SPBCG_RES_REDUCED:
return(0);
break;
case SPBCG_PSOLVE_FAIL_REC:
case SPBCG_ATIMES_FAIL_REC:
return(1);
break;
case SPBCG_CONV_FAIL:
case SPBCG_MEM_NULL:
case SPBCG_ATIMES_FAIL_UNREC:
case SPBCG_PSOLVE_FAIL_UNREC:
return(-1);
break;
}
return(0);
}
/*---------------------------------------------------------------
ARKSpbcgSolve:
This routine handles the call to the generic solver SpbcgSolve
for the solution of the linear system Ax = b with the SPBCG
method. The solution x is returned in the vector b.
If the WRMS norm of b is small, we return x = b (if this is the
first Newton iteration) or x = 0 (if a later Newton iteration).
Otherwise, we set the tolerance parameter and initial guess
(x = 0), call SpbcgSolve, and copy the solution x into b. The
x-scaling and b-scaling arrays are both equal to weight.
The counters nli, nps, and ncfl are incremented, and the return
value is set according to the success of SpbcgSolve. The
success flag is returned if SpbcgSolve converged, or if this is
the first Newton iteration and the residual norm was reduced
below its initial value.
---------------------------------------------------------------*/
static int ARKSpbcgSolve(ARKodeMem ark_mem, N_Vector b,
N_Vector weight, N_Vector ynow,
N_Vector fnow)
{
realtype bnorm, res_norm;
ARKSpilsMem arkspils_mem;
SpbcgMem spbcg_mem;
int nli_inc, nps_inc, retval;
arkspils_mem = (ARKSpilsMem) ark_mem->ark_lmem;
spbcg_mem = (SpbcgMem) arkspils_mem->s_spils_mem;
/* Test norm(b); if small, return x = 0 or x = b */
arkspils_mem->s_deltar = arkspils_mem->s_eplifac * ark_mem->ark_eLTE;
bnorm = N_VWrmsNorm(b, weight);
if (bnorm <= arkspils_mem->s_deltar) {
if (ark_mem->ark_mnewt > 0) N_VConst(ZERO, b);
return(0);
}
/* Set vectors ycur and fcur for use by the Atimes and Psolve routines */
arkspils_mem->s_ycur = ynow;
arkspils_mem->s_fcur = fnow;
/* Set inputs delta and initial guess x = 0 to SpbcgSolve */
arkspils_mem->s_delta = arkspils_mem->s_deltar * arkspils_mem->s_sqrtN;
N_VConst(ZERO, arkspils_mem->s_x);
/* N_VConst(ark_mem->ark_uround, arkspils_mem->s_x); */
/* Call SpbcgSolve and copy x to b */
retval = SpbcgSolve(spbcg_mem, ark_mem, arkspils_mem->s_x, b,
arkspils_mem->s_pretype, arkspils_mem->s_delta,
ark_mem, weight, weight, ARKSpilsAtimes,
ARKSpilsPSolve, &res_norm, &nli_inc, &nps_inc);
N_VScale(ONE, arkspils_mem->s_x, b);
/* Increment counters nli, nps, and ncfl */
arkspils_mem->s_nli += nli_inc;
arkspils_mem->s_nps += nps_inc;
if (retval != SPBCG_SUCCESS) arkspils_mem->s_ncfl++;
/* Log solver statistics to diagnostics file (if requested) */
if (ark_mem->ark_report)
fprintf(ark_mem->ark_diagfp, " kry %19.16g %19.16g %i %i\n",
bnorm, res_norm, nli_inc, nps_inc);
/* Interpret return value from SpbcgSolve */
arkspils_mem->s_last_flag = retval;
switch(retval) {
case SPBCG_SUCCESS:
return(0);
break;
case SPBCG_RES_REDUCED:
/* allow reduction but not solution on first Newton iteration,
otherwise return with a recoverable failure */
if (ark_mem->ark_mnewt == 0) return(0);
else return(1);
break;
case SPBCG_CONV_FAIL:
return(1);
break;
case SPBCG_PSOLVE_FAIL_REC:
return(1);
break;
case SPBCG_ATIMES_FAIL_REC:
return(1);
break;
case SPBCG_MEM_NULL:
return(-1);
break;
case SPBCG_ATIMES_FAIL_UNREC:
arkProcessError(ark_mem, SPBCG_ATIMES_FAIL_UNREC, "ARKSPBCG",
"ARKSpbcgSolve", MSGS_JTIMES_FAILED);
return(-1);
break;
case SPBCG_PSOLVE_FAIL_UNREC:
arkProcessError(ark_mem, SPBCG_PSOLVE_FAIL_UNREC, "ARKSPBCG",
"ARKSpbcgSolve", MSGS_PSOLVE_FAILED);
return(-1);
break;
}
return(0);
}
