void FIDA_DENSE(long int *neq, int *ier)
{
*ier = 0;
*ier = IDADense(IDA_idamem, *neq);
IDA_ls = IDA_LS_DENSE;
return;
}
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);
}
void IdaSolver::initialize(const double &pVoiStart, const double &pVoiEnd,
const int &pStatesCount, const int &pCondVarCount,
double *pConstants, double *pRates, double *pStates,
double *pAlgebraic, double *pCondVar,
ComputeEssentialVariablesFunction pComputeEssentialVariables,
ComputeResidualsFunction pComputeResiduals,
ComputeRootInformationFunction pComputeRootInformation,
ComputeStateInformationFunction pComputeStateInformation)
{
static const double VoiEpsilon = 1.0e-9;
if (!mSolver) {
// Initialise the ODE solver itself
OpenCOR::CoreSolver::CoreDaeSolver::initialize(pVoiStart, pVoiEnd,
pStatesCount,
pCondVarCount,
pConstants, pRates,
pStates, pAlgebraic,
pCondVar,
pComputeEssentialVariables,
pComputeResiduals,
pComputeRootInformation,
pComputeStateInformation);
// Retrieve some of the IDA properties
if (mProperties.contains(MaximumStepProperty))
mMaximumStep = mProperties.value(MaximumStepProperty).toDouble();
else
emit error(QObject::tr("the 'maximum step' property value could not be retrieved"));
if (mProperties.contains(MaximumNumberOfStepsProperty))
mMaximumNumberOfSteps = mProperties.value(MaximumNumberOfStepsProperty).toInt();
else
emit error(QObject::tr("the 'maximum number of steps' property value could not be retrieved"));
if (mProperties.contains(RelativeToleranceProperty))
mRelativeTolerance = mProperties.value(RelativeToleranceProperty).toDouble();
else
emit error(QObject::tr("the 'relative tolerance' property value could not be retrieved"));
if (mProperties.contains(AbsoluteToleranceProperty))
mAbsoluteTolerance = mProperties.value(AbsoluteToleranceProperty).toDouble();
else
emit error(QObject::tr("the 'absolute tolerance' property value could not be retrieved"));
// Create the states vector
mStatesVector = N_VMake_Serial(pStatesCount, pStates);
mRatesVector = N_VMake_Serial(pStatesCount, pRates);
// Create the IDA solver
mSolver = IDACreate();
// Use our own error handler
IDASetErrHandlerFn(mSolver, errorHandler, this);
// Initialise the IDA solver
IDAInit(mSolver, residualFunction, pVoiStart,
mStatesVector, mRatesVector);
IDARootInit(mSolver, pCondVarCount, rootFindingFunction);
//---GRY--- NEED TO CHECK THAT OUR IDA CODE WORKS AS EXPECTED BY TRYING
// IT OUT ON A MODEL WHICH NEEDS ROOT FINDING (E.G. THE
// SAUCERMAN MODEL)...
// Set some user data
delete mUserData; // Just in case the solver got initialised before
mUserData = new IdaSolverUserData(pConstants, pAlgebraic, pCondVar,
pComputeEssentialVariables,
pComputeResiduals,
pComputeRootInformation);
IDASetUserData(mSolver, mUserData);
// Set the linear solver
IDADense(mSolver, pStatesCount);
// Set the maximum step
IDASetMaxStep(mSolver, mMaximumStep);
// Set the maximum number of steps
IDASetMaxNumSteps(mSolver, mMaximumNumberOfSteps);
// Set the relative and absolute tolerances
IDASStolerances(mSolver, mRelativeTolerance, mAbsoluteTolerance);
// Compute the model's initial conditions
// Note: this requires retrieving the model's state information, setting
// the IDA object's id vector and then calling IDACalcIC()...
double *id = new double[pStatesCount];
pComputeStateInformation(id);
N_Vector idVector = N_VMake_Serial(pStatesCount, id);
IDASetId(mSolver, idVector);
IDACalcIC(mSolver, IDA_YA_YDP_INIT,
pVoiStart+((pVoiEnd-pVoiStart > 0)?VoiEpsilon:-VoiEpsilon));
N_VDestroy_Serial(idVector);
delete[] id;
} else {
// Reinitialise the IDA object
IDAReInit(mSolver, pVoiStart, mStatesVector, mRatesVector);
// Compute the model's new initial conditions
IDACalcIC(mSolver, IDA_YA_YDP_INIT,
pVoiStart+((pVoiEnd-pVoiStart > 0)?VoiEpsilon:-VoiEpsilon));
}
}
int main(void)
{
void *mem;
N_Vector yy, yp, avtol;
realtype rtol, *yval, *ypval, *atval;
realtype t0, t1, tout, tret;
int iout, retval;
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-6);
atval[1] = RCONST(1.0e-10);
atval[2] = RCONST(1.0e-6);
/* Integration limits */
t0 = ZERO;
t1 = RCONST(0.4);
PrintHeader(rtol, avtol, yy);
/* Call IDACreate and IDAMalloc to initialize IDA memory */
mem = IDACreate();
if(check_flag((void *)mem, "IDACreate", 0)) return(1);
retval = IDAMalloc(mem, resrob, t0, yy, yp, IDA_SV, rtol, avtol);
if(check_flag(&retval, "IDAMalloc", 1)) return(1);
/* Free avtol */
N_VDestroy_Serial(avtol);
/* Call IDADense and set up the linear solver. */
retval = IDADense(mem, NEQ);
if(check_flag(&retval, "IDADense", 1)) return(1);
retval = IDADenseSetJacFn(mem, jacrob, NULL);
if(check_flag(&retval, "IDADenseSetJacFn", 1)) return(1);
/* Loop over tout values and call IDASolve. */
for (tout = t1, iout = 1; iout <= NOUT ; iout++, tout *= RCONST(10.0)) {
retval=IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
if(check_flag(&retval, "IDASolve", 1)) return(1);
PrintOutput(mem,tret,yy);
}
PrintFinalStats(mem);
/* Free memory */
IDAFree(mem);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
return(0);
}
void Ida::initialize()
{
_properties = dynamic_cast<ISystemProperties*>(_system);
_continuous_system = dynamic_cast<IContinuous*>(_system);
_event_system = dynamic_cast<IEvent*>(_system);
_mixed_system = dynamic_cast<IMixedSystem*>(_system);
_time_system = dynamic_cast<ITime*>(_system);
IGlobalSettings* global_settings = dynamic_cast<ISolverSettings*>(_idasettings)->getGlobalSettings();
// Kennzeichnung, dass initialize()() (vor der Integration) aufgerufen wurde
_idid = 5000;
_tLastEvent = 0.0;
_event_n = 0;
SolverDefaultImplementation::initialize();
_dimStates = _continuous_system->getDimContinuousStates();
_dimZeroFunc = _event_system->getDimZeroFunc()+_event_system->getDimClock();
_dimAE = _continuous_system->getDimAE();
if(_dimAE>0)
_dimSys=_dimAE+ _dimStates;
else
_dimSys=_dimStates;
if (_dimStates <= 0)
{
_idid = -1;
throw std::invalid_argument("Ida::initialize()");
}
else
{
// Allocate state vectors, stages and temporary arrays
/*if (_z)
delete[] _z;
if (_zInit)
delete[] _zInit;
if (_zWrite)
delete[] _zWrite;*/
if (_y)
delete[] _y;
if (_yInit)
delete[] _yInit;
if (_yWrite)
delete[] _yWrite;
if (_ypWrite)
delete[] _ypWrite;
if (_yp)
delete[] _yp;
if (_dae_res)
delete[] _dae_res;
if (_zeroSign)
delete[] _zeroSign;
if (_absTol)
delete[] _absTol;
if(_delta)
delete [] _delta;
if(_deltaInv)
delete [] _deltaInv;
if(_ysave)
delete [] _ysave;
_y = new double[_dimSys];
_yp = new double[_dimSys];
_yInit = new double[_dimSys];
_yWrite = new double[_dimSys];
_ypWrite = new double[_dimSys];
_dae_res = new double[_dimSys];
/*
_z = new double[_dimSys];
_zInit = new double[_dimSys];
_zWrite = new double[_dimSys];
*/
_zeroSign = new int[_dimZeroFunc];
_absTol = new double[_dimSys];
_delta =new double[_dimSys];
_deltaInv =new double[_dimSys];
_ysave =new double[_dimSys];
memset(_y, 0, _dimSys * sizeof(double));
memset(_yp, 0, _dimSys * sizeof(double));
memset(_yInit, 0, _dimSys * sizeof(double));
memset(_ysave, 0, _dimSys * sizeof(double));
std::fill_n(_absTol, _dimSys, 1.0);
// Counter initialisieren
_outStps = 0;
if (_idasettings->getDenseOutput())
{
// Ausgabeschrittweite
_hOut = global_settings->gethOutput();
}
// Allocate memory for the solver
_idaMem = IDACreate();
if (check_flag((void*) _idaMem, "IDACreate", 0))
{
_idid = -5;
throw std::invalid_argument(/*_idid,_tCurrent,*/"Ida::initialize()");
}
//
// Make Ida ready for integration
//
// Set initial values for IDA
//_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
_continuous_system->getContinuousStates(_yInit);
memcpy(_y, _yInit, _dimStates * sizeof(double));
if(_dimAE>0)
{
_mixed_system->getAlgebraicDAEVars(_yInit+_dimStates);
memcpy(_y+_dimStates, _yInit+_dimStates, _dimAE * sizeof(double));
_continuous_system->getContinuousStates(_yp);
}
// Get nominal values
_continuous_system->getNominalStates(_absTol);
for (int i = 0; i < _dimStates; i++)
_absTol[i] = dynamic_cast<ISolverSettings*>(_idasettings)->getATol();
_CV_y0 = N_VMake_Serial(_dimSys, _yInit);
_CV_y = N_VMake_Serial(_dimSys, _y);
_CV_yp = N_VMake_Serial(_dimSys, _yp);
_CV_yWrite = N_VMake_Serial(_dimSys, _yWrite);
_CV_ypWrite = N_VMake_Serial(_dimSys, _ypWrite);
_CV_absTol = N_VMake_Serial(_dimSys, _absTol);
if (check_flag((void*) _CV_y0, "N_VMake_Serial", 0))
{
_idid = -5;
throw std::invalid_argument("Ida::initialize()");
}
//is already initialized: calcFunction(_tCurrent, NV_DATA_S(_CV_y0), NV_DATA_S(_CV_yp),NV_DATA_S(_CV_yp));
// Initialize Ida (Initial values are required)
_idid = IDAInit(_idaMem, rhsFunctionCB, _tCurrent, _CV_y0, _CV_yp);
if (_idid < 0)
{
_idid = -5;
throw std::invalid_argument("Ida::initialize()");
}
_idid = IDASetErrHandlerFn(_idaMem, errOutputIDA, _data);
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
// Set Tolerances
_idid = IDASVtolerances(_idaMem, dynamic_cast<ISolverSettings*>(_idasettings)->getRTol(), _CV_absTol); // RTOL and ATOL
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
// Set the pointer to user-defined data
_idid = IDASetUserData(_idaMem, _data);
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
_idid = IDASetInitStep(_idaMem, 1e-6); // INITIAL STEPSIZE
if (_idid < 0)
throw std::invalid_argument("Ida::initialize()");
_idid = IDASetMaxStep(_idaMem, global_settings->getEndTime() / 10.0); // MAXIMUM STEPSIZE
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
_idid = IDASetMaxNonlinIters(_idaMem, 5); // Max number of iterations
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
_idid = IDASetMaxErrTestFails(_idaMem, 100);
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
_idid = IDASetMaxNumSteps(_idaMem, 1e3); // Max Number of steps
if (_idid < 0)
throw std::invalid_argument(/*_idid,_tCurrent,*/"IDA::initialize()");
// Initialize linear solver
_idid = IDADense(_idaMem, _dimSys);
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
if(_dimAE>0)
{
_idid = IDASetSuppressAlg(_idaMem, TRUE);
double* tmp = new double[_dimSys];
std::fill_n(tmp, _dimStates, 1.0);
std::fill_n(tmp+_dimStates, _dimAE, 0.0);
_idid = IDASetId(_idaMem, N_VMake_Serial(_dimSys,tmp));
delete [] tmp;
if (_idid < 0)
throw std::invalid_argument("IDA::initialize()");
}
// Use own jacobian matrix
//_idid = CVDlsSetDenseJacFn(_idaMem, &jacobianFunctionCB);
//if (_idid < 0)
// throw std::invalid_argument("IDA::initialize()");
if (_dimZeroFunc)
{
_idid = IDARootInit(_idaMem, _dimZeroFunc, &zeroFunctionCB);
memset(_zeroSign, 0, _dimZeroFunc * sizeof(int));
_idid = IDASetRootDirection(_idaMem, _zeroSign);
if (_idid < 0)
throw std::invalid_argument(/*_idid,_tCurrent,*/"IDA::initialize()");
memset(_zeroSign, -1, _dimZeroFunc * sizeof(int));
memset(_zeroVal, -1, _dimZeroFunc * sizeof(int));
}
_ida_initialized = true;
//
// IDA is ready for integration
//
// BOOST_LOG_SEV(ida_lg::get(), ida_info) << "IDA initialized";
}
}
int main(void)
{
UserData data;
void *mem;
N_Vector yy, yp, id;
realtype rtol, atol;
realtype t0, tf, tout, dt, tret;
int flag, iout;
/* User data */
data = (UserData) malloc(sizeof *data);
data->a = 0.5; /* half-length of crank */
data->J1 = 1.0; /* crank moment of inertia */
data->m2 = 1.0; /* mass of connecting rod */
data->J2 = 2.0; /* moment of inertia of connecting rod */
data->k = 1.0; /* spring constant */
data->c = 1.0; /* damper constant */
data->l0 = 1.0; /* spring free length */
data->F = 1.0; /* external constant force */
/* Create N_Vectors */
yy = N_VNew_Serial(NEQ);
yp = N_VNew_Serial(NEQ);
id = N_VNew_Serial(NEQ);
/* Consistent IC */
setIC(yy, yp, data);
/* ID array */
N_VConst(ONE, id);
NV_Ith_S(id,6) = ZERO;
NV_Ith_S(id,7) = ZERO;
NV_Ith_S(id,8) = ZERO;
NV_Ith_S(id,9) = ZERO;
/* Tolerances */
rtol = RCONST(1.0e-6);
atol = RCONST(1.0e-6);
/* Integration limits */
t0 = ZERO;
tf = TEND;
dt = (tf-t0)/(NOUT-1);
/* IDA initialization */
mem = IDACreate();
flag = IDAInit(mem, ressc, t0, yy, yp);
flag = IDASStolerances(mem, rtol, atol);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
PrintHeader(rtol, atol, yy);
/* In loop, call IDASolve, print results, and test for error. */
PrintOutput(mem,t0,yy);
tout = dt;
for (iout=1; iout<NOUT; iout++) {
tout = iout*dt;
flag = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
if (flag < 0) break;
PrintOutput(mem,tret,yy);
}
PrintFinalStats(mem);
/* Free memory */
free(data);
IDAFree(&mem);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(id);
return(0);
}
/* Main program */
int main()
{
UserData data;
void *mem;
N_Vector yy, yp, rr, q;
int flag;
realtype time, tout, incr;
int nout;
mem = NULL;
yy = yp = NULL;
/* Allocate user data. */
data = (UserData) malloc(sizeof(*data));
/* Fill user's data with the appropriate values for coefficients. */
data->k1 = RCONST(18.7);
data->k2 = RCONST(0.58);
data->k3 = RCONST(0.09);
data->k4 = RCONST(0.42);
data->K = RCONST(34.4);
data->klA = RCONST(3.3);
data->Ks = RCONST(115.83);
data->pCO2 = RCONST(0.9);
data->H = RCONST(737.0);
/* 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);
/* Consistent IC for y, y'. */
#define y01 0.444
#define y02 0.00123
#define y03 0.00
#define y04 0.007
#define y05 0.0
Ith(yy,1) = RCONST(y01);
Ith(yy,2) = RCONST(y02);
Ith(yy,3) = RCONST(y03);
Ith(yy,4) = RCONST(y04);
Ith(yy,5) = RCONST(y05);
Ith(yy,6) = data->Ks * RCONST(y01) * RCONST(y04);
/* Get y' = - res(t0, y, 0) */
N_VConst(ZERO, yp);
rr = N_VNew_Serial(NEQ);
res(T0, yy, yp, rr, data);
N_VScale(-ONE, rr, yp);
N_VDestroy_Serial(rr);
/* Create and initialize q0 for quadratures. */
q = N_VNew_Serial(1);
if (check_flag((void *)q, "N_VNew_Serial", 0)) return(1);
Ith(q,1) = ZERO;
/* Call IDACreate and IDAInit to initialize IDA memory */
mem = IDACreate();
if(check_flag((void *)mem, "IDACreate", 0)) return(1);
flag = IDAInit(mem, res, T0, yy, yp);
if(check_flag(&flag, "IDAInit", 1)) return(1);
/* Set tolerances. */
flag = IDASStolerances(mem, RTOL, ATOL);
if(check_flag(&flag, "IDASStolerances", 1)) return(1);
/* Attach user data. */
flag = IDASetUserData(mem, data);
if(check_flag(&flag, "IDASetUserData", 1)) return(1);
/* Attach linear solver. */
flag = IDADense(mem, NEQ);
/* Initialize QUADRATURE(S). */
flag = IDAQuadInit(mem, rhsQ, q);
if (check_flag(&flag, "IDAQuadInit", 1)) return(1);
/* Set tolerances and error control for quadratures. */
flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
if (check_flag(&flag, "IDAQuadSStolerances", 1)) return(1);
flag = IDASetQuadErrCon(mem, TRUE);
if (check_flag(&flag, "IDASetQuadErrCon", 1)) return(1);
PrintHeader(RTOL, ATOL, yy);
/* Print initial states */
PrintOutput(mem,0.0,yy);
tout = T1; nout = 0;
incr = RPowerR(TF/T1,ONE/NF);
/* FORWARD run. */
while (1) {
flag = IDASolve(mem, tout, &time, yy, yp, IDA_NORMAL);
if (check_flag(&flag, "IDASolve", 1)) return(1);
PrintOutput(mem, time, yy);
nout++;
tout *= incr;
if (nout>NF) break;
}
flag = IDAGetQuad(mem, &time, q);
if (check_flag(&flag, "IDAGetQuad", 1)) return(1);
printf("\n--------------------------------------------------------\n");
printf("G: %24.16f \n",Ith(q,1));
printf("--------------------------------------------------------\n\n");
PrintFinalStats(mem);
IDAFree(&mem);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(q);
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 */
}
int main(void)
{
UserData data;
void *mem;
N_Vector yy, yp, id, q;
realtype tret, tout;
int flag;
id = N_VNew_Serial(NEQ);
yy = N_VNew_Serial(NEQ);
yp = N_VNew_Serial(NEQ);
q = N_VNew_Serial(1);
data = (UserData) malloc(sizeof *data);
data->a = 0.5; /* half-length of crank */
data->J1 = 1.0; /* crank moment of inertia */
data->m2 = 1.0; /* mass of connecting rod */
data->m1 = 1.0;
data->J2 = 2.0; /* moment of inertia of connecting rod */
data->params[0] = 1.0; /* spring constant */
data->params[1] = 1.0; /* damper constant */
data->l0 = 1.0; /* spring free length */
data->F = 1.0; /* external constant force */
N_VConst(ONE, id);
NV_Ith_S(id, 9) = ZERO;
NV_Ith_S(id, 8) = ZERO;
NV_Ith_S(id, 7) = ZERO;
NV_Ith_S(id, 6) = ZERO;
/* Consistent IC*/
setIC(yy, yp, data);
/* IDAS initialization */
mem = IDACreate();
flag = IDAInit(mem, ressc, TBEGIN, yy, yp);
flag = IDASStolerances(mem, RTOLF, ATOLF);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
flag = IDASetMaxNumSteps(mem, 20000);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
N_VConst(ZERO, q);
flag = IDAQuadInit(mem, rhsQ, q);
flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
flag = IDASetQuadErrCon(mem, TRUE);
PrintHeader(RTOLF, ATOLF, yy);
/* Print initial states */
PrintOutput(mem,0.0,yy);
/* Perform forward run */
tout = TEND/NOUT;
while (1) {
flag = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
if (check_flag(&flag, "IDASolve", 1)) return(1);
PrintOutput(mem,tret,yy);
tout += TEND/NOUT;
if (tret > TEND) break;
}
PrintFinalStats(mem);
IDAGetQuad(mem, &tret, q);
printf("--------------------------------------------\n");
printf(" G = %24.16f\n", Ith(q,1));
printf("--------------------------------------------\n\n");
IDAFree(&mem);
/* Free memory */
free(data);
N_VDestroy(id);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(q);
return(0);
}
/*
* Linear Solvers
*/
CAMLprim value sundials_ml_ida_dense(value ida_solver, value N) {
CAMLparam2(ida_solver, N);
const int ret = IDADense(IDA_MEM(ida_solver), Int_val(N));
CAMLreturn(Val_int(ret));
}
int main(void)
{
UserData data;
void *mem;
N_Vector yy, yp, id, q, *yyS, *ypS, *qS;
realtype tret;
realtype pbar[2];
realtype dp, G, Gm[2], Gp[2];
int flag, is;
realtype atolS[NP];
id = N_VNew_Serial(NEQ);
yy = N_VNew_Serial(NEQ);
yp = N_VNew_Serial(NEQ);
q = N_VNew_Serial(1);
yyS= N_VCloneVectorArray(NP,yy);
ypS= N_VCloneVectorArray(NP,yp);
qS = N_VCloneVectorArray_Serial(NP, q);
data = (UserData) malloc(sizeof *data);
data->a = 0.5; /* half-length of crank */
data->J1 = 1.0; /* crank moment of inertia */
data->m2 = 1.0; /* mass of connecting rod */
data->m1 = 1.0;
data->J2 = 2.0; /* moment of inertia of connecting rod */
data->params[0] = 1.0; /* spring constant */
data->params[1] = 1.0; /* damper constant */
data->l0 = 1.0; /* spring free length */
data->F = 1.0; /* external constant force */
N_VConst(ONE, id);
NV_Ith_S(id, 9) = ZERO;
NV_Ith_S(id, 8) = ZERO;
NV_Ith_S(id, 7) = ZERO;
NV_Ith_S(id, 6) = ZERO;
printf("\nSlider-Crank example for IDAS:\n");
/* Consistent IC*/
setIC(yy, yp, data);
for (is=0;is<NP;is++) {
N_VConst(ZERO, yyS[is]);
N_VConst(ZERO, ypS[is]);
}
/* IDA initialization */
mem = IDACreate();
flag = IDAInit(mem, ressc, TBEGIN, yy, yp);
flag = IDASStolerances(mem, RTOLF, ATOLF);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
flag = IDASetMaxNumSteps(mem, 20000);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
flag = IDASensInit(mem, NP, IDA_SIMULTANEOUS, NULL, yyS, ypS);
pbar[0] = data->params[0];pbar[1] = data->params[1];
flag = IDASetSensParams(mem, data->params, pbar, NULL);
flag = IDASensEEtolerances(mem);
IDASetSensErrCon(mem, TRUE);
N_VConst(ZERO, q);
flag = IDAQuadInit(mem, rhsQ, q);
flag = IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
flag = IDASetQuadErrCon(mem, TRUE);
N_VConst(ZERO, qS[0]);
flag = IDAQuadSensInit(mem, rhsQS, qS);
atolS[0] = atolS[1] = ATOLQ;
flag = IDAQuadSensSStolerances(mem, RTOLQ, atolS);
flag = IDASetQuadSensErrCon(mem, TRUE);
/* Perform forward run */
printf("\nForward integration ... ");
flag = IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
if (check_flag(&flag, "IDASolve", 1)) return(1);
printf("done!\n");
PrintFinalStats(mem);
IDAGetQuad(mem, &tret, q);
printf("--------------------------------------------\n");
printf(" G = %24.16f\n", Ith(q,1));
printf("--------------------------------------------\n\n");
IDAGetQuadSens(mem, &tret, qS);
printf("-------------F O R W A R D------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", Ith(qS[0],1), Ith(qS[1],1));
printf("--------------------------------------------\n\n");
IDAFree(&mem);
/* Finite differences for dG/dp */
dp = 0.00001;
data->params[0] = ONE;
data->params[1] = ONE;
mem = IDACreate();
setIC(yy, yp, data);
flag = IDAInit(mem, ressc, TBEGIN, yy, yp);
flag = IDASStolerances(mem, RTOLFD, ATOLFD);
flag = IDASetUserData(mem, data);
flag = IDASetId(mem, id);
flag = IDASetSuppressAlg(mem, TRUE);
/* Call IDADense and set up the linear solver. */
flag = IDADense(mem, NEQ);
N_VConst(ZERO, q);
IDAQuadInit(mem, rhsQ, q);
IDAQuadSStolerances(mem, RTOLQ, ATOLQ);
IDASetQuadErrCon(mem, TRUE);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem,&tret,q);
G = Ith(q,1);
/*printf(" G =%12.6e\n", Ith(q,1));*/
/******************************
* BACKWARD for k
******************************/
data->params[0] -= dp;
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gm[0] = Ith(q,1);
/*printf("Gm[0]=%12.6e\n", Ith(q,1));*/
/****************************
* FORWARD for k *
****************************/
data->params[0] += (TWO*dp);
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gp[0] = Ith(q,1);
/*printf("Gp[0]=%12.6e\n", Ith(q,1));*/
/* Backward for c */
data->params[0] = ONE;
data->params[1] -= dp;
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gm[1] = Ith(q,1);
/* Forward for c */
data->params[1] += (TWO*dp);
setIC(yy, yp, data);
IDAReInit(mem, TBEGIN, yy, yp);
N_VConst(ZERO, q);
IDAQuadReInit(mem, q);
IDASolve(mem, TEND, &tret, yy, yp, IDA_NORMAL);
IDAGetQuad(mem, &tret, q);
Gp[1] = Ith(q,1);
IDAFree(&mem);
printf("\n\n Checking using Finite Differences \n\n");
printf("---------------BACKWARD------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (G-Gm[0])/dp, (G-Gm[1])/dp);
printf("-----------------------------------------\n\n");
printf("---------------FORWARD-------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-G)/dp, (Gp[1]-G)/dp);
printf("-----------------------------------------\n\n");
printf("--------------CENTERED-------------------\n");
printf(" dG/dp: %12.4le %12.4le\n", (Gp[0]-Gm[0])/(TWO*dp) ,(Gp[1]-Gm[1])/(TWO*dp));
printf("-----------------------------------------\n\n");
/* Free memory */
free(data);
N_VDestroy(id);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(q);
return(0);
}
int IDADenseB(void *ida_mem, int which, long int NeqB)
{
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, "IDASDENSE", "IDADenseB", 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, "IDASDENSE", "IDADenseB", 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, "IDASDENSE", "IDADenseB", 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;
}
/* Alloc memory for IDADlsMemRecB */
idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB));
if (idadlsB_mem == NULL) {
IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASDENSE", "IDADenseB", MSGD_MEM_FAIL);
return(IDADLS_MEM_FAIL);
}
/* set matrix type and initialize Jacob function. */
idadlsB_mem->d_typeB = SUNDIALS_DENSE;
idadlsB_mem->d_bjacB = NULL;
/* Attach lmemB data and lfreeB function. */
IDAB_mem->ida_lmem = idadlsB_mem;
IDAB_mem->ida_lfree = IDADenseFreeB;
/* Call IDADense to the IDAS data of the backward problem. */
ida_memB = (void *)IDAB_mem->IDA_mem;
flag = IDADense(ida_memB, NeqB);
if (flag != IDADLS_SUCCESS) {
free(idadlsB_mem);
idadlsB_mem = NULL;
}
return(flag);
}