/*
extern int
gsl_odeiv_control_hadjust (gsl_odeiv_control * c, gsl_odeiv_step * s,
const double y0[], const double yerr[],
const double dydt[], double * h);
*/
static PyObject *
PyGSL_odeiv_control_hadjust(PyGSL_odeiv_control *self, PyObject *args)
{
PyObject *result = NULL;
PyObject *y0_o = NULL, *yerr_o = NULL, *dydt_o = NULL;
PyArrayObject *y0 = NULL, *yerr = NULL, *dydt = NULL;
double h = 0;
int r = 0;
size_t dimension = 0;
FUNC_MESS_BEGIN();
assert(PyGSL_ODEIV_CONTROL_Check(self));
if(!PyArg_ParseTuple(args, "OOOd", &y0_o, &yerr_o, &dydt_o, &h)){
return NULL;
}
dimension = self->step->system.dimension;
y0 = PyGSL_PyArray_PREPARE_gsl_vector_view(y0_o, PyArray_DOUBLE, 1, dimension, 1, NULL);
if(y0 == NULL) goto fail;
yerr = PyGSL_PyArray_PREPARE_gsl_vector_view(yerr_o, PyArray_DOUBLE, 1, dimension, 2, NULL);
if(yerr == NULL) goto fail;
dydt = PyGSL_PyArray_PREPARE_gsl_vector_view(yerr_o, PyArray_DOUBLE, 1, dimension, 3, NULL);
if(dydt == NULL) goto fail;
FUNC_MESS(" Array Pointers End");
r = gsl_odeiv_control_hadjust(self->control, self->step->step,
(double *) y0->data,
(double *) yerr->data,
(double *) dydt->data, &h);
FUNC_MESS(" Function End");
Py_DECREF(y0); y0 = NULL;
Py_DECREF(yerr); yerr = NULL;
Py_DECREF(dydt); dydt = NULL;
result = Py_BuildValue("di",h,r);
FUNC_MESS_END();
return result;
fail:
FUNC_MESS("IN Fail");
Py_XDECREF(y0);
Py_XDECREF(yerr);
Py_XDECREF(dydt);
FUNC_MESS("IN Fail END");
return NULL;
}
CAMLprim value ml_gsl_odeiv_control_hadjust(value c, value s, value y,
value yerr, value dydt, value h)
{
double c_h = Double_val(h);
int status =
gsl_odeiv_control_hadjust(ODEIV_CONTROL_VAL(c), ODEIV_STEP_VAL(s),
Double_array_val(y), Double_array_val(yerr),
Double_array_val(dydt), &c_h);
{
CAMLparam0();
CAMLlocal2(vh, r);
vh = copy_double(c_h);
r = alloc_small(2, 0);
Field(r, 0) = Val_int(status + 1);
Field(r, 1) = vh;
CAMLreturn(r);
}
}
static VALUE rb_gsl_odeiv_control_hadjust(VALUE obj, VALUE ss, VALUE yy0,
VALUE yyerr, VALUE ddydt, VALUE hh)
{
gsl_odeiv_control *c = NULL;
gsl_odeiv_step *s = NULL;
gsl_vector *y0 = NULL, *yerr = NULL, *dydt = NULL;
double h;
int status;
CHECK_VECTOR(yy0);
CHECK_VECTOR(yyerr);
CHECK_VECTOR(ddydt);
Data_Get_Struct(obj, gsl_odeiv_control, c);
Data_Get_Struct(ss, gsl_odeiv_step, s);
Data_Get_Struct(yy0, gsl_vector, y0);
Data_Get_Struct(yyerr, gsl_vector, yerr);
Data_Get_Struct(ddydt, gsl_vector, dydt);
h = NUM2DBL(hh);
status = gsl_odeiv_control_hadjust(c, s, y0->data, yerr->data,
dydt->data, &h);
return rb_ary_new3(2, rb_float_new(h), INT2FIX(status));
}
/* Evolution framework method.
*
* Uses an adaptive step control object
*/
int
gsl_odeiv_evolve_apply (gsl_odeiv_evolve * e,
gsl_odeiv_control * con,
gsl_odeiv_step * step,
const gsl_odeiv_system * dydt,
double *t, double t1, double *h, double y[])
{
const double t0 = *t;
double h0 = *h;
int step_status;
int final_step = 0;
double dt = t1 - t0; /* remaining time, possibly less than h */
if (e->dimension != step->dimension)
{
GSL_ERROR ("step dimension must match evolution size", GSL_EINVAL);
}
if ((dt < 0.0 && h0 > 0.0) || (dt > 0.0 && h0 < 0.0))
{
GSL_ERROR ("step direction must match interval direction", GSL_EINVAL);
}
/* No need to copy if we cannot control the step size. */
if (con != NULL)
{
DBL_MEMCPY (e->y0, y, e->dimension);
}
/* Calculate initial dydt once if the method can benefit. */
if (step->type->can_use_dydt_in)
{
int status = GSL_ODEIV_FN_EVAL (dydt, t0, y, e->dydt_in);
if (status)
{
return status;
}
}
try_step:
if ((dt >= 0.0 && h0 > dt) || (dt < 0.0 && h0 < dt))
{
h0 = dt;
final_step = 1;
}
else
{
final_step = 0;
}
if (step->type->can_use_dydt_in)
{
step_status =
gsl_odeiv_step_apply (step, t0, h0, y, e->yerr, e->dydt_in,
e->dydt_out, dydt);
}
else
{
step_status =
gsl_odeiv_step_apply (step, t0, h0, y, e->yerr, NULL, e->dydt_out,
dydt);
}
/* Check for stepper internal failure */
if (step_status != GSL_SUCCESS)
{
*h = h0; /* notify user of step-size which caused the failure */
return step_status;
}
e->count++;
e->last_step = h0;
if (final_step)
{
*t = t1;
}
else
{
*t = t0 + h0;
}
if (con != NULL)
{
/* Check error and attempt to adjust the step. */
double h_old = h0;
const int hadjust_status
= gsl_odeiv_control_hadjust (con, step, y, e->yerr, e->dydt_out, &h0);
if (hadjust_status == GSL_ODEIV_HADJ_DEC)
{
/* Check that the reported status is correct (i.e. an actual
decrease in h0 occured) and the suggested h0 will change
the time by at least 1 ulp */
double t_curr = GSL_COERCE_DBL(*t);
double t_next = GSL_COERCE_DBL((*t) + h0);
if (fabs(h0) < fabs(h_old) && t_next != t_curr)
{
/* Step was decreased. Undo step, and try again with new h0. */
DBL_MEMCPY (y, e->y0, dydt->dimension);
e->failed_steps++;
goto try_step;
}
else
{
h0 = h_old; /* keep current step size */
}
}
}
*h = h0; /* suggest step size for next time-step */
return step_status;
}
/* Evolution framework method.
*
* Uses an adaptive step control object
*/
int
gsl_odeiv_evolve_apply (gsl_odeiv_evolve * e,
gsl_odeiv_control * con,
gsl_odeiv_step * step,
const gsl_odeiv_system * dydt,
double *t, double t1, double *h, double y[])
{
const double t0 = *t;
double h0 = *h;
int step_status;
int final_step = 0;
double dt = t1 - t0; /* remaining time, possibly less than h */
if (e->dimension != step->dimension)
{
GSL_ERROR ("step dimension must match evolution size", GSL_EINVAL);
}
if ((dt < 0.0 && h0 > 0.0) || (dt > 0.0 && h0 < 0.0))
{
GSL_ERROR ("step direction must match interval direction", GSL_EINVAL);
}
/* No need to copy if we cannot control the step size. */
if (con != NULL)
{
DBL_MEMCPY (e->y0, y, e->dimension);
}
/* Calculate initial dydt once if the method can benefit. */
if (step->type->can_use_dydt_in)
{
int status = GSL_ODEIV_FN_EVAL (dydt, t0, y, e->dydt_in);
if (status)
{
return status;
}
}
try_step:
if ((dt >= 0.0 && h0 > dt) || (dt < 0.0 && h0 < dt))
{
h0 = dt;
final_step = 1;
}
else
{
final_step = 0;
}
if (step->type->can_use_dydt_in)
{
step_status =
gsl_odeiv_step_apply (step, t0, h0, y, e->yerr, e->dydt_in,
e->dydt_out, dydt);
}
else
{
step_status =
gsl_odeiv_step_apply (step, t0, h0, y, e->yerr, NULL, e->dydt_out,
dydt);
}
/* Check for stepper internal failure */
if (step_status != GSL_SUCCESS)
{
return step_status;
}
e->count++;
e->last_step = h0;
if (final_step)
{
*t = t1;
}
else
{
*t = t0 + h0;
}
if (con != NULL)
{
/* Check error and attempt to adjust the step. */
const int hadjust_status
= gsl_odeiv_control_hadjust (con, step, y, e->yerr, e->dydt_out, &h0);
if (hadjust_status == GSL_ODEIV_HADJ_DEC)
{
/* Step was decreased. Undo and go back to try again. */
DBL_MEMCPY (y, e->y0, dydt->dimension);
e->failed_steps++;
goto try_step;
}
}
*h = h0; /* suggest step size for next time-step */
return step_status;
}
/*This is the main function of the integration program that calls the gsl Runge-Kutta integrator:*/
void integrator(function F, int D, void *params, double x[], double dxdt[], double x0[], double t[], int iters, double s_noise, double abstol, double reltol) {
/*Temporary variables*/
double *y = (double*) malloc( sizeof(double)*D ); /*state variable at time t-1 (input) and then at time t(output)*/
double *dydt_in = (double*) malloc( sizeof(double)*D ); /*rate of change at time point t-1*/
double *dydt_out= (double*) malloc( sizeof(double)*D ); /*rate of change at time point t*/
double *yerr = (double*) malloc( sizeof(double)*D );/*error*/
double t0,tf,tc,dt=(t[1]-t[0])/2,noise;/*initial time point, final time point, current time point, current time step, noise*/
int j,ii;/*State variable and iteration indexes*/
int status;/*integrator success flag*/
/*Definitions and initializations of gsl integrator necessary inputs and parameters:*/
/*Prepare noise generator*/
const gsl_rng_type *Q;
gsl_rng *r;
gsl_rng_env_setup();
Q = gsl_rng_default;
r = gsl_rng_alloc(Q);
/*Create a stepping function*/
const gsl_odeiv_step_type *T = gsl_odeiv_step_rkf45;
gsl_odeiv_step *s = gsl_odeiv_step_alloc(T, D);
/*Create an adaptive control function*/
gsl_odeiv_control *c = gsl_odeiv_control_y_new(abstol, reltol);
/*Create the system to be integrated (with NULL jacobian)*/
gsl_odeiv_system sys = {F, NULL, D, params};
/*The integration loop:*/
/*Initialize*/
/*Calculate dx/dt for x0*/
tc=t[0];
/* initialise dydt_in from system parameters */
/*GSL_ODEIV_FN_EVAL(&sys, t, y, dydt_in);*/
GSL_ODEIV_FN_EVAL(&sys, tc, x0, dydt_in);
for (j=0;j<D;j++) {
y[j] = x[j] = x0[j];
}
/*Integration*/
for (ii=1; ii<iters; ii++) {
/*Call the integrator*/
/*int gsl_odeiv_step_apply(gsl_odeiv_step * s, double t, double h, double y[], double yerr[], const double dydt_in[], double dydt_out[], const gsl_odeiv_system * dydt)*/
t0=t[ii-1];
tf=t[ii];
tc=t0;
while (tc<tf) {
/*Constraint time step h such as that tc+h<=tf*/
if (tc+dt>tf) dt=tf-tc;
/*Advance a h time step*/
status=gsl_odeiv_step_apply(s, tc, dt, y, yerr, dydt_in, dydt_out, &sys);
if (status != GSL_SUCCESS) break;
/*Modify time sep*/
gsl_odeiv_control_hadjust(c,s,y,yerr,dydt_in,&dt);
/*Increase current time*/
tc += dt;
/*Add noise*/
for (j=0;j<D;j++) {
noise=gsl_ran_gaussian_ziggurat(r, s_noise);
y[j] += sqrt(dt)*noise;
//dydt_in[j]+=noise;
}
}
/*Unpack and store result for this time point*/
if (status != GSL_SUCCESS) break;
for (j=0;j<D;j++) {
x[ii*D+j] = y[j];
dxdt[(ii-1)*D+j] = dydt_in[j];
/*Prepare next step*/
dydt_in[j] = dydt_out[j];
}
}
/*Get dxdt for the last time point*/
for (j=0;j<D;j++) dxdt[(iters-1)*D+j] = dydt_out[j];
/*Free dynamically allocated memory*/
gsl_odeiv_control_free(c);
printf("c freed\n");
gsl_odeiv_step_free(s);
printf("s freed\n");
gsl_rng_free(r);
printf("rng freed\n");
free(yerr);
printf("yerr freed\n");
free(dydt_out);
printf("dydt_out freed\n");
free(dydt_in);
printf("dydt_in freed\n");
free(y);
printf("y freed\n");
}