static void PrintOutput(void *arkode_mem, realtype t)
{
long int nst, nfe, nfi, nni;
int flag;
realtype hu;
flag = ARKodeGetNumSteps(arkode_mem, &nst);
check_flag(&flag, "ARKodeGetNumSteps", 1);
flag = ARKodeGetNumRhsEvals(arkode_mem, &nfe, &nfi);
check_flag(&flag, "ARKodeGetNumRhsEvals", 1);
flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1);
flag = ARKodeGetLastStep(arkode_mem, &hu);
check_flag(&flag, "ARKodeGetLastStep", 1);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("t = %10.2Le nst = %ld nfe = %ld nfi = %ld nni = %ld", t, nst, nfe, nfi, nni);
printf(" hu = %11.2Le\n\n", hu);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("t = %10.2e nst = %ld nfe = %ld nfi = %ld nni = %ld", t, nst, nfe, nfi, nni);
printf(" hu = %11.2e\n\n", hu);
#else
printf("t = %10.2e nst = %ld nfe = %ld nfi = %ld nni = %ld", t, nst, nfe, nfi, nni);
printf(" hu = %11.2e\n\n", hu);
#endif
}
/* Print current t, step count, order, stepsize, and sampled c1,c2 values */
static void PrintOutput(void *arkode_mem, int my_pe, MPI_Comm comm,
N_Vector u, realtype t)
{
int flag;
realtype hu, *udata, tempu[2];
int npelast;
long int i0, i1, nst;
MPI_Status status;
HYPRE_ParVector uhyp;
npelast = NPEX*NPEY - 1;
uhyp = N_VGetVector_ParHyp(u);
udata = hypre_VectorData(hypre_ParVectorLocalVector(uhyp));
/* Send c1,c2 at top right mesh point to PE 0 */
if (my_pe == npelast) {
i0 = NVARS*MXSUB*MYSUB - 2;
i1 = i0 + 1;
if (npelast != 0)
MPI_Send(&udata[i0], 2, PVEC_REAL_MPI_TYPE, 0, 0, comm);
else {
tempu[0] = udata[i0];
tempu[1] = udata[i1];
}
}
/* On PE 0, receive c1,c2 at top right, then print performance data
and sampled solution values */
if (my_pe == 0) {
if (npelast != 0)
MPI_Recv(&tempu[0], 2, PVEC_REAL_MPI_TYPE, npelast, 0, comm, &status);
flag = ARKodeGetNumSteps(arkode_mem, &nst);
check_flag(&flag, "ARKodeGetNumSteps", 1, my_pe);
flag = ARKodeGetLastStep(arkode_mem, &hu);
check_flag(&flag, "ARKodeGetLastStep", 1, my_pe);
#if defined(SUNDIALS_EXTENDED_PRECISION)
printf("t = %.2Le no. steps = %ld stepsize = %.2Le\n",
t, nst, hu);
printf("At bottom left: c1, c2 = %12.3Le %12.3Le \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3Le %12.3Le \n\n", tempu[0], tempu[1]);
#elif defined(SUNDIALS_DOUBLE_PRECISION)
printf("t = %.2e no. steps = %ld stepsize = %.2e\n",
t, nst, hu);
printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]);
#else
printf("t = %.2e no. steps = %ld stepsize = %.2e\n",
t, nst, hu);
printf("At bottom left: c1, c2 = %12.3e %12.3e \n", udata[0], udata[1]);
printf("At top right: c1, c2 = %12.3e %12.3e \n\n", tempu[0], tempu[1]);
#endif
}
}
/* The C function FARKLapackDenseJac interfaces between ARKODE
and a Fortran subroutine FARKDJAC for solution of a linear
system using Lapack with dense Jacobian approximation.
Addresses of arguments are passed to FARKDJAC, using the macro
DENSE_COL and the routine N_VGetArrayPointer from NVECTOR */
int FARKLapackDenseJac(long int N, realtype t, N_Vector y,
N_Vector fy, DlsMat J, void *user_data,
N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
int ier;
realtype *ydata, *fydata, *jacdata, *v1data, *v2data, *v3data;
realtype h;
FARKUserData ARK_userdata;
ARKodeGetLastStep(ARK_arkodemem, &h);
ydata = N_VGetArrayPointer(y);
fydata = N_VGetArrayPointer(fy);
v1data = N_VGetArrayPointer(vtemp1);
v2data = N_VGetArrayPointer(vtemp2);
v3data = N_VGetArrayPointer(vtemp3);
jacdata = DENSE_COL(J,0);
ARK_userdata = (FARKUserData) user_data;
FARK_DJAC(&N, &t, ydata, fydata, jacdata, &h, ARK_userdata->ipar,
ARK_userdata->rpar, v1data, v2data, v3data, &ier);
return(ier);
}
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;
}
}
}
/* Main Program */
int main() {
/* general problem parameters */
realtype T0 = RCONST(0.0); /* initial time */
realtype Tf = RCONST(1.0); /* final time */
realtype rtol = 1.e-3; /* relative tolerance */
realtype atol = 1.e-10; /* absolute tolerance */
realtype hscale = 1.0; /* time step change factor on resizes */
UserData udata = NULL;
realtype *data;
long int N = 21; /* initial spatial mesh size */
realtype refine = 3.e-3; /* adaptivity refinement tolerance */
realtype k = 0.5; /* heat conductivity */
long int i, nni, nni_cur=0, nni_tot=0, nli, nli_tot=0;
int iout=0;
/* general problem variables */
int flag; /* reusable error-checking flag */
N_Vector y = NULL; /* empty vector for storing solution */
N_Vector y2 = NULL; /* empty vector for storing solution */
N_Vector yt = NULL; /* empty vector for swapping */
void *arkode_mem = NULL; /* empty ARKode memory structure */
FILE *XFID, *UFID;
realtype t, olddt, newdt;
realtype *xnew = NULL;
long int Nnew;
/* allocate and fill initial udata structure */
udata = (UserData) malloc(sizeof(*udata));
udata->N = N;
udata->k = k;
udata->refine_tol = refine;
udata->x = malloc(N * sizeof(realtype));
for (i=0; i<N; i++) udata->x[i] = 1.0*i/(N-1);
/* Initial problem output */
printf("\n1D adaptive Heat PDE test problem:\n");
printf(" diffusion coefficient: k = %g\n", udata->k);
printf(" initial N = %li\n", udata->N);
/* Initialize data structures */
y = N_VNew_Serial(N); /* Create initial serial vector for solution */
if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1;
N_VConst(0.0, y); /* Set initial conditions */
/* output mesh to disk */
XFID=fopen("heat_mesh.txt","w");
/* output initial mesh to disk */
for (i=0; i<udata->N; i++) fprintf(XFID," %.16e", udata->x[i]);
fprintf(XFID,"\n");
/* Open output stream for results, access data array */
UFID=fopen("heat1D.txt","w");
/* output initial condition to disk */
data = N_VGetArrayPointer(y);
for (i=0; i<udata->N; i++) fprintf(UFID," %.16e", data[i]);
fprintf(UFID,"\n");
/* Create the solver memory */
arkode_mem = ARKodeCreate();
if (check_flag((void *) arkode_mem, "ARKodeCreate", 0)) return 1;
/* Initialize the integrator memory */
flag = ARKodeInit(arkode_mem, NULL, f, T0, y);
if (check_flag(&flag, "ARKodeInit", 1)) return 1;
/* Set routines */
flag = ARKodeSetUserData(arkode_mem, (void *) udata); /* Pass udata to user functions */
if (check_flag(&flag, "ARKodeSetUserData", 1)) return 1;
flag = ARKodeSetMaxNumSteps(arkode_mem, 10000); /* Increase max num steps */
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return 1;
flag = ARKodeSStolerances(arkode_mem, rtol, atol); /* Specify tolerances */
if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1;
flag = ARKodeSetAdaptivityMethod(arkode_mem, 2, 1, 0, NULL); /* Set adaptivity method */
if (check_flag(&flag, "ARKodeSetAdaptivityMethod", 1)) return 1;
flag = ARKodeSetPredictorMethod(arkode_mem, 0); /* Set predictor method */
if (check_flag(&flag, "ARKodeSetPredictorMethod", 1)) return 1;
/* Linear solver specification */
flag = ARKPcg(arkode_mem, 0, N);
if (check_flag(&flag, "ARKPcg", 1)) return 1;
flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac);
if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1;
/* Main time-stepping loop: calls ARKode to perform the integration, then
prints results. Stops when the final time has been reached */
t = T0;
olddt = 0.0;
newdt = 0.0;
printf(" iout dt_old dt_new ||u||_rms N NNI NLI\n");
printf(" ----------------------------------------------------------------------------------------\n");
printf(" %4i %19.15e %19.15e %19.15e %li %2i %3i\n",
iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, 0, 0);
while (t < Tf) {
/* "set" routines */
flag = ARKodeSetStopTime(arkode_mem, Tf);
if (check_flag(&flag, "ARKodeSetStopTime", 1)) return 1;
flag = ARKodeSetInitStep(arkode_mem, newdt);
if (check_flag(&flag, "ARKodeSetInitStep", 1)) return 1;
/* call integrator */
flag = ARKode(arkode_mem, Tf, y, &t, ARK_ONE_STEP);
if (check_flag(&flag, "ARKode", 1)) return 1;
/* "get" routines */
flag = ARKodeGetLastStep(arkode_mem, &olddt);
if (check_flag(&flag, "ARKodeGetLastStep", 1)) return 1;
flag = ARKodeGetCurrentStep(arkode_mem, &newdt);
if (check_flag(&flag, "ARKodeGetCurrentStep", 1)) return 1;
flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
if (check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1)) return 1;
flag = ARKSpilsGetNumLinIters(arkode_mem, &nli);
if (check_flag(&flag, "ARKSpilsGetNumLinIters", 1)) return 1;
/* print current solution stats */
iout++;
printf(" %4i %19.15e %19.15e %19.15e %li %2li %3li\n",
iout, olddt, newdt, sqrt(N_VDotProd(y,y)/udata->N), udata->N, nni-nni_cur, nli);
nni_cur = nni;
nni_tot = nni;
nli_tot += nli;
/* output results and current mesh to disk */
data = N_VGetArrayPointer(y);
for (i=0; i<udata->N; i++) fprintf(UFID," %.16e", data[i]);
fprintf(UFID,"\n");
for (i=0; i<udata->N; i++) fprintf(XFID," %.16e", udata->x[i]);
fprintf(XFID,"\n");
/* adapt the spatial mesh */
xnew = adapt_mesh(y, &Nnew, udata);
if (check_flag(xnew, "ark_adapt", 0)) return 1;
/* create N_Vector of new length */
y2 = N_VNew_Serial(Nnew);
if (check_flag((void *) y2, "N_VNew_Serial", 0)) return 1;
/* project solution onto new mesh */
flag = project(udata->N, udata->x, y, Nnew, xnew, y2);
if (check_flag(&flag, "project", 1)) return 1;
/* delete old vector, old mesh */
N_VDestroy_Serial(y);
free(udata->x);
/* swap x and xnew so that new mesh is stored in udata structure */
udata->x = xnew;
xnew = NULL;
udata->N = Nnew; /* store size of new mesh */
/* swap y and y2 so that y holds new solution */
yt = y;
y = y2;
y2 = yt;
/* call ARKodeResize to notify integrator of change in mesh */
flag = ARKodeResize(arkode_mem, y, hscale, t, NULL, NULL);
if (check_flag(&flag, "ARKodeResize", 1)) return 1;
/* destroy and re-allocate linear solver memory */
flag = ARKPcg(arkode_mem, 0, udata->N);
if (check_flag(&flag, "ARKPcg", 1)) return 1;
flag = ARKSpilsSetJacTimesVecFn(arkode_mem, Jac);
if (check_flag(&flag, "ARKSpilsSetJacTimesVecFn", 1)) return 1;
}
printf(" ----------------------------------------------------------------------------------------\n");
/* Free integrator memory */
ARKodeFree(&arkode_mem);
/* print some final statistics */
printf(" Final solver statistics:\n");
printf(" Total number of time steps = %i\n", iout);
printf(" Total nonlinear iterations = %li\n", nni_tot);
printf(" Total linear iterations = %li\n\n", nli_tot);
/* Clean up and return with successful completion */
fclose(UFID);
fclose(XFID);
N_VDestroy_Serial(y); /* Free vectors */
free(udata->x); /* Free user data */
free(udata);
return 0;
}