static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1,
N_Vector vtemp2, N_Vector vtemp3)
{
realtype r;
N_Vector ftemp, y;
booleantype invOK;
CVDiagMem cvdiag_mem;
int retval;
cvdiag_mem = (CVDiagMem) lmem;
/* Rename work vectors for use as temporary values of y and f */
ftemp = vtemp1;
y = vtemp2;
/* Form y with perturbation = FRACT*(func. iter. correction) */
r = FRACT * rl1;
N_VLinearSum(h, fpred, -ONE, zn[1], ftemp);
N_VLinearSum(r, ftemp, ONE, ypred, y);
/* Evaluate f at perturbed y */
retval = f(tn, y, M, cv_mem->cv_user_data);
nfeDI++;
if (retval < 0) {
cvProcessError(cv_mem, CVDIAG_RHSFUNC_UNRECVR, "CVDIAG", "CVDiagSetup", MSGDG_RHSFUNC_FAILED);
last_flag = CVDIAG_RHSFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = CVDIAG_RHSFUNC_RECVR;
return(1);
}
/* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */
N_VLinearSum(ONE, M, -ONE, fpred, M);
N_VLinearSum(FRACT, ftemp, -h, M, M);
N_VProd(ftemp, ewt, y);
/* Protect against deltay_i being at roundoff level */
N_VCompare(uround, y, bit);
N_VAddConst(bit, -ONE, bitcomp);
N_VProd(ftemp, bit, y);
N_VLinearSum(FRACT, y, -ONE, bitcomp, y);
N_VDiv(M, y, M);
N_VProd(M, bit, M);
N_VLinearSum(ONE, M, -ONE, bitcomp, M);
/* Invert M with test for zero components */
invOK = N_VInvTest(M, M);
if (!invOK) {
last_flag = CVDIAG_INV_FAIL;
return(1);
}
/* Set jcur = TRUE, save gamma in gammasv, and return */
*jcurPtr = TRUE;
gammasv = gamma;
last_flag = CVDIAG_SUCCESS;
return(0);
}
void N_VCompare_SensWrapper(realtype c, N_Vector x, N_Vector z)
{
int i;
for (i=0; i < NV_NVECS_SW(x); i++)
N_VCompare(c, NV_VEC_SW(x,i), NV_VEC_SW(z,i));
return;
}
