int IDADlsSetDenseJacFnBS(void *ida_mem, int which, IDADlsDenseJacFnBS jacBS)
{
IDAMem IDA_mem;
IDAadjMem IDAADJ_mem;
IDABMem IDAB_mem;
IDADlsMemB idadlsB_mem;
void *ida_memB;
int flag;
/* Is ida_mem allright? */
if (ida_mem == NULL) {
IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASDLS", "IDADlsSetDenseJacFnBS", MSGD_CAMEM_NULL);
return(IDADLS_MEM_NULL);
}
IDA_mem = (IDAMem) ida_mem;
/* Is ASA initialized? */
if (IDA_mem->ida_adjMallocDone == FALSE) {
IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASDLS", "IDADlsSetDenseJacFnBS", MSGD_NO_ADJ);
return(IDADLS_NO_ADJ);
}
IDAADJ_mem = IDA_mem->ida_adj_mem;
/* Check the value of which */
if ( which >= IDAADJ_mem->ia_nbckpbs ) {
IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASDLS", "IDADlsSetDenseJacFnBS", MSGD_BAD_WHICH);
return(IDADLS_ILL_INPUT);
}
/* Find the IDABMem entry in the linked list corresponding to 'which'. */
IDAB_mem = IDAADJ_mem->IDAB_mem;
while (IDAB_mem != NULL) {
if( which == IDAB_mem->ida_index ) break;
/* advance */
IDAB_mem = IDAB_mem->ida_next;
}
/* Get the IDAMem corresponding to this backward problem. */
ida_memB = (void*) IDAB_mem->IDA_mem;
if (IDAB_mem->ida_lmem == NULL) {
IDAProcessError(IDAB_mem->IDA_mem, IDADLS_LMEMB_NULL,
"IDASDLS", "IDADlsSetDenseJacFnBS", MSGD_LMEMB_NULL);
return(IDADLS_LMEMB_NULL);
}
idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem;
idadlsB_mem->d_djacBS = jacBS;
if (jacBS != NULL) {
flag = IDADlsSetDenseJacFn(ida_memB, idaDlsDenseJacBSWrapper);
} else {
flag = IDADlsSetDenseJacFn(ida_memB, NULL);
}
return(flag);
}
int main(void)
{
void *mem;
N_Vector yy, yp, avtol;
realtype rtol, *yval, *ypval, *atval;
realtype t0, tout1, tout, tret;
int iout, retval, retvalr;
int rootsfound[2];
mem = NULL;
yy = yp = avtol = NULL;
yval = ypval = atval = NULL;
/* Allocate N-vectors. */
yy = N_VNew_Serial(NEQ);
if(check_flag((void *)yy, "N_VNew_Serial", 0)) return(1);
yp = N_VNew_Serial(NEQ);
if(check_flag((void *)yp, "N_VNew_Serial", 0)) return(1);
avtol = N_VNew_Serial(NEQ);
if(check_flag((void *)avtol, "N_VNew_Serial", 0)) return(1);
/* Create and initialize y, y', and absolute tolerance vectors. */
yval = NV_DATA_S(yy);
yval[0] = ONE;
yval[1] = ZERO;
yval[2] = ZERO;
ypval = NV_DATA_S(yp);
ypval[0] = RCONST(-0.04);
ypval[1] = RCONST(0.04);
ypval[2] = ZERO;
rtol = RCONST(1.0e-4);
atval = NV_DATA_S(avtol);
atval[0] = RCONST(1.0e-8);
atval[1] = RCONST(1.0e-14);
atval[2] = RCONST(1.0e-6);
/* Integration limits */
t0 = ZERO;
tout1 = RCONST(0.4);
PrintHeader(rtol, avtol, yy);
/* Call IDACreate and IDAInit to initialize IDA memory */
mem = IDACreate();
if(check_flag((void *)mem, "IDACreate", 0)) return(1);
retval = IDAInit(mem, resrob, t0, yy, yp);
if(check_flag(&retval, "IDAInit", 1)) return(1);
/* Call IDASVtolerances to set tolerances */
retval = IDASVtolerances(mem, rtol, avtol);
if(check_flag(&retval, "IDASVtolerances", 1)) return(1);
/* Free avtol; IDASVtolerances() makes its own copy. */
N_VDestroy_Serial(avtol);
/* Call IDARootInit to specify the root function grob with 2 components */
retval = IDARootInit(mem, 2, grob);
if (check_flag(&retval, "IDARootInit", 1)) return(1);
/* Call IDADense and set up the linear solver. */
retval = IDADense(mem, NEQ);
if(check_flag(&retval, "IDADense", 1)) return(1);
retval = IDADlsSetDenseJacFn(mem, jacrob);
if(check_flag(&retval, "IDADlsSetDenseJacFn", 1)) return(1);
/* In loop, call IDASolve, print results, and test for error.
Break out of loop when NOUT preset output times have been reached. */
iout = 0; tout = tout1;
while(1) {
/* IDA_NORMAL means to step until it overshoots tout and then interpolate
* to t = tout, returning IDA_SUCCESS. If there's a root (specified above
* with IDARootInit()) before t = tout, then return IDA_ROOT_RETURN; the
* time of that root is stored in tret. */
retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
PrintOutput(mem,tret,yy);
if(check_flag(&retval, "IDASolve", 1)) return(1);
if (retval == IDA_ROOT_RETURN) {
retvalr = IDAGetRootInfo(mem, rootsfound);
check_flag(&retvalr, "IDAGetRootInfo", 1);
PrintRootInfo(rootsfound[0],rootsfound[1]);
}
if (retval == IDA_SUCCESS) {
iout++;
tout *= RCONST(10.0);
}
if (iout == NOUT) break;
}
PrintFinalStats(mem);
/* Free memory */
IDAFree(&mem);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
return(0);
}
/* creates CVODES structures and fills cvodeSolver
return 1 => success
return 0 => failure
*/
int
IntegratorInstance_createIDASolverStructures(integratorInstance_t *engine)
{
int i, flag, neq, nalg;
realtype *ydata, *abstoldata, *dydata;
odeModel_t *om = engine->om;
cvodeData_t *data = engine->data;
cvodeSolver_t *solver = engine->solver;
cvodeSettings_t *opt = engine->opt;
neq = engine->om->neq; /* number of ODEs */
nalg = engine->om->nalg; /* number of algebraic constraints */
/* construct jacobian, if wanted and not yet existing */
if ( opt->UseJacobian && om->jacob == NULL )
/* reset UseJacobian option, depending on success */
engine->UseJacobian = ODEModel_constructJacobian(om);
else if ( !opt->UseJacobian )
{
/* free jacobian from former runs (not necessary, frees also
unsuccessful jacobians from former runs ) */
ODEModel_freeJacobian(om);
SolverError_error(WARNING_ERROR_TYPE,
SOLVER_ERROR_MODEL_NOT_SIMPLIFIED,
"Jacobian matrix construction skipped.");
engine->UseJacobian = om->jacobian;
}
/* construct algebraic `Jacobian' (or do that in constructJacobian */
/* CVODESolverStructures from former runs must be freed */
if ( engine->run > 1 )
IntegratorInstance_freeIDASolverStructures(engine);
/*
* Allocate y, abstol vectors
*/
solver->y = N_VNew_Serial(neq + nalg);
CVODE_HANDLE_ERROR((void *)solver->y, "N_VNew_Serial for vector y", 0);
solver->dy = N_VNew_Serial(neq + nalg);
CVODE_HANDLE_ERROR((void *)solver->dy, "N_VNew_Serial for vector dy", 0);
solver->abstol = N_VNew_Serial(neq + nalg);
CVODE_HANDLE_ERROR((void *)solver->abstol,
"N_VNew_Serial for vector abstol", 0);
/*
* Initialize y, abstol vectors
*/
ydata = NV_DATA_S(solver->y);
abstoldata = NV_DATA_S(solver->abstol);
dydata = NV_DATA_S(solver->dy);
for ( i=0; i<neq; i++ )
{
/* Set initial value vector components of y and y' */
ydata[i] = data->value[i];
/* Set absolute tolerance vector components,
currently the same absolute error is used for all y */
abstoldata[i] = opt->Error;
dydata[i] = evaluateAST(om->ode[i], data);
}
/* set initial value vector components for algebraic rule variables */
/* scalar relative tolerance: the same for all y */
solver->reltol = opt->RError;
/*
* Call IDACreate to create the solver memory:
*
*/
solver->cvode_mem = IDACreate();
CVODE_HANDLE_ERROR((void *)(solver->cvode_mem), "IDACreate", 0);
/*
* Call IDAInit to initialize the integrator memory:
*
* cvode_mem pointer to the CVode memory block returned by CVodeCreate
* fRes user's right hand side function
* t0 initial value of time
* y the dependent variable vector
* dy the ODE value vector
*/
flag = IDAInit(solver->cvode_mem, fRes, solver->t0, solver->y,
solver->dy);
CVODE_HANDLE_ERROR(&flag, "IDAInit", 1);
/*
* specify scalar relative and vector absolute tolerances
* reltol the scalar relative tolerance
* abstol pointer to the absolute tolerance vector
*/
flag = IDASVtolerances(solver->cvode_mem, solver->reltol, solver->abstol);
CVODE_HANDLE_ERROR(&flag, "IDASVtolerances", 1);
/*
* Link the main integrator with data for right-hand side function
*/
flag = IDASetUserData(solver->cvode_mem, engine->data);
CVODE_HANDLE_ERROR(&flag, "IDASetUserData", 1);
/*
* Link the main integrator with the IDADENSE linear solver
*/
flag = IDADense(solver->cvode_mem, neq);
CVODE_HANDLE_ERROR(&flag, "IDADense", 1);
/*
* Set the routine used by the IDADense linear solver
* to approximate the Jacobian matrix to ...
*/
if ( opt->UseJacobian == 1 ) {
/* ... user-supplied routine JacRes : put JacRes instead of NULL
when working */
flag = IDADlsSetDenseJacFn(solver->cvode_mem, JacRes);
CVODE_HANDLE_ERROR(&flag, "IDADlsSetDenseJacFn", 1);
}
return 1; /* OK */
}
