static int kinDenseSetup(KINMem kin_mem)
{
KINDlsMem kindls_mem;
int retval;
long int ier;
kindls_mem = (KINDlsMem) lmem;
nje++;
SetToZero(J);
retval = djac(n, uu, fval, J, J_data, vtemp1, vtemp2);
if (retval != 0) {
last_flag = -1;
return(-1);
}
/* Do LU factorization of J */
ier = DenseGETRF(J, lpivots);
/* Return 0 if the LU was complete; otherwise return -1 */
last_flag = ier;
if (ier > 0) return(-1);
return(0);
}
/*
* idaLapackDenseSetup does the setup operations for the dense linear solver.
* It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y',
* updates counters, and calls the dense LU factorization routine.
*/
static int idaLapackDenseSetup(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;
int intn;
idadls_mem = (IDADlsMem) lmem;
intn = (int) n;
/* Call Jacobian function */
nje++;
SetToZero(JJ);
retval = djac(n, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3);
if (retval < 0) {
IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackDenseSetup", 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 */
dgetrf_f77(&intn, &intn, JJ->data, &intn, pivots, &ier);
/* Return 0 if the LU was complete; otherwise return 1 */
last_flag = (long int) ier;
if (ier > 0) return(1);
return(0);
}
static int IDADenseSetup(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 = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata,
tmp1, tmp2, tmp3);
if (retval < 0)
{
IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDADENSE", "IDADenseSetup", 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 = DenseGETRF(JJ, lpivots);
if (retfac != 0)
{
last_flag = retfac;
return(+1);
}
last_flag = IDADLS_SUCCESS;
return(0);
}
static int kinLapackDenseSetup(KINMem kin_mem)
{
KINDlsMem kindls_mem;
int ier, retval;
kindls_mem = (KINDlsMem) lmem;
nje++;
SetToZero(J);
retval = djac(n, uu, fval, J, J_data, vtemp1, vtemp2);
if (retval != 0) {
last_flag = -1;
return(-1);
}
/* Do LU factorization of J */
dgetrf_f77(&n, &n, 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);
}
/*
* cvLapackDenseSetup does the setup operations for the dense 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 dense LU factorization routine.
*/
static int cvLapackDenseSetup(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 = djac(n, 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", "cvLapackDenseSetup", 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 */
dgetrf_f77(&n, &n, 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);
}