static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del,
realtype tol, N_Vector ewt, void* ida_mem)
{
IDAMem IDA_mem;
int m, retval;
realtype delnrm;
realtype rate;
if (ida_mem == NULL) {
IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsConvTest", MSG_NO_MEM);
return(IDA_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* compute the norm of the correction */
delnrm = N_VWrmsNorm(del, ewt);
/* get the current nonlinear solver iteration count */
retval = SUNNonlinSolGetCurIter(NLS, &m);
if (retval != IDA_SUCCESS) return(IDA_MEM_NULL);
/* test for convergence, first directly, then with rate estimate. */
if (m == 0){
IDA_mem->ida_oldnrm = delnrm;
if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS);
} else {
rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m );
if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR);
IDA_mem->ida_ss = rate/(ONE - rate);
}
if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS);
/* not yet converged */
return(SUN_NLS_CONTINUE);
}
static int IDAKLUSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
N_Vector tmp3)
{
int retval;
realtype tn, cj;
IDASlsMem idasls_mem;
IDASlsSparseJacFn jaceval;
KLUData klu_data;
SlsMat JacMat;
void *jacdata;
realtype uround_twothirds;
uround_twothirds = SUNRpowerR(IDA_mem->ida_uround,TWOTHIRDS);
idasls_mem = (IDASlsMem) (IDA_mem->ida_lmem);
tn = IDA_mem->ida_tn;
cj = IDA_mem->ida_cj;
klu_data = (KLUData) idasls_mem->s_solver_data;
jaceval = idasls_mem->s_jaceval;
jacdata = idasls_mem->s_jacdata;
JacMat = idasls_mem->s_JacMat;
/* Check that Jacobian eval routine is set */
if (jaceval == NULL) {
IDAProcessError(IDA_mem, IDASLS_JAC_NOSET, "IDASLS", "IDAKLUSetup",
MSGSP_JAC_NOSET);
free(idasls_mem); idasls_mem = NULL;
return(IDASLS_JAC_NOSET);
}
/* Increment nje counter and call Jacobian eval routine. */
idasls_mem->s_nje++;
retval = jaceval(tn, cj, yyp, ypp, rrp, JacMat, jacdata,
tmp1, tmp2, tmp3);
if (retval < 0) {
IDAProcessError(IDA_mem, IDASLS_JACFUNC_UNRECVR, "IDASLS",
"IDAKLUSetup", MSGSP_JACFUNC_FAILED);
idasls_mem->s_last_flag = IDASLS_JACFUNC_UNRECVR;
return(IDASLS_JACFUNC_UNRECVR);
}
if (retval > 0) {
idasls_mem->s_last_flag = IDASLS_JACFUNC_RECVR;
return(+1);
}
if (idasls_mem->s_first_factorize) {
/* ------------------------------------------------------------
Get the symbolic factorization
------------------------------------------------------------*/
/* Update the ordering option with any user-updated values from
calls to IDAKLUSetOrdering */
klu_data->s_Common.ordering = klu_data->s_ordering;
klu_data->s_Symbolic = klu_analyze(JacMat->N, JacMat->colptrs,
JacMat->rowvals, &(klu_data->s_Common));
if (klu_data->s_Symbolic == NULL) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
/* ------------------------------------------------------------
Compute the LU factorization of the Jacobian.
------------------------------------------------------------*/
klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals, JacMat->data,
klu_data->s_Symbolic, &(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
idasls_mem->s_first_factorize = 0;
}
else {
retval = klu_refactor(JacMat->colptrs, JacMat->rowvals, JacMat->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
/*-----------------------------------------------------------
Check if a cheap estimate of the reciprocal of the condition
number is getting too small. If so, delete
the prior numeric factorization and recompute it.
-----------------------------------------------------------*/
retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.rcond) < uround_twothirds ) {
/* Condition number may be getting large.
Compute more accurate estimate */
retval = klu_condest(JacMat->colptrs, JacMat->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup",
MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.condest) >
(1.0/uround_twothirds) ) {
/* More accurate estimate also says condition number is
large, so recompute the numeric factorization */
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals,
JacMat->data, klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS",
"IDAKLUSetup", MSGSP_PACKAGE_FAIL);
return(IDASLS_PACKAGE_FAIL);
}
}
}
}
idasls_mem->s_last_flag = IDASLS_SUCCESS;
return(0);
}
/*---------------------------------------------------------------
arkMassKLUSetup:
This routine does the setup operations for the ARKMassKLU
linear solver module. It calls the mass matrix evaluation
routine, updates counters, and calls the LU factorization
routine. The return value is either
ARkSLS_SUCCESS = 0 if successful,
+1 if the Meval routine failed recoverably or the
LU factorization failed, or
-1 if the Meval routine failed unrecoverably.
---------------------------------------------------------------*/
static int arkMassKLUSetup(ARKodeMem ark_mem, N_Vector vtemp1,
N_Vector vtemp2, N_Vector vtemp3)
{
ARKSlsMassMem arksls_mem;
KLUData klu_data;
int retval;
realtype uround_twothirds;
uround_twothirds = SUNRpowerR(ark_mem->ark_uround,TWOTHIRDS);
arksls_mem = (ARKSlsMassMem) ark_mem->ark_mass_mem;
klu_data = (KLUData) arksls_mem->s_solver_data;
/* Check that mass matrix eval routine is set */
if (arksls_mem->s_Meval == NULL) {
arkProcessError(ark_mem, ARKSLS_MASS_NOSET, "ARKSLS",
"arkMassKLUSetup", MSGSP_MASS_NOSET);
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_MASS_NOSET);
}
/* call Meval routine for new M matrix */
SparseSetMatToZero(arksls_mem->s_M);
retval = arksls_mem->s_Meval(ark_mem->ark_tn, arksls_mem->s_M,
arksls_mem->s_Mdata, vtemp1,
vtemp2, vtemp3);
arksls_mem->s_nme++;
if (retval < 0) {
arkProcessError(ark_mem, ARKSLS_MASSFUNC_UNRECVR, "ARKSLS",
"arkMassKLUSetup", MSGSP_MASSFUNC_FAILED);
arksls_mem->s_last_flag = ARKSLS_MASSFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
arksls_mem->s_last_flag = ARKSLS_MASSFUNC_RECVR;
return(1);
}
/* Copy M into M_lu for LU decomposition */
SparseCopyMat(arksls_mem->s_M, arksls_mem->s_M_lu);
/* On first decomposition, get the symbolic factorization */
if (arksls_mem->s_first_factorize) {
/* Update the ordering option with user-updated values */
klu_data->s_Common.ordering = klu_data->s_ordering;
/* Perform symbolic analysis of sparsity structure */
if (klu_data->s_Symbolic != NULL) {
klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common));
}
klu_data->s_Symbolic = klu_analyze(arksls_mem->s_M_lu->N,
arksls_mem->s_M_lu->indexptrs,
arksls_mem->s_M_lu->indexvals,
&(klu_data->s_Common));
if (klu_data->s_Symbolic == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
/* ------------------------------------------------------------
Compute the LU factorization of the Jacobian.
------------------------------------------------------------*/
if( klu_data->s_Numeric != NULL) {
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
}
klu_data->s_Numeric = klu_factor(arksls_mem->s_M_lu->indexptrs,
arksls_mem->s_M_lu->indexvals,
arksls_mem->s_M_lu->data,
klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
arksls_mem->s_first_factorize = 0;
}
else {
retval = klu_refactor(arksls_mem->s_M_lu->indexptrs,
arksls_mem->s_M_lu->indexvals,
arksls_mem->s_M_lu->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
/*-----------------------------------------------------------
Check if a cheap estimate of the reciprocal of the condition
number is getting too small. If so, delete
the prior numeric factorization and recompute it.
-----------------------------------------------------------*/
retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.rcond) < uround_twothirds ) {
/* Condition number may be getting large.
Compute more accurate estimate */
retval = klu_condest(arksls_mem->s_M_lu->indexptrs,
arksls_mem->s_M_lu->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.condest) >
(1.0/uround_twothirds) ) {
/* More accurate estimate also says condition number is
large, so recompute the numeric factorization */
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
klu_data->s_Numeric = klu_factor(arksls_mem->s_M_lu->indexptrs,
arksls_mem->s_M_lu->indexvals,
arksls_mem->s_M_lu->data,
klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKMassKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
}
}
}
arksls_mem->s_last_flag = ARKSLS_SUCCESS;
return(0);
}
/*---------------------------------------------------------------
arkKLUSetup:
This routine does the setup operations for the ARKKLU linear
solver module. It calls the Jacobian evaluation routine,
updates counters, and calls the LU factorization routine.
The return value is either
ARKSLS_SUCCESS = 0 if successful,
+1 if the jac routine failed recoverably or the
LU factorization failed, or
-1 if the jac routine failed unrecoverably.
---------------------------------------------------------------*/
static int arkKLUSetup(ARKodeMem ark_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;
ARKSlsMem arksls_mem;
ARKSlsMassMem arksls_mass_mem;
KLUData klu_data;
int retval;
realtype uround_twothirds;
uround_twothirds = SUNRpowerR(ark_mem->ark_uround,TWOTHIRDS);
arksls_mem = (ARKSlsMem) ark_mem->ark_lmem;
klu_data = (KLUData) arksls_mem->s_solver_data;
/* Check that Jacobian eval routine is set */
if (arksls_mem->s_Jeval == NULL) {
arkProcessError(ark_mem, ARKSLS_JAC_NOSET, "ARKSLS",
"arkKLUSetup", MSGSP_JAC_NOSET);
free(arksls_mem); arksls_mem = NULL;
return(ARKSLS_JAC_NOSET);
}
/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
dgamma = SUNRabs((ark_mem->ark_gamma/ark_mem->ark_gammap) - ONE);
jbad = (ark_mem->ark_nst == 0) ||
(ark_mem->ark_nst > arksls_mem->s_nstlj + ARKS_MSBJ) ||
((convfail == ARK_FAIL_BAD_J) && (dgamma < ARKS_DGMAX)) ||
(convfail == ARK_FAIL_OTHER);
jok = !jbad;
/* If jok = TRUE, use saved copy of J */
if (jok) {
*jcurPtr = FALSE;
SparseCopyMat(arksls_mem->s_savedJ, arksls_mem->s_A);
/* If jok = FALSE, call jac routine for new J value */
} else {
arksls_mem->s_nje++;
arksls_mem->s_nstlj = ark_mem->ark_nst;
*jcurPtr = TRUE;
SparseSetMatToZero(arksls_mem->s_A);
retval = arksls_mem->s_Jeval(ark_mem->ark_tn, ypred, fpred,
arksls_mem->s_A, arksls_mem->s_Jdata,
vtemp1, vtemp2, vtemp3);
if (retval < 0) {
arkProcessError(ark_mem, ARKSLS_JACFUNC_UNRECVR, "ARKSLS",
"arkKLUSetup", MSGSP_JACFUNC_FAILED);
arksls_mem->s_last_flag = ARKSLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
arksls_mem->s_last_flag = ARKSLS_JACFUNC_RECVR;
return(1);
}
SparseCopyMat(arksls_mem->s_A, arksls_mem->s_savedJ);
}
/* Scale J by -gamma */
SparseScaleMat(-ark_mem->ark_gamma, arksls_mem->s_A);
/* Add mass matrix to get A = M-gamma*J */
if (ark_mem->ark_mass_matrix) {
/* Compute mass matrix */
arksls_mass_mem = (ARKSlsMassMem) ark_mem->ark_mass_mem;
SparseSetMatToZero(arksls_mass_mem->s_M);
retval = arksls_mass_mem->s_Meval(ark_mem->ark_tn,
arksls_mass_mem->s_M,
arksls_mass_mem->s_Mdata,
vtemp1, vtemp2, vtemp3);
arksls_mass_mem->s_nme++;
if (retval < 0) {
arkProcessError(ark_mem, ARKSLS_MASSFUNC_UNRECVR, "ARKSLS",
"arkKLUSetup", MSGSP_MASSFUNC_FAILED);
arksls_mem->s_last_flag = ARKSLS_MASSFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
arksls_mem->s_last_flag = ARKSLS_MASSFUNC_RECVR;
return(1);
}
/* add to A */
retval = SparseAddMat(arksls_mem->s_A, arksls_mass_mem->s_M);
if (retval < 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"arkKLUSetup", "Error in adding mass matrix to Jacobian");
arksls_mem->s_last_flag = ARKSLS_PACKAGE_FAIL;
return(retval);
}
if (retval > 0) return(retval);
} else {
SparseAddIdentityMat(arksls_mem->s_A);
}
/* On first decomposition, get the symbolic factorization */
if (arksls_mem->s_first_factorize) {
/* Update the ordering option with user-updated values */
klu_data->s_Common.ordering = klu_data->s_ordering;
/* Perform symbolic analysis of sparsity structure */
if (klu_data->s_Symbolic != NULL) {
klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common));
}
klu_data->s_Symbolic = klu_analyze(arksls_mem->s_A->NP,
arksls_mem->s_A->indexptrs,
arksls_mem->s_A->indexvals,
&(klu_data->s_Common));
if (klu_data->s_Symbolic == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
/* ------------------------------------------------------------
Compute the LU factorization of the Jacobian.
------------------------------------------------------------*/
if( klu_data->s_Numeric != NULL) {
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
}
klu_data->s_Numeric = klu_factor(arksls_mem->s_A->indexptrs,
arksls_mem->s_A->indexvals,
arksls_mem->s_A->data,
klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
arksls_mem->s_first_factorize = 0;
}
else {
retval = klu_refactor(arksls_mem->s_A->indexptrs,
arksls_mem->s_A->indexvals,
arksls_mem->s_A->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
/*-----------------------------------------------------------
Check if a cheap estimate of the reciprocal of the condition
number is getting too small. If so, delete
the prior numeric factorization and recompute it.
-----------------------------------------------------------*/
retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.rcond) < uround_twothirds ) {
/* Condition number may be getting large.
Compute more accurate estimate */
retval = klu_condest(arksls_mem->s_A->indexptrs,
arksls_mem->s_A->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.condest) >
(1.0/uround_twothirds) ) {
/* More accurate estimate also says condition number is
large, so recompute the numeric factorization */
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
klu_data->s_Numeric = klu_factor(arksls_mem->s_A->indexptrs,
arksls_mem->s_A->indexvals,
arksls_mem->s_A->data,
klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
arkProcessError(ark_mem, ARKSLS_PACKAGE_FAIL, "ARKSLS",
"ARKKLUSetup", MSGSP_PACKAGE_FAIL);
return(ARKSLS_PACKAGE_FAIL);
}
}
}
}
arksls_mem->s_last_flag = ARKSLS_SUCCESS;
return(0);
}
static int cvKLUSetup(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;
int retval;
long int nst, nstlj;
realtype tn, gamma, gammap, dgamma;
CVSlsMem cvsls_mem;
CVSlsSparseJacFn jaceval;
KLUData klu_data;
SlsMat JacMat, savedJ;
void *jacdata;
realtype uround_twothirds;
uround_twothirds = SUNRpowerR(cv_mem->cv_uround,TWOTHIRDS);
cvsls_mem = (CVSlsMem) (cv_mem->cv_lmem);
tn = cv_mem->cv_tn;
gamma = cv_mem->cv_gamma;
gammap = cv_mem->cv_gammap;
nst = cv_mem->cv_nst;
klu_data = (KLUData) cvsls_mem->s_solver_data;
jaceval = cvsls_mem->s_jaceval;
jacdata = cvsls_mem->s_jacdata;
JacMat = cvsls_mem->s_JacMat;
savedJ = cvsls_mem->s_savedJ;
nstlj = cvsls_mem->s_nstlj;
/* Check that Jacobian eval routine is set */
if (jaceval == NULL) {
cvProcessError(cv_mem, CVSLS_JAC_NOSET, "CVSLS", "cvKLUSetup",
MSGSP_JAC_NOSET);
free(cvsls_mem); cvsls_mem = NULL;
return(CVSLS_JAC_NOSET);
}
/* Determine whether Jacobian needs to be recalculated */
dgamma = SUNRabs((gamma/gammap) - ONE);
jbad = (nst == 0) || (nst > nstlj + CVS_MSBJ) ||
((convfail == CV_FAIL_BAD_J) && (dgamma < CVS_DGMAX)) ||
(convfail == CV_FAIL_OTHER);
jok = !jbad;
if (jok) {
/* If jok = TRUE, use saved copy of J */
*jcurPtr = FALSE;
SparseCopyMat(savedJ, JacMat);
} else {
/* If jok = FALSE, call jac routine for new J value */
cvsls_mem->s_nje++;
cvsls_mem->s_nstlj = nst;
*jcurPtr = TRUE;
SparseSetMatToZero(JacMat);
retval = jaceval(tn, ypred, fpred, JacMat, jacdata, vtemp1, vtemp2, vtemp3);
if (retval < 0) {
cvProcessError(cv_mem, CVSLS_JACFUNC_UNRECVR, "CVSLS", "cvKLUSetup", MSGSP_JACFUNC_FAILED);
cvsls_mem->s_last_flag = CVSLS_JACFUNC_UNRECVR;
return(-1);
}
if (retval > 0) {
cvsls_mem->s_last_flag = CVSLS_JACFUNC_RECVR;
return(1);
}
SparseCopyMat(JacMat, savedJ);
}
/* Scale and add I to get M = I - gamma*J */
SparseScaleMat(-gamma, JacMat);
SparseAddIdentityMat(JacMat);
if (cvsls_mem->s_first_factorize) {
/* ------------------------------------------------------------
Get the symbolic factorization
------------------------------------------------------------*/
/* Update the ordering option with any user-updated values from
calls to CVKLUSetOrdering */
klu_data->s_Common.ordering = klu_data->s_ordering;
if (klu_data->s_Symbolic != NULL) {
klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common));
}
klu_data->s_Symbolic = klu_analyze(JacMat->NP, JacMat->indexptrs,
JacMat->indexvals, &(klu_data->s_Common));
if (klu_data->s_Symbolic == NULL) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
/* ------------------------------------------------------------
Compute the LU factorization of the Jacobian.
------------------------------------------------------------*/
/* If klu_factor previously called, free data */
if( klu_data->s_Numeric != NULL) {
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
}
klu_data->s_Numeric = klu_factor(JacMat->indexptrs, JacMat->indexvals,
JacMat->data,
klu_data->s_Symbolic, &(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
cvsls_mem->s_first_factorize = 0;
}
else {
retval = klu_refactor(JacMat->indexptrs, JacMat->indexvals, JacMat->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "cvKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
/*-----------------------------------------------------------
Check if a cheap estimate of the reciprocal of the condition
number is getting too small. If so, delete
the prior numeric factorization and recompute it.
-----------------------------------------------------------*/
retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.rcond) < uround_twothirds ) {
/* Condition number may be getting large.
Compute more accurate estimate */
retval = klu_condest(JacMat->indexptrs, JacMat->data,
klu_data->s_Symbolic, klu_data->s_Numeric,
&(klu_data->s_Common));
if (retval == 0) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
if ( (klu_data->s_Common.condest) >
(1.0/uround_twothirds) ) {
/* More accurate estimate also says condition number is
large, so recompute the numeric factorization */
klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
klu_data->s_Numeric = klu_factor(JacMat->indexptrs, JacMat->indexvals,
JacMat->data, klu_data->s_Symbolic,
&(klu_data->s_Common));
if (klu_data->s_Numeric == NULL) {
cvProcessError(cv_mem, CVSLS_PACKAGE_FAIL, "CVSLS", "CVKLUSetup",
MSGSP_PACKAGE_FAIL);
return(CVSLS_PACKAGE_FAIL);
}
}
}
}
cvsls_mem->s_last_flag = CVSLS_SUCCESS;
return(0);
}