static int
msbdf_reset (void *vstate, size_t dim)
{
msbdf_state_t *state = (msbdf_state_t *) vstate;
size_t i;
state->ni = 0;
state->ord = 1;
state->ordwait = 2;
state->ordwaitbackup = 2;
state->failord = 0;
state->failt = GSL_NAN;
state->gammaprev = 1.0;
state->nJ = 0;
state->nM = 0;
state->failcount = 0;
DBL_ZERO_MEMSET (state->hprev, MSBDF_MAX_ORD);
DBL_ZERO_MEMSET (state->hprevbackup, MSBDF_MAX_ORD);
DBL_ZERO_MEMSET (state->z, (MSBDF_MAX_ORD + 1) * dim);
DBL_ZERO_MEMSET (state->zbackup, (MSBDF_MAX_ORD + 1) * dim);
for (i = 0; i < MSBDF_MAX_ORD; i++)
{
state->ordprev[i] = 1;
state->ordprevbackup[i] = 1;
}
#ifdef DEBUG
printf ("-- msbdf_reset called\n");
#endif
return GSL_SUCCESS;
}
static int
rk2imp_reset (void *vstate, size_t dim)
{
rk2imp_state_t *state = (rk2imp_state_t *) vstate;
DBL_ZERO_MEMSET (state->knu, dim);
DBL_ZERO_MEMSET (state->ytmp, dim);
return GSL_SUCCESS;
}
static int
eulerplus_reset (void *vstate, size_t dim)
{
eulerplus_state_t *state = (eulerplus_state_t *) vstate;
DBL_ZERO_MEMSET (state->k1, dim);
DBL_ZERO_MEMSET (state->k2, dim);
DBL_ZERO_MEMSET (state->ytmp, dim);
return GSL_SUCCESS;
}
static int
rk4_reset (void *vstate, size_t dim)
{
rk4_state_t *state = (rk4_state_t *) vstate;
DBL_ZERO_MEMSET (state->k, dim);
DBL_ZERO_MEMSET (state->k1, dim);
DBL_ZERO_MEMSET (state->y0, dim);
DBL_ZERO_MEMSET (state->ytmp, dim);
DBL_ZERO_MEMSET (state->y_onestep, dim);
return GSL_SUCCESS;
}
static int
gear2_reset (void *vstate, size_t dim)
{
gear2_state_t *state = (gear2_state_t *) vstate;
DBL_ZERO_MEMSET (state->yim1, dim);
DBL_ZERO_MEMSET (state->k, dim);
DBL_ZERO_MEMSET (state->y0, dim);
state->primed = 0;
state->last_h = 0.0;
return GSL_SUCCESS;
}
static int
rk8pd_reset (void *vstate, size_t dim)
{
rk8pd_state_t *state = (rk8pd_state_t *) vstate;
int i;
for (i = 0; i < 13; i++)
{
DBL_ZERO_MEMSET (state->k[i], dim);
}
DBL_ZERO_MEMSET (state->ytmp, dim);
return GSL_SUCCESS;
}
static int
euler_reset (void *vstate, size_t dim)
{
euler_state_t *state = (euler_state_t *) vstate;
DBL_ZERO_MEMSET (state->k, dim);
return GSL_SUCCESS;
}
static int
bsimp_reset (void *vstate, size_t dim)
{
bsimp_state_t *state = (bsimp_state_t *) vstate;
state->h_next = 0;
DBL_ZERO_MEMSET (state->yp, dim);
return GSL_SUCCESS;
}
static int
rkck_reset (void *vstate, size_t dim)
{
rkck_state_t *state = (rkck_state_t *) vstate;
DBL_ZERO_MEMSET (state->k1, dim);
DBL_ZERO_MEMSET (state->k2, dim);
DBL_ZERO_MEMSET (state->k3, dim);
DBL_ZERO_MEMSET (state->k4, dim);
DBL_ZERO_MEMSET (state->k5, dim);
DBL_ZERO_MEMSET (state->k6, dim);
DBL_ZERO_MEMSET (state->ytmp, dim);
DBL_ZERO_MEMSET (state->y0, dim);
return GSL_SUCCESS;
}
static int
rk4imp_reset (void *vstate, size_t dim)
{
rk4imp_state_t *state = (rk4imp_state_t *) vstate;
DBL_ZERO_MEMSET (state->y_onestep, dim);
DBL_ZERO_MEMSET (state->y0_orig, dim);
DBL_ZERO_MEMSET (state->y0, dim);
DBL_ZERO_MEMSET (state->k1nu, dim);
DBL_ZERO_MEMSET (state->k2nu, dim);
DBL_ZERO_MEMSET (state->ytmp1, dim);
DBL_ZERO_MEMSET (state->ytmp2, dim);
return GSL_SUCCESS;
}
static int
rk1imp_reset (void *vstate, size_t dim)
{
rk1imp_state_t *state = (rk1imp_state_t *) vstate;
DBL_ZERO_MEMSET (state->y_onestep, dim);
DBL_ZERO_MEMSET (state->y_twostep, dim);
DBL_ZERO_MEMSET (state->ytmp, dim);
DBL_ZERO_MEMSET (state->y_save, dim);
DBL_ZERO_MEMSET (state->YZ, dim);
DBL_ZERO_MEMSET (state->fYZ, dim);
return GSL_SUCCESS;
}
static int
msbdf_calccoeffs (const size_t ord, const size_t ordwait,
const double h, const double hprev[],
double l[],
double *errcoeff, double *ordm1coeff,
double *ordp1coeff, double *ordp2coeff, double *gamma)
{
/* Calculates coefficients (l) of polynomial Lambda, error and
auxiliary order change evaluation coefficients.
*/
if (ord == 1)
{
l[0] = 1.0;
l[1] = 1.0;
*errcoeff = 0.5;
*ordp1coeff = 2.0;
{
const double hsum = h + hprev[0];
const double a5 = -1.5;
const double a6 = -1.0 - h / hsum;
const double c2 = 2.0 / (1.0 - a6 + a5);
*ordp2coeff = fabs (c2 * (h / hsum) * 3.0 * a5);
}
}
else
{
size_t i, j;
double hsum = h;
double coeff1 = -1.0;
double x;
/* Calculate the actual polynomial coefficients (l) */
DBL_ZERO_MEMSET (l, MSBDF_MAX_ORD + 1);
l[0] = 1.0;
l[1] = 1.0;
for (i = 2; i < ord; i++)
{
hsum += hprev[i - 2];
coeff1 += -1.0 / i;
for (j = i; j > 0; j--)
{
l[j] += h / hsum * l[j - 1];
}
}
coeff1 += -1.0 / ord;
x = -l[1] - coeff1;
for (i = ord; i > 0; i--)
{
l[i] += l[i - 1] * x;
}
#ifdef DEBUG
{
size_t di;
printf ("-- calccoeffs l: ");
for (di = 0; di < ord + 1; di++)
{
printf ("%.5e ", l[di]);
}
printf ("\n");
}
#endif
hsum += hprev[ord - 2];
{
const double coeff2 = -l[1] - h / hsum;
const double a1 = 1.0 - coeff2 + coeff1;
const double a2 = 1.0 + ord * a1;
/* Calculate error coefficient */
*errcoeff = fabs (a1 / (coeff1 * a2));
/* Calculate auxiliary coefficients used in evaluation of change
of order
*/
if (ordwait < 2)
{
const double a3 = coeff1 + 1.0 / ord;
const double a4 = coeff2 + h / hsum;
const double c1 = a3 / (1.0 - a4 + a3);
*ordm1coeff = fabs (c1 / (x / l[ord]));
*ordp1coeff = fabs (a2 / (l[ord] * (h / hsum) / x));
hsum += hprev[ord - 1];
{
const double a5 = coeff1 - 1.0 / (ord + 1.0);
const double a6 = coeff2 - h / hsum;
const double c2 = a2 / (1.0 - a6 + a5);
*ordp2coeff = fabs (c2 * (h / hsum) * (ord + 2) * a5);
}
}
}
}
*gamma = h / l[1];
#ifdef DEBUG
printf ("-- calccoeffs ordm1coeff=%.5e ", *ordm1coeff);
printf ("ordp1coeff=%.5e ", *ordp1coeff);
printf ("ordp2coeff=%.5e ", *ordp2coeff);
printf ("errcoeff=%.5e\n", *errcoeff);
#endif
return GSL_SUCCESS;
}
static int
msbdf_apply (void *vstate, size_t dim, double t, double h,
double y[], double yerr[],
const double dydt_in[], double dydt_out[],
const gsl_odeiv2_system * sys)
{
/* Carries out a step by BDF linear multistep methods. */
msbdf_state_t *state = (msbdf_state_t *) vstate;
double *const z = state->z;
double *const zbackup = state->zbackup;
double *const ytmp = state->ytmp;
double *const ytmp2 = state->ytmp2;
double *const l = state->l;
double *const hprev = state->hprev;
double *const hprevbackup = state->hprevbackup;
size_t *const ordprev = state->ordprev;
size_t *const ordprevbackup = state->ordprevbackup;
double *const errlev = state->errlev;
gsl_vector *const abscor = state->abscor;
gsl_vector *const relcor = state->relcor;
gsl_vector *const svec = state->svec;
gsl_vector *const tempvec = state->tempvec;
size_t ord = state->ord; /* order for this step */
double ordm1coeff = 0.0;
double ordp1coeff = 0.0;
double ordp2coeff = 0.0;
double errcoeff = 0.0; /* error coefficient */
double gamma = 0.0; /* gamma coefficient */
const size_t max_failcount = 3;
size_t i;
#ifdef DEBUG
{
size_t di;
printf ("msbdf_apply: t=%.5e, ord=%d, h=%.5e, y:", t, (int) ord, h);
for (di = 0; di < dim; di++)
{
printf ("%.5e ", y[di]);
}
printf ("\n");
}
#endif
/* Check if t is the same as on previous stepper call (or last
failed call). This means that calculation of previous step failed
or the step was rejected, and therefore previous state will be
restored or the method will be reset.
*/
if (state->ni > 0 && (t == state->tprev || t == state->failt))
{
if (state->ni == 1)
{
/* No step has been accepted yet, reset method */
msbdf_reset (vstate, dim);
#ifdef DEBUG
printf ("-- first step was REJECTED, msbdf_reset called\n");
#endif
}
else
{
/* A succesful step has been saved, restore previous state. */
/* If previous step suggests order increase, but the step was
rejected, then do not increase order.
*/
if (ord > ordprev[0])
{
state->ord = ordprev[0];
ord = state->ord;
}
/* Restore previous state */
DBL_MEMCPY (z, zbackup, (MSBDF_MAX_ORD + 1) * dim);
DBL_MEMCPY (hprev, hprevbackup, MSBDF_MAX_ORD);
for (i = 0; i < MSBDF_MAX_ORD; i++)
{
ordprev[i] = ordprevbackup[i];
}
state->ordwait = state->ordwaitbackup;
state->gammaprev = state->gammaprevbackup;
#ifdef DEBUG
printf ("-- previous step was REJECTED, state restored\n");
#endif
}
/* If step is repeatedly rejected, then reset method */
state->failcount++;
if (state->failcount > max_failcount && state->ni > 1)
{
msbdf_reset (vstate, dim);
ord = state->ord;
#ifdef DEBUG
printf ("-- max_failcount reached, msbdf_reset called\n");
#endif
}
}
else
{
/* The previous step was accepted. Backup current state. */
DBL_MEMCPY (zbackup, z, (MSBDF_MAX_ORD + 1) * dim);
DBL_MEMCPY (hprevbackup, hprev, MSBDF_MAX_ORD);
for (i = 0; i < MSBDF_MAX_ORD; i++)
{
ordprevbackup[i] = ordprev[i];
}
state->ordwaitbackup = state->ordwait;
state->gammaprevbackup = state->gammaprev;
state->failcount = 0;
#ifdef DEBUG
if (state->ni > 0)
{
printf ("-- previous step was ACCEPTED, state saved\n");
}
#endif
}
#ifdef DEBUG
printf ("-- ord=%d, ni=%ld, ordwait=%d\n", (int) ord, state->ni,
(int) state->ordwait);
size_t di;
printf ("-- ordprev: ");
for (di = 0; di < MSBDF_MAX_ORD; di++)
{
printf ("%d ", (int) ordprev[di]);
}
printf ("\n");
#endif
/* Get desired error levels via gsl_odeiv2_control object through driver
object, which is a requirement for this stepper.
*/
if (state->driver == NULL)
{
return GSL_EFAULT;
}
else
{
size_t i;
for (i = 0; i < dim; i++)
{
if (dydt_in != NULL)
{
gsl_odeiv2_control_errlevel (state->driver->c, y[i],
dydt_in[i], h, i, &errlev[i]);
}
else
{
gsl_odeiv2_control_errlevel (state->driver->c, y[i],
0.0, h, i, &errlev[i]);
}
}
}
#ifdef DEBUG
{
size_t di;
printf ("-- errlev: ");
for (di = 0; di < dim; di++)
{
printf ("%.5e ", errlev[di]);
}
printf ("\n");
}
#endif
/* On first call initialize Nordsieck matrix */
if (state->ni == 0)
{
size_t i;
DBL_ZERO_MEMSET (z, (MSBDF_MAX_ORD + 1) * dim);
if (dydt_in != NULL)
{
DBL_MEMCPY (ytmp, dydt_in, dim);
}
else
{
int s = GSL_ODEIV_FN_EVAL (sys, t, y, ytmp);
if (s != GSL_SUCCESS)
{
return s;
}
}
DBL_MEMCPY (&z[0 * dim], y, dim);
DBL_MEMCPY (&z[1 * dim], ytmp, dim);
for (i = 0; i < dim; i++)
{
z[1 * dim + i] *= h;
}
}
/* Stability enhancement heuristic for msbdf: If order > 1 and order
has not been changed, check for decrease in step size, that is
not accompanied by a decrease in method order. This condition may
be indication of BDF method stability problems, a change in ODE
system, or convergence problems in Newton iteration. In all
cases, the strategy is to decrease method order.
*/
#ifdef DEBUG
printf ("-- check_no_order_decrease %d, check_step_size_decrease %d\n",
msbdf_check_no_order_decrease (ordprev),
msbdf_check_step_size_decrease (hprev));
#endif
if (ord > 1 &&
ord - ordprev[0] == 0 &&
msbdf_check_no_order_decrease (ordprev) &&
msbdf_check_step_size_decrease (hprev))
{
state->ord--;
state->ordwait = ord + 2;
ord = state->ord;
#ifdef DEBUG
printf ("-- stability enhancement decreased order to %d\n", (int) ord);
#endif
}
/* Sanity check */
{
const int deltaord = ord - ordprev[0];
if (deltaord > 1 || deltaord < -1)
{
printf ("-- order change %d\n", deltaord);
GSL_ERROR_NULL ("msbdf_apply too large order change", GSL_ESANITY);
}
/* Modify Nordsieck matrix if order or step length has been changed */
/* If order increased by 1, adjust Nordsieck matrix */
if (deltaord == 1)
{
if (ord > 2)
{
size_t i, j;
double hsum = h;
double coeff1 = -1.0;
double coeff2 = 1.0;
double hrelprev = 1.0;
double hrelprod = 1.0;
double hrel = 0.0;
/* Calculate coefficients used in adjustment to l */
DBL_ZERO_MEMSET (l, MSBDF_MAX_ORD + 1);
l[2] = 1.0;
for (i = 1; i < ord - 1; i++)
{
hsum += hprev[i];
hrel = hsum / h;
hrelprod *= hrel;
coeff1 -= 1.0 / (i + 1);
coeff2 += 1.0 / hrel;
for (j = i + 2; j > 1; j--)
{
l[j] *= hrelprev;
l[j] += l[j - 1];
}
hrelprev = hrel;
}
/* Scale Nordsieck matrix */
{
const double c = (-coeff1 - coeff2) / hrelprod;
for (i = 0; i < dim; i++)
{
z[ord * dim + i] = c * gsl_vector_get (abscor, i);
}
}
for (i = 2; i < ord; i++)
for (j = 0; j < dim; j++)
{
z[i * dim + j] += l[i] * z[ord * dim + j];
}
}
else
{
/* zero new vector for order incease from 1 to 2 */
DBL_ZERO_MEMSET (&z[ord * dim], dim);
}
#ifdef DEBUG
printf ("-- order increase detected, Nordsieck modified\n");
#endif
}
/* If order decreased by 1, adjust Nordsieck matrix */
if (deltaord == -1)
{
size_t i, j;
double hsum = 0.0;
/* Calculate coefficients used in adjustment to l */
DBL_ZERO_MEMSET (l, MSBDF_MAX_ORD + 1);
l[2] = 1.0;
for (i = 1; i < ord; i++)
{
hsum += hprev[i - 1];
for (j = i + 2; j > 1; j--)
{
l[j] *= hsum / h;
l[j] += l[j - 1];
}
}
/* Scale Nordsieck matrix */
for (i = 2; i < ord + 1; i++)
for (j = 0; j < dim; j++)
{
z[i * dim + j] += -l[i] * z[(ord + 1) * dim + j];
}
#ifdef DEBUG
printf ("-- order decrease detected, Nordsieck modified\n");
#endif
}
/* Scale Nordsieck vectors if step size has been changed */
if (state->ni > 0 && h != hprev[0])
{
size_t i, j;
const double hrel = h / hprev[0];
double coeff = hrel;
for (i = 1; i < ord + 1; i++)
{
for (j = 0; j < dim; j++)
{
z[i * dim + j] *= coeff;
}
coeff *= hrel;
}
#ifdef DEBUG
printf ("-- h != hprev, Nordsieck modified\n");
#endif
}
/* Calculate polynomial coefficients (l), error coefficient and
auxiliary coefficients
*/
msbdf_calccoeffs (ord, state->ordwait, h, hprev, l, &errcoeff,
º1coeff, &ordp1coeff, &ordp2coeff, &gamma);
/* Carry out the prediction step */
{
size_t i, j, k;
for (i = 1; i < ord + 1; i++)
for (j = ord; j > i - 1; j--)
for (k = 0; k < dim; k++)
{
z[(j - 1) * dim + k] += z[j * dim + k];
}
#ifdef DEBUG
{
size_t di;
printf ("-- predicted y: ");
for (di = 0; di < dim; di++)
{
printf ("%.5e ", z[di]);
}
printf ("\n");
}
#endif
}
/* Calculate correction step to abscor */
{
int s;
s = msbdf_corrector (vstate, sys, t, h, dim, z, errlev, l, errcoeff,
abscor, relcor, ytmp, ytmp2,
state->dfdy, state->dfdt, state->M,
state->p, state->rhs,
&(state->nJ), &(state->nM),
state->tprev, state->failt, gamma,
state->gammaprev, hprev[0]);
if (s != GSL_SUCCESS)
{
return s;
}
}
{
/* Add accepted final correction step to Nordsieck matrix */
size_t i, j;
for (i = 0; i < ord + 1; i++)
for (j = 0; j < dim; j++)
{
z[i * dim + j] += l[i] * gsl_vector_get (abscor, j);
}
#ifdef DEBUG
{
size_t di;
printf ("---- l: ");
for (di = 0; di < ord + 1; di++)
{
printf ("%.5e ", l[di]);
}
printf ("\n");
printf ("-- corrected y: ");
for (di = 0; di < dim; di++)
{
printf ("%.5e ", z[di]);
}
printf ("\n");
}
#endif
/* Derivatives at output */
if (dydt_out != NULL)
{
int s = GSL_ODEIV_FN_EVAL (sys, t + h, z, dydt_out);
if (s == GSL_EBADFUNC)
{
return s;
}
if (s != GSL_SUCCESS)
{
msbdf_failurehandler (vstate, dim, t);
#ifdef DEBUG
printf ("-- FAIL at user function evaluation\n");
#endif
return s;
}
}
/* Calculate error estimate */
for (i = 0; i < dim; i++)
{
yerr[i] = fabs (gsl_vector_get (abscor, i)) * errcoeff;
}
#ifdef DEBUG
{
size_t di;
printf ("-- yerr: ");
for (di = 0; di < dim; di++)
{
printf ("%.5e ", yerr[di]);
}
printf ("\n");
}
#endif
/* Save y values */
for (i = 0; i < dim; i++)
{
y[i] = z[0 * dim + i];
}
}
/* Scale abscor with errlev for later use in norm calculations */
{
size_t i;
for (i = 0; i < dim; i++)
{
gsl_vector_set (abscor, i, gsl_vector_get (abscor, i) / errlev[i]);
}
}
/* Save items needed for evaluation of order increase on next
call, if needed
*/
if (state->ordwait == 1 && ord < MSBDF_MAX_ORD)
{
size_t i;
state->ordp1coeffprev = ordp1coeff;
for (i = 0; i < dim; i++)
{
gsl_vector_set (svec, i, gsl_vector_get (abscor, i));
}
}
/* Consider and execute order change for next step */
if (state->ordwait == 0)
{
msbdf_eval_order (abscor, tempvec, svec, errcoeff, dim, errlev,
ordm1coeff, ordp1coeff,
state->ordp1coeffprev, ordp2coeff,
hprev, h, z, &(state->ord), &(state->ordwait));
}
/* Undo scaling of abscor for possible order increase on next step */
{
size_t i;
for (i = 0; i < dim; i++)
{
gsl_vector_set (abscor, i, gsl_vector_get (abscor, i) * errlev[i]);
}
}
/* Save information about current step in state and update counters */
{
size_t i;
for (i = MSBDF_MAX_ORD - 1; i > 0; i--)
{
hprev[i] = hprev[i - 1];
ordprev[i] = ordprev[i - 1];
}
}
hprev[0] = h;
ordprev[0] = ord;
#ifdef DEBUG
{
size_t di;
printf ("-- hprev: ");
for (di = 0; di < MSBDF_MAX_ORD; di++)
{
printf ("%.5e ", hprev[di]);
}
printf ("\n");
}
#endif
state->tprev = t;
state->ordwait--;
state->ni++;
state->gammaprev = gamma;
state->nJ++;
state->nM++;
#ifdef DEBUG
printf ("-- nJ=%d, nM=%d\n", (int) state->nJ, (int) state->nM);
#endif
}
return GSL_SUCCESS;
}
