void ParameterisedCvode::EvaluateYDerivatives(double time, const N_Vector rY, N_Vector rDY)
{
NV_Ith_S(rDY, 0) = GetVectorComponent(mParameters,0);
}
/**
* Solves an initial value problem using CVODES to integrate over a system of
* ODEs with optional forward sensitivity analysis. The initial conditions for
* the system and for the sensitivity analysis are expected to be in the first
* rows of simdata and sensitivities, respectively.
*
* @param [in] rhs the right-hand side of the system of ODEs
* @param [in] num_timepoints the number of timepoints
* @param [in] num_species the number of independent variables
* @param [in] num_sens the number of parameters to compute sensitivities
* for (set to zero to disable sensitivity
* calculations)
* @param [in] timepoints the timepoints at which data is to be returned
* @param [in] params parameters
* @param [in] sensi the indices of the parameters to compute the
* sensitivities for (may be NULL to compute the
* sensitivities for all parameters)
* @param [in] options additional options for the integrator
* @param [out] simdata contains the state values for each species at
* each timepoint in column-major order.
* @param [out] sensitivities sensitivities of each parameter in sensi
* with respect to each independent variable.
* The sensitivity of parameter j with respect to
* variable k at timepoint i is stored at
* (j * num_species + k) * lds + i.
* May be NULL if sensitivities are not to be
* calculated.
* @param [in] lds leading dimension of simdata and sensitivities
*
* @return 0 on success,
* GMCMC_ENOMEM if there was not enough memory to create the solver,
* GMCMC_EINVAL if there was an invalid argument to the function,
* GMCMC_ELINAL if the solution could not be found.
*/
int cvodes_solve(gmcmc_ode_rhs rhs, size_t num_timepoints, size_t num_species, size_t num_params, size_t num_sens, const double * timepoints, const double * params, const size_t * sensi, const cvodes_options * options, double * simdata, double * sensitivities, size_t lds) {
int error;
// Set vector of initial values
N_Vector y = N_VNew_Serial((long int)num_species);
for (size_t j = 0; j < num_species; j++)
NV_Ith_S(y, j) = simdata[j * lds];
// Create CVODES object
void * cvode_mem;
if ((cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON)) == NULL)
GMCMC_ERROR("Failed to allocate ODE solver", GMCMC_ENOMEM);
// Initialise CVODES solver
if ((error = CVodeInit(cvode_mem, cvodes_rhs, timepoints[0], y)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
GMCMC_ERROR("Failed to initialise ODE solver", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
// Set integration tolerances
if ((error = CVodeSStolerances(cvode_mem, options->reltol, options->abstol)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
GMCMC_ERROR("Failed to set ODE solver integration tolerances", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
// Create a copy of the parameters in case CVODES modifies them
realtype * sens_params;
if ((sens_params = malloc(num_params * sizeof(realtype))) == NULL) {
CVodeFree(&cvode_mem);
GMCMC_ERROR("Failed to allocate copy of parameter vector for sensitivity analysis", GMCMC_ENOMEM);
}
for (size_t i = 0; i < num_params; i++)
sens_params[i] = (realtype)params[i];
// Set optional inputs
cvodes_userdata userdata = { rhs, sens_params };
if ((error = CVodeSetUserData(cvode_mem, &userdata)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
free(sens_params);
GMCMC_ERROR("Failed to set ODE solver user data", GMCMC_EINVAL);
}
// Attach linear solver module
if ((error = CVLapackDense(cvode_mem, (int)num_species)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
free(sens_params);
GMCMC_ERROR("Failed to attach ODE solver module", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
N_Vector * yS = NULL;
int * plist = NULL;
if (num_sens > 0) {
// Set sensitivity initial conditions
yS = N_VCloneVectorArray_Serial((int)num_sens, y);
for (size_t j = 0; j < num_sens; j++) {
for (size_t i = 0; i < num_species; i++)
NV_Ith_S(yS[j], i) = sensitivities[(j * num_species + i) * lds];
}
// Activate sensitivity calculations
// Use default finite differences
if ((error = CVodeSensInit(cvode_mem, (int)num_sens, CV_SIMULTANEOUS, NULL, yS)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
free(sens_params);
GMCMC_ERROR("Failed to activate ODE solver sensitivity calculations", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
// Set sensitivity tolerances
if ((error = CVodeSensEEtolerances(cvode_mem)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
free(sens_params);
GMCMC_ERROR("Failed to set ODE solver sensitivity tolerances", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
if (sensi != NULL) {
if ((plist = malloc(num_sens * sizeof(int))) == NULL) {
CVodeFree(&cvode_mem);
free(sens_params);
GMCMC_ERROR("Failed to allocate sensitivity parameter list", GMCMC_ENOMEM);
}
for (size_t i = 0; i < num_sens; i++)
plist[i] = (int)sensi[i];
}
// Set sensitivity analysis optional inputs
if ((error = CVodeSetSensParams(cvode_mem, sens_params, NULL, plist)) != CV_SUCCESS) {
CVodeFree(&cvode_mem);
free(plist);
free(sens_params);
GMCMC_ERROR("Failed to set ODE solver sensitivity parameters", (error == CV_ILL_INPUT) ? GMCMC_EINVAL : GMCMC_ENOMEM);
}
}
// Advance solution in time
realtype tret;
for (size_t i = 1; i < num_timepoints; i++) {
if ((error = CVode(cvode_mem, timepoints[i], y, &tret, CV_NORMAL)) != CV_SUCCESS) {
free(plist);
free(sens_params);
CVodeFree(&cvode_mem);
GMCMC_ERROR("Failed to advance ODE solution", GMCMC_ELINAL);
}
for (size_t j = 0; j < num_species; j++)
simdata[j * lds + i] = NV_Ith_S(y, j);
// Extract the sensitivity solution
if (yS != NULL) {
if ((error = CVodeGetSens(cvode_mem, &tret, yS)) != CV_SUCCESS) {
free(plist);
free(sens_params);
CVodeFree(&cvode_mem);
GMCMC_ERROR("Failed to extract ODE sensitivity solution", GMCMC_ELINAL);
}
for (size_t j = 0; j < num_sens; j++) {
for (size_t k = 0; k < num_species; k++)
sensitivities[(j * num_species + k) * lds + i] = NV_Ith_S(yS[j], k);
}
}
}
N_VDestroy(y);
if (yS != NULL)
N_VDestroyVectorArray_Serial(yS, (int)num_sens);
free(plist);
free(sens_params);
// Free solver memory
CVodeFree(&cvode_mem);
return 0;
}
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 main(int narg, char **args)
{
realtype reltol, t, tout;
N_Vector state, abstol;
void *cvode_mem;
int flag, flagr;
FILE *pout;
if(!(pout = fopen("Locke2008_Circadian_Clock.dat", "w"))){
fprintf(stderr, "Cannot open file Locke2008_Circadian_Clock.dat. Are you trying to write to a non-existent directory? Exiting...\n");
exit(1);
}
state = abstol = NULL;
cvode_mem = NULL;
state = N_VNew_Serial(NEQ);
if (check_flag((void *)state, "N_VNew_Serial", 0)) return(1);
abstol = N_VNew_Serial(NEQ);
if (check_flag((void *)abstol, "N_VNew_Serial", 0)) return(1);
realtype Kc = 4.8283;
realtype v_4 = 1.0841;
realtype v_6 = 4.6645;
realtype vc = 6.7924;
realtype v_1 = 6.8355;
realtype v_2 = 8.4297;
realtype K = 1.0;
realtype v_8 = 3.5216;
realtype L = 0.0;
realtype n = 5.6645;
realtype k3 = 0.1177;
realtype K2 = 0.291;
realtype K1 = 2.7266;
realtype k7 = 0.2282;
realtype K6 = 9.9849;
realtype k5 = 0.3352;
realtype K4 = 8.1343;
realtype K8 = 7.4519;
realtype init_X1 = 4.25;
realtype tscale = 1.0;
realtype init_Z1 = 2.25;
realtype init_Z2 = 0.0;
realtype init_V1 = 2.5;
realtype init_V2 = 0.0;
realtype init_X2 = 0.0;
realtype compartment = 1.0;
realtype init_Y1 = 3.25;
realtype init_Y2 = 0.0;
realtype p[] = {Kc, v_4, v_6, vc, v_1, v_2, K, v_8, L, n, k3, K2, K1, k7, K6, k5, K4, K8, init_X1, tscale, init_Z1, init_Z2, init_V1, init_V2, init_X2, compartment, init_Y1, init_Y2, };
realtype X1 = init_X1;
realtype X2 = init_X2;
realtype V1 = init_V1;
realtype V2 = init_V2;
realtype Y1 = init_Y1;
realtype Y2 = init_Y2;
realtype Z1 = init_Z1;
realtype Z2 = init_Z2;
NV_Ith_S(state, 0) = init_Y2;
NV_Ith_S(state, 1) = init_V1;
NV_Ith_S(state, 2) = init_Y1;
NV_Ith_S(state, 3) = init_V2;
NV_Ith_S(state, 4) = init_X2;
NV_Ith_S(state, 5) = init_X1;
NV_Ith_S(state, 6) = init_Z1;
NV_Ith_S(state, 7) = init_Z2;
reltol = RTOL;
NV_Ith_S(abstol,0) = ATOL0;
NV_Ith_S(abstol,1) = ATOL1;
NV_Ith_S(abstol,2) = ATOL2;
NV_Ith_S(abstol,3) = ATOL3;
NV_Ith_S(abstol,4) = ATOL4;
NV_Ith_S(abstol,5) = ATOL5;
NV_Ith_S(abstol,6) = ATOL6;
NV_Ith_S(abstol,7) = ATOL7;
/* Allocations and initializations */
cvode_mem = CVodeCreate(CV_BDF, CV_NEWTON);
if (check_flag((void *)cvode_mem, "CVodeCreate", 0)) return(1);
flag = CVodeInit(cvode_mem, dstate_dt, T0, state);
if (check_flag(&flag, "CVodeInit", 1)) return(1);
flag = CVodeSetUserData(cvode_mem, p);
if (check_flag(&flag, "CVodeSetUserData", 1)) return(1);
flag = CVodeSVtolerances(cvode_mem, reltol, abstol);
if (check_flag(&flag, "CVodeSVtolerances", 1)) return(1);
flag = CVDense(cvode_mem, NEQ);
if (check_flag(&flag, "CVDense", 1)) return(1);
printf(" \n Integrating Locke2008_Circadian_Clock_0 \n\n");
printf("#t Y2, V1, Y1, V2, X2, X1, Z1, Z2, \n");
PrintOutput(pout, t, state);
tout = DT;
while(1) {
flag = CVode(cvode_mem, tout, state, &t, CV_NORMAL);
{
PrintOutput(pout, t, state);
if(check_flag(&flag, "CVode", 1)) break;
if(flag == CV_SUCCESS) {
tout += DT;
}
if (t >= T1) break;
}
}
PrintFinalStats(cvode_mem);
N_VDestroy_Serial(state);
N_VDestroy_Serial(abstol);
CVodeFree(&cvode_mem);
fclose(pout);
return(0);
}
static int dstate_dt(realtype t, N_Vector state, N_Vector dstate, void *p){
realtype *pars = (realtype *) p;
realtype Kc = pars[0];
realtype v_4 = pars[1];
realtype v_6 = pars[2];
realtype vc = pars[3];
realtype v_1 = pars[4];
realtype v_2 = pars[5];
realtype K = pars[6];
realtype v_8 = pars[7];
realtype L = pars[8];
realtype n = pars[9];
realtype k3 = pars[10];
realtype K2 = pars[11];
realtype K1 = pars[12];
realtype k7 = pars[13];
realtype K6 = pars[14];
realtype k5 = pars[15];
realtype K4 = pars[16];
realtype K8 = pars[17];
realtype init_X1 = pars[18];
realtype tscale = pars[19];
realtype init_Z1 = pars[20];
realtype init_Z2 = pars[21];
realtype init_V1 = pars[22];
realtype init_V2 = pars[23];
realtype init_X2 = pars[24];
realtype compartment = pars[25];
realtype init_Y1 = pars[26];
realtype init_Y2 = pars[27];
realtype Y2 = NV_Ith_S(state, 0);
realtype V1 = NV_Ith_S(state, 1);
realtype Y1 = NV_Ith_S(state, 2);
realtype V2 = NV_Ith_S(state, 3);
realtype X2 = NV_Ith_S(state, 4);
realtype X1 = NV_Ith_S(state, 5);
realtype Z1 = NV_Ith_S(state, 6);
realtype Z2 = NV_Ith_S(state, 7);
realtype rate__R6 = compartment * v_4 * Y1 / compartment / (K4 + Y1 / compartment);
realtype rate__R7 = compartment * k5 * Y1 / compartment;
realtype rate__R4 = compartment * L;
realtype rate__R5 = compartment * k3 * X1 / compartment;
realtype rate__R2 = compartment * v_2 * X1 / compartment / (K2 + X1 / compartment);
realtype rate__R1 = compartment * v_1 * pow(K1, n) / (pow(K1, n) + pow(Z1 / compartment, n));
realtype F = 1.0 / 2.0 * (V1 + V2);
realtype rate__R3 = compartment * vc * K * F / (Kc + K * F);
realtype rate__R8 = compartment * v_6 * Z1 / compartment / (K6 + Z1 / compartment);
realtype rate__R9 = compartment * k7 * X1 / compartment;
realtype rate__R14 = compartment * L;
realtype rate__R15 = compartment * k3 * X2 / compartment;
realtype rate__R16 = compartment * v_4 * Y2 / compartment / (K4 + Y2 / compartment);
realtype rate__R17 = compartment * k5 * Y2 / compartment;
realtype rate__R10 = compartment * v_8 * V1 / compartment / (K8 + V1 / compartment);
realtype rate__R11 = compartment * v_1 * pow(K1, n) / (pow(K1, n) + pow(Z2 / compartment, n));
realtype rate__R12 = compartment * v_2 * X2 / compartment / (K2 + X2 / compartment);
realtype rate__R13 = compartment * vc * K * F / (Kc + K * F);
realtype rate__R20 = compartment * v_8 * V2 / compartment / (K8 + V2 / compartment);
realtype rate__R18 = compartment * v_6 * Z2 / compartment / (K6 + Z2 / compartment);
realtype rate__R19 = compartment * k7 * X2 / compartment;
NV_Ith_S(dstate, 0) = tscale * (rate__R15 - rate__R16);
NV_Ith_S(dstate, 1) = tscale * (rate__R9 - rate__R10);
NV_Ith_S(dstate, 2) = tscale * (rate__R5 - rate__R6);
NV_Ith_S(dstate, 3) = tscale * (rate__R19 - rate__R20);
NV_Ith_S(dstate, 4) = tscale * (rate__R11 - rate__R12 + rate__R13 + rate__R14);
NV_Ith_S(dstate, 5) = tscale * (rate__R1 - rate__R2 + rate__R3 + rate__R4);
NV_Ith_S(dstate, 6) = tscale * (rate__R7 - rate__R8);
NV_Ith_S(dstate, 7) = tscale * (rate__R17 - rate__R18);
return(0);
}
int main()
{
PbData data;
realtype R, L, m, g, V0;
void *cpode_mem;
N_Vector yy, yp, ctols;
realtype reltol, abstol;
realtype t0, tf, t;
realtype x1, y1, x2, y2;
realtype vx1, vy1, vx2, vy2;
int flag, Neq, Nc;
int rdir[1], iroots[1];
FILE *fout;
/* --------------------------------
* INITIALIZATIONS
* -------------------------------- */
R = 0.1; /* ball radius */
L = 1.0; /* pendulum length */
m = 1.0; /* pendulum mass */
g = 9.8; /* gravitational acc. */
V0 = 3.0; /* initial velocity for pendulum 1 */
/* Set-up user data structure */
data = (PbData)malloc(sizeof *data);
data->R = R;
data->L = L;
data->m = m;
data->g = g;
/* Problem dimensions */
Neq = 2*2*2;
Nc = 2*2;
/* Solution vectors */
yy = N_VNew_Serial(Neq);
yp = N_VNew_Serial(Neq);
/* Integration limits */
t0 = 0.0;
tf = 6.0;
/* Integration and projection tolerances */
reltol = 1.0e-8;
abstol = 1.0e-8;
ctols = N_VNew_Serial(Nc);
N_VConst(1.0e-8, ctols);
/* Direction of monitored events
* (only zero-crossing with decreasing even function) */
rdir[0] = -1;
/* --------------------------------
* CASE 1
* -------------------------------- */
fout = fopen("newton1.out","w");
/* Initial conditions */
NV_Ith_S(yy,0) = R; NV_Ith_S(yy,4) = -R;
NV_Ith_S(yy,1) = -L; NV_Ith_S(yy,5) = -L;
NV_Ith_S(yy,2) = V0; NV_Ith_S(yy,6) = 0.0;
NV_Ith_S(yy,3) = 0.0; NV_Ith_S(yy,7) = 0.0;
/* Initialize solver */
cpode_mem = CPodeCreate(CP_EXPL, CP_BDF, CP_NEWTON);
flag = CPodeInit(cpode_mem, ffun1, data, t0, yy, yp, CP_SS, reltol, &abstol);
flag = CPDense(cpode_mem, Neq);
flag = CPodeRootInit(cpode_mem, 1, gfun, data);
flag = CPodeSetRootDirection(cpode_mem, rdir);
/* Set-up the internal projection */
flag = CPodeProjInit(cpode_mem, CP_PROJ_L2NORM, CP_CNSTR_NONLIN, cfun, data, ctols);
flag = CPodeSetProjTestCnstr(cpode_mem, TRUE);
flag = CPDenseProj(cpode_mem, Nc, Neq, CPDIRECT_LU);
/* Integrate in ONE_STEP mode, while monitoring events */
t = t0;
while(t<tf) {
flag = CPode(cpode_mem, tf, &t, yy, yp, CP_ONE_STEP);
if (flag < 0) break;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
fprintf(fout, "%lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf",
t, x1, y1, x2, y2, vx1, vy1, vx2, vy2);
if (flag == CP_ROOT_RETURN) {
CPodeGetRootInfo(cpode_mem, iroots);
fprintf(fout, " %d\n", iroots[0]);
/* Note: the test iroots[0]<0 is really needed ONLY if not using rdir */
if (iroots[0] < 0) {
/* Update velocities in yy */
contact(yy, data);
/* reinitialize CPODES solver */
flag = CPodeReInit(cpode_mem, ffun1, data, t, yy, yp, CP_SS, reltol, &abstol);
}
} else {
fprintf(fout, " 0\n");
}
}
PrintFinalStats(cpode_mem);
CPodeFree(&cpode_mem);
fclose(fout);
/* --------------------------------
* CASE 2
* -------------------------------- */
fout = fopen("newton2.out","w");
/* Initial conditions */
NV_Ith_S(yy,0) = R; NV_Ith_S(yy,4) = -R;
NV_Ith_S(yy,1) = -L; NV_Ith_S(yy,5) = -L;
NV_Ith_S(yy,2) = 0.0; NV_Ith_S(yy,6) = 0.0;
NV_Ith_S(yy,3) = 0.0; NV_Ith_S(yy,7) = 0.0;
/* Initialize solver */
cpode_mem = CPodeCreate(CP_EXPL, CP_BDF, CP_NEWTON);
flag = CPodeInit(cpode_mem, ffun2, data, t0, yy, yp, CP_SS, reltol, &abstol);
flag = CPDense(cpode_mem, Neq);
flag = CPodeRootInit(cpode_mem, 1, gfun, data);
flag = CPodeSetRootDirection(cpode_mem, rdir);
/* Set-up the internal projection */
flag = CPodeProjInit(cpode_mem, CP_PROJ_L2NORM, CP_CNSTR_NONLIN, cfun, data, ctols);
flag = CPodeSetProjTestCnstr(cpode_mem, TRUE);
flag = CPDenseProj(cpode_mem, Nc, Neq, CPDIRECT_LU);
/* Integrate in ONE_STEP mode, while monitoring events */
t = t0;
while(t<tf) {
flag = CPode(cpode_mem, tf, &t, yy, yp, CP_ONE_STEP);
if (flag < 0) break;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
fprintf(fout, "%lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf %14.10lf",
t, x1, y1, x2, y2, vx1, vy1, vx2, vy2);
if (flag == CP_ROOT_RETURN) {
CPodeGetRootInfo(cpode_mem, iroots);
fprintf(fout, " %d\n", iroots[0]);
/* Note: the test iroots[0]<0 is really needed ONLY if not using rdir */
if (iroots[0] < 0) {
/* Update velocities in yy */
contact(yy, data);
/* reinitialize CPODES solver */
flag = CPodeReInit(cpode_mem, ffun2, data, t, yy, yp, CP_SS, reltol, &abstol);
}
} else {
fprintf(fout, " 0\n");
}
}
PrintFinalStats(cpode_mem);
CPodeFree(&cpode_mem);
fclose(fout);
/* --------------------------------
* CLEAN-UP
* -------------------------------- */
free(data);
N_VDestroy_Serial(yy);
N_VDestroy_Serial(yp);
N_VDestroy_Serial(ctols);
return(0);
}
void initialize(char *filename, Model_Data DS, Control_Data *CS, N_Vector CV_Y)
{
int i;
realtype a_x, a_y, b_x, b_y, c_x, c_y;
realtype a_zmin, a_zmax, b_zmin, b_zmax, c_zmin, c_zmax;
realtype tempvalue;
FILE *int_file;
char *fn;
printf("\nInitializing data structure ... ");
for(i=0; i<DS->NumEle; i++)
{
a_x = DS->Node[DS->Ele[i].node[0]-1].x;
b_x = DS->Node[DS->Ele[i].node[1]-1].x;
c_x = DS->Node[DS->Ele[i].node[2]-1].x;
a_y = DS->Node[DS->Ele[i].node[0]-1].y;
b_y = DS->Node[DS->Ele[i].node[1]-1].y;
c_y = DS->Node[DS->Ele[i].node[2]-1].y;
a_zmin = DS->Node[DS->Ele[i].node[0]-1].zmin;
b_zmin = DS->Node[DS->Ele[i].node[1]-1].zmin;
c_zmin = DS->Node[DS->Ele[i].node[2]-1].zmin;
a_zmax = DS->Node[DS->Ele[i].node[0]-1].zmax;
b_zmax = DS->Node[DS->Ele[i].node[1]-1].zmax;
c_zmax = DS->Node[DS->Ele[i].node[2]-1].zmax;
DS->Ele[i].area = 0.5*((b_x - a_x)*(c_y - a_y) - (b_y - a_y)*(c_x - a_x));
DS->Ele[i].zmin = (a_zmin + b_zmin + c_zmin)/3.0;
DS->Ele[i].zmax = (a_zmax + b_zmax + c_zmax)/3.0;
DS->Ele[i].edge[0] = pow((a_x - b_x), 2) + pow((a_y - b_y), 2);
DS->Ele[i].edge[1] = pow((b_x - c_x), 2) + pow((b_y - c_y), 2);
DS->Ele[i].edge[2] = pow((c_x - a_x), 2) + pow((c_y - a_y), 2);
/* calculate centroid of triangle */
/*
DS->Ele[i].x = (a_x + b_x + c_x)/3.0;
DS->Ele[i].y = (a_y + b_y + c_y)/3.0;
*/
/* calculate circumcenter of triangle */
DS->Ele[i].x = a_x - ((b_y - a_y)*DS->Ele[i].edge[2] - (c_y - a_y)*DS->Ele[i].edge[0])/(4*DS->Ele[i].area);
DS->Ele[i].y = a_y + ((b_x - a_x)*DS->Ele[i].edge[2] - (c_x - a_x)*DS->Ele[i].edge[0])/(4*DS->Ele[i].area);
DS->Ele[i].edge[0] = sqrt(DS->Ele[i].edge[0]);
DS->Ele[i].edge[1] = sqrt(DS->Ele[i].edge[1]);
DS->Ele[i].edge[2] = sqrt(DS->Ele[i].edge[2]);
}
/* allocate flux */
DS->FluxSurf = (realtype **)malloc(DS->NumEle*sizeof(realtype));
DS->FluxSub = (realtype **)malloc(DS->NumEle*sizeof(realtype));
DS->FluxRiv = (realtype **)malloc(DS->NumRiv*sizeof(realtype));
DS->EleET = (realtype **)malloc(DS->NumEle*sizeof(realtype));
for(i=0; i<DS->NumEle; i++)
{
DS->FluxSurf[i] = (realtype *)malloc(3*sizeof(realtype));
DS->FluxSub[i] = (realtype *)malloc(3*sizeof(realtype));
DS->EleET[i] = (realtype *)malloc(4*sizeof(realtype));
}
for(i=0; i<DS->NumRiv; i++)
{
DS->FluxRiv[i] = (realtype *)malloc(6*sizeof(realtype));
}
DS->ElePrep = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->EleVic = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->Recharge = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->EleIS = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->EleISmax = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->EleETP = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->Ele2IS = (realtype *)malloc(DS->NumEle*sizeof(realtype));
DS->EleNetPrep = (realtype *)malloc(DS->NumEle*sizeof(realtype));
for(i=0; i<DS->NumEle; i++)
{
DS->Ele[i].Ksat = DS->Soil[(DS->Ele[i].soil-1)].Ksat;
DS->Ele[i].Porosity = DS->Soil[(DS->Ele[i].soil-1)].SitaS -
DS->Soil[(DS->Ele[i].soil-1)].SitaR;
DS->Ele[i].Alpha = DS->Soil[(DS->Ele[i].soil-1)].Alpha;
DS->Ele[i].Beta = DS->Soil[(DS->Ele[i].soil-1)].Beta;
DS->Ele[i].Sf = DS->Soil[(DS->Ele[i].soil-1)].Sf;
DS->Ele[i].Rough = DS->Soil[DS->Ele[i].soil-1].Rough;
}
for(i=0; i<DS->NumRiv; i++)
{
DS->Riv[i].x = (DS->Node[DS->Riv[i].FromNode-1].x +
DS->Node[DS->Riv[i].ToNode-1].x)/2;
DS->Riv[i].y = (DS->Node[DS->Riv[i].FromNode-1].y +
DS->Node[DS->Riv[i].ToNode-1].y)/2;
DS->Riv[i].zmax = (DS->Node[DS->Riv[i].FromNode-1].zmax + DS->Node[DS->Riv[i].ToNode-1].zmax)/2;
DS->Riv[i].depth = DS->Riv_Shape[DS->Riv[i].shape-1].depth;
DS->Riv[i].zmin = DS->Riv[i].zmax - DS->Riv[i].depth;
DS->Riv[i].Length = sqrt(pow(DS->Node[DS->Riv[i].FromNode-1].x -
DS->Node[DS->Riv[i].ToNode-1].x, 2) +
pow(DS->Node[DS->Riv[i].FromNode-1].y -
DS->Node[DS->Riv[i].ToNode-1].y, 2));
}
/* initialize state varible */
/* relax cases */
if (CS->int_type == 0)
{
for(i=0; i<DS->NumEle; i++)
{
DS->EleIS[i] = 0;
NV_Ith_S(CV_Y, i) = 0;
NV_Ith_S(CV_Y, i + DS->NumEle) = 0.08;
NV_Ith_S(CV_Y, i + 2*DS->NumEle) = DS->Ele[i].zmax - DS->Ele[i].zmin - 0.1;
}
for(i=0; i<DS->NumRiv; i++)
{
NV_Ith_S(CV_Y, i + 3*DS->NumEle) = 0;
}
}
/* type mode */
else if (CS->int_type == 1)
{
for(i=0; i<DS->NumEle; i++)
{
DS->EleIS[i] = DS->Ele_IC[DS->Ele[i].IC-1].interception;
NV_Ith_S(CV_Y, i) = DS->Ele_IC[DS->Ele[i].IC-1].surf;
NV_Ith_S(CV_Y, i + DS->NumEle) = DS->Ele_IC[DS->Ele[i].IC-1].unsat;
NV_Ith_S(CV_Y, i + 2*DS->NumEle) = DS->Ele_IC[DS->Ele[i].IC-1].sat;
if ((NV_Ith_S(CV_Y, i + DS->NumEle) + NV_Ith_S(CV_Y, i + 2*DS->NumEle)) >= (DS->Ele[i].zmax - DS->Ele[i].zmin))
{
NV_Ith_S(CV_Y, i + DS->NumEle) = ((DS->Ele[i].zmax - DS->Ele[i].zmin) - NV_Ith_S(CV_Y, i + 2*DS->NumEle))*0.9;
if (NV_Ith_S(CV_Y, i + DS->NumEle) < 0) {NV_Ith_S(CV_Y, i + DS->NumEle) = 0; }
}
}
for(i=0; i<DS->NumRiv; i++)
{
NV_Ith_S(CV_Y, i + 3*DS->NumEle) = DS->Riv_IC[DS->Riv[i].IC-1].value;
}
}
/* hot start mode */
else
{
fn = (char *)malloc((strlen(filename)+4)*sizeof(char));
strcpy(fn, filename);
int_file = fopen(strcat(fn, ".int"), "r");
if(int_file == NULL)
{
printf("\n Fatal Error: %s.int is in use or does not exist!\n", filename);
exit(1);
}
else
{
for(i=0; i<DS->NumEle; i++)
{
fscanf(int_file, "%lf", &tempvalue);
if(tempvalue <= 0) {tempvalue = 0.01;}
NV_Ith_S(CV_Y, i + DS->NumEle) = tempvalue;
}
for(i=0; i<DS->NumEle; i++)
{
fscanf(int_file, "%lf", &tempvalue);
if(tempvalue <= 0) {tempvalue = 0.01;}
if(tempvalue >= (DS->Ele[i].zmax - DS->Ele[i].zmin)) {tempvalue = (DS->Ele[i].zmax - DS->Ele[i].zmin) - 0.01;}
NV_Ith_S(CV_Y, i + 2*DS->NumEle) = tempvalue;
}
for(i=0; i<DS->NumEle; i++)
{
DS->EleIS[i] = 0;
NV_Ith_S(CV_Y, i) = 0;
}
for(i=0; i<DS->NumRiv; i++)
{
NV_Ith_S(CV_Y, i + 3*DS->NumEle) = 0;
}
}
fclose(int_file);
}
printf("done.\n");
}
static int cfun(realtype t, N_Vector yy, N_Vector c, void *c_data)
{
PbData data;
realtype x1, y1, x2, y2;
realtype vx1, vy1, vx2, vy2;
realtype R, L;
data = (PbData) c_data;
R = data->R;
L = data->L;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
NV_Ith_S(c,0) = (x1-R)*(x1-R) + y1*y1 - L*L;
NV_Ith_S(c,1) = (x1-R)*vx1 + y1*vy1;
NV_Ith_S(c,2) = (x2+R)*(x2+R) + y2*y2 - L*L;
NV_Ith_S(c,3) = (x2+R)*vx2 + y2*vy2;
return(0);
}
static void contact(N_Vector yy, PbData data)
{
realtype x1, y1, x2, y2;
realtype vx1, vy1, vx2, vy2;
realtype vt1, vn1, vn1_, vt2, vn2, vn2_;
realtype alpha, ca, sa;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
/* Angle of contact line */
alpha = atan2(y2-y1, x2-x1);
ca = cos(alpha);
sa = sin(alpha);
/* Normal and tangential velocities before impact
* (rotate velocity vectors by +alpha) */
vn1 = ca*vx1 + sa*vy1;
vt1 = -sa*vx1 + ca*vy1;
vn2 = ca*vx2 + sa*vy2;
vt2 = -sa*vx2 + ca*vy2;
/* New normal velocities (M1=M2 and COR=1.0) */
vn1_ = vn2;
vn2_ = vn1;
vn1 = vn1_;
vn2 = vn2_;
/* Velocities after impact (rotate back by -alpha) */
vx1 = ca*vn1 - sa*vt1;
vy1 = sa*vn1 + ca*vt1;
vx2 = ca*vn2 - sa*vt2;
vy2 = sa*vn2 + ca*vt2;
NV_Ith_S(yy,2) = vx1; NV_Ith_S(yy,6) = vx2;
NV_Ith_S(yy,3) = vy1; NV_Ith_S(yy,7) = vy2;
return;
}
static int ffun1(realtype t, N_Vector yy, N_Vector fy, void *f_data)
{
PbData data;
realtype x1, y1, x2, y2;
realtype vx1, vy1, vx2, vy2;
realtype ax1, ay1, ax2, ay2;
realtype lam1, lam2;
realtype R, L, m, g;
data = (PbData) f_data;
R = data->R;
L = data->L;
m = data->m;
g = data->g;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
lam1 = m/(2*L*L)*(vx1*vx1 + vy1*vy1 - g*y1);
lam2 = m/(2*L*L)*(vx2*vx2 + vy2*vy2 - g*y2);
ax1 = -2.0*(x1-R)*lam1/m;
ay1 = -2.0*y1*lam1/m - g;
ax2 = -2.0*(x2+R)*lam2/m;
ay2 = -2.0*y2*lam2/m - g;
NV_Ith_S(fy,0) = vx1; NV_Ith_S(fy, 4) = vx2;
NV_Ith_S(fy,1) = vy1; NV_Ith_S(fy, 5) = vy2;
NV_Ith_S(fy,2) = ax1; NV_Ith_S(fy, 6) = ax2;
NV_Ith_S(fy,3) = ay1; NV_Ith_S(fy, 7) = ay2;
return(0);
}
static int ffun2(realtype t, N_Vector yy, N_Vector fy, void *f_data)
{
PbData data;
realtype x1, y1, x2, y2;
realtype vx1, vy1, vx2, vy2;
realtype ax1, ay1, ax2, ay2;
realtype lam1, lam2;
realtype R, L, m, g;
realtype pi, frc;
pi = 4.0*atan(1.0);
if ( (t <= 2*pi/5.0) ) {
frc = 3.0 * ( 1.0 - cos(5.0*t) );
} else {
frc = 0.0;
}
data = (PbData) f_data;
R = data->R;
L = data->L;
m = data->m;
g = data->g;
x1 = NV_Ith_S(yy,0); x2 = NV_Ith_S(yy,4);
y1 = NV_Ith_S(yy,1); y2 = NV_Ith_S(yy,5);
vx1 = NV_Ith_S(yy,2); vx2 = NV_Ith_S(yy,6);
vy1 = NV_Ith_S(yy,3); vy2 = NV_Ith_S(yy,7);
lam1 = m/(2*L*L)*(vx1*vx1 + vy1*vy1 + frc*(x1-R) - g*y1);
lam2 = m/(2*L*L)*(vx2*vx2 + vy2*vy2 - g*y2);
ax1 = -2.0*(x1-R)*lam1/m + frc;
ay1 = -2.0*y1*lam1/m - g;
ax2 = -2.0*(x2+R)*lam2/m;
ay2 = -2.0*y2*lam2/m - g;
NV_Ith_S(fy,0) = vx1; NV_Ith_S(fy, 4) = vx2;
NV_Ith_S(fy,1) = vy1; NV_Ith_S(fy, 5) = vy2;
NV_Ith_S(fy,2) = ax1; NV_Ith_S(fy, 6) = ax2;
NV_Ith_S(fy,3) = ay1; NV_Ith_S(fy, 7) = ay2;
return(0);
}
void CVodesIntegrator::initialize(double t0, FuncEval& func)
{
m_neq = func.neq();
m_t0 = t0;
m_time = t0;
if (m_y) {
N_VDestroy_Serial(m_y); // free solution vector if already allocated
}
m_y = N_VNew_Serial(static_cast<sd_size_t>(m_neq)); // allocate solution vector
for (size_t i = 0; i < m_neq; i++) {
NV_Ith_S(m_y, i) = 0.0;
}
// check abs tolerance array size
if (m_itol == CV_SV && m_nabs < m_neq) {
throw CVodesErr("not enough absolute tolerance values specified.");
}
func.getInitialConditions(m_t0, m_neq, NV_DATA_S(m_y));
if (m_cvode_mem) {
CVodeFree(&m_cvode_mem);
}
/*
* Specify the method and the iteration type:
* Cantera Defaults:
* CV_BDF - Use BDF methods
* CV_NEWTON - use Newton's method
*/
m_cvode_mem = CVodeCreate(m_method, m_iter);
if (!m_cvode_mem) {
throw CVodesErr("CVodeCreate failed.");
}
int flag = CVodeInit(m_cvode_mem, cvodes_rhs, m_t0, m_y);
if (flag != CV_SUCCESS) {
if (flag == CV_MEM_FAIL) {
throw CVodesErr("Memory allocation failed.");
} else if (flag == CV_ILL_INPUT) {
throw CVodesErr("Illegal value for CVodeInit input argument.");
} else {
throw CVodesErr("CVodeInit failed.");
}
}
CVodeSetErrHandlerFn(m_cvode_mem, &cvodes_err, this);
if (m_itol == CV_SV) {
flag = CVodeSVtolerances(m_cvode_mem, m_reltol, m_abstol);
} else {
flag = CVodeSStolerances(m_cvode_mem, m_reltol, m_abstols);
}
if (flag != CV_SUCCESS) {
if (flag == CV_MEM_FAIL) {
throw CVodesErr("Memory allocation failed.");
} else if (flag == CV_ILL_INPUT) {
throw CVodesErr("Illegal value for CVodeInit input argument.");
} else {
throw CVodesErr("CVodeInit failed.");
}
}
// pass a pointer to func in m_data
m_fdata.reset(new FuncData(&func, func.nparams()));
flag = CVodeSetUserData(m_cvode_mem, m_fdata.get());
if (flag != CV_SUCCESS) {
throw CVodesErr("CVodeSetUserData failed.");
}
if (func.nparams() > 0) {
sensInit(t0, func);
flag = CVodeSetSensParams(m_cvode_mem, m_fdata->m_pars.data(),
NULL, NULL);
}
applyOptions();
}
double& CVodesIntegrator::solution(size_t k)
{
return NV_Ith_S(m_y, k);
}
void OpenSMOKE_CVODE_Sundials<T>::Solve(const double xend)
{
int flag;
this->x_ = this->x0_;
this->xend_ = xend;
for(int i=0;i<this->n_;i++)
NV_Ith_S(y0Sundials_,i) = this->y0_[i];
if (firstCall_ == true)
{
firstCall_ = false;
/* Call CVodeCreate to create the solver memory and specify the
* Backward Differentiation Formula and the use of a Newton iteration */
cvode_mem_ = CVodeCreate(CV_BDF, CV_NEWTON);
if (check_flag((void *)cvode_mem_, std::string("CVodeCreate"), 0)) exit(-1);
/* Call CVodeInit to initialize the integrator memory and specify the
* user's right hand side function in y'=f(t,y), the inital time t0, and
* the initial dependent variable vector y0Sundials_. */
flag = CVodeInit(cvode_mem_, this->odeSystem_->GetSystemFunctionsStatic, this->odeSystem_->GetWriteFunctionStatic, this->x0_, y0Sundials_);
if (check_flag(&flag, std::string("CVodeInit"), 1)) exit(-1);
/* Call CVodeSVtolerances to specify the scalar relative tolerance
* and vector absolute tolerances */
flag = CVodeSStolerances(cvode_mem_, this->relTolerance_[0], this->absTolerance_[0]);
if (check_flag(&flag, std::string("CVodeSVtolerances"), 1)) exit(-1);
/* Call Solver */
if (this->iUseLapack_ == false)
{
if (this->mUpper_ == 0 && this->mLower_ == 0)
{
// std::cout << "CVODE Solver: Dense Jacobian (without Lapack)..." << std::endl;
flag = CVDense(cvode_mem_, this->n_);
if (check_flag(&flag, std::string("CVDense"), 1)) exit(-1);
}
else
{
// std::cout << "CVODE Solver: Band Jacobian (without Lapack)..." << std::endl;
flag = CVBand(cvode_mem_, this->n_, this->mUpper_, this->mLower_);
if (check_flag(&flag, std::string("CVBand"), 1)) exit(-1);
}
}
else
{
if (this->mUpper_ == 0 && this->mLower_ == 0)
{
// std::cout << "CVODE Solver: Dense Jacobian (with Lapack)..." << std::endl;
flag = CVLapackDense(cvode_mem_, this->n_);
if (check_flag(&flag, std::string("CVLapackDense"), 1)) exit(-1);
}
else
{
// std::cout << "CVODE Solver: Band Jacobian (with Lapack)..." << std::endl;
flag = CVLapackBand(cvode_mem_, this->n_, this->mUpper_, this->mLower_);
if (check_flag(&flag, std::string("CVLapackBand"), 1)) exit(-1);
}
}
}
else
{
flag = CVodeReInit(cvode_mem_, this->x0_, y0Sundials_);
if (check_flag(&flag, std::string("CVodeReInit"), 1)) exit(-1);
}
AnalyzeUserOptions();
/* Solving */
this->tStart_ = this->GetClockTime();
flag = CVode(cvode_mem_, this->xend_, ySundials_, &this->x_, CV_NORMAL);
this->tEnd_ = this->GetClockTime();
this->x0_ = this->x_;
for(int i=0;i<this->n_;i++)
NV_Ith_S(y0Sundials_,i) = NV_Ith_S(ySundials_,i);
for(int i=0;i<this->n_;i++)
this->y_[i] = NV_Ith_S(ySundials_,i);
}
int
full_solve (hid_t fid, hid_t dataset, hid_t* routeDatasets, hid_t dataspace, hid_t routeDataspace, hid_t datatype, hid_t routeDatatype, int cell_index, const inp_t * input_params, SOURCE_MODE mode,
const cell_table_t * cell, const net_t * network, const time_steps_t * ts,
int verbose)
{
double *abundances = NULL;
alloc_abundances( network, &abundances ); // Allocate the abundances array; it contains all species.
rout_t* routes = NULL;
if (( routes =
malloc (sizeof (rout_t) * input_params->output.n_output_species * N_OUTPUT_ROUTES)) == NULL)
{
fprintf (stderr, "astrochem: %s:%d: routes allocation failed.\n",
__FILE__, __LINE__);
return EXIT_SUCCESS;
}
double* output_abundances = NULL;
if (( output_abundances =
malloc (sizeof (double) * input_params->output.n_output_species )) == NULL)
{
fprintf (stderr, "astrochem: %s:%d: array allocation failed.\n",
__FILE__, __LINE__);
return EXIT_FAILURE;
}
#ifdef HAVE_OPENMP
omp_set_lock(&lock);
#endif
// Create the memory dataspace, selecting all output abundances
hsize_t size = input_params->output.n_output_species;
hid_t memDataspace = H5Screate_simple(1, &size, NULL);
// Create the file dataspace, and prepare selection of a chunk of the file
hid_t fileDataspace = H5Scopy(dataspace);
hsize_t count[3]={ 1, 1, input_params->output.n_output_species };
hsize_t routeSize[2] = { input_params->output.n_output_species, N_OUTPUT_ROUTES };
hsize_t routeCount[4]={ 1, 1, input_params->output.n_output_species, N_OUTPUT_ROUTES };
hid_t routeFileDataspace, routeMemDataspace;
if (input_params->output.trace_routes)
{
// Create the route memory dataspace, selecting all output routes
routeMemDataspace = H5Screate_simple(2, routeSize, NULL);
// Create the route file dataspace, and prepare selection of a chunk of the file
routeFileDataspace = H5Scopy(routeDataspace);
}
#ifdef HAVE_OPENMP
omp_unset_lock(&lock);
#endif
// Initializing abundance
#if 0 //Ultra complicated code
const species_name_t* species = malloc( input_params->abundances.n_initial_abundances * sizeof(*species));
double *initial_abundances = malloc( input_params->abundances.n_initial_abundances * sizeof(double) );
int i;
for( i = 0; i < input_params->abundances.n_initial_abundances ; i++ )
{
strcpy( network->species_names[input_params->abundances.initial_abundances[i].species_idx ] , species[i] );
initial_abundances[i] = input_params->abundances.initial_abundances[i].abundance;
}
set_initial_abundances( species, 3, initial_abundances, &network, abundances); // Set initial abundances
#else // same thing , without using api
int i;
for( i = 0; i < input_params->abundances.n_initial_abundances ; i++ )
{
abundances[ input_params->abundances.initial_abundances[i].species_idx ] = input_params->abundances.initial_abundances[i].abundance;
}
// Add grain abundances
int g, gm, gp;
double gabs;
g = find_species ("grain", network);
gm = find_species ("grain(-)", network);
gp = find_species ("grain(+)", network);
// Check if grain abundances have already been initialized one way or another
gabs=0.0;
if(g>=0) gabs += abundances[ g ];
if(gm>=0) gabs += abundances[ gm ];
if(gp>=0) gabs += abundances[ gp ];
if(gabs == 0.0) {
// Grains have not been initialized
// Check that grains are defined in our network, and if so, set the grain abundance
if(g>=0)
abundances[ g ] = input_params->phys.grain_abundance;
}
#endif
double min_nh; /* Minimum density */
/* Compute the minimum density to set the absolute tolerance of the
solver */
min_nh = cell->nh[0];
if (mode == DYNAMIC)
{
int i;
for (i = 1; i < ts->n_time_steps; i++)
{
if (cell->nh[i] < min_nh)
{
min_nh = cell->nh[i];
}
}
}
astrochem_mem_t astrochem_mem;
cell_t cell_unik;
cell_unik.av = cell->av[0];
cell_unik.nh = cell->nh[0];
cell_unik.tgas = cell->tgas[0];
cell_unik.tdust = cell->tdust[0];
if( solver_init( &cell_unik, network, &input_params->phys, abundances, min_nh, input_params->solver.abs_err, input_params->solver.rel_err, &astrochem_mem ) != EXIT_SUCCESS )
{
return EXIT_FAILURE;
}
else
{
int i, j;
/* Solve the system for each time step. */
for (i = 0; i < ts->n_time_steps; i++)
{
if (i!=0 && mode == DYNAMIC)
{
cell_unik.av = cell->av[i];
cell_unik.nh = cell->nh[i];
cell_unik.tgas = cell->tgas[i];
cell_unik.tdust = cell->tdust[i];
if( solve( &astrochem_mem, network, abundances, ts->time_steps[i], &cell_unik, verbose ) != EXIT_SUCCESS )
{
return EXIT_FAILURE;
}
}
else
{
if( solve( &astrochem_mem, network, abundances, ts->time_steps[i], NULL, verbose ) != EXIT_SUCCESS )
{
return EXIT_FAILURE;
}
}
/* Fill the array of abundances with the output species
abundances. Ignore species that are not in the
network. Abundance that are lower than MIN_ABUNDANCES are
set to 0. */
for (j = 0; j < input_params->output.n_output_species; j++)
{
if (mode == STATIC)
{
output_abundances[j] =
(double) NV_Ith_S (astrochem_mem.y, input_params->output.output_species_idx[j]) / cell->nh[0];
}
else
{
output_abundances[j] =
(double) NV_Ith_S (astrochem_mem.y, input_params->output.output_species_idx[j]) / cell->nh[i];
}
if (output_abundances[j] < MIN_ABUNDANCE)
output_abundances[j] = 0.;
#ifdef HAVE_OPENMP
omp_set_lock(&lock);
#endif
// Select a chunk of the file
hsize_t start[3]={ cell_index, i, 0 };
H5Sselect_hyperslab( fileDataspace, H5S_SELECT_SET, start, NULL, count , NULL );
// Write the chunk
H5Dwrite(dataset, datatype, memDataspace, fileDataspace, H5P_DEFAULT,
output_abundances );
#ifdef HAVE_OPENMP
omp_unset_lock(&lock);
#endif
}
/* Compute the rate of each formation/destruction route for
each output specie. */
if (input_params->output.trace_routes)
{
for (j = 0; j < input_params->output.n_output_species; j++)
{
int k;
int l;
for (l = 0; l < N_OUTPUT_ROUTES; l++)
{
routes[ j*N_OUTPUT_ROUTES + l ].formation.rate = 0;
routes[ j*N_OUTPUT_ROUTES + l ].destruction.rate = 0;
}
for (k = 0; k < network->n_reactions; k++)
{
/* If the species is a product of the
reaction then compute the formation
rate. If the rate is greater than the
smallest rate in the formation route
structure, we add the current reaction
number and rate to that structure. */
bool specie_in_products = false;
int p;
for( p = 0; p < MAX_PRODUCTS; p++ )
{
if( network->reactions[k].products[p] == input_params->output.output_species_idx[j])
{
specie_in_products = true;
break;
}
}
if( specie_in_products )
{
r_t formation_route;
double min_rate;
unsigned int min_rate_index;
if (network->reactions[k].reaction_type == 0)
{
formation_route.rate = astrochem_mem.params.reac_rates[k];
formation_route.rate *=
NV_Ith_S (astrochem_mem.y, network->reactions[k].reactants[0]);
}
else if (network->reactions[k].reaction_type == 23)
{
formation_route.rate = astrochem_mem.params.reac_rates[k];
}
else
{
formation_route.rate = astrochem_mem.params.reac_rates[k];
int r;
for( r = 0; r < MAX_REACTANTS; r++ )
{
if( network->reactions[k].reactants[r] != -1 )
{
formation_route.rate *=
NV_Ith_S (astrochem_mem.y, network->reactions[k].reactants[r]);
}
}
}
formation_route.reaction_no =
network->reactions[k].reaction_no;
min_rate = routes[ j*N_OUTPUT_ROUTES ].formation.rate;
min_rate_index = 0;
for (l = 1; l < N_OUTPUT_ROUTES; l++)
{
if (routes[ j*N_OUTPUT_ROUTES + l ].formation.rate <
min_rate)
{
min_rate =
routes[ j*N_OUTPUT_ROUTES + l ].formation.rate;
min_rate_index = (unsigned int) l;
}
}
if (formation_route.rate > min_rate)
{
routes[ j*N_OUTPUT_ROUTES + min_rate_index ].formation.rate = formation_route.rate;
routes[ j*N_OUTPUT_ROUTES + min_rate_index ].formation.reaction_no = formation_route.reaction_no;
}
}
/* If the species is reactant of the reaction
then compute the destruction rate. */
bool species_in_reactants = false;
int r;
for ( r = 0; r < MAX_REACTANTS; r++ )
{
if ( network->reactions[k].reactants[r] == input_params->output.output_species_idx[j])
{
species_in_reactants = true;
break;
}
}
if( species_in_reactants )
{
r_t destruction_route;
double min_rate;
unsigned int min_rate_index;
if (network->reactions[k].reaction_type == 0)
{
destruction_route.rate = astrochem_mem.params.reac_rates[k];
destruction_route.rate *=
NV_Ith_S (astrochem_mem.y, network->reactions[k].reactants[0]);
}
else if (network->reactions[k].reaction_type == 23)
{
destruction_route.rate = astrochem_mem.params.reac_rates[k];
}
else
{
destruction_route.rate = astrochem_mem.params.reac_rates[k];
for ( r = 0; r < MAX_REACTANTS; r++ )
{
if (network->reactions[k].reactants[r] != -1)
{
destruction_route.rate *=
NV_Ith_S (astrochem_mem.y, network->reactions[k].reactants[r]);
}
}
}
destruction_route.reaction_no =
network->reactions[k].reaction_no;
min_rate = routes[ j*N_OUTPUT_ROUTES ].destruction.rate;
min_rate_index = 0;
for (l = 1; l < N_OUTPUT_ROUTES; l++)
{
if (routes[ j*N_OUTPUT_ROUTES + l ].destruction.rate <
min_rate)
{
min_rate =
routes[ j*N_OUTPUT_ROUTES + l ].destruction.rate;
min_rate_index = (unsigned int) l;
}
}
if (destruction_route.rate > min_rate)
{
routes[ j*N_OUTPUT_ROUTES + min_rate_index ].destruction.rate = destruction_route.rate;
routes[ j*N_OUTPUT_ROUTES + min_rate_index ].destruction.reaction_no = destruction_route.reaction_no;
}
}
}
}
#ifdef HAVE_OPENMP
omp_set_lock(&lock);
#endif
// Selecting a chunk of the file
hsize_t routeStart[4]={ cell_index, i, 0, 0 };
H5Sselect_hyperslab( routeFileDataspace, H5S_SELECT_SET, routeStart, NULL, routeCount , NULL );
int spec_idx;
for( spec_idx = 0; spec_idx < input_params->output.n_output_species; spec_idx++ )
{
// Writing in each route datasets
H5Dwrite( routeDatasets[ spec_idx ], routeDatatype, routeMemDataspace, routeFileDataspace, H5P_DEFAULT,
routes );
}
#ifdef HAVE_OPENMP
omp_unset_lock(&lock);
#endif
}
}
}
#ifdef HAVE_OPENMP
omp_set_lock(&lock);
#endif
// Cleaning up hdf5
H5Sclose(memDataspace);
H5Sclose(fileDataspace);
if (input_params->output.trace_routes)
{
H5Sclose(routeMemDataspace);
H5Sclose(routeFileDataspace);
}
#ifdef HAVE_OPENMP
omp_unset_lock(&lock);
#endif
// Free
free( output_abundances );
free( routes );
free_abundances( abundances );
solver_close( &astrochem_mem );
return EXIT_SUCCESS;
}
/* Main Program */
int main()
{
/* general problem parameters */
realtype T0 = RCONST(0.0); /* initial time */
realtype T1 = RCONST(0.4); /* first output time */
realtype TMult = RCONST(10.0); /* output time multiplication factor */
int Nt = 12; /* total number of output times */
long int NEQ = 3; /* number of dependent vars. */
realtype reltol;
int rootsfound[2];
long int nst, nst_a, nfe, nfi, nsetups;
long int nje, nfeLS, nni, ncfn, netf, nge;
int flag, rtflag; /* reusable error-checking flags */
FILE *UFID;
realtype t, tout;
int iout;
/* general problem variables */
N_Vector y = NULL; /* empty vector for storing solution */
N_Vector atols = NULL; /* empty vector for absolute tolerances */
void *arkode_mem = NULL; /* empty ARKode memory structure */
/* set up the initial conditions */
realtype u0 = RCONST(1.0);
realtype v0 = RCONST(0.0);
realtype w0 = RCONST(0.0);
/* Initial problem output */
printf("\nRobertson ODE test problem (with rootfinding):\n");
printf(" initial conditions: u0 = %g, v0 = %g, w0 = %g\n",u0,v0,w0);
/* Initialize data structures */
y = N_VNew_Serial(NEQ); /* Create serial vector for solution */
if (check_flag((void *) y, "N_VNew_Serial", 0)) return 1;
atols = N_VNew_Serial(NEQ); /* Create serial vector absolute tolerances */
if (check_flag((void *) atols, "N_VNew_Serial", 0)) return 1;
NV_Ith_S(y,0) = u0; /* Set initial conditions into y */
NV_Ith_S(y,1) = v0;
NV_Ith_S(y,2) = w0;
arkode_mem = ARKodeCreate(); /* Create the solver memory */
if (check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return 1;
/* Call ARKodeInit to initialize the integrator memory and specify the
hand-side side function in y'=f(t,y), the inital time T0, and
the initial dependent variable vector y. Note: since this
problem is fully implicit, we set f_E to NULL and f_I to f. */
flag = ARKodeInit(arkode_mem, NULL, f, T0, y);
if (check_flag(&flag, "ARKodeInit", 1)) return 1;
/* Set tolerances */
reltol = RCONST(1.0e-4);
NV_Ith_S(atols,0) = RCONST(1.0e-8);
NV_Ith_S(atols,1) = RCONST(1.0e-11);
NV_Ith_S(atols,2) = RCONST(1.0e-8);
/* Set routines */
flag = ARKodeSetMaxErrTestFails(arkode_mem, 20); /* Increase max error test fails */
if (check_flag(&flag, "ARKodeSetMaxErrTestFails", 1)) return 1;
flag = ARKodeSetMaxNonlinIters(arkode_mem, 8); /* Increase max nonlinear iterations */
if (check_flag(&flag, "ARKodeSetMaxNonlinIters", 1)) return 1;
flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-7); /* Update nonlinear solver convergence coeff. */
if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return 1;
flag = ARKodeSetMaxNumSteps(arkode_mem, 100000); /* Increase max number of steps */
if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return 1;
flag = ARKodeSVtolerances(arkode_mem, reltol, atols); /* Specify tolerances */
if (check_flag(&flag, "ARKodeSStolerances", 1)) return 1;
/* Specify the root-finding function, having 2 equations */
flag = ARKodeRootInit(arkode_mem, 2, g);
if (check_flag(&flag, "ARKodeRootInit", 1)) return 1;
/* Linear solver specification */
flag = ARKDense(arkode_mem, NEQ); /* Specify dense linear solver */
if (check_flag(&flag, "ARKDense", 1)) return 1;
flag = ARKDlsSetDenseJacFn(arkode_mem, Jac); /* Set the Jacobian routine */
if (check_flag(&flag, "ARKDlsSetDenseJacFn", 1)) return 1;
/* Open output stream for results, output comment line */
UFID = fopen("solution.txt","w");
fprintf(UFID,"# t u v w\n");
/* output initial condition to disk */
fprintf(UFID," %.16e %.16e %.16e %.16e\n",
T0, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2));
/* Main time-stepping loop: calls ARKode to perform the integration, then
prints results. Stops when the final time has been reached */
t = T0;
printf(" t u v w\n");
printf(" -----------------------------------------------------\n");
printf(" %12.5e %12.5e %12.5e %12.5e\n",
t, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2));
tout = T1;
iout = 0;
while(1) {
flag = ARKode(arkode_mem, tout, y, &t, ARK_NORMAL); /* call integrator */
if (check_flag(&flag, "ARKode", 1)) break;
printf(" %12.5e %12.5e %12.5e %12.5e\n", t, /* access/print solution */
NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2));
fprintf(UFID," %.16e %.16e %.16e %.16e\n",
t, NV_Ith_S(y,0), NV_Ith_S(y,1), NV_Ith_S(y,2));
if (flag == ARK_ROOT_RETURN) { /* check if a root was found */
rtflag = ARKodeGetRootInfo(arkode_mem, rootsfound);
if (check_flag(&rtflag, "ARKodeGetRootInfo", 1)) return 1;
printf(" rootsfound[] = %3d %3d\n",
rootsfound[0], rootsfound[1]);
}
if (flag >= 0) { /* successful solve: update output time */
iout++;
tout *= TMult;
} else { /* unsuccessful solve: break */
fprintf(stderr,"Solver failure, stopping integration\n");
break;
}
if (iout == Nt) break; /* stop after enough outputs */
}
printf(" -----------------------------------------------------\n");
fclose(UFID);
/* Print some final statistics */
flag = ARKodeGetNumSteps(arkode_mem, &nst);
check_flag(&flag, "ARKodeGetNumSteps", 1);
flag = ARKodeGetNumStepAttempts(arkode_mem, &nst_a);
check_flag(&flag, "ARKodeGetNumStepAttempts", 1);
flag = ARKodeGetNumRhsEvals(arkode_mem, &nfe, &nfi);
check_flag(&flag, "ARKodeGetNumRhsEvals", 1);
flag = ARKodeGetNumLinSolvSetups(arkode_mem, &nsetups);
check_flag(&flag, "ARKodeGetNumLinSolvSetups", 1);
flag = ARKodeGetNumErrTestFails(arkode_mem, &netf);
check_flag(&flag, "ARKodeGetNumErrTestFails", 1);
flag = ARKodeGetNumNonlinSolvIters(arkode_mem, &nni);
check_flag(&flag, "ARKodeGetNumNonlinSolvIters", 1);
flag = ARKodeGetNumNonlinSolvConvFails(arkode_mem, &ncfn);
check_flag(&flag, "ARKodeGetNumNonlinSolvConvFails", 1);
flag = ARKDlsGetNumJacEvals(arkode_mem, &nje);
check_flag(&flag, "ARKDlsGetNumJacEvals", 1);
flag = ARKDlsGetNumRhsEvals(arkode_mem, &nfeLS);
check_flag(&flag, "ARKDlsGetNumRhsEvals", 1);
flag = ARKodeGetNumGEvals(arkode_mem, &nge);
check_flag(&flag, "ARKodeGetNumGEvals", 1);
printf("\nFinal Solver Statistics:\n");
printf(" Internal solver steps = %li (attempted = %li)\n",
nst, nst_a);
printf(" Total RHS evals: Fe = %li, Fi = %li\n", nfe, nfi);
printf(" Total linear solver setups = %li\n", nsetups);
printf(" Total RHS evals for setting up the linear system = %li\n", nfeLS);
printf(" Total number of Jacobian evaluations = %li\n", nje);
printf(" Total number of Newton iterations = %li\n", nni);
printf(" Total root-function g evals = %li\n", nge);
printf(" Total number of nonlinear solver convergence failures = %li\n", ncfn);
printf(" Total number of error test failures = %li\n", netf);
/* Clean up and return with successful completion */
N_VDestroy_Serial(y); /* Free y vector */
ARKodeFree(&arkode_mem); /* Free integrator memory */
return 0;
}
