double dodes(double initial_value, double start_time, double end_time, \
int (*ode_function), char *solver_type, double nequs, double eps_abs, \
double eps_rel, double step_size, int *params)
{
double out = 0, t = 0;
//int status;
out = initial_value;
t = start_time;
//Setup ODE related parameters
gsl_odeiv2_system sys = {ode_function, NULL, nequs, NULL};
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc (gsl_odeiv2_step_rkf45, nequs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs, eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (nequs);
while(t < end_time)
{
gsl_odeiv2_evolve_apply_fixed_step (e, c, s, &sys, &t, step_size, &out);
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
return out;
}
int main (void)
{
size_t neqs = 4; /* number of equations */
double eps_abs = 1.e-8,
eps_rel = 0.; /* desired precision */
double stepsize = 1e-6; /* initial integration step */
double R = 5.; /* the aerodynamic efficiency */
double t = 0., t1 = 240.; /* time interval */
int status;
/*
* Initial conditions
*/
double theta = -M_PI/3;
for (theta = -M_PI/3; theta < +M_PI/3; theta +=M_PI/12)
{
double y[4] = { 2, theta, 0., 2. }; /* for -pi/3 <= theta <= pi/3 */
/*
* Explicit embedded Runge-Kutta-Fehlberg (4,5) method.
* This method is a good general-purpose integrator.
*/
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc
(gsl_odeiv2_step_rkf45, neqs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs,
eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (neqs);
gsl_odeiv2_system sys = {func, NULL, neqs, &R};
/*
* Evolution loop
*/
while ( (t < t1) && (y[3] > 0) )
{
status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &t,
t1, &stepsize, y);
if (status != GSL_SUCCESS) {
printf ("Troubles: % .5e % .5e % .5e % .5e % .5e\n",
t, y[0], y[1], y[2], y[3]);
break;
}
printf ("% .5e % .5e % .5e % .5e % .5e\n",
t, y[0], y[1], y[2], y[3]);
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
}
return 0;
}
// Calculate thickness of material traversed for a given energy shift
double StopPow::Thickness(double E1, double E2) throw(std::invalid_argument)
{
// sanity checking:
if (E1 < get_Emin() || E1 > get_Emax() ||
E2 < get_Emin() || E2 > get_Emax()
|| E2 > E1)
{
std::stringstream msg;
msg << "Energies passed to StopPow::Thickness are bad: " << E1 << "," << E2;
throw std::invalid_argument(msg.str());
}
// ODE system to solve:
gsl_odeiv2_system sys = {Eout_func, NULL, 1, this};
// set up GSL ODE solver: stepping done manually for thickness
const gsl_odeiv2_step_type * T = gsl_odeiv2_step_rk4;
gsl_odeiv2_step * step = gsl_odeiv2_step_alloc (T, 1);
gsl_odeiv2_control * c = gsl_odeiv2_control_y_new (1e-6, 0.0);
gsl_odeiv2_evolve * e = gsl_odeiv2_evolve_alloc (1);
int status; double x = 0;
// step size for thickness iteration, corresponds to 50 keV change
double dx = -0.05 / dEdx(E1);
// step size for RK ODE solver, set at 1/100 of previous
double h = dx / 100.;
double y[1] = { E1 };
double y_last = E1;
// Loop until we overshoot, i.e. energy calculated becomes lower than E2
do
{
dx = -0.05 / dEdx(y_last);
y_last = y[0];
try
{
status = gsl_odeiv2_evolve_apply (e, c, step, &sys, &x, x+dx, &h, y);
}
catch(std::invalid_argument e)
{
break; // if we get to the end of the particle's range, this is reached
}
// check for errors:
if( status != GSL_SUCCESS )
throw std::domain_error("GSL RK4 ODE integration failed in StopPow::Ein!");
} while( y[0] > E2 );
// Do a linear interpolation between current point and previous point to get
// the most accurate value of thickness:
double slope = dEdx(y[0]);
double thick = x + (E2-y[0])/slope;
return thick;
}
int
integrate_ode_using_driver (double t, double t1, double y[], int n_steps,
double h_init, double h_max, double eps_abs,
double eps_rel, void *params, int print_values)
{
int i; // Counter in macro-step loop
int j; // Counter in print loop
int status;
size_t dim = NY;
double ti;
double dt = (t1-t)/(double)n_steps;
const gsl_odeiv2_step_type * T = gsl_odeiv2_step_msbdf;
gsl_odeiv2_step * s = gsl_odeiv2_step_alloc (T, dim);
gsl_odeiv2_system sys = {func, jac, dim, params};
gsl_odeiv2_driver * d = gsl_odeiv2_driver_alloc_y_new(&sys, gsl_odeiv2_step_msbdf, h_init, eps_abs, eps_rel);
gsl_odeiv2_step_set_driver(s, d);
if (h_max > 0.0)
{
gsl_odeiv2_driver_set_hmax(d, h_max);
}
for (i = 0; i < n_steps; ++i)
{
// Macro-step loop
ti = t + dt*(i+1);
status = gsl_odeiv2_driver_apply (d, &t, ti, y);
if (status != GSL_SUCCESS)
{
printf ("error, return value=%d\n", status);
break;
}
if (print_values)
{
printf(STRINGIFY(PRECISION), t);
for (j = 0; j < NY; ++j)
{
printf(" " STRINGIFY(PRECISION), y[j]);
}
printf("\n");
}
}
gsl_odeiv2_driver_free (d);
gsl_odeiv2_step_free (s);
return status;
}
void inittransitionengine() {
sys.function = &odesys;
sys.jacobian = NULL;
sys.dimension = xmax * ymax * nspecies;
sys.params = NULL;
stepper = gsl_odeiv2_step_alloc(gsl_odeiv2_step_rkf45, xmax * ymax * nspecies);
driver = gsl_odeiv2_driver_alloc_y_new(&sys, gsl_odeiv2_step_rkf45, timestep, 1e-6, 0.0);
yt = malloc(sizeof(double) * xmax * ymax * nspecies);
yerr = malloc(sizeof(double) * xmax * ymax * nspecies);
for (int i = 0; i < xmax * ymax * nspecies; i++) {
yerr[i] = 0;
}
}
int
main (void)
{
size_t neqs = 2; /* number of equations */
double eps_abs = 1.e-8, eps_rel = 0.; /* desired precision */
double stepsize = 1e-6; /* initial integration step */
double rho_c = 10.; /* central density */
double r = 1.e-3, r1 = 5.; /* time interval */
int status;
/*
* Initial conditions
*/
double y[2] = { 0, rho_c };
/*
* Explicit embedded Runge-Kutta-Fehlberg (4,5) method.
* This method is a good general-purpose integrator.
*/
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc (gsl_odeiv2_step_rkf45, neqs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs,
eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (neqs);
gsl_odeiv2_system sys = { dwarf_eqs, NULL, neqs, &rho_c };
/*
* Evolution loop
*/
while ((r < r1) && (y[1] > 0))
{
status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &r,
r1, &stepsize, y);
if (status != GSL_SUCCESS)
{
printf ("Troubles: % .5e % .5e % .5e\n", r, y[0], y[1]);
break;
}
printf ("% .5e % .5e % .5ex\n", r, y[0], y[1]);
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
return 0;
}
int main (void)
{
size_t neqs = 2; /* number of equations */
double eps_abs = 1.e-8,
eps_rel = 0.; /* desired precision */
double stepsize = 1e-6; /* initial integration step */
int status;
double t = 0., t1 = 100.; /* time interval */
double ommega = 140.; /* ommega for UNstable oscillation */
double y[2] = { 0.99 * PI, 0. }; /* initial conditions (phi, phy dot) */
/*
* Explicit embedded Runge-Kutta-Fehlberg (4,5) method.
* This method is a good general-purpose integrator.
*/
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc
(gsl_odeiv2_step_rkf45, neqs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs,
eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (neqs);
gsl_odeiv2_system sys = {func, NULL, neqs, &ommega};
/*
* Evolution loop
*/
while (t < t1)
{
status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &t,
t1, &stepsize, y);
if (status != GSL_SUCCESS) {
printf ("Troubles: % .5e % .5e % .5e\n",
t, y[0], y[1]);
break;
}
printf ("% .5e % .5e % .5e\n", t, y[0], y[1]);
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
return 0;
}
void dodea(double *initial_value, double start_time, double end_time, \
int (*ode_function), char *solver_type, double nequs, double eps_abs, \
double eps_rel, double step_size, int *params, double *out)
{
double t = start_time;
gsl_odeiv2_step_type *step_type;
/*Initialise output to initial state*/
int counter = 0;
for (counter = 0; counter<nequs;counter++)
{
out[counter] = initial_value[counter];
}
/*Setup ODE related parameters*/
gsl_odeiv2_system sys = {ode_function, NULL, nequs, params};
/*Select step solver*/
if (solver_type == "adams")
step_type = gsl_odeiv2_step_msadams;
if (solver_type == "stiff")
step_type = gsl_odeiv2_step_msbdf;
if (solver_type == "rk")
step_type = gsl_odeiv2_step_rk4;
if (solver_type == "rkf")
step_type = gsl_odeiv2_step_rkf45;
if (solver_type == "root")
step_type = gsl_odeiv2_step_rkck;
if (solver_type == "discrete")
step_type = gsl_odeiv2_step_rk8pd;
else
step_type = gsl_odeiv2_step_rkf45;
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc (step_type, nequs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs, eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (nequs);
while(t < end_time)
{
gsl_odeiv2_evolve_apply_fixed_step (e, c, s, &sys, &t, step_size, out);
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
}
int
main () {
double alpha = 2;
double beta = 4;
double gamma = 7; //3 and 7
double gmax = 5;
// you can use any stepper here
const gsl_odeiv2_step_type * T = gsl_odeiv2_step_rk4imp;
gsl_odeiv2_step * s = gsl_odeiv2_step_alloc(T, 3);
gsl_odeiv2_control * c = gsl_odeiv2_control_y_new(1e-6, 0.0);
gsl_odeiv2_evolve * e = gsl_odeiv2_evolve_alloc(3);
predprey_params pars = {alpha,beta,gamma,gmax,0,0}; /* the parameters */
gsl_odeiv2_system sys = {predprey, jac_predprey, 3, &pars};
gsl_odeiv2_driver * d = gsl_odeiv2_driver_alloc_y_new(&sys, T, 1e-6, 1e-6, 1e-6 );
gsl_odeiv2_step_set_driver(s, d);
double t = 0.0, t1 = 20.0;
double h = 1e-6;
double x[3] = { 1.0, 0.1, 3.0 };
double t2 = t;
double interval = 0.01;
while (t < t1)
{
int status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &t, t1, &h, x);
if (status != GSL_SUCCESS)
break;
if(t > t2+interval) {
printf ("%.5e %.5e %.5e %.5e\n", t, x[0], x[1], x[2]);
t2 = t;
}
}
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
fprintf(stderr,"Number of Jacobian evaluations = %d\n"
"Number of Function evaluations = %d\n", pars.jac_count,
pars.count);
return 0;
}
int main (void)
{
size_t neqs = 4; /* number of equations */
double eps_abs = 1.e-8, eps_rel = 0.; /* desired precision */
double stepsize = 1e-6; /* initial integration step */
double R = 10; /* the aerodynamic efficiency */
double t = 0., t1 = 600. ; /* time interval */
int status;
/*
* Initial conditions
*/
//loop twentyish times increassing launch angle
for(int i = 1; i <= 20; i++)
{
double y[4] = { 2.,-((double)PI / 3.), 0., 2. };
y[1] += i * 0.1;
double inangle = y[1];
/*
* Explicit embedded Runge-Kutta-Fehlberg (4,5) method.
* This method is a good general-purpose integrator.
*/
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc (gsl_odeiv2_step_rkf45, neqs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs, eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (neqs);
gsl_odeiv2_system sys = {func, NULL, neqs, &R};
/*
* Evolution loop
*/
while ( (t < t1) && (y[3] > 0) )
{
status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &t, t1, &stepsize, y);
if (status != GSL_SUCCESS) {
printf ("Troubles: % .5e % .5e % .5e % .5e % .5e\n", t, y[0], y[1], y[2], y[3]);
break;
}
}
//printf moved outside while loop to get final vaules
printf ("% .5e % .5e % .5e % .5e % .5e\n", t, y[0], inangle, y[2], y[3]);
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
}
return 0;
}
Integrator::Integrator() {
// Constructor
// Set the number of elements to be integrated
numelements = 4;
// Integration method as supplied by GSL
const gsl_odeiv2_step_type *Type = gsl_odeiv2_step_rk8pd;
//const gsl_odeiv2_step_type *Type = gsl_odeiv2_step_rkf45;
// Initialize GSL
step = gsl_odeiv2_step_alloc(Type, numelements);
control = gsl_odeiv2_control_yp_new(0, 1.0e-8); // absolute error, relative error
evolve = gsl_odeiv2_evolve_alloc(numelements);
// Set the initial stepsize to be quite small, in order to get good data on derivatives at the beginning
stepsize = minstepsize();
}
contractor_gsl::contractor_gsl(box const & box, shared_ptr<ode_constraint> const ctr, contractor const & eval_ctc, ode_direction const dir, double const timeout)
: contractor_cell(contractor_kind::GSL, box.size()), m_dir(dir),
m_ctr(ctr), m_eval_ctc(eval_ctc), m_timeout(timeout),
m_ic(m_ctr->get_ic()), m_vars_0(m_ic.get_vars_0()), m_pars_0(m_ic.get_pars_0()),
m_vars_t(m_ic.get_vars_t()), m_time_t(m_ic.get_time_t()),
m_par_lhs_names(m_ic.get_par_lhs_names()), m_odes(m_ic.get_odes()),
m_dim(m_ic.get_vars_0().size()), m_system({rhs, nullptr, m_dim, this}) {
// Build Map
for (unsigned i = 0; i < m_vars_0.size(); i++) {
Enode * from = m_odes[i].first;
m_value_lookup.emplace(from, i);
}
for (unsigned i = 0; i < m_pars_0.size(); i++) {
Enode * from = m_par_lhs_names[i];
m_param_lookup.emplace(from, i);
}
double const eps_abs = 1e-10; /* absolute error requested */
double const eps_rel = 1e-10; /* relative error requested */
const gsl_odeiv2_step_type * T = gsl_odeiv2_step_rk8pd;
m_step = gsl_odeiv2_step_alloc(T, m_dim);
m_control = gsl_odeiv2_control_y_new(eps_abs, eps_rel);
m_evolve = gsl_odeiv2_evolve_alloc(m_dim);
m_old_values = new double[m_dim];
m_values = new double[m_dim];
m_params = new double[m_pars_0.size()];
// Input: X_0, X_T, and Time
m_input = ibex::BitSet::empty(box.size());
for (Enode * e : m_ic.get_enode()->get_vars()) {
m_input.add(box.get_index(e));
}
// Output: Empty
m_output = ibex::BitSet::empty(box.size());
m_used_constraints.insert(m_ctr);
}
void IzhikevichBranch::subthreshold_regimeRegime_::init_solver() {
IntegrationStep_ = cell->B_.step_;
static const gsl_odeiv2_step_type* T1 = gsl_odeiv2_step_rk2;
//FIXME: Could be reduced to include only the states which have a time
// derivative
N = 2;
if ( s_ == 0 )
s_ = gsl_odeiv2_step_alloc (T1, N);
else
gsl_odeiv2_step_reset(s_);
if ( c_ == 0 )
c_ = gsl_odeiv2_control_standard_new (0.001, 0.0, 1.0, 0.0);
else
gsl_odeiv2_control_init(c_, 0.001, 0.0, 1.0, 0.0);
if ( e_ == 0 )
e_ = gsl_odeiv2_evolve_alloc(N);
else
gsl_odeiv2_evolve_reset(e_);
sys_.function = IzhikevichBranch_subthreshold_regime_dynamics;
sys_.jacobian = IzhikevichBranch_subthreshold_regime_jacobian;
sys_.dimension = N;
sys_.params = reinterpret_cast<void*>(this->cell);
if (u == 0)
u = (double *)malloc(sizeof(double) * N);
assert (u);
if (jac == 0)
jac = (double *)malloc(sizeof(double) * N);
assert (jac);
}
gsl_vector* EvolveNetwork(struct foodweb nicheweb, struct migration stochastic, gsl_rng* rng1, const gsl_rng_type* rng1_T, gsl_matrix* Dchoice, gsl_vector* result)
{
struct foodweb *params = &nicheweb; // Damit Holling2 auf das foodweb zugreifen kann
int S = nicheweb.S;
int Y = nicheweb.Y;
int Rnum = nicheweb.Rnum;
int Z = nicheweb.Z;
double Bmigr = stochastic.Bmigr;
printf("Bmigr ist %f\n", Bmigr);
//int Tchoice = nicheweb.Tchoice;
//double tcheck = 7805;
double aussterbeSchwelle;
if(stochastic.Bmigr < 1e-5)
{
aussterbeSchwelle = stochastic.Bmigr;
}
else
{
aussterbeSchwelle = 1e-5;
}
printf("aussterbeSchwelle ist %f\n",aussterbeSchwelle);
double Rsize = gsl_vector_get(nicheweb.network, (Rnum+S)*(Rnum+S)+Y*Y+2);
double *y = (double *)calloc((Rnum+S)*Y, sizeof(double)); // Ergebnis Array für den Lösungsalgorithmus
int i, j = 0;
int closezero= 1;
//-- Ergebnis Variablen-----------------------------------------------------------------------------------------------------------------------------------
gsl_vector *y0 = gsl_vector_calloc((Rnum+S)*Y); // Startwerte der Populationsgrößen
gsl_vector *ymax = gsl_vector_calloc((Rnum+S)*Y); // Maximalwerte nach t2
gsl_vector *ymin = gsl_vector_calloc((Rnum+S)*Y); // Minimalwerte nach t2
gsl_vector *yavg = gsl_vector_calloc((Rnum+S)*Y); // Durchschnittswert nach t2
//--Zufallszahlengenerator für Populationsgrößen----------------------------------------------------------------------------------------------------------
// const gsl_rng_type *rng1_T; // Für zufällige Populationsgröße der Spezies
// gsl_rng *rng1;
// gsl_rng_env_setup();
// rng1_T = gsl_rng_default; // default random number generator (so called mt19937)
// gsl_rng_default_seed = 0; // default seed for rng
// //gsl_rng_default_seed=((unsigned)time(NULL)); // random starting seed for rng
// rng1 = gsl_rng_alloc(rng1_T);
//--Erstelle y[] mit Startwerten für die Speziespopulationsgrößen---------------------------------------------------------------------------------------
for(j=0; j<Y; j++) // set initial species size "RANDOM" in each patch
{
for(i=0; i<Rnum; i++)
{
y[j*(Rnum+S)+i] = Rsize; // Ressourcen Größe pro Patch
}
for(i=Rnum; i<Rnum+S; i++)
{
if(closezero == 1) y[j*(Rnum+S)+i] = 0.0000001 + (gsl_rng_uniform_pos(rng1)*0.1);
else y[j*(Rnum+S)+i] = 0.001 + (gsl_rng_uniform_pos(rng1)*0.1);
//printf("y0 = %f\n", y[j*(Rnum+S)+i]);
}
}
// printf("Eintrag 5 von y ist am Anfang %f\n",y[5]);
printf("Spezies Anfangspopulationen erzeugt\n");
gsl_vector_view y_vec = gsl_vector_view_array(y, (Rnum+S)*Y);
gsl_vector_memcpy(y0, &y_vec.vector); //y0 enthält jetzt die so eben bestimmten Startwerte
//-------------------------------------------------------------------------------------------------------------------------------------------------------------
/*ODE: Ordinary Differential Equation mittlerweile gibt es die odeiv2 systeme -> sollte man vielleicht upgraden
Hilfe für die alte Version: http://www.inference.phy.cam.ac.uk/pjc51/local/gsl/manual/gsl-ref_25.html
Neue Version: https://www.gnu.org/software/gsl/manual/html_node/Ordinary-Differential-Equations.html#Ordinary-Differential-Equations
*/
const gsl_odeiv2_step_type *Solv = gsl_odeiv2_step_rkf45; // ODE Solver vom Typ RungeKutta 4/5 (siehe Dokumentation)
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc(Solv,(Rnum+S)*Y); // Schrittfunktion
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new(1e-6, 1e-8); // Kontrollfunktion zur Anpassung der Schrittgröße, um Genuigkeit zu gewährleisten
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc((Rnum+S)*Y); //
gsl_odeiv2_system sys = {Holling2, NULL, (size_t)(Rnum+S)*Y, params}; // ODE System struct -> dieses wird evolviert
gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new (&sys, gsl_odeiv2_step_rkf45, 1e-5, 1e-6, 1e-8);
// gsl_odeiv2_driver_set_hmax(d, 0.01);
/*---------------------------------------------------------------------------------------------------------------------------------------------------------------
gsl_odeiv_system ist ein Datentyp, der ein allgemeines ODE system mit frei wählbaren Parametern enthält.
Er wird definiert über vier Größen
(1) eine int funktion f(double t, const double y[], double dydt[], void * params)
Sie sollte die Vektorelemente der zu lösenden Funktion in dydt[] speichern für die Argumente (t,y) und die Parameter params enthalten
-> hier Hol_dynam(double t, const double y[], double ydot[], void *params)
(2) eine funktion "int (* jacobian) (double t, const double y[], double * dfdy, double dfdt[], void * params)", die die Jacobi-Matrix enthält.
Sie wird von weiter entwickelten Solvern benutzt. Für einfachere Solver muss sie nicht angegeben werden.
-> hier weggelassen mit NULL
(3) eine Größe size_t dimension, die die Dimension des Gleichungssystems angibt
-> hier (Rnum+S)*Y, da auf Y Patches jeweils S+Rnum Spezies leben
(4) void * params, einen Pointer auf die Parameter des Systems, diese werden hier über den *params übergeben
FRAGE: Muss network erst in ein Array geschrieben werden?
*/
//--DGL lösen mit Holling II---------------------------------------------------------------------------------------------------------------------------------------------------
double t = 0.0; // start time
double tend1 = 7800;
double tend2 = 8000; // endtime
double h = 1e-3; // stepwidth
double countsteps = 0; // Schritte
//double mu=0, nu=0, tau = 0;
double tlast = -0.1;
//int SpeciesNumber;
unsigned long migrationEventNumber = 0;
gsl_vector_set(nicheweb.migrPara,5, 0);
double taulast = 0;
//printf("Z ist %i\n",Z);
// int docheck = 0;
int k=0;
//--Erster Abschnitt bis t1--------------------------------------------------------------------------------------------------------------
printf("\nStarte Lösen der Populationsdynamik\n\n");
if(Y>1)
{
stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
//gsl_vector_set(nicheweb.migrPara, 0 , gsl_vector_get(nicheweb.migrPara, 0));
printf("migrationereignis zum Zeipunkt %f\n",gsl_vector_get(nicheweb.migrPara, 0));
}
else
{
printf("Es gibt nur ein Patch, sodass keine Migration stattfinden kann\n");
}
double hmean;
double ytest;
double ti;
// int k;
for(k = 1; k<78000;k++)
{
ti = k * tend1 / 78000.0;
gsl_vector_set(nicheweb.migrPara, 4,tlast);
//for(i=0; i<Rnum+S; i++)// Startgrößen
printf("t ist oben %f\n",t);
printf("ti ist oben %f\n",ti);
printf("k ist oben %i\n",k);
//printf("mu ist %f\n", gsl_vector_get(nicheweb.migrPara, 1));
//printf("nu ist %f\n", gsl_vector_get(nicheweb.migrPara, 2));
gsl_odeiv2_driver_set_hmax(d, 0.2);
int status = gsl_odeiv2_driver_apply(d, &t, ti, y);
printf("status ist %i\n",status);
if(status != GSL_SUCCESS) {
printf("Fehler beim Lösen der DGL!\n");
break;
} /*status = Ergebnis für einen Zeitschritt der DGL Lösung.
HollingII wird mit t, y, params, aufgerufen, die Ergebnisse legt es dann in ydot ab.
Die Werte in ydot werden dann als neue Werte für y verwendet.*/
// printf("t ist %f\n",t);
// printf("ti ist %f\n",ti);
// printf("h ist %f\n",h);
hmean += h;
if(h>1)
{
printf("h ist %f\n",h);
}
// ytest= y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)];
// if(status == GSL_SUCCESS) printf("Status OK\n");
while( (t > gsl_vector_get(nicheweb.migrPara, 0)) && (tlast < gsl_vector_get(nicheweb.migrPara, 0)) )
{
// printf("tlast ist %f und t ist %f\n", tlast,t);
y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)] = y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]+Bmigr;
y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 1)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)] = y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 1)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]-Bmigr;
gsl_vector_set(nicheweb.migrPara,5, gsl_vector_get(nicheweb.migrPara,5)+Bmigr);
for(i=0; i<(Rnum+S)*Y; i++)
{
// printf("y[%i]= %f\n",i,y[i]);
if(y[i] < 1e-10)
y[i] = 0; // bei Populationsgrößen kleiner als 10^-5 gilt die Population als ausgestorben
}
taulast = gsl_vector_get(nicheweb.migrPara, 0);
//printf("y vorher ist %f\t und nachher %f\n",ytest, y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]);
stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
gsl_vector_set(nicheweb.migrPara, 0 , gsl_vector_get(nicheweb.migrPara, 0)+taulast);
// printf("tau+t ist %f\n", gsl_vector_get(nicheweb.migrPara, 0));
//printf("ydotmigr ist %f\n", gsl_vector_get(nicheweb.migrPara, 5));
// printf("t+tau ist %f\n", gsl_vector_get(nicheweb.migrPara, 0));
//printf("nu ist %f\n", gsl_vector_get(nicheweb.migrPara, 2));
migrationEventNumber++;
// printf("migrationEventNumber ist %i\n",migrationEventNumber);
}
for(i=0; i<(Rnum+S)*Y; i++)
{
if(y[i] < aussterbeSchwelle)
y[i] = 0; // bei Populationsgrößen kleiner als 10^-5 gilt die Population als ausgestorben
}
tlast = t;
if(t > gsl_vector_get(nicheweb.migrPara, 0)&& migrationEventNumber < Z)
{
taulast = gsl_vector_get(nicheweb.migrPara, 0);
// printf("y vorher ist %f\t und nachher %f\n",ytest, y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]);
stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
gsl_vector_set(nicheweb.migrPara, 0 , gsl_vector_get(nicheweb.migrPara, 0)+taulast);
// printf("tau+t ist %f\n", gsl_vector_get(nicheweb.migrPara, 0));
// printf("ydotmigr ist %f\n", gsl_vector_get(nicheweb.migrPara, 5));
// printf("t+tau ist %f\n", gsl_vector_get(nicheweb.migrPara, 0));
// printf("nu ist %f\n", gsl_vector_get(nicheweb.migrPara, 2));
migrationEventNumber++;
// printf("migrationEventNumber ist %i\n",migrationEventNumber);
// if(migrationEventNumber!=0.00001*gsl_vector_get(nicheweb.migrPara,5))
// {
// int l;
// for(l = 0; l<100;l++)
// {
// printf("Hier\t");
// }
// }
}
}
for(i=0; i < (Rnum+S)*Y; i++) // Referenzwerte in min und max schreiben = Wert von y nach t = 7800
{
gsl_vector_set(ymax, i, y[i]);
gsl_vector_set(ymin, i, y[i]);
}
//-- Lösen von t1 bis t2-----------------------------------------------------------------------------------------------------------------------
// docheck = 1; // triggert, dass in HollingII nach Fixpunkt Attraktoren gesucht wird???
// int testf0, testf1, testf2 = 1;
//printf("t=%f\n", t);
//double migrationWerte[4];
printf("Komme in zweite Schleife");
for(k = 0; k<2000;k++)
{
ti = k * (tend1-tend2)/2000.0 + tend1;
printf("t ist oben %f\n",t);
printf("ti ist oben %f\n",ti);
printf("k ist oben %i\n",k);
gsl_vector_set(nicheweb.migrPara, 4,tlast);
//printf("SpeciesNumber %f\n", gsl_vector_get(nicheweb.migrPara,Z+3));
//printf("t=%f\n", t);
countsteps++;
//printf("y=%f\n", y[1]);
gsl_odeiv2_driver_set_hmax(d, 0.2);
int status = gsl_odeiv2_driver_apply(d, &t, tend1, y); // Hier werden fixp Variablen benutzt
// printf("h ist %f\n",h);
hmean += h;
// k++;
if(status != GSL_SUCCESS)
break;
while( (t > gsl_vector_get(nicheweb.migrPara, 0)) && (tlast < gsl_vector_get(nicheweb.migrPara, 0)))
{
y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)] = y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 2)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]+Bmigr;
y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 1)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)] = y[(Rnum+S)*(int)gsl_vector_get(nicheweb.migrPara, 1)+Rnum+(int)gsl_vector_get(nicheweb.migrPara, 3)]-Bmigr;
gsl_vector_set(nicheweb.migrPara,5, gsl_vector_get(nicheweb.migrPara,5)+Bmigr);
for(i=0; i<(Rnum+S)*Y; i++)
{
if(y[i] < aussterbeSchwelle)
y[i] = 0; // bei Populationsgrößen kleiner als 10^-5 gilt die Population als ausgestorben
}
taulast = gsl_vector_get(nicheweb.migrPara, 0);
stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
gsl_vector_set(nicheweb.migrPara, 0 , gsl_vector_get(nicheweb.migrPara, 0)+taulast);
// printf("ydotmigr ist %f\n", gsl_vector_get(nicheweb.migrPara, 5));
//printf("mu ist %f\n", gsl_vector_get(nicheweb.migrPara, 1));
//printf("nu ist %f\n", gsl_vector_get(nicheweb.migrPara, 2));
migrationEventNumber++;
}
for(i=0; i<(Rnum+S)*Y; i++)
{
if(y[i]< aussterbeSchwelle) // wieder Aussterbe-Kriterium
y[i]= 0;
}
//printf("test");
tlast = t;
// if(t > gsl_vector_get(nicheweb.migrPara, 0))
// {
// stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
// gsl_vector_set(nicheweb.migrPara, 0 , gsl_vector_get(nicheweb.migrPara, 0)+t);
// // printf("ydotmigr ist %f\n", gsl_vector_get(nicheweb.migrPara, 5));
// //printf("mu ist %f\n", gsl_vector_get(nicheweb.migrPara, 1));
// //printf("nu ist %f\n", gsl_vector_get(nicheweb.migrPara, 2));
// migrationEventNumber++;
// }
//printf("Migrationsereignis #%i\n",migrationEventNumber);
for(i=0; i<(Rnum+S)*Y; i++)
{
if(y[i] > gsl_vector_get(ymax, i)) // Checken ob y größer geworden ist
gsl_vector_set(ymax, i, y[i]);
if(y[i] < gsl_vector_get(ymin, i)) // Checken ob y kleiner geworden ist
gsl_vector_set(ymin, i, y[i]);
gsl_vector_set(yavg, i, ((gsl_vector_get(yavg, i)*(countsteps-1)+y[i])/countsteps));
}
//--Zum Testen, ob im Mittel das Gleiche wie bei deterministischen Migration rauskommt; sonst auskommentieren!!!---------------------------------------------
// if(t> tcheck )
// {
// //printf("Im Test\n");
// int j,k;
// //printf("migrationEventNumber ist %i\n", migrationEventNumber);
// //printf("y ist %f\n",y[1]);
// for(k = 0; k < migrationEventNumber; k++)
// {
// //printf("stochastic.AllMus ist %f\n",gsl_vector_get(stochastic.AllMus,k));
// gsl_vector_set(stochastic.AllMus, k,0);
// gsl_vector_set(stochastic.AllNus, k,0);
// gsl_vector_set(stochastic.SpeciesNumbers, k,0);
// gsl_vector_set(stochastic.Biomass_SpeciesNumbers, k,0);
// //printf("stochastic.AllMus ist nachher %f\n",gsl_vector_get(stochastic.AllMus,k));
// }
// migrationEventNumber = 0;
// for(j = 0 ; j < Z; j++)
// {
//
// stochMigration(nicheweb, stochastic, y, rng1, rng1_T, migrationEventNumber, Dchoice);
// migrationEventNumber++;
//
// }
//
// createOutputBiomass(nicheweb, y);
//
// t = tend2;
// }
//--Ende Test-----------------------------------------------------------------------------------------------------------------
// if(status == GSL_SUCCESS) printf("Status OK\n");
//testf0 = testf0*fixp0; Holling verwendet nur fix0, 1, 2 und fixp 0, 1,2
//testf1 = testf1*fixp1; Da testf0,1,2 vorher 1 sind stehen in test0,1,2 die Werte von fixp0,1,2
//testf2 = testf2*fixp2;
}
// hmean = hmean/k;
// printf("hmean ist %f\n",hmean);
gsl_vector_set(nicheweb.migrPara, 6, migrationEventNumber);
printf("migrationEventNumber ist %i\n", migrationEventNumber);
if(migrationEventNumber==Z)
{
printf("\n\n\n HIER \n\n\n");
}
printf("Letztes Migrationsereignis zum Zeitpunkt %f\n", gsl_vector_get(nicheweb.migrPara, 0));
printf("Es migrieren %f \n",gsl_vector_get(nicheweb.migrPara,5));
//--Ergebnis zusammen fassen--------------------------------------------------------------------------------------------------------------------
for(i=0; i<(Rnum+S)*Y; i++)
gsl_vector_set(result, 0*Y*(Rnum+S)+i, y[i]); //y[Ende] + y0 + ymax + ymin + yavg + fixp + TL
for(i=0; i<(Rnum+S)*Y; i++)
gsl_vector_set(result, 1*Y*(Rnum+S)+i, gsl_vector_get(y0, i));
for(i=0; i<(Rnum+S)*Y; i++)
gsl_vector_set(result, 2*Y*(Rnum+S)+i, gsl_vector_get(ymax, i));
for(i=0; i<(Rnum+S)*Y; i++)
gsl_vector_set(result, 3*Y*(Rnum+S)+i, gsl_vector_get(ymin, i));
for(i=0; i<(Rnum+S)*Y; i++)
gsl_vector_set(result, 4*Y*(Rnum+S)+i, gsl_vector_get(yavg, i));
for(i=0; i < S; i++)
gsl_vector_set(result, 5*Y*(Rnum+S)+i, gsl_vector_get(nicheweb.network, (Rnum+S)*(Rnum+S)+1+Y*Y+1+(Rnum+S)+i));
// Fixpunkte mit übergeben, die sollen in .out datei
gsl_vector_set(result, 5*Y*(Rnum+S)+S+0, gsl_vector_get((&nicheweb)->fixpunkte, 3));
gsl_vector_set(result, 5*Y*(Rnum+S)+S+1, gsl_vector_get((&nicheweb)->fixpunkte, 4));
gsl_vector_set(result, 5*Y*(Rnum+S)+S+2, gsl_vector_get((&nicheweb)->fixpunkte, 5));
free(y);
// free(params);
gsl_vector_free(y0);
gsl_vector_free(ymax);
gsl_vector_free(ymin);
gsl_vector_free(yavg);
gsl_odeiv2_step_free(s);
// gsl_rng_free(rng1);
gsl_odeiv2_control_free(c);
gsl_odeiv2_evolve_free(e);
gsl_odeiv2_driver_free(d);
return result;
}
static gsl_odeiv2_driver *
driver_alloc (const gsl_odeiv2_system * sys, const double hstart,
const gsl_odeiv2_step_type * T)
{
/* Allocates and initializes an ODE driver system. Step and evolve
objects are allocated here, but control object is allocated in
another function.
*/
gsl_odeiv2_driver *state =
(gsl_odeiv2_driver *) malloc (sizeof (gsl_odeiv2_driver));
if (state == NULL)
{
GSL_ERROR_NULL ("failed to allocate space for driver state",
GSL_ENOMEM);
}
if (sys == NULL)
{
GSL_ERROR_NULL ("gsl_odeiv2_system must be defined", GSL_EINVAL);
}
{
const size_t dim = sys->dimension;
if (dim == 0)
{
GSL_ERROR_NULL
("gsl_odeiv2_system dimension must be a positive integer",
GSL_EINVAL);
}
state->sys = sys;
state->s = gsl_odeiv2_step_alloc (T, dim);
if (state->s == NULL)
{
free (state);
GSL_ERROR_NULL ("failed to allocate step object", GSL_ENOMEM);
}
state->e = gsl_odeiv2_evolve_alloc (dim);
}
if (state->e == NULL)
{
gsl_odeiv2_step_free (state->s);
free (state);
GSL_ERROR_NULL ("failed to allocate evolve object", GSL_ENOMEM);
}
if (hstart >= 0.0 || hstart < 0.0)
{
state->h = hstart;
}
else
{
GSL_ERROR_NULL ("invalid hstart", GSL_EINVAL);
}
state->h = hstart;
state->hmin = 0.0;
state->hmax = GSL_DBL_MAX;
state->nmax = 0;
state->n = 0;
state->c = NULL;
return state;
}
int main(int argc, char **argv){
/* Here on ask for initial values on each concentration IN THIS STAGE ON DEFINES INITIAL CONDITIONS
Note that we have 5 conditions, setting 0.0 for the initial complex concentration */
double y[3]={1,40,4};
double p1=askvalue("a1?",-1e6,1e6),p2=askvalue("b1?",-1e6,1e6),p3=askvalue("d1?",-1e6,1e6),p4=askvalue("b2?",-1e6,1e6);
double p5=askvalue("d2?",-1e6,1e6),p6=askvalue("a2?",-1e6,1e6),p7=askvalue("b3?",-1e6,1e6),p8=askvalue("d36?",-1e6,1e6); // Rate constans, one can use an "askvalue" for demand them to the user
/* Here one defines the parameters as an array of 4 elements
this array is passed to the routine of solution */
double parametros[8]={p1,p2,p3,p4,p5,p6,p7,p8};
double t=0.0,tf;
double yerr[3];
double stepp;
//FILE *resultados; // Deleted only one file results
//opendatafile(&resultados,"resultados.txt","w");
/* added file separation for each complex */
/* here one creates the pointer to write to a file */
FILE *filedataca;
FILE *filedatamg;
FILE *filedatacaparv;
/* using opendatafile routine in "commonroutines.c" as a file handler */
/* Opening files to write and putting some information on each */
opendatafile(&filedataca,"results-zombie.txt","w"); //open the file for write
fprintf(filedataca,"### Time\tZombie\n");
opendatafile(&filedatamg,"results-sano.txt","w"); //open the file for write
fprintf(filedatamg,"### Time\tSano\n");
opendatafile(&filedatacaparv,"results-inmune.txt","w"); //open the file for write
fprintf(filedatacaparv,"### Time\tInmune\n");
fprintf(filedataca,"%E %E\n",t,y[0]);
fprintf(filedatamg,"%E %E\n",t,y[1]);
fprintf(filedatacaparv,"%E %E\n",t,y[2]);
/***************************************************************/
/* Now one defines the stuff that GSL Needs to solve the system */
/***************************************************************/
/* Here one creates the step method one can change where says "gsl_odeiv2_step_rk8pd" by
* gsl_odeiv2_step_rk2 - Runge Kutta (2,3) Method
* gsl_odeiv2_step_rk4 - 4th Order Runge Kutta Method (The Classical)
* gsl_odeiv2_step_rkf45 - Runge-Kutta-Fehlberg (4,5) Method (General Purpose, GSL Recommended)
* gsl_odeiv2_step_rkck - Runge- Kutta Cash-Karp (4,5) Method
* gsl_odeiv2_step_rk8pd - Runge- Kutta Prince-Dormand (8,9) Method (defined here by default) */
const gsl_odeiv2_step_type *Type=gsl_odeiv2_step_rkf45;
/* Here one says to GSL that must create memory for 5 ODES (note the five)
* this must be changed when one changes the number of equations */
gsl_odeiv2_step *Step=gsl_odeiv2_step_alloc(Type,3);
/* Here one defines the system of ODEs as Sys and then calls the created system "reactions"
* The NULL it's because we haven't defined a jacobian matrix, one uses the jacobian when
the method demands but for the methods listed above one don't needs to define a jacobian
so one puts NULL
* then one puts 5 cuz we have 5 ODEs to integrate
* the on puts ¶meters on makes a "reference call" to the defined array of parameters to pass to the system
remember that in "reactions" one uses them*/
gsl_odeiv2_system Sys={reactions,NULL,3,¶metros};
/*askvalue returns double, usage "askvalue(char mensaje[200], double xmin, double xmax)"*/
stepp=askvalue("Paso de Integración",0,1);
tf=askvalue("Tiempo de Integración",1e-6,1e6);
printf("\n");
while(t<tf){
/* The function "gsl_odeiv2_step_apply(Step,t,stepp,y,yerr,dy/dt_in,dy/dt_out,&Sys)"
applies the stepping function Step to the system of equations defined by Sys,
using the step-size stepp to advance the system from time t and state y to time t+h.
The new state of the system is stored in y on output, with an estimate of the absolute
error in each component stored in yerr. If the argument dydt_in is not null it should
point an array containing the derivatives for the system at time t on input. This is
optional as the derivatives will be computed internally if they are not provided, but
allows the reuse of existing derivative information. On output the new derivatives of
the system at time t+h will be stored in dydt_out if it is not null.
* Note that both dy/dt_in and dy/dt_out are defined as null below*/
int status=gsl_odeiv2_step_apply(Step,t,stepp,y,yerr,NULL,NULL,&Sys);
//fprintf(resultados,"\n%.6E %.6E %.6E %.6E %.6E %.6E",t,y[0],y[1],y[2],y[3],y[4]); // Deleted, used in one file results
fprintf(filedataca,"%E %E\n",t,y[0]);
fprintf(filedatamg,"%E %E\n",t,y[1]);
fprintf(filedatacaparv,"%E %E\n",t,y[2]);
printf("%.6E %.6E %.6E %.6E\n",t,y[0],y[1],y[2]);
t++;
}
fclose(filedataca);
fclose(filedatamg);
fclose(filedatacaparv);
/* If GNU Plot it's intalled uncomment the lines below to create plots of the results on images */
system("gnuplot -p -e \"set terminal png size 1640,1480;set output 'kinetic-all.png';plot 'results-zombie.txt' w lp,'results-sano.txt' w lp,'results-inmune.txt' w lp\"");
system("gnuplot -p -e \"set terminal png size 1640,1480;set output 'kinetic-ca.png';plot 'results-zombie.txt' w lp\"");
system("gnuplot -p -e \"set terminal png size 1640,1480;set output 'kinetic-mg.png';plot 'results-sano.txt' w lp\"");
system("gnuplot -p -e \"set terminal png size 1640,1480;set output 'kinetic-parv.png';plot 'results-inmune.txt' w lp\"");
exit(0);
} //End of Main Code
/*
* FUNCTION
* Name: red_evol
* Description:
*
*/
int red_evol ( void* params, const double r[], double time_end, double step,
const gsl_vector* req_red, gsl_matrix* red_m )
{
struct f_params* pars = (struct f_params*) params ;
unsigned int i ; /* counter for the for loops */
/*
*
* evolving the systems
*
*/
double t = 0 ;
/* setting the initial vector */
gsl_vector* init_red = gsl_vector_calloc(4) ;
for ( i = 0 ; i < 4 ; i++ )
gsl_vector_set ( init_red, i, r[i] ) ;
/*
*
* Initializing the system for Redfield dynamics
*
*/
gsl_odeiv2_system red_sys = { generator, jac, 4, (void*) red_m } ;
/* Choosing the step function type: Runge-Kutta-Fehlberg (4,5) */
/* gsl_odeiv2_step* s = gsl_odeiv2_step_alloc ( gsl_odeiv2_step_rkf45 , 4 ) ; */
/* Choosing the step function type: Runge-Kutta Cash-Karp (4,5) */
gsl_odeiv2_step* r_s = gsl_odeiv2_step_alloc ( gsl_odeiv2_step_rkck , 4 ) ;
/* Setting the step control: abserr=1e-9, relerr=1e-3 */
gsl_odeiv2_control* r_c = gsl_odeiv2_control_standard_new ( 1e-9, 1e-3, 1, 1 ) ;
/* Allocating the space for evolution function */
gsl_odeiv2_evolve* r_e = gsl_odeiv2_evolve_alloc ( 4 ) ;
/* opening the files */
FILE* f_red = fopen ( "RED-EVOLUTION.dat", "w" ) ;
FILE* g_red = fopen ( "RED-ENTROPY-PROD.dat", "w" ) ;
FILE* h_red = fopen ( "RED-CURRENT.dat", "w" ) ;
FILE* i_red = fopen ( "RED-ENTROPY.dat", "w" ) ;
/* writing data */
while ( t < t_end )
{
evol ( t, init_red, step, r_e, r_c, r_s, &red_sys ) ;
fprintf ( f_red, "%.2f %.9f %.9f %.9f %.9f\n", t,
VECTOR(init_red,1), VECTOR(init_red,2),
VECTOR(init_red,3),
gsl_hypot3(VECTOR(init_red,1),VECTOR(init_red,2),
VECTOR(init_red,3)) ) ;
fprintf ( g_red, "%.2f %.9f\n",
t, entropy_production( init_red, req_red, red_m )) ;
fprintf ( h_red, "%.2f %.9f\n", t, tot_current(init_red, pars) ) ;
fprintf ( i_red, "%.2f %.9f\n",
t, entropy_of_state(init_red) ) ;
t += step ;
}
/* final entropy */
printf("Final entropy: %g\n", entropy_of_state(init_red) ) ;
/* close the files */
fclose (f_red) ;
fclose (g_red) ;
fclose (h_red) ;
fclose (i_red) ;
/* free memory for evolution */
gsl_odeiv2_evolve_free (r_e) ;
gsl_odeiv2_control_free (r_c) ;
gsl_odeiv2_step_free (r_s) ;
return 0;
} /* ----- end of function red_evol ----- */
int main (void)
{
size_t neqs = 4; /* number of equations */
double eps_abs = 1.e-10,
eps_rel = 0.; /* desired precision */
double stepsize = 1e-6; /* initial integration step */
double R = 10.; /* the aerodynamic efficiency */
double t, t1; /* time interval */
int status;
int i, np = 50; /* number of points */
double alt1 = 0.1, alt2 = 5., altitude;
double step;
step = (alt2 - alt1)/(np - 1);
for (i = 0; i < np; i++)
{
t = 0.;
t1 = 520.; /* Code stops before hitting maximum time step */
altitude = alt1 + i*step;
/*
* Initial conditions
*/
double y[4] = { 2., 0., 0., altitude }; /* for res3 */
/*
* Explicit embedded Runge-Kutta-Fehlberg (4,5) method.
* This method is a good general-purpose integrator.
*/
gsl_odeiv2_step *s = gsl_odeiv2_step_alloc
(gsl_odeiv2_step_rkf45, neqs);
gsl_odeiv2_control *c = gsl_odeiv2_control_y_new (eps_abs,
eps_rel);
gsl_odeiv2_evolve *e = gsl_odeiv2_evolve_alloc (neqs);
gsl_odeiv2_system sys = {func, NULL, neqs, &R};
/*
* Evolution loop
*/
while ( (t < t1) && (y[3] > 0) ) /* ends loop before max time step */
{
status = gsl_odeiv2_evolve_apply (e, c, s, &sys, &t,
t1, &stepsize, y);
if (status != GSL_SUCCESS) {
printf ("Troubles: % .5e % .5e % .5e % .5e % .5e\n",
t, y[0], y[1], y[2], y[3]);
break;
}
}
printf ("% .5e % .5e % .5e % .5e % .5e % .5e \n",
t, y[0], y[1], y[2], y[3], altitude);
gsl_odeiv2_evolve_free (e);
gsl_odeiv2_control_free (c);
gsl_odeiv2_step_free (s);
}
return 0;
}
ssm_calc_t *ssm_calc_new(json_t *jdata, ssm_nav_t *nav, ssm_data_t *data, ssm_fitness_t *fitness, ssm_options_t *opts, int thread_id)
{
ssm_calc_t *calc = malloc(sizeof (ssm_calc_t));
if (calc==NULL) {
char str[SSM_STR_BUFFSIZE];
snprintf(str, SSM_STR_BUFFSIZE, "Allocation impossible for ssm_calc_t (thread_id: %d)", thread_id);
ssm_print_err(str);
exit(EXIT_FAILURE);
}
/***********/
/* threads */
/***********/
calc->threads_length = ssm_sanitize_n_threads(opts->n_thread, fitness);
calc->thread_id = thread_id;
/******************/
/* random numbers */
/******************/
// random number generator and parallel MC simulations:
//
// idea using one different seed per thread but is it realy uncorelated ???
// Should I go through the trouble of changing from GSL to SPRNG????
// answer:
// I would recommend using ranlxd. The seeds should give 2^31
// effectively independent streams of length 10^171. A discussion of the
// seeding procedure can be found in the file notes.ps at
// http://www.briangough.ukfsn.org/ranlux_2.2/
// --
// Brian Gough
//
// => we create as many rng as parallel threads *but* note that for
// the operations not prarallelized, we always use
// cacl[0].randgsl
const gsl_rng_type *Type;
if (calc->threads_length == 1){ //we don't need a rng supporting parallel computing, we use mt19937 that is way faster than ranlxs0 (1754 k ints/sec vs 565 k ints/sec)
Type = gsl_rng_mt19937; /*MT19937 generator of Makoto Matsumoto and Takuji Nishimura*/
} else {
Type = gsl_rng_ranlxs0; //gsl_rng_ranlxs2 is better than gsl_rng_ranlxs0 but 2 times slower
}
unsigned long int seed;
if(opts->flag_seed_time){
seed = (unsigned) time(NULL);
} else{
seed=2;
}
calc->seed = seed + opts->id; /*we ensure uniqueness of seed in case of parrallel runs*/
calc->randgsl = gsl_rng_alloc(Type);
gsl_rng_set(calc->randgsl, calc->seed + thread_id);
/*******************/
/* implementations */
/*******************/
int dim = _ssm_dim_X(nav);
if (nav->implementation == SSM_ODE || nav->implementation == SSM_EKF){
calc->T = gsl_odeiv2_step_rkf45;
calc->control = gsl_odeiv2_control_y_new(opts->eps_abs, opts->eps_rel);
calc->step = gsl_odeiv2_step_alloc(calc->T, dim);
calc->evolve = gsl_odeiv2_evolve_alloc(dim);
(calc->sys).function = (nav->implementation == SSM_ODE) ? &ssm_step_ode: &ssm_step_ekf;
(calc->sys).jacobian = NULL;
(calc->sys).dimension= dim;
(calc->sys).params= calc;
if(nav->implementation == SSM_EKF){
int can_run;
if ( (nav->noises_off & (SSM_NO_DEM_STO)) && (nav->noises_off & (SSM_NO_WHITE_NOISE)) ) {
calc->eval_Q = &ssm_eval_Q_no_dem_sto_no_env_sto;
can_run = 0;
} else if ((nav->noises_off & SSM_NO_DEM_STO) && !(nav->noises_off & SSM_NO_WHITE_NOISE)) {
calc->eval_Q = &ssm_eval_Q_no_dem_sto;
can_run = nav->par_noise->length;
} else if (!(nav->noises_off & SSM_NO_DEM_STO) && (nav->noises_off & SSM_NO_WHITE_NOISE)) {
calc->eval_Q = &ssm_eval_Q_no_env_sto;
can_run = 1;
} else {
calc->eval_Q = &ssm_eval_Q_full;
can_run = 1;
}
if(!(nav->noises_off & SSM_NO_DIFF)){
can_run += nav->states_diff->length;
}
if(!can_run){
ssm_print_err("Kalman methods must be used with at least one source of stochasticity in the process.");
exit(EXIT_FAILURE);
}
int n_s = nav->states_sv_inc->length + nav->states_diff->length;
int n_o = nav->observed_length;
calc->_pred_error = gsl_vector_calloc(n_o);
calc->_zero = gsl_vector_calloc(n_o);
calc->_St = gsl_matrix_calloc(n_o, n_o);
calc->_Stm1 = gsl_matrix_calloc(n_o, n_o);
calc->_Rt = gsl_matrix_calloc(n_o, n_o);
calc->_Ht = gsl_matrix_calloc(n_s, n_o);
calc->_Kt = gsl_matrix_calloc(n_s, n_o);
calc->_Tmp_N_SV_N_TS = gsl_matrix_calloc(n_s, n_o);
calc->_Tmp_N_TS_N_SV = gsl_matrix_calloc(n_o, n_s);
calc->_Q = gsl_matrix_calloc(n_s, n_s);
calc->_FtCt = gsl_matrix_calloc(n_s, n_s);
calc->_Ft = gsl_matrix_calloc(n_s, n_s);
calc->_eval = gsl_vector_calloc(n_s);
calc->_evec = gsl_matrix_calloc(n_s, n_s);
calc->_w_eigen_vv = gsl_eigen_symmv_alloc(n_s);
}
} else if (nav->implementation == SSM_SDE){
calc->y_pred = ssm_d1_new(dim);
} else if (nav->implementation == SSM_PSR){
ssm_psr_new(calc);
}
/**************************/
/* multi-threaded sorting */
/**************************/
calc->J = fitness->J;
calc->to_be_sorted = ssm_d1_new(fitness->J);
calc->index_sorted = ssm_st1_new(fitness->J);
/**************/
/* references */
/**************/
calc->_par = NULL;
calc->_nav = nav;
/**************/
/* covariates */
/**************/
json_t *jcovariates = json_object_get(jdata, "covariates");
calc->covariates_length = json_array_size(jcovariates);
if(calc->covariates_length){
calc->acc = malloc(calc->covariates_length * sizeof(gsl_interp_accel *));
if (calc->acc == NULL) {
char str[SSM_STR_BUFFSIZE];
snprintf(str, SSM_STR_BUFFSIZE, "Allocation impossible in file :%s line : %d",__FILE__,__LINE__);
ssm_print_err(str);
exit(EXIT_FAILURE);
}
calc->spline = malloc(calc->covariates_length * sizeof(gsl_spline *));
if (calc->spline == NULL) {
char str[SSM_STR_BUFFSIZE];
snprintf(str, SSM_STR_BUFFSIZE, "Allocation impossible in file :%s line : %d",__FILE__,__LINE__);
ssm_print_err(str);
exit(EXIT_FAILURE);
}
const gsl_interp_type *my_gsl_interp_type = ssm_str_to_interp_type(opts->interpolator);
int k, z;
double freeze_forcing; // the time (in days) to freeze (i.e only take metadata from this time) (ignored if freeze_forcing < 0.0)
double t_max; //t_max the highest possible time in days when interpolated metadata will be requested (negative values default to last point of metadata).
//assess freeze_forcing and t_max...
struct tm tm_start;
memset(&tm_start, 0, sizeof(struct tm));
strptime(data->date_t0, "%Y-%m-%d", &tm_start);
time_t t_start = timegm(&tm_start);
if(strcmp("", opts->end)!=0){
struct tm tm_freeze;
memset(&tm_freeze, 0, sizeof(struct tm));
strptime(opts->freeze_forcing, "%Y-%m-%d", &tm_freeze);
time_t t_freeze = timegm(&tm_freeze);
freeze_forcing = difftime(t_freeze, t_start)/(24.0*60.0*60.0);
} else {
freeze_forcing = -1.0;
}
if(strcmp("", opts->end)!=0){
struct tm tm_end;
memset(&tm_end, 0, sizeof(struct tm));
strptime(opts->end, "%Y-%m-%d", &tm_end);
time_t t_end = timegm(&tm_end);
t_max = difftime(t_end, t_start)/(24.0*60.0*60.0);
} else {
t_max = -1.0;
}
for (k=0; k< calc->covariates_length; k++) {
json_t *jcovariate = json_array_get(jcovariates, k);
double *x = ssm_load_jd1_new(jcovariate, "x");
double *y = ssm_load_jd1_new(jcovariate, "y");
int size = json_array_size(json_object_get(jcovariate, "x"));
if((freeze_forcing < 0.0) && (t_max > x[size-1])){ //no freeze but t_max > x[size-1] repeat last value
int prev_size = size ;
size += ((int) t_max - x[prev_size-1]) ;
double *tmp_x = realloc(x, size * sizeof (double) );
if ( tmp_x == NULL ) {
ssm_print_err("Reallocation impossible"); free(x); exit(EXIT_FAILURE);
} else {
x = tmp_x;
}
double *tmp_y = realloc(y, size * sizeof (double) );
if ( tmp_y == NULL ) {
ssm_print_err("Reallocation impossible"); free(y); exit(EXIT_FAILURE);
} else {
y = tmp_y;
}
//repeat last value
double xlast = x[prev_size-1];
for(z = prev_size; z < size ; z++ ){
x[z] = xlast + z;
y[z] = y[prev_size - 1];
}
}
if( (freeze_forcing>=0.0) || (size == 1) ){ //only 1 value: make it 2
double x_all[2];
x_all[0] = x[0];
x_all[1] = GSL_MAX( GSL_MAX( t_max, ((data->n_obs>=1) ? (double) data->rows[data->n_obs-1]->time: 0.0) ), x[size-1]);
double y_all[2];
y_all[0] = (size == 1) ? y[0]: gsl_spline_eval(calc->spline[k], GSL_MIN(freeze_forcing, x[size-1]), calc->acc[k]); //interpolate y for time freeze_forcing requested (if possible)
y_all[1] = y_all[0];
calc->acc[k] = gsl_interp_accel_alloc ();
calc->spline[k] = gsl_spline_alloc (gsl_interp_linear, 2);
gsl_spline_init (calc->spline[k], x_all, y_all, 2);
} else if (size >= gsl_interp_type_min_size(my_gsl_interp_type)) {
calc->acc[k] = gsl_interp_accel_alloc ();
calc->spline[k] = gsl_spline_alloc(my_gsl_interp_type, size);
gsl_spline_init (calc->spline[k], x, y, size);
} else {
ssm_print_warning("insufficient data points for required metadata interpolator, switching to linear");
calc->acc[k] = gsl_interp_accel_alloc ();
calc->spline[k] = gsl_spline_alloc (gsl_interp_linear, size);
gsl_spline_init(calc->spline[k], x, y, size);
}
free(x);
free(y);
}
}
return calc;
}