void Arkode::ArkodeCore()
{
_idid = ARKodeReInit(_arkodeMem, NULL, ARK_fCallback, _tCurrent, _ARK_y);
_idid = ARKodeSetStopTime(_arkodeMem, _tEnd);
_idid = ARKodeSetInitStep(_arkodeMem, 1e-12);
if (_idid < 0)
throw ModelicaSimulationError(SOLVER,"ARKode::ReInit");
bool writeEventOutput = (_settings->getGlobalSettings()->getOutputPointType() == OPT_ALL);
bool writeOutput = !(_settings->getGlobalSettings()->getOutputPointType() == OPT_NONE);
while (_solverStatus & ISolver::CONTINUE && !_interrupt )
{
_ark_rt = ARKode(_arkodeMem, _tEnd, _ARK_y, &_tCurrent, ARK_ONE_STEP);
_idid = ARKodeGetNumSteps(_arkodeMem, &_locStps);
//if (_idid != CV_SUCCESS)
// throw ModelicaSimulationError(SOLVER,"CVodeGetNumSteps failed. The cvode mem pointer is NULL");
_idid = ARKodeGetLastStep(_arkodeMem, &_h);
//if (_idid != CV_SUCCESS)
// throw ModelicaSimulationError(SOLVER,"CVodeGetLastStep failed. The cvode mem pointer is NULL");
//Check if there was at least one output-point within the last solver interval
// -> Write output if true
if (writeOutput)
{
writeArkodeOutput(_tCurrent, _h, _locStps);
}
//set completed step to system and check if terminate was called
if(_continuous_system->stepCompleted(_tCurrent))
_solverStatus = DONE;
// Perform state selection
bool state_selection = stateSelection();
if (state_selection)
_continuous_system->getContinuousStates(_z);
_zeroFound = false;
// Check if step was successful
/*
if (check_flag(&_cv_rt, "CVode", 1))
{
_solverStatus = ISolver::SOLVERERROR;
break;
}*/
// A root was found
if ((_ark_rt == ARK_ROOT_RETURN) && !isInterrupted())
{
// CVode 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 ModelicaSimulationError(EVENT_HANDLING,"Number of events exceeded in time interval " + to_string(_abs) + " at time " + to_string(_tCurrent));
// CVode 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)
{
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
writeToFile(0, _tCurrent, _h);
}
_idid = ARKodeGetRootInfo(_arkodeMem, _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 cvode-solver
// Take care about the memory regions, _z is the same like _CV_y
_continuous_system->getContinuousStates(_z);
}
}
if ((_zeroFound || state_selection)&& !isInterrupted())
{
if (writeEventOutput)
{
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
writeToFile(0, _tCurrent, _h);
}
_idid = ARKodeReInit(_arkodeMem, NULL, ARK_fCallback, _tCurrent, _ARK_y);
if (_idid < 0)
throw ModelicaSimulationError(SOLVER,"CVode::ReInit()");
// Der Eventzeitpunkt kann auf der Endzeit liegen (Time-Events). In diesem Fall wird der Solver beendet, da CVode sonst eine interne Warnung
if (_tCurrent == _tEnd)
_ark_rt = ARK_TSTOP_RETURN;
}
++_outStps;
_tLastSuccess = _tCurrent;
if (_ark_rt == ARK_TSTOP_RETURN)
{
_time_system->setTime(_tEnd);
//Solver has finished calculation - calculate the final values
_continuous_system->setContinuousStates(NV_DATA_S(_ARK_y));
_continuous_system->evaluateAll(IContinuous::CONTINUOUS);
if(writeOutput)
writeToFile(0, _tEnd, _h);
_accStps += _locStps;
_solverStatus = DONE;
}
}
}
int main()
{
realtype abstol=ATOL, reltol=RTOL, t, tout;
N_Vector c;
WebData wdata;
void *arkode_mem;
booleantype firstrun;
int jpre, gstype, flag;
int ns, mxns, iout;
c = NULL;
wdata = NULL;
arkode_mem = NULL;
/* Initializations */
c = N_VNew_Serial(NEQ);
if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1);
wdata = AllocUserData();
if(check_flag((void *)wdata, "AllocUserData", 2)) return(1);
InitUserData(wdata);
ns = wdata->ns;
mxns = wdata->mxns;
/* Print problem description */
PrintIntro();
/* Loop over jpre and gstype (four cases) */
for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) {
for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) {
/* Initialize c and print heading */
CInit(c, wdata);
PrintHeader(jpre, gstype);
/* Call ARKodeInit or ARKodeReInit, then ARKSpgmr to set up problem */
firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS);
if (firstrun) {
arkode_mem = ARKodeCreate();
if(check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return(1);
wdata->arkode_mem = arkode_mem;
flag = ARKodeSetUserData(arkode_mem, wdata);
if(check_flag(&flag, "ARKodeSetUserData", 1)) return(1);
flag = ARKodeInit(arkode_mem, NULL, f, T0, c);
if(check_flag(&flag, "ARKodeInit", 1)) return(1);
flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
if (check_flag(&flag, "ARKodeSStolerances", 1)) return(1);
flag = ARKodeSetMaxNumSteps(arkode_mem, 1000);
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return(1);
flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-3);
if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return(1);
flag = ARKSpgmr(arkode_mem, jpre, MAXL);
if(check_flag(&flag, "ARKSpgmr", 1)) return(1);
flag = ARKSpilsSetGSType(arkode_mem, gstype);
if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);
flag = ARKSpilsSetEpsLin(arkode_mem, DELT);
if(check_flag(&flag, "ARKSpilsSetEpsLin", 1)) return(1);
flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve);
if(check_flag(&flag, "ARKSpilsSetPreconditioner", 1)) return(1);
} else {
flag = ARKodeReInit(arkode_mem, NULL, f, T0, c);
if(check_flag(&flag, "ARKodeReInit", 1)) return(1);
flag = ARKSpilsSetPrecType(arkode_mem, jpre);
check_flag(&flag, "ARKSpilsSetPrecType", 1);
flag = ARKSpilsSetGSType(arkode_mem, gstype);
if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1);
}
/* Print initial values */
if (firstrun) PrintAllSpecies(c, ns, mxns, T0);
/* Loop over output points, call ARKode, print sample solution values. */
tout = T1;
for (iout = 1; iout <= NOUT; iout++) {
flag = ARKode(arkode_mem, tout, c, &t, ARK_NORMAL);
PrintOutput(arkode_mem, t);
if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t);
if(check_flag(&flag, "ARKode", 1)) break;
if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT;
}
/* Print final statistics, and loop for next case */
PrintFinalStats(arkode_mem);
}
}
/* Free all memory */
ARKodeFree(&arkode_mem);
N_VDestroy_Serial(c);
FreeUserData(wdata);
return(0);
}
/* Fortran interface routine to re-initialize ARKode memory
structure; functions as an all-in-one interface to the C
routines ARKodeReInit and ARKodeSStolerances (or
ARKodeSVtolerances); see farkode.h for further details */
void FARK_REINIT(realtype *t0, realtype *y0, int *imex, int *iatol,
realtype *rtol, realtype *atol, int *ier) {
N_Vector Vatol;
realtype reltol, abstol;
*ier = 0;
/* Initialize all pointers to NULL */
Vatol = NULL;
/* Set data in F2C_ARKODE_vec to y0 */
N_VSetArrayPointer(y0, F2C_ARKODE_vec);
/* Call ARKodeReInit based on imex argument */
switch (*imex) {
case 0: /* purely implicit */
*ier = ARKodeReInit(ARK_arkodemem, NULL, FARKfi,
*t0, F2C_ARKODE_vec);
break;
case 1: /* purely explicit */
*ier = ARKodeReInit(ARK_arkodemem, FARKfe, NULL,
*t0, F2C_ARKODE_vec);
break;
case 2: /* imex */
*ier = ARKodeReInit(ARK_arkodemem, FARKfe, FARKfi,
*t0, F2C_ARKODE_vec);
break;
}
/* Reset data pointers */
N_VSetArrayPointer(NULL, F2C_ARKODE_vec);
/* On failure, exit */
if (*ier != ARK_SUCCESS) {
*ier = -1;
return;
}
/* Set tolerances */
reltol=1.e-4;
abstol=1.e-9;
if (*rtol > 0.0) reltol = *rtol;
switch (*iatol) {
case 1:
if (*atol > 0.0) abstol = *atol;
*ier = ARKodeSStolerances(ARK_arkodemem, reltol, abstol);
break;
case 2:
Vatol = N_VCloneEmpty(F2C_ARKODE_vec);
if (Vatol == NULL) {
*ier = -1;
return;
}
N_VSetArrayPointer(atol, Vatol);
if (N_VMin(Vatol) <= 0.0) N_VConst(abstol, Vatol);
*ier = ARKodeSVtolerances(ARK_arkodemem, reltol, Vatol);
N_VDestroy(Vatol);
break;
}
/* On failure, exit */
if (*ier != ARK_SUCCESS) {
*ier = -1;
return;
}
return;
}
/***************************** Main Program ******************************/
int main(int argc, char *argv[])
{
UserData data;
void *arkode_mem;
realtype abstol, reltol, t, tout;
N_Vector u;
int iout, my_pe, npes, flag, jpre;
long int neq, local_N, mudq, mldq, mukeep, mlkeep;
MPI_Comm comm;
data = NULL;
arkode_mem = NULL;
u = NULL;
/* Set problem size neq */
neq = NVARS*MX*MY;
/* Get processor number and total number of pe's */
MPI_Init(&argc, &argv);
comm = MPI_COMM_WORLD;
MPI_Comm_size(comm, &npes);
MPI_Comm_rank(comm, &my_pe);
if (npes != NPEX*NPEY) {
if (my_pe == 0)
fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n",
npes, NPEX*NPEY);
MPI_Finalize();
return(1);
}
/* Set local length */
local_N = NVARS*MXSUB*MYSUB;
/* Allocate and load user data block */
data = (UserData) malloc(sizeof *data);
if(check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1);
InitUserData(my_pe, local_N, comm, data);
/* Allocate and initialize u, and set tolerances */
u = N_VNew_Parallel(comm, local_N, neq);
if(check_flag((void *)u, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
SetInitialProfiles(u, data);
abstol = ATOL;
reltol = RTOL;
/* Call ARKodeCreate to create the solver memory */
arkode_mem = ARKodeCreate();
if(check_flag((void *)arkode_mem, "ARKodeCreate", 0, my_pe)) MPI_Abort(comm, 1);
/* Set the pointer to user-defined data */
flag = ARKodeSetUserData(arkode_mem, data);
if(check_flag(&flag, "ARKodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1);
/* Call ARKodeInit to initialize the integrator memory and specify the
user's right hand side functions in u'=fe(t,u)+fi(t,u) [here fe is NULL],
the inital time T0, and the initial dependent variable vector u. */
flag = ARKodeInit(arkode_mem, NULL, f, T0, u);
if(check_flag(&flag, "ARKodeInit", 1, my_pe)) return(1);
/* Call ARKodeSetMaxNumSteps to increase default */
flag = ARKodeSetMaxNumSteps(arkode_mem, 10000);
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1, my_pe)) return(1);
/* Call ARKodeSStolerances to specify the scalar relative tolerance
and scalar absolute tolerances */
flag = ARKodeSStolerances(arkode_mem, reltol, abstol);
if (check_flag(&flag, "ARKodeSStolerances", 1, my_pe)) return(1);
/* Call ARKSpgmr to specify the linear solver ARKSPGMR with left
preconditioning and the default Krylov dimension maxl */
flag = ARKSpgmr(arkode_mem, PREC_LEFT, 0);
if(check_flag(&flag, "ARKBBDSpgmr", 1, my_pe)) MPI_Abort(comm, 1);
/* Initialize BBD preconditioner */
mudq = mldq = NVARS*MXSUB;
mukeep = mlkeep = NVARS;
flag = ARKBBDPrecInit(arkode_mem, local_N, mudq, mldq,
mukeep, mlkeep, ZERO, flocal, NULL);
if(check_flag(&flag, "ARKBBDPrecAlloc", 1, my_pe)) MPI_Abort(comm, 1);
/* Print heading */
if (my_pe == 0) PrintIntro(npes, mudq, mldq, mukeep, mlkeep);
/* Loop over jpre (= PREC_LEFT, PREC_RIGHT), and solve the problem */
for (jpre=PREC_LEFT; jpre<=PREC_RIGHT; jpre++) {
/* On second run, re-initialize u, the integrator, ARKBBDPRE, and ARKSPGMR */
if (jpre == PREC_RIGHT) {
SetInitialProfiles(u, data);
flag = ARKodeReInit(arkode_mem, NULL, f, T0, u);
if(check_flag(&flag, "ARKodeReInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = ARKBBDPrecReInit(arkode_mem, mudq, mldq, ZERO);
if(check_flag(&flag, "ARKBBDPrecReInit", 1, my_pe)) MPI_Abort(comm, 1);
flag = ARKSpilsSetPrecType(arkode_mem, PREC_RIGHT);
check_flag(&flag, "ARKSpilsSetPrecType", 1, my_pe);
if (my_pe == 0) {
printf("\n\n-------------------------------------------------------");
printf("------------\n");
}
}
if (my_pe == 0) {
printf("\n\nPreconditioner type is: jpre = %s\n\n",
(jpre == PREC_LEFT) ? "PREC_LEFT" : "PREC_RIGHT");
}
/* In loop over output points, call ARKode, print results, test for error */
for (iout=1, tout=TWOHR; iout<=NOUT; iout++, tout+=TWOHR) {
flag = ARKode(arkode_mem, tout, u, &t, ARK_NORMAL);
if(check_flag(&flag, "ARKode", 1, my_pe)) break;
PrintOutput(arkode_mem, my_pe, comm, u, t);
}
/* Print final statistics */
if (my_pe == 0) PrintFinalStats(arkode_mem);
} /* End of jpre loop */
/* Free memory */
N_VDestroy_Parallel(u);
free(data);
ARKodeFree(&arkode_mem);
MPI_Finalize();
return(0);
}
