/*---------------------------------------------------------------
IDABBDPrecSetup:
IDABBDPrecSetup generates a band-block-diagonal preconditioner
matrix, where the local block (on this processor) is a band
matrix. Each local block is computed by a difference quotient
scheme via calls to the user-supplied routines glocal, gcomm.
After generating the block in the band matrix PP, this routine
does an LU factorization in place in PP.
The IDABBDPrecSetup parameters used here are as follows:
tt is the current value of the independent variable t.
yy is the current value of the dependent variable vector,
namely the predicted value of y(t).
yp is the current value of the derivative vector y',
namely the predicted value of y'(t).
c_j is the scalar in the system Jacobian, proportional to 1/hh.
bbd_data is the pointer to BBD memory set by IDABBDInit
The argument rr is not used.
Return value:
The value returned by this IDABBDPrecSetup function is a int
flag indicating whether it was successful. This value is
0 if successful,
> 0 for a recoverable error (step will be retried), or
< 0 for a nonrecoverable error (step fails).
----------------------------------------------------------------*/
static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp,
N_Vector rr, realtype c_j, void *bbd_data)
{
sunindextype ier;
IBBDPrecData pdata;
IDAMem IDA_mem;
int retval;
pdata =(IBBDPrecData) bbd_data;
IDA_mem = (IDAMem) pdata->ida_mem;
/* Call IBBDDQJac for a new Jacobian calculation and store in PP. */
retval = SUNMatZero(pdata->PP);
retval = IBBDDQJac(pdata, tt, c_j, yy, yp, pdata->tempv1,
pdata->tempv2, pdata->tempv3, pdata->tempv4);
if (retval < 0) {
IDAProcessError(IDA_mem, -1, "IDASBBDPRE", "IDABBDPrecSetup",
MSGBBD_FUNC_FAILED);
return(-1);
}
if (retval > 0) {
return(+1);
}
/* Do LU factorization of matrix and return error flag */
ier = SUNLinSolSetup_Band(pdata->LS, pdata->PP);
return(ier);
}
int jacrob(realtype tt, realtype cj,
N_Vector yy, N_Vector yp, N_Vector resvec,
SUNMatrix JJ, void *user_data,
N_Vector tempv1, N_Vector tempv2, N_Vector tempv3)
{
realtype *yval;
sunindextype *colptrs = SUNSparseMatrix_IndexPointers(JJ);
sunindextype *rowvals = SUNSparseMatrix_IndexValues(JJ);
realtype *data = SUNSparseMatrix_Data(JJ);
yval = N_VGetArrayPointer(yy);
SUNMatZero(JJ);
colptrs[0] = 0;
colptrs[1] = 3;
colptrs[2] = 6;
colptrs[3] = 9;
/* column 0 */
data[0] = RCONST(-0.04) - cj;
rowvals[0] = 0;
data[1] = RCONST(0.04);
rowvals[1] = 1;
data[2] = ONE;
rowvals[2] = 2;
/* column 1 */
data[3] = RCONST(1.0e4)*yval[2];
rowvals[3] = 0;
data[4] = (RCONST(-1.0e4)*yval[2]) - (RCONST(6.0e7)*yval[1]) - cj;
rowvals[4] = 1;
data[5] = ONE;
rowvals[5] = 2;
/* column 2 */
data[6] = RCONST(1.0e4)*yval[1];
rowvals[6] = 0;
data[7] = RCONST(-1.0e4)*yval[1];
rowvals[7] = 1;
data[8] = ONE;
rowvals[8] = 2;
return(0);
}
/*-----------------------------------------------------------------
cvLsSetup
This conditionally calls the LS 'setup' routine.
When using a SUNMatrix object, this determines whether
to update a Jacobian matrix (or use a stored version), based
on heuristics regarding previous convergence issues, the number
of time steps since it was last updated, etc.; it then creates
the system matrix from this, the 'gamma' factor and the
identity matrix, A = I-gamma*J.
This routine then calls the LS 'setup' routine with A.
-----------------------------------------------------------------*/
int cvLsSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
N_Vector fpred, booleantype *jcurPtr,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
CVLsMem cvls_mem;
realtype dgamma;
int retval;
/* access CVLsMem structure */
if (cv_mem->cv_lmem==NULL) {
cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVLS",
"cvLsSetup", MSG_LS_LMEM_NULL);
return(CVLS_LMEM_NULL);
}
cvls_mem = (CVLsMem) cv_mem->cv_lmem;
/* Set CVLs N_Vector pointers to current solution and rhs */
cvls_mem->ycur = ypred;
cvls_mem->fcur = fpred;
/* Use nst, gamma/gammap, and convfail to set J/P eval. flag jok */
dgamma = SUNRabs((cv_mem->cv_gamma/cv_mem->cv_gammap) - ONE);
cvls_mem->jbad = (cv_mem->cv_nst == 0) ||
(cv_mem->cv_nst > cvls_mem->nstlj + cvls_mem->msbj) ||
((convfail == CV_FAIL_BAD_J) && (dgamma < CVLS_DGMAX)) ||
(convfail == CV_FAIL_OTHER);
/* If using a NULL SUNMatrix, set jcur to jbad; otherwise update J as appropriate */
if (cvls_mem->A == NULL) {
*jcurPtr = cvls_mem->jbad;
} else {
/* If jbad = SUNFALSE, use saved copy of J */
if (!cvls_mem->jbad) {
*jcurPtr = SUNFALSE;
retval = SUNMatCopy(cvls_mem->savedJ, cvls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVLS",
"cvLsSetup", MSG_LS_SUNMAT_FAILED);
cvls_mem->last_flag = CVLS_SUNMAT_FAIL;
return(cvls_mem->last_flag);
}
/* If jbad = SUNTRUE, call jac routine for new J value */
} else {
cvls_mem->nje++;
cvls_mem->nstlj = cv_mem->cv_nst;
*jcurPtr = SUNTRUE;
retval = SUNMatZero(cvls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVLS",
"cvLsSetup", MSG_LS_SUNMAT_FAILED);
cvls_mem->last_flag = CVLS_SUNMAT_FAIL;
return(cvls_mem->last_flag);
}
retval = cvls_mem->jac(cv_mem->cv_tn, ypred, fpred, cvls_mem->A,
cvls_mem->J_data, vtemp1, vtemp2, vtemp3);
if (retval < 0) {
cvProcessError(cv_mem, CVLS_JACFUNC_UNRECVR, "CVLS",
"cvLsSetup", MSG_LS_JACFUNC_FAILED);
cvls_mem->last_flag = CVLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
cvls_mem->last_flag = CVLS_JACFUNC_RECVR;
return(1);
}
retval = SUNMatCopy(cvls_mem->A, cvls_mem->savedJ);
if (retval) {
cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVLS",
"cvLsSetup", MSG_LS_SUNMAT_FAILED);
cvls_mem->last_flag = CVLS_SUNMAT_FAIL;
return(cvls_mem->last_flag);
}
}
/* Scale and add I to get A = I - gamma*J */
retval = SUNMatScaleAddI(-cv_mem->cv_gamma, cvls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVLS",
"cvLsSetup", MSG_LS_SUNMAT_FAILED);
cvls_mem->last_flag = CVLS_SUNMAT_FAIL;
return(cvls_mem->last_flag);
}
}
/* Call LS setup routine -- the LS may call cvLsPSetup, who will
pass the heuristic suggestions above to the user code(s) */
cvls_mem->last_flag = SUNLinSolSetup(cvls_mem->LS, cvls_mem->A);
/* If the SUNMatrix was NULL, update heuristics flags */
if (cvls_mem->A == NULL) {
/* If user set jcur to SUNTRUE, increment npe and save nst value */
if (*jcurPtr) {
cvls_mem->npe++;
cvls_mem->nstlj = cv_mem->cv_nst;
}
/* Update jcur flag if we suggested an update */
if (cvls_mem->jbad) *jcurPtr = SUNTRUE;
}
return(cvls_mem->last_flag);
}
/*-----------------------------------------------------------------
cvDlsSetup
-----------------------------------------------------------------
This routine determines whether to update a Jacobian matrix (or
use a stored version), based on heuristics regarding previous
convergence issues, the number of time steps since it was last
updated, etc.; it then creates the system matrix from this, the
'gamma' factor and the identity matrix,
A = I-gamma*J.
This routine then calls the LS 'setup' routine with A.
-----------------------------------------------------------------*/
int cvDlsSetup(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;
CVDlsMem cvdls_mem;
int retval;
/* Return immediately if cv_mem or cv_mem->cv_lmem are NULL */
if (cv_mem == NULL) {
cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS",
"cvDlsSetup", MSGD_CVMEM_NULL);
return(CVDLS_MEM_NULL);
}
if (cv_mem->cv_lmem == NULL) {
cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS",
"cvDlsSetup", MSGD_LMEM_NULL);
return(CVDLS_LMEM_NULL);
}
cvdls_mem = (CVDlsMem) cv_mem->cv_lmem;
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = SUNRabs((cv_mem->cv_gamma/cv_mem->cv_gammap) - ONE);
jbad = (cv_mem->cv_nst == 0) ||
(cv_mem->cv_nst > cvdls_mem->nstlj + CVD_MSBJ) ||
((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) ||
(convfail == CV_FAIL_OTHER);
jok = !jbad;
/* If jok = SUNTRUE, use saved copy of J */
if (jok) {
*jcurPtr = SUNFALSE;
retval = SUNMatCopy(cvdls_mem->savedJ, cvdls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVDLS_SUNMAT_FAIL, "CVDLS",
"cvDlsSetup", MSGD_MATCOPY_FAILED);
cvdls_mem->last_flag = CVDLS_SUNMAT_FAIL;
return(-1);
}
/* If jok = SUNFALSE, call jac routine for new J value */
} else {
cvdls_mem->nje++;
cvdls_mem->nstlj = cv_mem->cv_nst;
*jcurPtr = SUNTRUE;
retval = SUNMatZero(cvdls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVDLS_SUNMAT_FAIL, "CVDLS",
"cvDlsSetup", MSGD_MATZERO_FAILED);
cvdls_mem->last_flag = CVDLS_SUNMAT_FAIL;
return(-1);
}
retval = cvdls_mem->jac(cv_mem->cv_tn, ypred,
fpred, cvdls_mem->A,
cvdls_mem->J_data, vtemp1, vtemp2, vtemp3);
if (retval < 0) {
cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVDLS",
"cvDlsSetup", MSGD_JACFUNC_FAILED);
cvdls_mem->last_flag = CVDLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
cvdls_mem->last_flag = CVDLS_JACFUNC_RECVR;
return(1);
}
retval = SUNMatCopy(cvdls_mem->A, cvdls_mem->savedJ);
if (retval) {
cvProcessError(cv_mem, CVDLS_SUNMAT_FAIL, "CVDLS",
"cvDlsSetup", MSGD_MATCOPY_FAILED);
cvdls_mem->last_flag = CVDLS_SUNMAT_FAIL;
return(-1);
}
}
/* Scale and add I to get A = I - gamma*J */
retval = SUNMatScaleAddI(-cv_mem->cv_gamma, cvdls_mem->A);
if (retval) {
cvProcessError(cv_mem, CVDLS_SUNMAT_FAIL, "CVDLS",
"cvDlsSetup", MSGD_MATSCALEADDI_FAILED);
cvdls_mem->last_flag = CVDLS_SUNMAT_FAIL;
return(-1);
}
/* Call generic linear solver 'setup' with this system matrix, and
return success/failure flag */
cvdls_mem->last_flag = SUNLinSolSetup(cvdls_mem->LS, cvdls_mem->A);
return(cvdls_mem->last_flag);
}
