static int kinBandSetup(KINMem kin_mem)
{
KINDlsMem kindls_mem;
int retval;
long int ier;
kindls_mem = (KINDlsMem) lmem;
nje++;
SetToZero(J);
retval = bjac(n, mu, ml, uu, fval, J, J_data, vtemp1, vtemp2);
if (retval != 0) {
last_flag = -1;
return(-1);
}
/* Do LU factorization of J */
ier = BandGBTRF(J, lpivots);
/* Return 0 if the LU was complete; otherwise return -1 */
last_flag = ier;
if (ier > 0) return(-1);
return(0);
}
/*
* idaLapackBandSetup does the setup operations for the band linear solver.
* It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y',
* updates counters, and calls the band LU factorization routine.
*/
static int idaLapackBandSetup(IDAMem IDA_mem,
N_Vector yP, N_Vector ypP, N_Vector fctP,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
IDADlsMem idadls_mem;
int ier, retval;
idadls_mem = (IDADlsMem) lmem;
/* Call Jacobian function */
nje++;
SetToZero(JJ);
retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3);
if (retval < 0) {
IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED);
last_flag = IDADLS_JACFUNC_UNRECVR;
return(-1);
} else if (retval > 0) {
last_flag = IDADLS_JACFUNC_RECVR;
return(+1);
}
/* Do LU factorization of M */
dgbtrf_f77(&n, &n, &ml, &mu, JJ->data, &(JJ->ldim), pivots, &ier);
/* Return 0 if the LU was complete; otherwise return 1 */
last_flag = ier;
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;
IDADlsMem idadls_mem;
idadls_mem = (IDADlsMem) lmem;
/* Increment nje counter. */
nje++;
/* Zero out JJ; call Jacobian routine jac; return if it failed. */
SetToZero(JJ);
retval = bjac(neq, mu, ml, tn, cj, yyp, ypp, rrp,
JJ, jacdata, tmp1, tmp2, tmp3);
if (retval < 0) {
IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDASBAND", "IDABandSetup", MSGD_JACFUNC_FAILED);
last_flag = IDADLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
last_flag = IDADLS_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 = IDADLS_SUCCESS;
return(0);
}
static int kinLapackBandSetup(KINMem kin_mem)
{
KINDlsMem kindls_mem;
int ier, retval;
kindls_mem = (KINDlsMem) lmem;
nje++;
SetToZero(J);
retval = bjac(n, mu, ml, uu, fval, J, J_data, vtemp1, vtemp2);
if (retval != 0) {
last_flag = -1;
return(-1);
}
/* Do LU factorization of J */
dgbtrf_f77(&n, &n, &ml, &mu, J->data, &(J->ldim), pivots, &ier);
/* Return 0 if the LU was complete; otherwise return -1 */
last_flag = ier;
if (ier > 0) return(-1);
return(0);
}
/*
* cvLapackBandSetup does the setup operations for the band linear solver.
* It makes a decision whether or not to call the Jacobian evaluation
* routine based on various state variables, and if not it uses the
* saved copy. In any case, it constructs the Newton matrix M = I - gamma*J,
* updates counters, and calls the band LU factorization routine.
*/
static int cvLapackBandSetup(CVodeMem cv_mem, int convfail,
N_Vector yP, N_Vector fctP,
booleantype *jcurPtr,
N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
CVDlsMem cvdls_mem;
realtype dgamma, fact;
booleantype jbad, jok;
int ier, retval, one = 1;
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;
dcopy_f77(&(savedJ->ldata), savedJ->data, &one, M->data, &one);
} else {
/* If jok = FALSE, call jac routine for new J value */
nje++;
nstlj = nst;
*jcurPtr = TRUE;
SetToZero(M);
retval = bjac(n, mu, ml, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3);
if (retval == 0) {
dcopy_f77(&(M->ldata), M->data, &one, savedJ->data, &one);
} else if (retval < 0) {
cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSLAPACK", "cvLapackBandSetup", MSGD_JACFUNC_FAILED);
last_flag = CVDLS_JACFUNC_UNRECVR;
return(-1);
} else if (retval > 0) {
last_flag = CVDLS_JACFUNC_RECVR;
return(1);
}
}
/* Scale J by - gamma */
fact = -gamma;
dscal_f77(&(M->ldata), &fact, M->data, &one);
/* Add identity to get M = I - gamma*J*/
AddIdentity(M);
/* Do LU factorization of M */
dgbtrf_f77(&n, &n, &ml, &mu, M->data, &(M->ldim), pivots, &ier);
/* Return 0 if the LU was complete; otherwise return 1 */
last_flag = ier;
if (ier > 0) return(1);
return(0);
}
