static int
CVDenseSetup(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;
integertype ier;
CVDenseMem cvdense_mem;
cvdense_mem = (CVDenseMem) lmem;
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = ABS((gamma / gammap) - ONE);
jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) ||
((convfail == FAIL_BAD_J) && (dgamma < CVD_DGMAX)) ||
(convfail == FAIL_OTHER);
jok = !jbad;
if (jok)
{
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
DenseCopy(savedJ, M);
}
else
{
/* If jok = FALSE, call jac routine for new J value */
nje++;
if (iopt != NULL)
iopt[DENSE_NJE] = nje;
nstlj = nst;
*jcurPtr = TRUE;
DenseZero(M);
jac(N, M, f, f_data, tn, ypred, fpred, ewt, h,
uround, J_data, &nfe, vtemp1, vtemp2, vtemp3);
DenseCopy(M, savedJ);
}
/* Scale and add I to get M = I - gamma*J */
DenseScale(-gamma, M);
DenseAddI(M);
/* Do LU factorization of M */
ier = DenseFactor(M, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
if (ier > 0)
return (1);
return (0);
}
static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
N_Vector fpred, booleantype *jcurPtr,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
CVDlsMem cvdls_mem;
booleantype jbad, jok;
realtype dgamma;
int retval;
long int ier;
cvdls_mem = (CVDlsMem) lmem;
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = ABS((gamma/gammap) - ONE);
jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) ||
((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) ||
(convfail == CV_FAIL_OTHER);
jok = !jbad;
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
DenseCopy(savedJ, M);
} else {
/* If jok = FALSE, call jac routine for new J value */
nje++;
nstlj = nst;
*jcurPtr = TRUE;
SetToZero(M);
retval = jac(n, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3);
if (retval < 0) {
cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSDENSE", "cvDenseSetup", MSGD_JACFUNC_FAILED);
last_flag = CVDLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = CVDLS_JACFUNC_RECVR;
return(1);
}
DenseCopy(M, savedJ);
}
/* Scale and add I to get M = I - gamma*J */
DenseScale(-gamma, M);
AddIdentity(M);
/* Do LU factorization of M */
ier = DenseGETRF(M, lpivots);
/* Return 0 if the LU was complete; otherwise return 1 */
last_flag = ier;
if (ier > 0) return(1);
return(0);
}
CAMLprim value c_densematrix_scale(value vc, value va)
{
CAMLparam2(vc, va);
DenseScale(Double_val(vc), DLSMAT(va));
CAMLreturn (Val_unit);
}
static int cpDenseSetup(CPodeMem cp_mem, int convfail,
N_Vector yP, N_Vector ypP, N_Vector fctP,
booleantype *jcurPtr,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
booleantype jbad, jok;
realtype dgamma;
long int ier;
CPDlsMem cpdls_mem;
int retval;
cpdls_mem = (CPDlsMem) lmem;
switch (ode_type) {
case CP_EXPL:
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = ABS((gamma/gammap) - ONE);
jbad = (nst == 0) || (nst > nstlj + CPD_MSBJ) ||
((convfail == CP_FAIL_BAD_J) && (dgamma < CPD_DGMAX)) ||
(convfail == CP_FAIL_OTHER);
jok = !jbad;
/* Test if it is enough to use a saved Jacobian copy */
if (jok) {
*jcurPtr = FALSE;
DenseCopy(savedJ, M);
} else {
nstlj = nst;
*jcurPtr = TRUE;
DenseZero(M);
retval = jacE(n, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3);
nje++;
if (retval < 0) {
cpProcessError(cp_mem, CPDIRECT_JACFUNC_UNRECVR, "CPDENSE", "cpDenseSetup", MSGD_JACFUNC_FAILED);
last_flag = CPDIRECT_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = CPDIRECT_JACFUNC_RECVR;
return(1);
}
DenseCopy(M, savedJ);
}
/* Scale and add I to get M = I - gamma*J */
DenseScale(-gamma, M);
DenseAddI(M);
break;
case CP_IMPL:
/* Initialize Jacobian to 0 and call Jacobian function */
DenseZero(M);
retval = jacI(n, tn, gamma, yP, ypP, fctP, M, J_data, tmp1, tmp2, tmp3);
nje++;
if (retval < 0) {
cpProcessError(cp_mem, CPDIRECT_JACFUNC_UNRECVR, "CPDENSE", "cpDenseSetup", MSGD_JACFUNC_FAILED);
last_flag = CPDIRECT_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = CPDIRECT_JACFUNC_RECVR;
return(1);
}
break;
}
/* Do LU factorization of M */
ier = DenseGETRF(M, pivots);
/* Return 0 if the LU was complete; otherwise return 1 */
last_flag = ier;
if (ier > 0) return(1);
return(0);
}