static int cpBBDPrecSetupImpl(realtype t, N_Vector y, N_Vector yp, N_Vector r,
realtype gamma, void *bbd_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
int ier, retval;
CPBBDPrecData pdata;
CPodeMem cp_mem;
pdata =(CPBBDPrecData) bbd_data;
cp_mem = (CPodeMem) pdata->cpode_mem;
/* Call cpBBDDQJacImpl for a new Jacobian calculation and store in savedP. */
BandZero(savedP);
retval = cpBBDDQJacImpl(pdata, t, gamma, y, yp,
tmp1, tmp2, tmp3, pdata->tmp4);
if (retval < 0) {
cpProcessError(cp_mem, CPBBDPRE_FUNC_UNRECVR, "CPBBDPRE", "cpBBDPrecSetupImpl", MSGBBDP_FUNC_FAILED);
return(-1);
}
if (retval > 0) {
return(+1);
}
/* Do LU factorization of preconditioner block in place (in savedP). */
ier = BandGBTRF(savedP, pivots);
/* Return 0 if the LU was complete, or +1 otherwise. */
if (ier > 0) return(+1);
return(0);
}
static int CVBBDPrecSetup(realtype t, N_Vector y, N_Vector fy,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *bbd_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
long int ier;
CVBBDPrecData pdata;
pdata = (CVBBDPrecData) bbd_data;
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
BandCopy(savedJ, savedP, mukeep, mlkeep);
} else {
/* Otherwise call CVBBDDQJac for new J value */
*jcurPtr = TRUE;
BandZero(savedJ);
CVBBDDQJac(pdata, t, y, tmp1, tmp2, tmp3);
nge += 1 + MIN(mldq + mudq + 1, Nlocal);
BandCopy(savedJ, savedP, mukeep, mlkeep);
}
/* Scale and add I to get P = I - gamma*J */
BandScale(-gamma, savedP);
BandAddI(savedP);
/* Do LU factorization of P in place */
ier = BandFactor(savedP, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
if (ier > 0) return(1);
return(0);
}
int IDABBDPrecSetup(realtype tt,
N_Vector yy, N_Vector yp, N_Vector rr,
realtype c_j, void *prec_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
long int retfac;
int retval;
IBBDPrecData pdata;
IDAMem IDA_mem;
pdata =(IBBDPrecData) prec_data;
IDA_mem = (IDAMem) pdata->ida_mem;
/* Call IBBDDQJac for a new Jacobian calculation and store in PP. */
BandZero(PP);
retval = IBBDDQJac(pdata, tt, c_j, yy, yp,
tempv1, tempv2, tempv3, pdata->tempv4);
if (retval < 0) {
IDAProcessError(IDA_mem, IDABBDPRE_FUNC_UNRECVR, "IDABBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED);
return(-1);
}
if (retval > 0) {
return(+1);
}
/* Do LU factorization of preconditioner block in place (in PP). */
retfac = BandGBTRF(PP, pivots);
/* Return 0 if the LU was complete, or +1 otherwise. */
if (retfac > 0) return(+1);
return(0);
}
static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *bp_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
long int ier;
CVBandPrecData pdata;
/* Assume matrix and pivots have already been allocated. */
pdata = (CVBandPrecData) bp_data;
if (jok) {
/* If jok = TRUE, use saved copy of J. */
*jcurPtr = FALSE;
BandCopy(savedJ, savedP, mu, ml);
} else {
/* If jok = FALSE, call CVBandPDQJac for new J value. */
*jcurPtr = TRUE;
BandZero(savedJ);
CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2);
BandCopy(savedJ, savedP, mu, ml);
}
/* Scale and add I to get savedP = I - gamma*J. */
BandScale(-gamma, savedP);
BandAddI(savedP);
/* Do LU factorization of matrix. */
ier = BandFactor(savedP, pivots);
/* Return 0 if the LU was complete; otherwise return 1. */
if (ier > 0) return(1);
return(0);
}
static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
N_Vector tmp3)
{
int retval;
long int retfac;
IDABandMem idaband_mem;
idaband_mem = (IDABandMem) lmem;
/* Increment nje counter. */
nje++;
/* Zero out JJ; call Jacobian routine jac; return if it failed. */
BandZero(JJ);
retval = jac(neq, mu, ml, tn, yyp, ypp, rrp, cj,
jacdata, JJ, tmp1, tmp2, tmp3);
last_flag = retval;
if (retval < 0) return(-1);
if (retval > 0) return(+1);
/* Do LU factorization of JJ; return success or fail flag. */
retfac = BandFactor(JJ, pivots);
if (retfac != 0) {
last_flag = 1;
return(+1);
}
last_flag = 0;
return(0);
}
static int CVBandPrecSetup(realtype t, N_Vector y, N_Vector fy,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *bp_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
long int ier;
CVBandPrecData pdata;
CVodeMem cv_mem;
int retval;
/* Assume matrix and pivots have already been allocated. */
pdata = (CVBandPrecData) bp_data;
cv_mem = (CVodeMem) pdata->cvode_mem;
if (jok) {
/* If jok = TRUE, use saved copy of J. */
*jcurPtr = FALSE;
BandCopy(savedJ, savedP, mu, ml);
} else {
/* If jok = FALSE, call CVBandPDQJac for new J value. */
*jcurPtr = TRUE;
BandZero(savedJ);
retval = CVBandPDQJac(pdata, t, y, fy, tmp1, tmp2);
if (retval < 0) {
CVProcessError(cv_mem, CVBANDPRE_RHSFUNC_UNRECVR, "CVBANDPRE", "CVBandPrecSetup", MSGBP_RHSFUNC_FAILED);
return(-1);
}
if (retval > 0) {
return(1);
}
BandCopy(savedJ, savedP, mu, ml);
}
/* Scale and add I to get savedP = I - gamma*J. */
BandScale(-gamma, savedP);
BandAddI(savedP);
/* Do LU factorization of matrix. */
ier = BandFactor(savedP, pivots);
/* Return 0 if the LU was complete; otherwise return 1. */
if (ier > 0) return(1);
return(0);
}
static int cpBBDPrecSetupExpl(realtype t, N_Vector y, N_Vector fy,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *bbd_data,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
int ier;
CPBBDPrecData pdata;
CPodeMem cp_mem;
int retval;
pdata = (CPBBDPrecData) bbd_data;
cp_mem = (CPodeMem) pdata->cpode_mem;
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
BandCopy(savedJ, savedP, mukeep, mlkeep);
} else {
/* Otherwise call cpBBDDQJacExpl for new J value */
*jcurPtr = TRUE;
BandZero(savedJ);
retval = cpBBDDQJacExpl(pdata, t, y, tmp1, tmp2, tmp3);
if (retval < 0) {
cpProcessError(cp_mem, CPBBDPRE_FUNC_UNRECVR, "CPBBDPRE", "cpBBDPrecSetup", MSGBBDP_FUNC_FAILED);
return(-1);
}
if (retval > 0) {
return(1);
}
BandCopy(savedJ, savedP, mukeep, mlkeep);
}
/* Scale and add I to get P = I - gamma*J */
BandScale(-gamma, savedP);
BandAddI(savedP);
/* Do LU factorization of P in place */
ier = BandGBTRF(savedP, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
if (ier > 0) return(1);
return(0);
}
static int CVBandSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1,
N_Vector vtemp2, N_Vector vtemp3)
{
booleantype jbad, jok;
realtype dgamma;
long int ier;
CVBandMem cvband_mem;
cvband_mem = (CVBandMem) lmem;
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = ABS((gamma/gammap) - ONE);
jbad = (nst == 0) || (nst > nstlj + CVB_MSBJ) ||
((convfail == CV_FAIL_BAD_J) && (dgamma < CVB_DGMAX)) ||
(convfail == CV_FAIL_OTHER);
jok = !jbad;
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
BandCopy(savedJ, M, mu, ml);
} else {
/* If jok = FALSE, call jac routine for new J value */
nje++;
nstlj = nst;
*jcurPtr = TRUE;
BandZero(M);
jac(n, mu, ml, M, tn, ypred, fpred, J_data, vtemp1, vtemp2, vtemp3);
BandCopy(M, savedJ, mu, ml);
}
/* Scale and add I to get M = I - gamma*J */
BandScale(-gamma, M);
BandAddI(M);
/* Do LU factorization of M */
ier = BandFactor(M, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
if (ier > 0) {
last_flag = ier;
return(1);
}
last_flag = CVBAND_SUCCESS;
return(0);
}
int PVBBDPrecon(integer N, real t, N_Vector y, N_Vector fy,
boole jok, boole *jcurPtr, real gamma, N_Vector ewt,
real h, real uround, long int *nfePtr, void *P_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
integer Nlocal, ier;
real rely, srur;
PVBBDData pdata;
pdata = (PVBBDData)P_data;
Nlocal = N_VLOCLENGTH(y);
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
BandCopy(savedJ, savedP, mukeep, mlkeep);
} else {
/* Otherwise call PVBBDDQJac for new J value */
*jcurPtr = TRUE;
BandZero(savedJ);
/* Set relative increment for y via dqrely and uround */
srur = RSqrt(uround);
rely = (dqrely == ZERO) ? srur : dqrely;
PVBBDDQJac(Nlocal, mudq, mldq, mukeep, mlkeep, rely, gloc, cfn, savedJ,
f_data, t, y, ewt, h, uround, vtemp1, vtemp2, vtemp3);
nge += 1 + MIN(mldq + mudq + 1, Nlocal);
BandCopy(savedJ, savedP, mukeep, mlkeep);
}
/* Scale and add I to get P = I - gamma*J */
BandScale(-gamma, savedP);
BandAddI(savedP);
/* Do LU factorization of P in place */
ier = BandFactor(savedP, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
if (ier > 0) return(1);
return(0);
}
int KINBBDPrecSetup(N_Vector uu, N_Vector uscale,
N_Vector fval, N_Vector fscale,
void *p_data,
N_Vector vtemp1, N_Vector vtemp2)
{
long int ier;
KBBDPrecData pdata;
KINMem kin_mem;
N_Vector vtemp3;
int retval;
pdata = (KBBDPrecData) p_data;
kin_mem = (KINMem) pdata->kin_mem;
vtemp3 = pdata->vtemp3;
/* call KBBDDQJac for a new jacobian and store in PP */
BandZero(PP);
retval = KBBDDQJac(pdata, uu, uscale, vtemp1, vtemp2, vtemp3);
if (retval != 0) {
KINProcessError(kin_mem, KINBBDPRE_FUNC_UNRECVR, "KINBBDPRE", "KINBBDPrecSetup", MSGBBD_FUNC_FAILED);
return(-1);
}
nge += (1 + MIN(mldq+mudq+1, Nlocal));
/* do LU factorization of P in place (in PP) */
ier = BandGBTRF(PP, pivots);
/* return 0 if the LU was complete, else return 1 */
if (ier > 0) return(1);
else return(0);
}
static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
N_Vector tmp3)
{
int retval;
long int retfac;
IDABandMem idaband_mem;
idaband_mem = (IDABandMem) lmem;
/* Increment nje counter. */
nje++;
/* Zero out JJ; call Jacobian routine jac; return if it failed. */
BandZero(JJ);
retval = jac(neq, mu, ml, tn, yyp, ypp, rrp, cj,
jacdata, JJ, tmp1, tmp2, tmp3);
if (retval < 0) {
IDAProcessError(IDA_mem, IDABAND_JACFUNC_UNRECVR, "IDABAND", "IDABandSetup", MSGB_JACFUNC_FAILED);
last_flag = IDABAND_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = IDABAND_JACFUNC_RECVR;
return(+1);
}
/* Do LU factorization of JJ; return success or fail flag. */
retfac = BandGBTRF(JJ, pivots);
if (retfac != 0) {
last_flag = retfac;
return(+1);
}
last_flag = IDABAND_SUCCESS;
return(0);
}
