int SundialsIda::getRootInfo()
{
int flag = IDAGetRootInfo(sundialsMem, &rootsFound[0]);
if (check_flag(&flag, "IDAGetRootInfo", 1))
throw DebugException("SundialsIda::getRootInfo: error in IDAGetRootInfo.");
return flag;
}
CAMLprim value sundials_ml_ida_get_root_info(value ida_solver, value rootsfound) {
CAMLparam2(ida_solver, rootsfound);
int len = Wosize_val(rootsfound);
int roots[len];
/* totally stupid API from the IDA side, they copy the array and then we copy ... */
const int ret = IDAGetRootInfo(IDA_MEM(ida_solver), roots);
for (int i = 0; i < len; i++)
Field(rootsfound, i) = Val_int(roots[i]);
CAMLreturn(Val_int(ret));
}
void FIDA_ROOTINFO(int *nrtfn, int *info, int *ier)
{
*ier = IDAGetRootInfo(IDA_idamem, info);
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];
int nnz;
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-6);
atval[2] = RCONST(1.0e-6);
/* Integration limits */
t0 = ZERO;
tout1 = 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 = IDAInit(mem, resrob, t0, yy, yp);
if(check_flag(&retval, "IDAInit", 1)) return(1);
retval = IDASVtolerances(mem, rtol, avtol);
if(check_flag(&retval, "IDASVtolerances", 1)) return(1);
/* Free avtol */
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 IDASuperLUMT and set up the linear solver. */
nnz = NEQ * NEQ;
retval = IDASuperLUMT(mem, 1, NEQ, nnz);
if(check_flag(&retval, "IDASuperLUMT", 1)) return(1);
retval = IDASlsSetSparseJacFn(mem, jacrob);
if(check_flag(&retval, "IDASlsSetSparseJacFn", 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) {
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);
}
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];
SUNMatrix A;
SUNLinearSolver LS;
sunindextype nnz;
mem = NULL;
yy = yp = avtol = NULL;
yval = ypval = atval = NULL;
A = NULL;
LS = NULL;
/* Allocate N-vectors. */
yy = N_VNew_Serial(NEQ);
if(check_retval((void *)yy, "N_VNew_Serial", 0)) return(1);
yp = N_VNew_Serial(NEQ);
if(check_retval((void *)yp, "N_VNew_Serial", 0)) return(1);
avtol = N_VNew_Serial(NEQ);
if(check_retval((void *)avtol, "N_VNew_Serial", 0)) return(1);
/* Create and initialize y, y', and absolute tolerance vectors. */
yval = N_VGetArrayPointer(yy);
yval[0] = ONE;
yval[1] = ZERO;
yval[2] = ZERO;
ypval = N_VGetArrayPointer(yp);
ypval[0] = RCONST(-0.04);
ypval[1] = RCONST(0.04);
ypval[2] = ZERO;
rtol = RCONST(1.0e-4);
atval = N_VGetArrayPointer(avtol);
atval[0] = RCONST(1.0e-8);
atval[1] = RCONST(1.0e-6);
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_retval((void *)mem, "IDACreate", 0)) return(1);
retval = IDAInit(mem, resrob, t0, yy, yp);
if(check_retval(&retval, "IDAInit", 1)) return(1);
/* Call IDASVtolerances to set tolerances */
retval = IDASVtolerances(mem, rtol, avtol);
if(check_retval(&retval, "IDASVtolerances", 1)) return(1);
/* Free avtol */
N_VDestroy(avtol);
/* Call IDARootInit to specify the root function grob with 2 components */
retval = IDARootInit(mem, 2, grob);
if (check_retval(&retval, "IDARootInit", 1)) return(1);
/* Create sparse SUNMatrix for use in linear solves */
nnz = NEQ * NEQ;
A = SUNSparseMatrix(NEQ, NEQ, nnz, CSC_MAT);
if(check_retval((void *)A, "SUNSparseMatrix", 0)) return(1);
/* Create SuperLUMT SUNLinearSolver object (one thread) */
LS = SUNLinSol_SuperLUMT(yy, A, 1);
if(check_retval((void *)LS, "SUNLinSol_SuperLUMT", 0)) return(1);
/* Attach the matrix and linear solver */
retval = IDASetLinearSolver(mem, LS, A);
if(check_retval(&retval, "IDASetLinearSolver", 1)) return(1);
/* Set the user-supplied Jacobian routine */
retval = IDASetJacFn(mem, jacrob);
if(check_retval(&retval, "IDASetJacFn", 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) {
retval = IDASolve(mem, tout, &tret, yy, yp, IDA_NORMAL);
PrintOutput(mem,tret,yy);
if(check_retval(&retval, "IDASolve", 1)) return(1);
if (retval == IDA_ROOT_RETURN) {
retvalr = IDAGetRootInfo(mem, rootsfound);
check_retval(&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);
SUNLinSolFree(LS);
SUNMatDestroy(A);
N_VDestroy(yy);
N_VDestroy(yp);
return(0);
}
void Ida::IDACore()
{
_idid = IDAReInit(_idaMem, _tCurrent, _CV_y,_CV_yp);
_idid = IDASetStopTime(_idaMem, _tEnd);
_idid = IDASetInitStep(_idaMem, 1e-12);
if (_idid < 0)
throw std::runtime_error("IDA::ReInit");
bool writeEventOutput = (_settings->getGlobalSettings()->getOutputPointType() == OPT_ALL);
bool writeOutput = !(_settings->getGlobalSettings()->getOutputPointType() == OPT_NONE);
while ((_solverStatus & ISolver::CONTINUE) && !_interrupt )
{
_cv_rt = IDASolve(_idaMem, _tEnd, &_tCurrent, _CV_y, _CV_yp, IDA_ONE_STEP);
_idid = IDAGetNumSteps(_idaMem, &_locStps);
if (_idid != IDA_SUCCESS)
throw std::runtime_error("IDAGetNumSteps failed. The ida mem pointer is NULL");
_idid =IDAGetLastStep(_idaMem, &_h);
if (_idid != IDA_SUCCESS)
throw std::runtime_error("IDAGetLastStep failed. The ida mem pointer is NULL");
//Check if there was at least one output-point within the last solver interval
// -> Write output if true
if (writeOutput)
{
writeIDAOutput(_tCurrent, _h, _locStps);
}
#ifdef RUNTIME_PROFILING
MEASURETIME_REGION_DEFINE(idaStepCompletedHandler, "IDAStepCompleted");
if(MeasureTime::getInstance() != NULL)
{
MEASURETIME_START(measuredFunctionStartValues, idaStepCompletedHandler, "IDAStepCompleted");
}
#endif
//set completed step to system and check if terminate was called
if(_continuous_system->stepCompleted(_tCurrent))
_solverStatus = DONE;
#ifdef RUNTIME_PROFILING
if(MeasureTime::getInstance() != NULL)
{
MEASURETIME_END(measuredFunctionStartValues, measuredFunctionEndValues, (*measureTimeFunctionsArray)[5], idaStepCompletedHandler);
}
#endif
// Perform state selection
bool state_selection = stateSelection();
if (state_selection)
_continuous_system->getContinuousStates(_y);
_zeroFound = false;
// Check if step was successful
if (check_flag(&_cv_rt, "IDA", 1))
{
_solverStatus = ISolver::SOLVERERROR;
break;
}
// A root was found
if ((_cv_rt == IDA_ROOT_RETURN) && !isInterrupted())
{
// IDA is setting _tCurrent to the time where the first event occurred
double _abs = fabs(_tLastEvent - _tCurrent);
_zeroFound = true;
if ((_abs < 1e-3) && _event_n == 0)
{
_tLastEvent = _tCurrent;
_event_n++;
}
else if ((_abs < 1e-3) && (_event_n >= 1 && _event_n < 500))
{
_event_n++;
}
else if ((_abs >= 1e-3))
{
//restart event counter
_tLastEvent = _tCurrent;
_event_n = 0;
}
else
throw std::runtime_error("Number of events exceeded in time interval " + to_string(_abs) + " at time " + to_string(_tCurrent));
// IDA has interpolated the states at time 'tCurrent'
_time_system->setTime(_tCurrent);
// To get steep steps in the result file, two value points (P1 and P2) must be added
//
// Y | (P2) X...........
// | :
// | :
// |........X (P1)
// |---------------------------------->
// | ^ t
// _tCurrent
// Write the values of (P1)
if (writeEventOutput)
{
if(_dimAE>0)
{
_continuous_system->evaluateDAE(IContinuous::CONTINUOUS);
}
else
{
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
}
writeToFile(0, _tCurrent, _h);
}
_idid = IDAGetRootInfo(_idaMem, _zeroSign);
for (int i = 0; i < _dimZeroFunc; i++)
_events[i] = bool(_zeroSign[i]);
if (_mixed_system->handleSystemEvents(_events))
{
// State variables were reinitialized, thus we have to give these values to the ida-solver
// Take care about the memory regions, _z is the same like _CV_y
_continuous_system->getContinuousStates(_y);
if(_dimAE>0)
{
_mixed_system->getAlgebraicDAEVars(_y+_dimStates);
_continuous_system->getRHS(_yp);
}
calcFunction(_tCurrent, NV_DATA_S(_CV_y), NV_DATA_S(_CV_yp),_dae_res);
}
}
if ((_zeroFound || state_selection)&& !isInterrupted())
{
// Write the values of (P2)
if (writeEventOutput)
{
// If we want to write the event-results, we should evaluate the whole system again
if(_dimAE>0)
{
_continuous_system->evaluateDAE(IContinuous::CONTINUOUS);
}
else
{
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
}
writeToFile(0, _tCurrent, _h);
}
_idid = IDAReInit(_idaMem, _tCurrent, _CV_y,_CV_yp);
if (_idid < 0)
throw std::runtime_error("IDA::ReInit()");
// Der Eventzeitpunkt kann auf der Endzeit liegen (Time-Events). In diesem Fall wird der Solver beendet, da IDA sonst eine interne Warnung schmeißt
if (_tCurrent == _tEnd)
_cv_rt = IDA_TSTOP_RETURN;
}
// Zähler für die Anzahl der ausgegebenen Schritte erhöhen
++_outStps;
_tLastSuccess = _tCurrent;
if (_cv_rt == IDA_TSTOP_RETURN)
{
_time_system->setTime(_tEnd);
_continuous_system->setContinuousStates(NV_DATA_S(_CV_y));
if(_dimAE>0)
{
_mixed_system->setAlgebraicDAEVars(NV_DATA_S(_CV_y)+_dimStates);
_continuous_system->setStateDerivatives(NV_DATA_S(_CV_yp));
_continuous_system->evaluateDAE(IContinuous::CONTINUOUS);
}
else
{
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
}
if(writeOutput)
writeToFile(0, _tEnd, _h);
_accStps += _locStps;
_solverStatus = DONE;
}
}
}