static odegsl_t *
odesys_odegsl_ctor (odesys_t * ode)
{
odegsl_t *odegsl;
molecule_t *molecule = ode->params->molecule;
int ncoef = molecule->get_ncoef (molecule);
if (MEMORY_ALLOC (odegsl) < 0)
{
MEMORY_OOMERR;
fprintf (stderr,
"%s %d: unable to allocate memory for odegsl object.\n",
__func__, __LINE__);
return NULL;
}
odegsl->system.dimension = 2 * ncoef;
odegsl->system.function = odesys_tdse_function;
odegsl->system.jacobian = NULL;
odegsl->system.params = (void *) ode->params;
/* Note that we hard-code the ODE step type here. The step type
chosen is a general purpose type. In the future, should probably
try others. */
odegsl->step = gsl_odeiv_step_alloc (gsl_odeiv_step_rkf45, 2 * ncoef);
odegsl->evolve = gsl_odeiv_evolve_alloc (2 * ncoef);
odegsl->control = gsl_odeiv_control_standard_new
(ode->eps_abs, ode->eps_rel, ode->y_scale, ode->dydx_scale);
odegsl->hstep = ode->hstep;
odegsl->hinit = ode->hstep;
return odegsl;
}
static gsl_odeiv_control* make_control_standard(VALUE epsabs,
VALUE epsrel,
VALUE ay, VALUE adydt)
{
Need_Float(epsabs); Need_Float(epsrel);
Need_Float(ay); Need_Float(adydt);
return gsl_odeiv_control_standard_new(NUM2DBL(epsabs), NUM2DBL(epsrel),
NUM2DBL(ay), NUM2DBL(adydt));
}
int
sys_driver (const gsl_odeiv_step_type * T,
const gsl_odeiv_system * sys,
double t0, double t1, double hstart,
double y[], double epsabs, double epsrel,
const char desc[])
{
/* This function evolves a system sys with stepper T from t0 to t1.
Step length is varied via error control with possibly different
absolute and relative error tolerances.
*/
int s = 0;
int steps = 0;
double t = t0;
double h = hstart;
gsl_odeiv_step * step = gsl_odeiv_step_alloc (T, sys->dimension);
gsl_odeiv_control *c =
gsl_odeiv_control_standard_new (epsabs, epsrel, 1.0, 0.0);
gsl_odeiv_evolve *e = gsl_odeiv_evolve_alloc (sys->dimension);
while (t < t1)
{
s = gsl_odeiv_evolve_apply (e, c, step, sys, &t, t1, &h, y);
if (s != GSL_SUCCESS)
{
gsl_test(s, "sys_driver: %s evolve_apply returned %d",
gsl_odeiv_step_name (step), s);
break;
}
if (steps > 1e7)
{
gsl_test(GSL_EMAXITER,
"sys_driver: %s evolve_apply reached maxiter at t=%g",
gsl_odeiv_step_name (step), t);
s = GSL_EMAXITER;
break;
}
steps++;
}
gsl_test(s, "%s %s [%g,%g], %d steps completed",
gsl_odeiv_step_name (step), desc, t0, t1, steps);
gsl_odeiv_evolve_free (e);
gsl_odeiv_control_free (c);
gsl_odeiv_step_free (step);
return s;
}
CAMLprim value ml_gsl_odeiv_control_standard_new(value eps_abs, value eps_rel,
value a_y, value a_dydt)
{
gsl_odeiv_control *c =
gsl_odeiv_control_standard_new(Double_val(eps_abs), Double_val(eps_rel),
Double_val(a_y), Double_val(a_dydt));
value res;
Abstract_ptr(res, c);
return res;
}
void integrator_init(LALStatus *status, INT2 num, void *params,
int(*derivator)(REAL8, const REAL8[], REAL8[], void *),
integrator_System *integrator) {
INITSTATUS(status, "integrator_init", INTEGRATORC);
ATTATCHSTATUSPTR(status);
integrator->solver_type = gsl_odeiv_step_rkf45;
integrator->solver_step
= gsl_odeiv_step_alloc(integrator->solver_type, num);
integrator->solver_control = gsl_odeiv_control_standard_new(1.0e-9, 1.0e-9,
.2, .2);
integrator->solver_evolve = gsl_odeiv_evolve_alloc(num);
integrator->solver_system.jacobian = NULL;
integrator->solver_system.dimension = num;
integrator->solver_system.params = params;
integrator->solver_system.function = derivator;
DETATCHSTATUSPTR(status);
RETURN (status);
}
gsl_odeiv_control *
gsl_odeiv_control_yp_new(double eps_abs, double eps_rel)
{
return gsl_odeiv_control_standard_new(eps_abs, eps_rel, 0.0, 1.0);
}
void
test_evolve_system (const gsl_odeiv_step_type * T,
const gsl_odeiv_system * sys,
double t0, double t1, double hstart,
double y[], double yfin[],
double err_target, const char *desc)
{
/* Tests system sys with stepper T. Step length is controlled by
error estimation from the stepper.
*/
int steps = 0;
size_t i;
double t = t0;
double h = hstart;
/* Tolerance factor in testing errors */
const double factor = 10;
gsl_odeiv_step * step = gsl_odeiv_step_alloc (T, sys->dimension);
gsl_odeiv_control *c =
gsl_odeiv_control_standard_new (err_target, err_target, 1.0, 0.0);
gsl_odeiv_evolve *e = gsl_odeiv_evolve_alloc (sys->dimension);
while (t < t1)
{
int s = gsl_odeiv_evolve_apply (e, c, step, sys, &t, t1, &h, y);
if (s != GSL_SUCCESS && sys != &rhs_func_xsin)
{
gsl_test(s, "%s evolve_apply returned %d",
gsl_odeiv_step_name (step), s);
break;
}
if (steps > 100000)
{
gsl_test(GSL_EFAILED,
"%s evolve_apply reached maxiter",
gsl_odeiv_step_name (step));
break;
}
steps++;
}
/* err_target is target error of one step. Test if stepper has made
larger error than (tolerance factor times) the number of steps
times the err_target */
for (i = 0; i < sys->dimension; i++)
{
gsl_test_abs (y[i], yfin[i], factor * e->count * err_target,
"%s %s evolve(%d)",
gsl_odeiv_step_name (step), desc, i);
}
gsl_odeiv_evolve_free (e);
gsl_odeiv_control_free (c);
gsl_odeiv_step_free (step);
}