Blame ode-initval2/cstd.c

Packit 67cb25
/* ode-initval2/cstd.c
Packit 67cb25
 * 
Packit 67cb25
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
Packit 67cb25
 * 
Packit 67cb25
 * This program is free software; you can redistribute it and/or modify
Packit 67cb25
 * it under the terms of the GNU General Public License as published by
Packit 67cb25
 * the Free Software Foundation; either version 3 of the License, or (at
Packit 67cb25
 * your option) any later version.
Packit 67cb25
 * 
Packit 67cb25
 * This program is distributed in the hope that it will be useful, but
Packit 67cb25
 * WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 67cb25
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Packit 67cb25
 * General Public License for more details.
Packit 67cb25
 * 
Packit 67cb25
 * You should have received a copy of the GNU General Public License
Packit 67cb25
 * along with this program; if not, write to the Free Software
Packit 67cb25
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
Packit 67cb25
 */
Packit 67cb25
Packit 67cb25
#include <config.h>
Packit 67cb25
#include <stdlib.h>
Packit 67cb25
#include <math.h>
Packit 67cb25
#include <gsl/gsl_errno.h>
Packit 67cb25
#include <gsl/gsl_math.h>
Packit 67cb25
#include <gsl/gsl_odeiv2.h>
Packit 67cb25
#include "control_utils.c"
Packit 67cb25
Packit 67cb25
typedef struct
Packit 67cb25
{
Packit 67cb25
  double eps_abs;
Packit 67cb25
  double eps_rel;
Packit 67cb25
  double a_y;
Packit 67cb25
  double a_dydt;
Packit 67cb25
}
Packit 67cb25
std_control_state_t;
Packit 67cb25
Packit 67cb25
static void *
Packit 67cb25
std_control_alloc (void)
Packit 67cb25
{
Packit 67cb25
  std_control_state_t *s =
Packit 67cb25
    (std_control_state_t *) malloc (sizeof (std_control_state_t));
Packit 67cb25
Packit 67cb25
  if (s == 0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR_NULL ("failed to allocate space for std_control_state",
Packit 67cb25
                      GSL_ENOMEM);
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  return s;
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
static int
Packit 67cb25
std_control_init (void *vstate,
Packit 67cb25
                  double eps_abs, double eps_rel, double a_y, double a_dydt)
Packit 67cb25
{
Packit 67cb25
  std_control_state_t *s = (std_control_state_t *) vstate;
Packit 67cb25
Packit 67cb25
  if (eps_abs < 0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR ("eps_abs is negative", GSL_EINVAL);
Packit 67cb25
    }
Packit 67cb25
  else if (eps_rel < 0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR ("eps_rel is negative", GSL_EINVAL);
Packit 67cb25
    }
Packit 67cb25
  else if (a_y < 0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR ("a_y is negative", GSL_EINVAL);
Packit 67cb25
    }
Packit 67cb25
  else if (a_dydt < 0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR ("a_dydt is negative", GSL_EINVAL);
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  s->eps_rel = eps_rel;
Packit 67cb25
  s->eps_abs = eps_abs;
Packit 67cb25
  s->a_y = a_y;
Packit 67cb25
  s->a_dydt = a_dydt;
Packit 67cb25
Packit 67cb25
  return GSL_SUCCESS;
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
static int
Packit 67cb25
std_control_hadjust (void *vstate, size_t dim, unsigned int ord,
Packit 67cb25
                     const double y[], const double yerr[], const double yp[],
Packit 67cb25
                     double *h)
Packit 67cb25
{
Packit 67cb25
  std_control_state_t *state = (std_control_state_t *) vstate;
Packit 67cb25
Packit 67cb25
  const double eps_abs = state->eps_abs;
Packit 67cb25
  const double eps_rel = state->eps_rel;
Packit 67cb25
  const double a_y = state->a_y;
Packit 67cb25
  const double a_dydt = state->a_dydt;
Packit 67cb25
Packit 67cb25
  const double S = 0.9;
Packit 67cb25
  const double h_old = *h;
Packit 67cb25
Packit 67cb25
  double rmax = DBL_MIN;
Packit 67cb25
  size_t i;
Packit 67cb25
Packit 67cb25
  for (i = 0; i < dim; i++)
Packit 67cb25
    {
Packit 67cb25
      const double D0 =
Packit 67cb25
        eps_rel * (a_y * fabs (y[i]) + a_dydt * fabs (h_old * yp[i])) +
Packit 67cb25
        eps_abs;
Packit 67cb25
      const double r = fabs (yerr[i]) / fabs (D0);
Packit 67cb25
      rmax = GSL_MAX_DBL (r, rmax);
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  if (rmax > 1.1)
Packit 67cb25
    {
Packit 67cb25
      /* decrease step, no more than factor of 5, but a fraction S more
Packit 67cb25
         than scaling suggests (for better accuracy) */
Packit 67cb25
      double r = S / pow (rmax, 1.0 / ord);
Packit 67cb25
Packit 67cb25
      if (r < 0.2)
Packit 67cb25
        r = 0.2;
Packit 67cb25
Packit 67cb25
      *h = r * h_old;
Packit 67cb25
Packit 67cb25
      return GSL_ODEIV_HADJ_DEC;
Packit 67cb25
    }
Packit 67cb25
  else if (rmax < 0.5)
Packit 67cb25
    {
Packit 67cb25
      /* increase step, no more than factor of 5 */
Packit 67cb25
      double r = S / pow (rmax, 1.0 / (ord + 1.0));
Packit 67cb25
Packit 67cb25
      if (r > 5.0)
Packit 67cb25
        r = 5.0;
Packit 67cb25
Packit 67cb25
      if (r < 1.0)              /* don't allow any decrease caused by S<1 */
Packit 67cb25
        r = 1.0;
Packit 67cb25
Packit 67cb25
      *h = r * h_old;
Packit 67cb25
Packit 67cb25
      return GSL_ODEIV_HADJ_INC;
Packit 67cb25
    }
Packit 67cb25
  else
Packit 67cb25
    {
Packit 67cb25
      /* no change */
Packit 67cb25
      return GSL_ODEIV_HADJ_NIL;
Packit 67cb25
    }
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
static int
Packit 67cb25
std_control_errlevel (void *vstate, const double y, const double dydt,
Packit 67cb25
                      const double h, const size_t ind, double *errlev)
Packit 67cb25
{
Packit 67cb25
  std_control_state_t *state = (std_control_state_t *) vstate;
Packit 67cb25
Packit 67cb25
  const double eps_abs = state->eps_abs;
Packit 67cb25
  const double eps_rel = state->eps_rel;
Packit 67cb25
  const double a_y = state->a_y;
Packit 67cb25
  const double a_dydt = state->a_dydt;
Packit 67cb25
Packit 67cb25
  *errlev = eps_rel * (a_y * fabs (y) + a_dydt * fabs (h * dydt)) + eps_abs;
Packit 67cb25
Packit 67cb25
  if (*errlev <= 0.0)
Packit 67cb25
    {
Packit 67cb25
      GSL_ERROR_NULL ("errlev <= zero", GSL_ESANITY);
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  return GSL_SUCCESS;
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
Packit 67cb25
static void
Packit 67cb25
std_control_free (void *vstate)
Packit 67cb25
{
Packit 67cb25
  std_control_state_t *state = (std_control_state_t *) vstate;
Packit 67cb25
  free (state);
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
static const gsl_odeiv2_control_type std_control_type = { "standard",   /* name */
Packit 67cb25
  &std_control_alloc,
Packit 67cb25
  &std_control_init,
Packit 67cb25
  &std_control_hadjust,
Packit 67cb25
  &std_control_errlevel,
Packit 67cb25
  &control_set_driver_null,
Packit 67cb25
  &std_control_free
Packit 67cb25
};
Packit 67cb25
Packit 67cb25
const gsl_odeiv2_control_type *gsl_odeiv2_control_standard =
Packit 67cb25
  &std_control_type;
Packit 67cb25
Packit 67cb25
Packit 67cb25
gsl_odeiv2_control *
Packit 67cb25
gsl_odeiv2_control_standard_new (double eps_abs, double eps_rel,
Packit 67cb25
                                 double a_y, double a_dydt)
Packit 67cb25
{
Packit 67cb25
  gsl_odeiv2_control *c =
Packit 67cb25
    gsl_odeiv2_control_alloc (gsl_odeiv2_control_standard);
Packit 67cb25
Packit 67cb25
  int status = gsl_odeiv2_control_init (c, eps_abs, eps_rel, a_y, a_dydt);
Packit 67cb25
Packit 67cb25
  if (status != GSL_SUCCESS)
Packit 67cb25
    {
Packit 67cb25
      gsl_odeiv2_control_free (c);
Packit 67cb25
      GSL_ERROR_NULL ("error trying to initialize control", status);
Packit 67cb25
    }
Packit 67cb25
Packit 67cb25
  return c;
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
gsl_odeiv2_control *
Packit 67cb25
gsl_odeiv2_control_y_new (double eps_abs, double eps_rel)
Packit 67cb25
{
Packit 67cb25
  return gsl_odeiv2_control_standard_new (eps_abs, eps_rel, 1.0, 0.0);
Packit 67cb25
}
Packit 67cb25
Packit 67cb25
Packit 67cb25
gsl_odeiv2_control *
Packit 67cb25
gsl_odeiv2_control_yp_new (double eps_abs, double eps_rel)
Packit 67cb25
{
Packit 67cb25
  return gsl_odeiv2_control_standard_new (eps_abs, eps_rel, 0.0, 1.0);
Packit 67cb25
}