#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>

#include <gsl/gsl_integration.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_roots.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_sf_legendre.h>

#include "fftlog.h"

#include "ccl.h"
#include "ccl_params.h"

/*--------ROUTINE: taper_cl ------
TASK:n Apply cosine tapering to Cls to reduce aliasing
INPUT: number of ell bins for Cl, ell vector, C_ell vector, limits for tapering
       e.g., ell_limits=[low_ell_limit_lower,low_ell_limit_upper,high_ell_limit_lower,high_ell_limit_upper]
*/
static int taper_cl(int n_ell,double *ell,double *cl, double *ell_limits)
{

  for(int i=0;i<n_ell;i++) {
    if(ell[i]<ell_limits[0] || ell[i]>ell_limits[3]) {
      cl[i]=0;//ell outside desirable range
      continue;
    }
    if(ell[i]>=ell_limits[1] && ell[i]<=ell_limits[2])
      continue;//ell within good ell range

    if(ell[i]<ell_limits[1])//tapering low ell
      cl[i]*=cos((ell[i]-ell_limits[1])/(ell_limits[1]-ell_limits[0])*M_PI/2.);

    if(ell[i]>ell_limits[2])//tapering high ell
      cl[i]*=cos((ell[i]-ell_limits[2])/(ell_limits[3]-ell_limits[2])*M_PI/2.);
  }

  return 0;
}

/*--------ROUTINE: ccl_tracer_corr_fftlog ------
TASK: For a given tracer, get the correlation function
      Following function takes a function to calculate angular cl as well.
      By default above function will call it using ccl_angular_cl
INPUT: type of tracer, number of theta values to evaluate = NL, theta vector
 */
static void ccl_tracer_corr_fftlog(ccl_cosmology *cosmo,
				   int n_ell,double *ell,double *cls,
				   int n_theta,double *theta,double *wtheta,
				   int corr_type,int do_taper_cl,double *taper_cl_limits,
				   int *status)
{
  int i;
  double *l_arr,*cl_arr,*th_arr,*wth_arr;

  l_arr=ccl_log_spacing(ccl_splines->ELL_MIN_CORR,ccl_splines->ELL_MAX_CORR,ccl_splines->N_ELL_CORR);
  if(l_arr==NULL) {
    *status=CCL_ERROR_LINSPACE;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_fftlog ran out of memory\n");
    return;
  }
  cl_arr=malloc(ccl_splines->N_ELL_CORR*sizeof(double));
  if(cl_arr==NULL) {
    free(l_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_fftlog ran out of memory\n");
    return;
  }

  //Interpolate input Cl into array needed for FFTLog
  SplPar *cl_spl=ccl_spline_init(n_ell,ell,cls,cls[0],0);
  if(cl_spl==NULL) {
    free(l_arr);
    free(cl_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_fftlog ran out of memory\n");
    return;
  }

  double cl_tilt,l_edge,cl_edge;
  l_edge=ell[n_ell-1];
  if((cls[n_ell-1]*cls[n_ell-2]<0) || (cls[n_ell-2]==0)) {
    cl_tilt=0;
    cl_edge=0;
  }
  else {
    cl_tilt=log(cls[n_ell-1]/cls[n_ell-2])/log(ell[n_ell-1]/ell[n_ell-2]);
    cl_edge=cls[n_ell-1];
  }
  for(i=0;i<ccl_splines->N_ELL_CORR;i++) {
    if(l_arr[i]>=l_edge)
      cl_arr[i]=cl_edge*pow(l_arr[i]/l_edge,cl_tilt);
    else
      cl_arr[i]=ccl_spline_eval(l_arr[i],cl_spl);
  }
  ccl_spline_free(cl_spl);

  if (do_taper_cl)
    taper_cl(ccl_splines->N_ELL_CORR,l_arr,cl_arr,taper_cl_limits);

  th_arr=malloc(sizeof(double)*ccl_splines->N_ELL_CORR);
  if(th_arr==NULL) {
    free(l_arr);
    free(cl_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_fftlog ran out of memory\n");
    return;
  }
  wth_arr=(double *)malloc(sizeof(double)*ccl_splines->N_ELL_CORR);
  if(wth_arr==NULL) {
    free(l_arr); free(cl_arr); free(th_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_fftlog ran out of memory\n");
    return;
  }

  for(i=0;i<ccl_splines->N_ELL_CORR;i++)
    th_arr[i]=0;
  //Although set here to 0, theta is modified by FFTlog to obtain the correlation at ~1/l

  int i_bessel=0;
  if(corr_type==CCL_CORR_GG) i_bessel=0;
  if(corr_type==CCL_CORR_GL) i_bessel=2;
  if(corr_type==CCL_CORR_LP) i_bessel=0;
  if(corr_type==CCL_CORR_LM) i_bessel=4;
  fftlog_ComputeXi2D(i_bessel,ccl_splines->N_ELL_CORR,l_arr,cl_arr,th_arr,wth_arr);

  // Interpolate to output values of theta
  SplPar *wth_spl=ccl_spline_init(ccl_splines->N_ELL_CORR,th_arr,wth_arr,wth_arr[0],0);
  for(i=0;i<n_theta;i++)
    wtheta[i]=ccl_spline_eval(theta[i]*M_PI/180.,wth_spl);
  ccl_spline_free(wth_spl);

  free(l_arr); free(cl_arr);
  free(th_arr); free(wth_arr);

  return;
}

typedef struct {
  int nell;
  double ell0;
  double ellf;
  double cl0;
  double clf;
  int extrapol_0;
  int extrapol_f;
  double tilt0;
  double tiltf;
  SplPar *cl_spl;
  int i_bessel;
  double th;
} corr_int_par;

static double corr_bessel_integrand(double l,void *params)
{
  double cl,jbes;
  corr_int_par *p=(corr_int_par *)params;
  double x=l*p->th;

  if(l<p->ell0) {
    if(p->extrapol_0)
      cl=p->cl0*pow(l/p->ell0,p->tilt0);
    else
      cl=0;
  }
  else if(l>p->ellf) {
    if(p->extrapol_f)
      cl=p->clf*pow(l/p->ellf,p->tiltf);
    else
      cl=0;
  }
  else
    cl=ccl_spline_eval(l,p->cl_spl);

  jbes=gsl_sf_bessel_Jn(p->i_bessel,x);

  return l*jbes*cl;
}

static void ccl_tracer_corr_bessel(ccl_cosmology *cosmo,
				   int n_ell,double *ell,double *cls,
				   int n_theta,double *theta,double *wtheta,
				   int corr_type,int *status)
{
  corr_int_par *cp=malloc(sizeof(corr_int_par));
  if(cp==NULL) {
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_bessel ran out of memory\n");
    return;
  }

  cp->nell=n_ell;
  cp->ell0=ell[0];
  cp->ellf=ell[n_ell-1];
  cp->cl0=cls[0];
  cp->clf=cls[n_ell-1];
  cp->cl_spl=ccl_spline_init(n_ell,ell,cls,cls[0],0);
  if(cp->cl_spl==NULL) {
    free(cp);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_bessel ran out of memory\n");
    return;
  }
  switch(corr_type) {
  case CCL_CORR_GG :
    cp->i_bessel=0;
    break;
  case CCL_CORR_GL :
    cp->i_bessel=2;
    break;
  case CCL_CORR_LP :
    cp->i_bessel=0;
    break;
  case CCL_CORR_LM :
    cp->i_bessel=4;
    break;
  }

  if(cls[0]*cls[1]<=0)
    cp->extrapol_0=0;
  else {
    cp->extrapol_0=1;
    cp->tilt0=log10(cls[1]/cls[0])/log10(ell[1]/ell[0]);
  }

  if(cls[n_ell-2]*cls[n_ell-1]<=0)
    cp->extrapol_f=0;
  else {
    cp->extrapol_f=1;
    cp->tiltf=log10(cls[n_ell-1]/cls[n_ell-2])/log10(ell[n_ell-1]/ell[n_ell-2]);
  }

  int ith, gslstatus;
  double result,eresult;
  gsl_function F;
  gsl_integration_workspace *w=gsl_integration_workspace_alloc(ccl_gsl->N_ITERATION);
  for(ith=0;ith<n_theta;ith++) {
    cp->th=theta[ith]*M_PI/180;
    F.function=&corr_bessel_integrand;
    F.params=cp;
    //TODO: Split into intervals between first bessel zeros before integrating
    //This will help both speed and accuracy of the integral.
    gslstatus = gsl_integration_qag(&F, 0, ccl_splines->ELL_MAX_CORR, 0,
                                    ccl_gsl->INTEGRATION_EPSREL, ccl_gsl->N_ITERATION,
                                    ccl_gsl->INTEGRATION_GAUSS_KRONROD_POINTS,
                                    w, &result, &eresult);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_correlation.c: ccl_tracer_corr_bessel():");
      *status |= gslstatus;
    }
    wtheta[ith]=result/(2*M_PI);
  }
  gsl_integration_workspace_free(w);
  ccl_spline_free(cp->cl_spl);
  free(cp);
}

/*--------ROUTINE: ccl_compute_legendre_polynomial ------
TASK: Compute input factor for ccl_tracer_corr_legendre
INPUT: tracer 1, tracer 2, i_bessel, theta array, n_theta, L_max, output Pl_theta
 */
static void ccl_compute_legendre_polynomial(int corr_type,double theta,int ell_max,double *Pl_theta)
{
  int i,j;
  double k=0;
  double cth=cos(theta*M_PI/180);

  //Initialize Pl_theta
  for (j=0;j<=ell_max;j++)
      Pl_theta[j]=0.;

  if(corr_type==CCL_CORR_GG) {
    gsl_sf_legendre_Pl_array(ell_max,cth,Pl_theta);
    for (j=0;j<=ell_max;j++)
      Pl_theta[j]*=(2*j+1);
  }
  else if(corr_type==CCL_CORR_GL) {
    for (j=2;j<=ell_max;j++) {//https://arxiv.org/pdf/1007.4809.pdf
      Pl_theta[j]=gsl_sf_legendre_Plm(j,2,cth);
      Pl_theta[j]*=(2*j+1.)/((j+0.)*(j+1.));
    }
  }
}

/*--------ROUTINE: ccl_tracer_corr_legendre ------
TASK: Compute correlation function via Legendre polynomials
INPUT: cosmology, number of theta bins, theta array, tracer 1, tracer 2, i_bessel, boolean
       for tapering, vector of tapering limits, correlation vector, angular_cl function.
 */
static void ccl_tracer_corr_legendre(ccl_cosmology *cosmo,
				     int n_ell,double *ell,double *cls,
				     int n_theta,double *theta,double *wtheta,
				     int corr_type,int do_taper_cl,double *taper_cl_limits,
				     int *status)
{
  int i;
  double *l_arr,*cl_arr,*Pl_theta;
  SplPar *cl_spl;

  if(corr_type==CCL_CORR_LM || corr_type==CCL_CORR_LP){
    *status=CCL_ERROR_NOT_IMPLEMENTED;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: CCL does not support full-sky xi+- calcuations.\nhttps://arxiv.org/abs/1702.05301 indicates flat-sky to be sufficient.\n");
  }

  if(*status==0) {
    l_arr=malloc(((int)(ccl_splines->ELL_MAX_CORR)+1)*sizeof(double));
    if(l_arr==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_legendre ran out of memory\n");
    }
  }

  if(*status==0) {
    cl_arr=malloc(((int)(ccl_splines->ELL_MAX_CORR)+1)*sizeof(double));
    if(cl_arr==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_legendre ran out of memory\n");
    }
  }

  if(*status==0) {
    //Interpolate input Cl into
    cl_spl=ccl_spline_init(n_ell,ell,cls,cls[0],0);
    if(cl_spl==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_legendre ran out of memory\n");
    }
  }

  if(*status==0) {
    double cl_tilt,l_edge,cl_edge;
    l_edge=ell[n_ell-1];
    if((cls[n_ell-1]*cls[n_ell-2]<0) || (cls[n_ell-2]==0)) {
      cl_tilt=0;
      cl_edge=0;
    }
    else {
      cl_tilt=log(cls[n_ell-1]/cls[n_ell-2])/log(ell[n_ell-1]/ell[n_ell-2]);
      cl_edge=cls[n_ell-1];
    }
    for(i=0;i<=(int)(ccl_splines->ELL_MAX_CORR);i++) {
      double l=(double)i;
      l_arr[i]=l;
      if(l>=l_edge)
	cl_arr[i]=cl_edge*pow(l/l_edge,cl_tilt);
      else
	cl_arr[i]=ccl_spline_eval(l,cl_spl);
    }
    ccl_spline_free(cl_spl);

    if (do_taper_cl)
      *status=taper_cl((int)(ccl_splines->ELL_MAX_CORR)+1,l_arr,cl_arr,taper_cl_limits);
  }

  if(*status==0) {
    Pl_theta=malloc(sizeof(double)*((int)(ccl_splines->ELL_MAX_CORR)+1));
    if(Pl_theta==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_tracer_corr_legendre ran out of memory\n");
    }
  }

  if(*status==0) {
    for (int i=0;i<n_theta;i++) {
      wtheta[i]=0;
      ccl_compute_legendre_polynomial(corr_type,theta[i],(int)(ccl_splines->ELL_MAX_CORR),Pl_theta);
      for(int i_L=1;i_L<(int)(ccl_splines->ELL_MAX_CORR);i_L+=1)
	wtheta[i]+=cl_arr[i_L]*Pl_theta[i_L];
      wtheta[i]/=(M_PI*4);
    }
  }

  free(Pl_theta);
  free(l_arr);
  free(cl_arr);
}

/*--------ROUTINE: ccl_tracer_corr ------
TASK: For a given tracer, get the correlation function. Do so by running
      ccl_angular_cls. If you already have Cls calculated, go to the next
      function to pass them directly.
INPUT: cosmology, number of theta values to evaluate = NL, theta vector,
       tracer 1, tracer 2, i_bessel, key for tapering, limits of tapering
       correlation function.
 */
void ccl_correlation(ccl_cosmology *cosmo,
		     int n_ell,double *ell,double *cls,
		     int n_theta,double *theta,double *wtheta,
		     int corr_type,int do_taper_cl,double *taper_cl_limits,int flag_method,
		     int *status)
{
  switch(flag_method) {
  case CCL_CORR_FFTLOG :
    ccl_tracer_corr_fftlog(cosmo,n_ell,ell,cls,n_theta,theta,wtheta,corr_type,
			   do_taper_cl,taper_cl_limits,status);
    break;
  case CCL_CORR_LGNDRE :
    ccl_tracer_corr_legendre(cosmo,n_ell,ell,cls,n_theta,theta,wtheta,corr_type,
			     do_taper_cl,taper_cl_limits,status);
    break;
  case CCL_CORR_BESSEL :
    ccl_tracer_corr_bessel(cosmo,n_ell,ell,cls,n_theta,theta,wtheta,corr_type,status);
    break;
  default :
    *status=CCL_ERROR_INCONSISTENT;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_correlation. Unknown algorithm\n");
  }

  ccl_check_status(cosmo,status);
}

/*--------ROUTINE: ccl_correlation_3d ------
TASK: Calculate the 3d-correlation function. Do so by using FFTLog.

INPUT: cosmology, scale factor a,
       number of r values, r values,
       key for tapering, limits of tapering

Correlation function result will be in array xi
 */

void ccl_correlation_3d(ccl_cosmology *cosmo, double a,
			int n_r,double *r,double *xi,
			int do_taper_pk,double *taper_pk_limits,
			int *status)
{
  int i,N_ARR;
  double *k_arr,*pk_arr,*r_arr,*xi_arr;

  //number of data points for k and pk array
  N_ARR=(int)(ccl_splines->N_K_3DCOR*log10(ccl_splines->K_MAX/ccl_splines->K_MIN));

  k_arr=ccl_log_spacing(ccl_splines->K_MIN,ccl_splines->K_MAX,N_ARR);
  if(k_arr==NULL) {
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_correlation_3d ran out of memory\n");
    return;
  }

  pk_arr=malloc(N_ARR*sizeof(double));
  if(pk_arr==NULL) {
    free(k_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_correlation_3d ran out of memory\n");
    return;
  }

  for (i=0; i<N_ARR; i++)
    pk_arr[i] = ccl_nonlin_matter_power(cosmo, k_arr[i], a, status);

  if (do_taper_pk)
    taper_cl(N_ARR,k_arr,pk_arr,taper_pk_limits);

  r_arr=malloc(sizeof(double)*N_ARR);
  if(r_arr==NULL) {
    free(k_arr);
    free(pk_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_correlation_3d ran out of memory\n");
    return;
  }
  xi_arr=malloc(sizeof(double)*N_ARR);
  if(xi_arr==NULL) {
    free(k_arr); free(pk_arr); free(r_arr);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_correlation.c: ccl_correlation_3d ran out of memory\n");
    return;
  }

  for(i=0;i<N_ARR;i++)
    r_arr[i]=0;

  pk2xi(N_ARR,k_arr,pk_arr,r_arr,xi_arr);

  // Interpolate to output values of r
  SplPar *xi_spl=ccl_spline_init(N_ARR,r_arr,xi_arr,xi_arr[0],0);
  for(i=0;i<n_r;i++)
    xi[i]=ccl_spline_eval(r[i],xi_spl);
  ccl_spline_free(xi_spl);

  free(k_arr); free(pk_arr);
  free(r_arr); free(xi_arr);

  ccl_check_status(cosmo,status);

  return;
}


/* poly/test.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Brian Gough
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_poly.h>
#include <gsl/gsl_heapsort.h>

static int
cmp_cplx(const double *a, const double *b)
{
	double t = (a[0] * a[0] + a[1] * a[1]) - (b[0] * b[0] + b[1] * b[1]);
	return t < 0.0 ? -1 : t > 0.0 ? 1 : 0;
}

int
main (void)
{
  const double eps = 100.0 * GSL_DBL_EPSILON;

  gsl_ieee_env_setup ();

  /* Polynomial evaluation */

  {
    double x, y;
    double c[3] = { 1.0, 0.5, 0.3 };
    x = 0.5;
    y = gsl_poly_eval (c, 3, x);
    gsl_test_rel (y, 1 + 0.5 * x + 0.3 * x * x, eps,
                  "gsl_poly_eval({1, 0.5, 0.3}, 0.5)");
  }

  {
    double x, y;
    double d[11] = { 1, -1, 1, -1, 1, -1, 1, -1, 1, -1, 1 };
    x = 1.0;
    y = gsl_poly_eval (d, 11, x);
    gsl_test_rel (y, 1.0, eps,
                  "gsl_poly_eval({1,-1, 1, -1, 1, -1, 1, -1, 1, -1, 1}, 1.0)");

  }

  {
    gsl_complex x, y;
    double c[1] = {0.3};
    GSL_SET_REAL (&x, 0.75);
    GSL_SET_IMAG (&x, 1.2);
    y = gsl_poly_complex_eval (c, 1, x);

    gsl_test_rel (GSL_REAL (y), 0.3, eps, "y.real, gsl_poly_complex_eval ({0.3}, 0.75 + 1.2i)");
    gsl_test_rel (GSL_IMAG (y), 0.0, eps, "y.imag, gsl_poly_complex_eval ({0.3}, 0.75 + 1.2i)");
  }

  {
    gsl_complex x, y;
    double c[4] = {2.1, -1.34, 0.76, 0.45};
    GSL_SET_REAL (&x, 0.49);
    GSL_SET_IMAG (&x, 0.95);
    y = gsl_poly_complex_eval (c, 4, x);

    gsl_test_rel (GSL_REAL (y), 0.3959143, eps, "y.real, gsl_poly_complex_eval ({2.1, -1.34, 0.76, 0.45}, 0.49 + 0.95i)");
    gsl_test_rel (GSL_IMAG (y), -0.6433305, eps, "y.imag, gsl_poly_complex_eval ({2.1, -1.34, 0.76, 0.45}, 0.49 + 0.95i)");
  }

  {
    gsl_complex x, y;
    gsl_complex c[1];
    GSL_SET_REAL (&c[0], 0.674);
    GSL_SET_IMAG (&c[0], -1.423);
    GSL_SET_REAL (&x, -1.44);
    GSL_SET_IMAG (&x, 9.55);
    y = gsl_complex_poly_complex_eval (c, 1, x);

    gsl_test_rel (GSL_REAL (y), 0.674, eps, "y.real, gsl_complex_poly_complex_eval ({0.674 - 1.423i}, -1.44 + 9.55i)");
    gsl_test_rel (GSL_IMAG (y), -1.423, eps, "y.imag, gsl_complex_poly_complex_eval ({0.674 - 1.423i}, -1.44 + 9.55i)");
  }

  {
    gsl_complex x, y;
    gsl_complex c[4];
    GSL_SET_REAL (&c[0], -2.31);
    GSL_SET_IMAG (&c[0], 0.44);
    GSL_SET_REAL (&c[1], 4.21);
    GSL_SET_IMAG (&c[1], -3.19);
    GSL_SET_REAL (&c[2], 0.93);
    GSL_SET_IMAG (&c[2], 1.04);
    GSL_SET_REAL (&c[3], -0.42);
    GSL_SET_IMAG (&c[3], 0.68);
    GSL_SET_REAL (&x, 0.49);
    GSL_SET_IMAG (&x, 0.95);
    y = gsl_complex_poly_complex_eval (c, 4, x);

    gsl_test_rel (GSL_REAL (y), 1.82462012, eps, "y.real, gsl_complex_poly_complex_eval ({-2.31 + 0.44i, 4.21 - 3.19i, 0.93 + 1.04i, -0.42 + 0.68i}, 0.49 + 0.95i)");
    gsl_test_rel (GSL_IMAG (y), 2.30389412, eps, "y.imag, gsl_complex_poly_complex_eval ({-2.31 + 0.44i, 4.21 - 3.19i, 0.93 + 1.04i, -0.42 + 0.68i}, 0.49 + 0.95i)");
  }

  /* Quadratic */

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (4.0, -20.0, 26.0, &x0, &x1);

    gsl_test (n != 0, "gsl_poly_solve_quadratic, no roots, (2x - 5)^2 = -1");
  }

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (4.0, -20.0, 25.0, &x0, &x1);

    gsl_test (n != 2, "gsl_poly_solve_quadratic, one root, (2x - 5)^2 = 0");
    gsl_test_rel (x0, 2.5, 1e-9, "x0, (2x - 5)^2 = 0");
    gsl_test_rel (x1, 2.5, 1e-9, "x1, (2x - 5)^2 = 0");
    gsl_test (x0 != x1, "x0 == x1, (2x - 5)^2 = 0");
  }

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (4.0, -20.0, 21.0, &x0, &x1);

    gsl_test (n != 2, "gsl_poly_solve_quadratic, two roots, (2x - 5)^2 = 4");
    gsl_test_rel (x0, 1.5, 1e-9, "x0, (2x - 5)^2 = 4");
    gsl_test_rel (x1, 3.5, 1e-9, "x1, (2x - 5)^2 = 4");
  }

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (4.0, 7.0, 0.0, &x0, &x1);

    gsl_test (n != 2, "gsl_poly_solve_quadratic, two roots, x(4x + 7) = 0");
    gsl_test_rel (x0, -1.75, 1e-9, "x0, x(4x + 7) = 0");
    gsl_test_rel (x1, 0.0, 1e-9, "x1, x(4x + 7) = 0");
  }

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (5.0, 0.0, -20.0, &x0, &x1);

    gsl_test (n != 2,
              "gsl_poly_solve_quadratic, two roots b = 0, 5 x^2 = 20");
    gsl_test_rel (x0, -2.0, 1e-9, "x0, 5 x^2 = 20");
    gsl_test_rel (x1, 2.0, 1e-9, "x1, 5 x^2 = 20");
  }

  {
    double x0, x1;

    int n = gsl_poly_solve_quadratic (0.0, 3.0, -21.0, &x0, &x1);

    gsl_test (n != 1,
              "gsl_poly_solve_quadratic, one root (linear) 3 x - 21 = 0");
    gsl_test_rel (x0, 7.0, 1e-9, "x0, 3x - 21 = 0");
  }

  {
    double x0, x1;
    int n = gsl_poly_solve_quadratic (0.0, 0.0, 1.0, &x0, &x1);

    gsl_test (n != 0,
              "gsl_poly_solve_quadratic, no roots 1 = 0");
  }

  /* Cubic */

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (0.0, 0.0, -27.0, &x0, &x1, &x2);

    gsl_test (n != 1, "gsl_poly_solve_cubic, one root, x^3 = 27");
    gsl_test_rel (x0, 3.0, 1e-9, "x0, x^3 = 27");
  }

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (-51.0, 867.0, -4913.0, &x0, &x1, &x2);

    gsl_test (n != 3, "gsl_poly_solve_cubic, three roots, (x-17)^3=0");
    gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)^3=0");
    gsl_test_rel (x1, 17.0, 1e-9, "x1, (x-17)^3=0");
    gsl_test_rel (x2, 17.0, 1e-9, "x2, (x-17)^3=0");
  }

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (-57.0, 1071.0, -6647.0, &x0, &x1, &x2);

    gsl_test (n != 3,
              "gsl_poly_solve_cubic, three roots, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (x1, 17.0, 1e-9, "x1, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (x2, 23.0, 1e-9, "x2, (x-17)(x-17)(x-23)=0");
  }

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (-11.0, -493.0, +6647.0, &x0, &x1, &x2);

    gsl_test (n != 3,
              "gsl_poly_solve_cubic, three roots, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (x0, -23.0, 1e-9, "x0, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (x1, 17.0, 1e-9, "x1, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (x2, 17.0, 1e-9, "x2, (x+23)(x-17)(x-17)=0");
  }

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (-143.0, 5087.0, -50065.0, &x0, &x1, &x2);

    gsl_test (n != 3,
              "gsl_poly_solve_cubic, three roots, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (x0, 17.0, 1e-9, "x0, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (x1, 31.0, 1e-9, "x1, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (x2, 95.0, 1e-9, "x2, (x-17)(x-31)(x-95)=0");
  }

  {
    double x0, x1, x2;

    int n = gsl_poly_solve_cubic (-109.0, 803.0, 50065.0, &x0, &x1, &x2);

    gsl_test (n != 3,
              "gsl_poly_solve_cubic, three roots, (x+17)(x-31)(x-95)=0");
    gsl_test_rel (x0, -17.0, 1e-9, "x0, (x+17)(x-31)(x-95)=0");
    gsl_test_rel (x1, 31.0, 1e-9, "x1, (x+17)(x-31)(x-95)=0");
    gsl_test_rel (x2, 95.0, 1e-9, "x2, (x+17)(x-31)(x-95)=0");
  }

  /* Quadratic with complex roots */

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 26.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, 2 roots (2x - 5)^2 = -1");
    gsl_test_rel (GSL_REAL (z0), 2.5, 1e-9, "z0.real, (2x - 5)^2 = -1");
    gsl_test_rel (GSL_IMAG (z0), -0.5, 1e-9, "z0.imag, (2x - 5)^2 = -1");

    gsl_test_rel (GSL_REAL (z1), 2.5, 1e-9, "z1.real, (2x - 5)^2 = -1");
    gsl_test_rel (GSL_IMAG (z1), 0.5, 1e-9, "z1.imag, (2x - 5)^2 = -1");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 25.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, one root, (2x - 5)^2 = 0");
    gsl_test_rel (GSL_REAL (z0), 2.5, 1e-9, "z0.real, (2x - 5)^2 = 0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag (2x - 5)^2 = 0");
    gsl_test_rel (GSL_REAL (z1), 2.5, 1e-9, "z1.real, (2x - 5)^2 = 0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag (2x - 5)^2 = 0");
    gsl_test (GSL_REAL (z0) != GSL_REAL (z1),
              "z0.real == z1.real, (2x - 5)^2 = 0");
    gsl_test (GSL_IMAG (z0) != GSL_IMAG (z1),
              "z0.imag == z1.imag, (2x - 5)^2 = 0");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (4.0, -20.0, 21.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, two roots, (2x - 5)^2 = 4");
    gsl_test_rel (GSL_REAL (z0), 1.5, 1e-9, "z0.real, (2x - 5)^2 = 4");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (2x - 5)^2 = 4");
    gsl_test_rel (GSL_REAL (z1), 3.5, 1e-9, "z1.real, (2x - 5)^2 = 4");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (2x - 5)^2 = 4");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (4.0, 7.0, 0.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, two roots, x(4x + 7) = 0");
    gsl_test_rel (GSL_REAL (z0), -1.75, 1e-9, "z0.real, x(4x + 7) = 0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, x(4x + 7) = 0");
    gsl_test_rel (GSL_REAL (z1), 0.0, 1e-9, "z1.real, x(4x + 7) = 0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, x(4x + 7) = 0");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (5.0, 0.0, -20.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, two roots b = 0, 5 x^2 = 20");
    gsl_test_rel (GSL_REAL (z0), -2.0, 1e-9, "z0.real, 5 x^2 = 20");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, 5 x^2 = 20");
    gsl_test_rel (GSL_REAL (z1), 2.0, 1e-9, "z1.real, 5 x^2 = 20");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, 5 x^2 = 20");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (5.0, 0.0, 20.0, &z0, &z1);

    gsl_test (n != 2,
              "gsl_poly_complex_solve_quadratic, two roots b = 0, 5 x^2 = -20");
    gsl_test_rel (GSL_REAL (z0), 0.0, 1e-9, "z0.real, 5 x^2 = -20");
    gsl_test_rel (GSL_IMAG (z0), -2.0, 1e-9, "z0.imag, 5 x^2 = -20");
    gsl_test_rel (GSL_REAL (z1), 0.0, 1e-9, "z1.real, 5 x^2 = -20");
    gsl_test_rel (GSL_IMAG (z1), 2.0, 1e-9, "z1.imag, 5 x^2 = -20");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (0.0, 3.0, -21.0, &z0, &z1);

    gsl_test (n != 1,
              "gsl_poly_complex_solve_quadratic, one root (linear) 3 x - 21 = 0");

    gsl_test_rel (GSL_REAL (z0), 7.0, 1e-9, "z0.real, 3x - 21 = 0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, 3x - 21 = 0");
  }

  {
    gsl_complex z0, z1;

    int n = gsl_poly_complex_solve_quadratic (0.0, 0.0, 1.0, &z0, &z1);
    gsl_test (n != 0,
              "gsl_poly_complex_solve_quadratic, no roots 1 = 0");
  }

  /* Cubic with complex roots */

  {
    gsl_complex z0, z1, z2;

    int n = gsl_poly_complex_solve_cubic (0.0, 0.0, -27.0, &z0, &z1, &z2);

    gsl_test (n != 3, "gsl_poly_complex_solve_cubic, three root, x^3 = 27");
    gsl_test_rel (GSL_REAL (z0), -1.5, 1e-9, "z0.real, x^3 = 27");
    gsl_test_rel (GSL_IMAG (z0), -1.5 * sqrt (3.0), 1e-9,
                  "z0.imag, x^3 = 27");
    gsl_test_rel (GSL_REAL (z1), -1.5, 1e-9, "z1.real, x^3 = 27");
    gsl_test_rel (GSL_IMAG (z1), 1.5 * sqrt (3.0), 1e-9, "z1.imag, x^3 = 27");
    gsl_test_rel (GSL_REAL (z2), 3.0, 1e-9, "z2.real, x^3 = 27");
    gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, x^3 = 27");
  }

  {
    gsl_complex z0, z1, z2;

    int n = gsl_poly_complex_solve_cubic (-1.0, 1.0, 39.0, &z0, &z1, &z2);

    gsl_test (n != 3,
              "gsl_poly_complex_solve_cubic, three root, (x+3)(x^2-4x+13) = 0");
    gsl_test_rel (GSL_REAL (z0), -3.0, 1e-9, "z0.real, (x+3)(x^2+1) = 0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x+3)(x^2+1) = 0");
    gsl_test_rel (GSL_REAL (z1), 2.0, 1e-9, "z1.real, (x+3)(x^2+1) = 0");
    gsl_test_rel (GSL_IMAG (z1), -3.0, 1e-9, "z1.imag, (x+3)(x^2+1) = 0");
    gsl_test_rel (GSL_REAL (z2), 2.0, 1e-9, "z2.real, (x+3)(x^2+1) = 0");
    gsl_test_rel (GSL_IMAG (z2), 3.0, 1e-9, "z2.imag, (x+3)(x^2+1) = 0");
  }

  {
    gsl_complex z0, z1, z2;

    int n =
      gsl_poly_complex_solve_cubic (-51.0, 867.0, -4913.0, &z0, &z1, &z2);

    gsl_test (n != 3,
              "gsl_poly_complex_solve_cubic, three roots, (x-17)^3=0");
    gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)^3=0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)^3=0");
    gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x-17)^3=0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)^3=0");
    gsl_test_rel (GSL_REAL (z2), 17.0, 1e-9, "z2.real, (x-17)^3=0");
    gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)^3=0");
  }

  {
    gsl_complex z0, z1, z2;

    int n =
      gsl_poly_complex_solve_cubic (-57.0, 1071.0, -6647.0, &z0, &z1, &z2);

    gsl_test (n != 3,
              "gsl_poly_complex_solve_cubic, three roots, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_REAL (z2), 23.0, 1e-9, "z2.real, (x-17)(x-17)(x-23)=0");
    gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)(x-17)(x-23)=0");
  }

  {
    gsl_complex z0, z1, z2;

    int n =
      gsl_poly_complex_solve_cubic (-11.0, -493.0, +6647.0, &z0, &z1, &z2);

    gsl_test (n != 3,
              "gsl_poly_complex_solve_cubic, three roots, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_REAL (z0), -23.0, 1e-9,
                  "z0.real, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_REAL (z1), 17.0, 1e-9, "z1.real, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_REAL (z2), 17.0, 1e-9, "z2.real, (x+23)(x-17)(x-17)=0");
    gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x+23)(x-17)(x-17)=0");
  }

  {
    gsl_complex z0, z1, z2;

    int n =
      gsl_poly_complex_solve_cubic (-143.0, 5087.0, -50065.0, &z0, &z1, &z2);

    gsl_test (n != 3,
              "gsl_poly_complex_solve_cubic, three roots, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_REAL (z0), 17.0, 1e-9, "z0.real, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_IMAG (z0), 0.0, 1e-9, "z0.imag, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_REAL (z1), 31.0, 1e-9, "z1.real, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_IMAG (z1), 0.0, 1e-9, "z1.imag, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_REAL (z2), 95.0, 1e-9, "z2.real, (x-17)(x-31)(x-95)=0");
    gsl_test_rel (GSL_IMAG (z2), 0.0, 1e-9, "z2.imag, (x-17)(x-31)(x-95)=0");
  }

  {
    /* Wilkinson polynomial: y = (x-1)(x-2)(x-3)(x-4)(x-5) */

    double a[6] = { -120, 274, -225, 85, -15, 1 };
    double z[6*2];

    gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc (6);

    int status = gsl_poly_complex_solve (a, 6, w, z);

    gsl_poly_complex_workspace_free (w);

    gsl_test (status,
              "gsl_poly_complex_solve, 5th-order Wilkinson polynomial");
    gsl_test_rel (z[0], 1.0, 1e-9, "z0.real, 5th-order polynomial");
    gsl_test_rel (z[1], 0.0, 1e-9, "z0.imag, 5th-order polynomial");
    gsl_test_rel (z[2], 2.0, 1e-9, "z1.real, 5th-order polynomial");
    gsl_test_rel (z[3], 0.0, 1e-9, "z1.imag, 5th-order polynomial");
    gsl_test_rel (z[4], 3.0, 1e-9, "z2.real, 5th-order polynomial");
    gsl_test_rel (z[5], 0.0, 1e-9, "z2.imag, 5th-order polynomial");
    gsl_test_rel (z[6], 4.0, 1e-9, "z3.real, 5th-order polynomial");
    gsl_test_rel (z[7], 0.0, 1e-9, "z3.imag, 5th-order polynomial");
    gsl_test_rel (z[8], 5.0, 1e-9, "z4.real, 5th-order polynomial");
    gsl_test_rel (z[9], 0.0, 1e-9, "z4.imag, 5th-order polynomial");
  }

  {
    /* : 8-th order polynomial y = x^8 + x^4 + 1 */

    double a[9] = { 1, 0, 0, 0, 1, 0, 0, 0, 1 };
    double z[8*2];

    double C = 0.5;
    double S = sqrt (3.0) / 2.0;

    gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc (9);

    int status = gsl_poly_complex_solve (a, 9, w, z);

    gsl_poly_complex_workspace_free (w);

    gsl_test (status, "gsl_poly_complex_solve, 8th-order polynomial");

    gsl_test_rel (z[0], -S, 1e-9, "z0.real, 8th-order polynomial");
    gsl_test_rel (z[1], C, 1e-9, "z0.imag, 8th-order polynomial");
    gsl_test_rel (z[2], -S, 1e-9, "z1.real, 8th-order polynomial");
    gsl_test_rel (z[3], -C, 1e-9, "z1.imag, 8th-order polynomial");
    gsl_test_rel (z[4], -C, 1e-9, "z2.real, 8th-order polynomial");
    gsl_test_rel (z[5], S, 1e-9, "z2.imag, 8th-order polynomial");
    gsl_test_rel (z[6], -C, 1e-9, "z3.real, 8th-order polynomial");
    gsl_test_rel (z[7], -S, 1e-9, "z3.imag, 8th-order polynomial");
    gsl_test_rel (z[8], C, 1e-9, "z4.real, 8th-order polynomial");
    gsl_test_rel (z[9], S, 1e-9, "z4.imag, 8th-order polynomial");
    gsl_test_rel (z[10], C, 1e-9, "z5.real, 8th-order polynomial");
    gsl_test_rel (z[11], -S, 1e-9, "z5.imag, 8th-order polynomial");
    gsl_test_rel (z[12], S, 1e-9, "z6.real, 8th-order polynomial");
    gsl_test_rel (z[13], C, 1e-9, "z6.imag, 8th-order polynomial");
    gsl_test_rel (z[14], S, 1e-9, "z7.real, 8th-order polynomial");
    gsl_test_rel (z[15], -C, 1e-9, "z7.imag, 8th-order polynomial");

  }

  {
    /* 15-th order polynomial y = (x + 1) * (x^10 + x^9 + 2 * x^7 + 4 * x^2 +
       4 * x + 8) * (x - 1)^2 * (x - 2)^2

       Problem reported by Munagala Ramanath (bug #39055)
    */

    double a[16] = { 32, -48, -8, 28, -8, 16, -16, 12, -16, 6, 10, -17, 10, 2, -4, 1 };
    double z[16*2];

    double expected[16*20] = {
	   1.0000000000000000,  0.00000000000000000,
	   1.0000000000000000,  0.00000000000000000,
	  -1.0000000000000000,  0.00000000000000000,
	 -0.65893856175240950,  0.83459757287426684,
	 -0.65893856175240950, -0.83459757287426684,
	-0.070891117403341281,  -1.1359249087587791,
	-0.070891117403341281,   1.1359249087587791,
	   1.1142366961812986, -0.48083981203389980,
	   1.1142366961812986,  0.48083981203389980,
	  -1.3066982484920768,  0.00000000000000000,
	  0.57284747839410854,   1.1987808988289705,
	  0.57284747839410854,  -1.1987808988289705,
	  -1.6078107423472359,  0.00000000000000000,
	   2.0000000000000000,  0.00000000000000000,
	   2.0000000000000000,  0.00000000000000000 };

    int i;

    gsl_poly_complex_workspace *w = gsl_poly_complex_workspace_alloc (16);

    int status = gsl_poly_complex_solve (a, 16, w, z);

    gsl_poly_complex_workspace_free (w);

    gsl_test (status, "gsl_poly_complex_solve, 15th-order polynomial");

    gsl_heapsort(z, 15, 2 * sizeof(double), (gsl_comparison_fn_t) &cmp_cplx);

    for (i = 0; i<15; i++)
      {
        gsl_test_abs (z[2*i], expected[2*i], 1e-7, "z%d.real, 15th-order polynomial", i);
        gsl_test_abs (z[2*i+1], expected[2*i+1], 1e-7, "z%d.imag, 15th-order polynomial", i);
      }
  }

  {
    int i;

    double xa[7] = {0.16, 0.97, 1.94, 2.74, 3.58, 3.73, 4.70 };
    double ya[7] = {0.73, 1.11, 1.49, 1.84, 2.30, 2.41, 3.07 };

    double dd_expected[7] = {  7.30000000000000e-01,
                               4.69135802469136e-01,
                              -4.34737219941284e-02,
                               2.68681098870099e-02,
                              -3.22937056934996e-03,
                               6.12763259971375e-03,
                              -6.45402453527083e-03 };

    double dd[7], coeff[7], work[7];

    gsl_poly_dd_init (dd, xa, ya, 7);

    for (i = 0; i < 7; i++)
      {
        gsl_test_rel (dd[i], dd_expected[i], 1e-10, "divided difference dd[%d]", i);
      }

    for (i = 0; i < 7; i++)
      {
        double y = gsl_poly_dd_eval(dd, xa, 7, xa[i]);
        gsl_test_rel (y, ya[i], 1e-10, "divided difference y[%d]", i);
      }

    gsl_poly_dd_taylor (coeff, 1.5, dd, xa, 7, work);

    for (i = 0; i < 7; i++)
      {
        double y = gsl_poly_eval(coeff, 7, xa[i] - 1.5);
        gsl_test_rel (y, ya[i], 1e-10, "taylor expansion about 1.5 y[%d]", i);
      }
  }

  {
    size_t i;
    double xa[3] = { 1.3, 1.6, 1.9 };
    double ya[3] = { 0.6200860, 0.4554022, 0.2818186 };
    double dya[3] = { -0.5220232, -0.5698959, -0.5811571 };

    double dd_expected[6] = {  6.200860000000e-01,
                              -5.220232000000e-01,
                              -8.974266666667e-02,
                               6.636555555556e-02,
                               2.666666666662e-03,
                              -2.774691357989e-03 };

    double dd[6], za[6], coeff[6], work[6];

    gsl_poly_dd_hermite_init(dd, za, xa, ya, dya, 3);

    for (i = 0; i < 6; i++)
      {
        gsl_test_rel (dd[i], dd_expected[i], 1e-10, "hermite divided difference dd[%d]", i);
      }

    for (i = 0; i < 3; i++)
      {
        double y = gsl_poly_dd_eval(dd, za, 6, xa[i]);
        gsl_test_rel (y, ya[i], 1e-10, "hermite divided difference y[%d]", i);
      }

    for (i = 0; i < 3; i++)
      {
        gsl_poly_dd_taylor(coeff, xa[i], dd, za, 6, work);
        gsl_test_rel (coeff[1], dya[i], 1e-10, "hermite divided difference dy/dx[%d]", i);
      }
  }

  {
    double c[6] = { +1.0, -2.0, +3.0, -4.0, +5.0, -6.0 };
    double dc[6];
    double x;
    x = -0.5;
    gsl_poly_eval_derivs(c, 6, x, dc, 6);

    gsl_test_rel (dc[0], c[0] + c[1]*x + c[2]*x*x + c[3]*x*x*x + c[4]*x*x*x*x + c[5]*x*x*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6}, 3.75)");
    gsl_test_rel (dc[1], c[1] + 2.0*c[2]*x + 3.0*c[3]*x*x + 4.0*c[4]*x*x*x + 5.0*c[5]*x*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 1, -12.375)");
    gsl_test_rel (dc[2], 2.0*c[2] + 3.0*2.0*c[3]*x + 4.0*3.0*c[4]*x*x + 5.0*4.0*c[5]*x*x*x , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 2, +48.0)");
    gsl_test_rel (dc[3], 3.0*2.0*c[3] + 4.0*3.0*2.0*c[4]*x + 5.0*4.0*3.0*c[5]*x*x , eps,"gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 3, -174.0)");
    gsl_test_rel (dc[4], 4.0*3.0*2.0*c[4] + 5.0*4.0*3.0*2.0*c[5]*x, eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 4, +480.0)");
    gsl_test_rel (dc[5], 5.0*4.0*3.0*2.0*c[5] , eps, "gsl_poly_eval_dp({+1, -2, +3, -4, +5, -6} deriv 5, -720.0)");
  }

  /* now summarize the results */

  exit (gsl_test_summary ());
}


#pragma once

#include <gsl/gsl_complex.h>

int compare(double n1, double n2, double precision = 1e-15);

int compare(const gsl_complex& c1, const gsl_complex& c2, double precision = 1e-15);
bool operator==(const gsl_complex& c1, const gsl_complex& c2);
bool operator!=(const gsl_complex& c1, const gsl_complex& c2);


/* ode-initval/test.c
 *
 * Copyright (C) 2009, 2010 Tuomo Keskitalo
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

/* Some functions and tests based on test.c by G. Jungman. */

#include <config.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_odeiv2.h>
#include "odeiv_util.h"

/* Maximum number of ODE equations */
#define MAXEQ 15

/* Maximum number of ODE solvers */
#define MAXNS 20

/* Track number of function and jacobian evaluations in tests
   with global variables
 */
int nfe;
int nje;

/**********************************************************/
/* ODE test system definitions                            */
/**********************************************************/

/* RHS for f=2. Solution y = 2 * t + t0 */

int
rhs_linear (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = 2.0;

  return GSL_SUCCESS;
}

int
jac_linear (double t, const double y[], double *dfdy, double dfdt[],
            void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = 0.0;
  dfdt[0] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_lin = {
  rhs_linear,
  jac_linear,
  1,
  0
};

/* RHS for f=y. Equals y=exp(t) with initial value y(0)=1.0 */

int
rhs_exp (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = y[0];

  return GSL_SUCCESS;
}

int
jac_exp (double t, const double y[], double *dfdy, double dfdt[],
         void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = y[0];
  dfdt[0] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_exp = {
  rhs_exp,
  jac_exp,
  1,
  0
};

int
rhs_sin (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = -y[1];
  f[1] = y[0];

  return GSL_SUCCESS;
}

int
jac_sin (double t, const double y[], double *dfdy, double dfdt[],
         void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = 0.0;
  dfdy[1] = -1.0;
  dfdy[2] = 1.0;
  dfdy[3] = 0.0;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_sin = {
  rhs_sin,
  jac_sin,
  2,
  0
};

/*  Sine/cosine with random failures */

static int rhs_xsin_reset = 0;
static int jac_xsin_reset = 0;

int
rhs_xsin (double t, const double y[], double f[], void *params)
{
  static int n = 0, m = 0;
  extern int nfe;
  nfe += 1;

  if (rhs_xsin_reset)
    {
      rhs_xsin_reset = 0;
      n = 0;
      m = 1;
    }
  n++;

  if (n >= m)
    {
      m = n * 1.3;
      return GSL_EFAILED;
    }

  if (n > 40 && n < 65)
    {
      f[0] = GSL_NAN;
      f[1] = GSL_NAN;
      return GSL_EFAILED;
    }

  f[0] = -y[1];
  f[1] = y[0];

  return GSL_SUCCESS;
}

int
jac_xsin (double t, const double y[], double *dfdy, double dfdt[],
          void *params)
{
  static int n = 0;
  extern int nje;
  nje += 1;

  if (jac_xsin_reset)
    {
      jac_xsin_reset = 0;
      n = 0;
    }
  n++;

  if (n > 50 && n < 55)
    {
      dfdy[0] = GSL_NAN;
      dfdy[1] = GSL_NAN;
      dfdy[2] = GSL_NAN;
      dfdy[3] = GSL_NAN;

      dfdt[0] = GSL_NAN;
      dfdt[1] = GSL_NAN;
      return GSL_EFAILED;
    }

  dfdy[0] = 0.0;
  dfdy[1] = -1.0;
  dfdy[2] = 1.0;
  dfdy[3] = 0.0;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_xsin = {
  rhs_xsin,
  jac_xsin,
  2,
  0
};

/* RHS for classic stiff example
   dy0 / dt =  998 * y0 + 1998 * y1    y0(0) = 1.0
   dy1 / dt = -999 * y0 - 1999 * y1    y1(0) = 0.0

   solution is
   y0 = 2 * exp(-t) - exp(-1000 * t)
   y1 = - exp(-t) + exp(-1000 * t)
*/

int
rhs_stiff (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = 998.0 * y[0] + 1998.0 * y[1];
  f[1] = -999.0 * y[0] - 1999.0 * y[1];

  return GSL_SUCCESS;
}

int
jac_stiff (double t, const double y[], double *dfdy, double dfdt[],
           void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = 998.0;
  dfdy[1] = 1998.0;
  dfdy[2] = -999.0;
  dfdy[3] = -1999.0;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_stiff = {
  rhs_stiff,
  jac_stiff,
  2,
  0
};

/* Cosine function */

int
rhs_cos (double t, const double *y, double *dydt, void *params)
{
  dydt[0] = cos (t);
  return GSL_SUCCESS;
}

int
jac_cos (double t, const double y[], double *dfdy, double dfdt[],
         void *params)
{
  dfdy[0] = 0.0;
  dfdt[0] = -sin (t);

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_cos = {
  rhs_cos,
  jac_cos,
  1,
  0
};

/* Broken problem for testing numerical problems in user function that
   leads to decrease of step size in gsl_odeiv2_evolve below machine
   precision.
 */

int
rhs_broken (double t, const double y[], double f[], void *params)
{
  if (t < 10.0)
    {
      f[0] = 1.0;
    }

  else
    {
      f[0] = GSL_NAN;
      return 123;
    }

  return GSL_SUCCESS;
}

int
jac_broken (double t, const double y[], double *dfdy, double dfdt[],
            void *params)
{
  if (t < 10.0)
    {
      dfdy[0] = 0.0;
      dfdt[0] = 0.0;
    }
  else
    {
      dfdy[0] = GSL_NAN;
      dfdt[0] = GSL_NAN;
      return 123;
    }

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_broken = {
  rhs_broken,
  jac_broken,
  1,
  0
};

/* Immediate user break (at t > 1.5) test sine system */

int
rhs_sin_ub (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = -y[1];
  f[1] = y[0];

  if (t > 1.5)
    {
      return GSL_EBADFUNC;
    }

  return GSL_SUCCESS;
}

int
jac_sin_ub (double t, const double y[], double *dfdy, double dfdt[],
            void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = 0.0;
  dfdy[1] = -1.0;
  dfdy[2] = 1.0;
  dfdy[3] = 0.0;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  if (t > 1.5)
    {
      return GSL_EBADFUNC;
    }

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_sin_ub = {
  rhs_sin_ub,
  jac_sin_ub,
  2,
  0
};

/* Badly scaled random function */

int
rhs_br (double t, const double *y, double *dydt, void *params)
{
  dydt[0] = (rand () - RAND_MAX / 2) * 2e100;
  return GSL_SUCCESS;
}

int
jac_br (double t, const double y[], double *dfdy, double dfdt[], void *params)
{
  dfdy[0] = (rand () - RAND_MAX / 2) * 2e100;
  dfdt[0] = (rand () - RAND_MAX / 2) * 2e100;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_br = {
  rhs_br,
  jac_br,
  1,
  0
};

/* stepfn and stepfn2 based on testcases from Frank Reininghaus
   <frank78ac@googlemail.com>
*/

/* Derivative change at t=0, small derivative */

int
rhs_stepfn (double t, const double *y, double *dydt, void *params)
{
  if (t >= 1.0)
    dydt[0] = 1;
  else
    dydt[0] = 0;

  return GSL_SUCCESS;
}

int
jac_stepfn (double t, const double y[], double *dfdy, double dfdt[],
            void *params)
{
  dfdy[0] = 0.0;
  dfdt[0] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_stepfn = {
  rhs_stepfn,
  jac_stepfn,
  1,
  0
};

/* Derivative change at t=0, large derivative */

int
rhs_stepfn2 (double t, const double *y, double *dydt, void *params)
{
  if (t >= 0.0)
    dydt[0] = 1e300;
  else
    dydt[0] = 0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_stepfn2 = {
  rhs_stepfn2,
  jac_stepfn,
  1,
  0
};

/* Volterra-Lotka predator-prey model
   f0 = (a - b * y1) * y0     y0(0) = 2.725
   f1 = (-c + d * y0) * y1    y1(0) = 1.0
 */

int
rhs_vl (double t, const double y[], double f[], void *params)
{
  const double a = -1.0;
  const double b = -1.0;
  const double c = -2.0;
  const double d = -1.0;

  extern int nfe;
  nfe += 1;

  f[0] = (a - b * y[1]) * y[0];
  f[1] = (-c + d * y[0]) * y[1];

  return GSL_SUCCESS;
}

int
jac_vl (double t, const double y[], double *dfdy, double dfdt[], void *params)
{
  const double a = -1.0;
  const double b = -1.0;
  const double c = -2.0;
  const double d = -1.0;

  extern int nje;
  nje += 1;

  dfdy[0] = a - b * y[1];
  dfdy[1] = -b * y[0];
  dfdy[2] = d * y[1];
  dfdy[3] = -c + d * y[0];

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_vl = {
  rhs_vl,
  jac_vl,
  2,
  0
};

/* van Der Pol oscillator
   f0 = y1                           y0(0) = 1.0
   f1 = -y0 + mu * y1 * (1 - y0^2)   y1(0) = 0.0
*/

int
rhs_vanderpol (double t, const double y[], double f[], void *params)
{
  const double mu = 10.0;

  extern int nfe;
  nfe += 1;

  f[0] = y[1];
  f[1] = -y[0] + mu * y[1] * (1.0 - y[0] * y[0]);

  return GSL_SUCCESS;
}

int
jac_vanderpol (double t, const double y[], double *dfdy, double dfdt[],
               void *params)
{
  const double mu = 10.0;

  extern int nje;
  nje += 1;

  dfdy[0] = 0.0;
  dfdy[1] = 1.0;
  dfdy[2] = -2.0 * mu * y[0] * y[1] - 1.0;
  dfdy[3] = mu * (1.0 - y[0] * y[0]);

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_vanderpol = {
  rhs_vanderpol,
  jac_vanderpol,
  2,
  0
};

/* Stiff trigonometric example
   f0 = -50 * (y0 - cos(t))    y0(0) = 0.0
 */

int
rhs_stifftrig (double t, const double y[], double f[], void *params)
{
  extern int nfe;
  nfe += 1;

  f[0] = -50 * (y[0] - cos (t));

  return GSL_SUCCESS;
}

int
jac_stifftrig (double t, const double y[], double *dfdy, double dfdt[],
               void *params)
{
  extern int nje;
  nje += 1;

  dfdy[0] = -50;

  dfdt[0] = -50 * sin (t);

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_stifftrig = {
  rhs_stifftrig,
  jac_stifftrig,
  1,
  0
};

/* The Oregonator - chemical Belusov-Zhabotinskii reaction
   y0(0) = 1.0, y1(0) = 2.0, y2(0) = 3.0
*/

int
rhs_oregonator (double t, const double y[], double f[], void *params)
{
  const double c1 = 77.27;
  const double c2 = 8.375e-6;
  const double c3 = 0.161;

  extern int nfe;
  nfe += 1;

  f[0] = c1 * (y[1] + y[0] * (1 - c2 * y[0] - y[1]));
  f[1] = 1 / c1 * (y[2] - y[1] * (1 + y[0]));
  f[2] = c3 * (y[0] - y[2]);

  return GSL_SUCCESS;
}

int
jac_oregonator (double t, const double y[], double *dfdy, double dfdt[],
                void *params)
{
  const double c1 = 77.27;
  const double c2 = 8.375e-6;
  const double c3 = 0.161;

  extern int nje;
  nje += 1;

  dfdy[0] = c1 * (1 - 2 * c2 * y[0] - y[1]);
  dfdy[1] = c1 * (1 - y[0]);
  dfdy[2] = 0.0;

  dfdy[3] = 1 / c1 * (-y[1]);
  dfdy[4] = 1 / c1 * (-1 - y[0]);
  dfdy[5] = 1 / c1;

  dfdy[6] = c3;
  dfdy[7] = 0.0;
  dfdy[8] = -c3;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;
  dfdt[2] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_oregonator = {
  rhs_oregonator,
  jac_oregonator,
  3,
  0
};

/* E5 - a stiff badly scaled chemical problem by Enright, Hull &
   Lindberg (1975): Comparing numerical methods for stiff systems of
   ODEs. BIT, vol. 15, pp. 10-48.

   f0 = -a * y0 - b * y0 * y2                            y0(0) = 1.76e-3
   f1 = a * y0 - m * c * y1 * y2                         y1(0) = 0.0
   f2 = a * y0 - b * y0 * y2 - m * c * y1 * y2 + c * y3  y2(0) = 0.0
   f3 = b * y0 * y2 - c * y3                             y3(0) = 0.0
 */

int
rhs_e5 (double t, const double y[], double f[], void *params)
{
  const double a = 7.89e-10;
  const double b = 1.1e7;
  const double c = 1.13e3;
  const double m = 1.0e6;

  extern int nfe;
  nfe += 1;

  f[0] = -a * y[0] - b * y[0] * y[2];
  f[1] = a * y[0] - m * c * y[1] * y[2];
  f[3] = b * y[0] * y[2] - c * y[3];
  f[2] = f[1] - f[3];

  return GSL_SUCCESS;
}

int
jac_e5 (double t, const double y[], double *dfdy, double dfdt[], void *params)
{
  const double a = 7.89e-10;
  const double b = 1.1e7;
  const double c = 1.13e3;
  const double m = 1.0e6;

  extern int nje;
  nje += 1;

  dfdy[0] = -a - b * y[2];
  dfdy[1] = 0.0;
  dfdy[2] = -b * y[0];
  dfdy[3] = 0.0;

  dfdy[4] = a;
  dfdy[5] = -m * c * y[2];
  dfdy[6] = -m * c * y[1];
  dfdy[7] = 0.0;

  dfdy[8] = a - b * y[2];
  dfdy[9] = -m * c * y[2];
  dfdy[10] = -b * y[0] - m * c * y[1];
  dfdy[11] = c;

  dfdy[12] = b * y[2];
  dfdy[13] = 0.0;
  dfdy[14] = b * y[0];
  dfdy[15] = -c;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;
  dfdt[2] = 0.0;
  dfdt[3] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_e5 = {
  rhs_e5,
  jac_e5,
  4,
  0
};

/* Chemical reaction system of H.H. Robertson (1966): The solution of
   a set of reaction rate equations. In: J. Walsh, ed.: Numer.
   Anal., an Introduction, Academ. Press, pp. 178-182.

   f0 = -a * y0 + b * y1 * y2             y0(0) = 1.0
   f1 = a * y0 - b * y1 * y2 - c * y1^2   y1(0) = 0.0
   f2 = c * y1^2                          y2(0) = 0.0
 */

int
rhs_robertson (double t, const double y[], double f[], void *params)
{
  const double a = 0.04;
  const double b = 1.0e4;
  const double c = 3.0e7;

  extern int nfe;
  nfe += 1;

  f[0] = -a * y[0] + b * y[1] * y[2];
  f[2] = c * y[1] * y[1];
  f[1] = -f[0] - f[2];

  return GSL_SUCCESS;
}

int
jac_robertson (double t, const double y[], double *dfdy, double dfdt[],
               void *params)
{
  const double a = 0.04;
  const double b = 1.0e4;
  const double c = 3.0e7;

  extern int nje;
  nje += 1;

  dfdy[0] = -a;
  dfdy[1] = b * y[2];
  dfdy[2] = b * y[1];

  dfdy[3] = a;
  dfdy[4] = -b * y[2] - 2 * c * y[1];
  dfdy[5] = -b * y[1];

  dfdy[6] = 0.0;
  dfdy[7] = 2 * c * y[1];
  dfdy[8] = 0.0;

  dfdt[0] = 0.0;
  dfdt[1] = 0.0;
  dfdt[2] = 0.0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_robertson = {
  rhs_robertson,
  jac_robertson,
  3,
  0
};

/* A two-dimensional oscillating Brusselator system.

   f0 = a + y0^2 * y1 - (b + 1) * y0      y0(0) = 1.5
   f1 = b * y0 - y0^2 * y1                y1(0) = 3.0
 */

int
rhs_brusselator (double t, const double y[], double f[], void *params)
{
  const double a = 1.0;
  const double b = 3.0;

  extern int nfe;
  nfe += 1;

  f[0] = a + y[0] * y[0] * y[1] - (b + 1.0) * y[0];
  f[1] = b * y[0] - y[0] * y[0] * y[1];

  return GSL_SUCCESS;
}

int
jac_brusselator (double t, const double y[], double *dfdy, double dfdt[],
                 void *params)
{
  const double b = 3.0;

  extern int nje;
  nje += 1;

  dfdy[0] = 2 * y[0] * y[1] - (b + 1.0);
  dfdy[1] = y[0] * y[0];

  dfdy[2] = b - 2 * y[0] * y[1];
  dfdy[3] = -y[0] * y[0];

  dfdt[0] = 0;
  dfdt[1] = 0;

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_brusselator = {
  rhs_brusselator,
  jac_brusselator,
  2,
  0
};

/* Ring Modulator, stiff ODE of dimension 15.

   Reference: Walter M. Lioen, Jacques J.B. de Swart, Test Set for
   Initial Value Problem Solvers, Release 2.1 September 1999,
   http://ftp.cwi.nl/IVPtestset/software.htm
 */

#define NRINGMOD 15

int
rhs_ringmod (double t, const double y[], double f[], void *params)
{
  const double c = 1.6e-8;
  const double cs = 2e-12;
  const double cp = 1e-8;
  const double r = 25e3;
  const double rp = 50e0;
  const double lh = 4.45e0;
  const double ls1 = 2e-3;
  const double ls2 = 5e-4;
  const double ls3 = 5e-4;
  const double rg1 = 36.3;
  const double rg2 = 17.3;
  const double rg3 = 17.3;
  const double ri = 5e1;
  const double rc = 6e2;
  const double gamma = 40.67286402e-9;
  const double delta = 17.7493332;
  const double pi = 3.141592653589793238462643383;

  const double uin1 = 0.5 * sin (2e3 * pi * t);
  const double uin2 = 2 * sin (2e4 * pi * t);
  const double ud1 = +y[2] - y[4] - y[6] - uin2;
  const double ud2 = -y[3] + y[5] - y[6] - uin2;
  const double ud3 = +y[3] + y[4] + y[6] + uin2;
  const double ud4 = -y[2] - y[5] + y[6] + uin2;

  const double qud1 = gamma * (exp (delta * ud1) - 1.0);
  const double qud2 = gamma * (exp (delta * ud2) - 1.0);
  const double qud3 = gamma * (exp (delta * ud3) - 1.0);
  const double qud4 = gamma * (exp (delta * ud4) - 1.0);

  extern int nfe;
  nfe += 1;

  f[0] = (y[7] - 0.5 * y[9] + 0.5 * y[10] + y[13] - y[0] / r) / c;
  f[1] = (y[8] - 0.5 * y[11] + 0.5 * y[12] + y[14] - y[1] / r) / c;
  f[2] = (y[9] - qud1 + qud4) / cs;
  f[3] = (-y[10] + qud2 - qud3) / cs;
  f[4] = (y[11] + qud1 - qud3) / cs;
  f[5] = (-y[12] - qud2 + qud4) / cs;
  f[6] = (-y[6] / rp + qud1 + qud2 - qud3 - qud4) / cp;
  f[7] = -y[0] / lh;
  f[8] = -y[1] / lh;
  f[9] = (0.5 * y[0] - y[2] - rg2 * y[9]) / ls2;
  f[10] = (-0.5 * y[0] + y[3] - rg3 * y[10]) / ls3;
  f[11] = (0.5 * y[1] - y[4] - rg2 * y[11]) / ls2;
  f[12] = (-0.5 * y[1] + y[5] - rg3 * y[12]) / ls3;
  f[13] = (-y[0] + uin1 - (ri + rg1) * y[13]) / ls1;
  f[14] = (-y[1] - (rc + rg1) * y[14]) / ls1;

  return GSL_SUCCESS;
}

int
jac_ringmod (double t, const double y[], double *dfdy, double dfdt[],
             void *params)
{
  const double c = 1.6e-8;
  const double cs = 2e-12;
  const double cp = 1e-8;
  const double r = 25e3;
  const double rp = 50e0;
  const double lh = 4.45e0;
  const double ls1 = 2e-3;
  const double ls2 = 5e-4;
  const double ls3 = 5e-4;
  const double rg1 = 36.3;
  const double rg2 = 17.3;
  const double rg3 = 17.3;
  const double ri = 5e1;
  const double rc = 6e2;
  const double gamma = 40.67286402e-9;
  const double delta = 17.7493332;
  const double pi = 3.141592653589793238462643383;

  const double uin2 = 2 * sin (2e4 * pi * t);
  const double ud1 = +y[2] - y[4] - y[6] - uin2;
  const double ud2 = -y[3] + y[5] - y[6] - uin2;
  const double ud3 = +y[3] + y[4] + y[6] + uin2;
  const double ud4 = -y[2] - y[5] + y[6] + uin2;
  const double qpud1 = gamma * delta * exp (delta * ud1);
  const double qpud2 = gamma * delta * exp (delta * ud2);
  const double qpud3 = gamma * delta * exp (delta * ud3);
  const double qpud4 = gamma * delta * exp (delta * ud4);

  extern int nje;
  size_t i;

  nje += 1;

  for (i = 0; i < NRINGMOD * NRINGMOD; i++)
    {
      dfdy[i] = 0.0;
    }

  dfdy[0 * NRINGMOD + 0] = -1 / (c * r);
  dfdy[0 * NRINGMOD + 7] = 1 / c;
  dfdy[0 * NRINGMOD + 9] = -0.5 / c;
  dfdy[0 * NRINGMOD + 10] = -dfdy[0 * NRINGMOD + 9];
  dfdy[0 * NRINGMOD + 13] = dfdy[0 * NRINGMOD + 7];
  dfdy[1 * NRINGMOD + 1] = dfdy[0 * NRINGMOD + 0];
  dfdy[1 * NRINGMOD + 8] = dfdy[0 * NRINGMOD + 7];
  dfdy[1 * NRINGMOD + 11] = dfdy[0 * NRINGMOD + 9];
  dfdy[1 * NRINGMOD + 12] = dfdy[0 * NRINGMOD + 10];
  dfdy[1 * NRINGMOD + 14] = dfdy[0 * NRINGMOD + 13];
  dfdy[2 * NRINGMOD + 2] = (-qpud1 - qpud4) / cs;
  dfdy[2 * NRINGMOD + 4] = qpud1 / cs;
  dfdy[2 * NRINGMOD + 5] = -qpud4 / cs;
  dfdy[2 * NRINGMOD + 6] = (qpud1 + qpud4) / cs;
  dfdy[2 * NRINGMOD + 9] = 1 / cs;
  dfdy[3 * NRINGMOD + 3] = (-qpud2 - qpud3) / cs;
  dfdy[3 * NRINGMOD + 4] = -qpud3 / cs;
  dfdy[3 * NRINGMOD + 5] = qpud2 / cs;
  dfdy[3 * NRINGMOD + 6] = (-qpud2 - qpud3) / cs;
  dfdy[3 * NRINGMOD + 10] = -1 / cs;
  dfdy[4 * NRINGMOD + 2] = qpud1 / cs;
  dfdy[4 * NRINGMOD + 3] = -qpud3 / cs;
  dfdy[4 * NRINGMOD + 4] = (-qpud1 - qpud3) / cs;
  dfdy[4 * NRINGMOD + 6] = (-qpud1 - qpud3) / cs;
  dfdy[4 * NRINGMOD + 11] = 1 / cs;
  dfdy[5 * NRINGMOD + 2] = -qpud4 / cs;
  dfdy[5 * NRINGMOD + 3] = qpud2 / cs;
  dfdy[5 * NRINGMOD + 5] = (-qpud2 - qpud4) / cs;
  dfdy[5 * NRINGMOD + 6] = (qpud2 + qpud4) / cs;
  dfdy[5 * NRINGMOD + 12] = -1 / cs;
  dfdy[6 * NRINGMOD + 2] = (qpud1 + qpud4) / cp;
  dfdy[6 * NRINGMOD + 3] = (-qpud2 - qpud3) / cp;
  dfdy[6 * NRINGMOD + 4] = (-qpud1 - qpud3) / cp;
  dfdy[6 * NRINGMOD + 5] = (qpud2 + qpud4) / cp;
  dfdy[6 * NRINGMOD + 6] = (-qpud1 - qpud2 - qpud3 - qpud4 - 1 / rp) / cp;
  dfdy[7 * NRINGMOD + 0] = -1 / lh;
  dfdy[8 * NRINGMOD + 1] = dfdy[7 * NRINGMOD + 0];
  dfdy[9 * NRINGMOD + 0] = 0.5 / ls2;
  dfdy[9 * NRINGMOD + 2] = -1 / ls2;
  dfdy[9 * NRINGMOD + 9] = -rg2 / ls2;
  dfdy[10 * NRINGMOD + 0] = -0.5 / ls3;
  dfdy[10 * NRINGMOD + 3] = 1 / ls3;
  dfdy[10 * NRINGMOD + 10] = -rg3 / ls3;
  dfdy[11 * NRINGMOD + 1] = dfdy[9 * NRINGMOD + 0];
  dfdy[11 * NRINGMOD + 4] = dfdy[9 * NRINGMOD + 2];
  dfdy[11 * NRINGMOD + 11] = dfdy[9 * NRINGMOD + 9];
  dfdy[12 * NRINGMOD + 1] = dfdy[10 * NRINGMOD + 0];
  dfdy[12 * NRINGMOD + 5] = dfdy[10 * NRINGMOD + 3];
  dfdy[12 * NRINGMOD + 12] = dfdy[10 * NRINGMOD + 10];
  dfdy[13 * NRINGMOD + 0] = -1 / ls1;
  dfdy[13 * NRINGMOD + 13] = -(ri + rg1) / ls1;
  dfdy[14 * NRINGMOD + 1] = dfdy[13 * NRINGMOD + 0];
  dfdy[14 * NRINGMOD + 14] = -(rc + rg1) / ls1;

  for (i = 0; i < NRINGMOD; i++)
    {
      dfdt[i] = 0.0;
    }

  return GSL_SUCCESS;
}

gsl_odeiv2_system rhs_func_ringmod = {
  rhs_ringmod,
  jac_ringmod,
  NRINGMOD,
  NULL
};

/**********************************************************/
/* Functions for carrying out tests                       */
/**********************************************************/

void
test_odeiv_stepper (const gsl_odeiv2_step_type * T,
                    const gsl_odeiv2_system * sys, const double h,
                    const double t, const char desc[], const double ystart[],
                    const double yfin[], const double relerr)
{
  /* tests stepper T with one fixed length step advance of system sys
     and compares the result with given values yfin
   */

  double y[MAXEQ] = { 0.0 };
  double yerr[MAXEQ] = { 0.0 };
  double scale_abs[MAXEQ];
  size_t ne = sys->dimension;
  size_t i;
  gsl_odeiv2_driver *d;

  for (i = 0; i < MAXEQ; i++)
    {
      scale_abs[i] = 1.0;
    }

  d = gsl_odeiv2_driver_alloc_scaled_new (sys, T, h, relerr, relerr,
                                          1.0, 0.0, scale_abs);

  DBL_MEMCPY (y, ystart, MAXEQ);

  {
    int s = gsl_odeiv2_step_apply (d->s, t, h, y, yerr, 0, 0, sys);

    if (s != GSL_SUCCESS)
      {
        gsl_test (s, "test_odeiv_stepper: %s step_apply returned %d", desc,
                  s);
      }
  }

  for (i = 0; i < ne; i++)
    {
      gsl_test_rel (y[i], yfin[i], relerr,
                    "%s %s step(%d)", gsl_odeiv2_step_name (d->s), desc, i);
    }

  gsl_odeiv2_driver_free (d);
}

void
test_stepper (const gsl_odeiv2_step_type * T)
{
  /* Tests stepper T with a step of selected systems */

  double y[MAXEQ] = { 0.0 };
  double yfin[MAXEQ] = { 0.0 };

  /* Step length */
  double h;

  /* Required tolerance */
  double err_target;

  /* classic stiff */
  h = 1e-7;
  err_target = 1e-4;
  y[0] = 1.0;
  y[1] = 0.0;

  {
    const double e1 = exp (-h);
    const double e2 = exp (-1000.0 * h);
    yfin[0] = 2.0 * e1 - e2;
    yfin[1] = -e1 + e2;
  }

  test_odeiv_stepper (T, &rhs_func_stiff, h, 0.0, "classic_stiff",
                      y, yfin, err_target);

  /* linear */
  h = 1e-1;
  err_target = 1e-10;
  y[0] = 0.58;
  yfin[0] = y[0] + 2 * h;
  test_odeiv_stepper (T, &rhs_func_lin, h, 0.0, "linear",
                      y, yfin, err_target);

  /* exponential */
  h = 1e-4;
  err_target = 1e-8;
  y[0] = exp (2.7);
  yfin[0] = exp (2.7 + h);
  test_odeiv_stepper (T, &rhs_func_exp, h, 2.7, "exponential",
                      y, yfin, err_target);
  /* cosine-sine */
  h = 1e-3;
  err_target = 1e-6;
  y[0] = cos (1.2);
  y[1] = sin (1.2);
  yfin[0] = cos (1.2 + h);
  yfin[1] = sin (1.2 + h);
  test_odeiv_stepper (T, &rhs_func_sin, h, 1.2, "cosine-sine",
                      y, yfin, err_target);
}

void
test_evolve_system (const gsl_odeiv2_step_type * T,
                    const gsl_odeiv2_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_odeiv2_driver *d =
    gsl_odeiv2_driver_alloc_standard_new (sys, T, h, err_target, err_target,
                                          1.0, 0.0);

  double *y_orig = (double *) malloc (sys->dimension * sizeof (double));

  int s = 0;

  extern int nfe, nje;
  nfe = 0;
  nje = 0;

  while (t < t1)
    {
      double t_orig = t;
      memcpy (y_orig, y, sys->dimension * sizeof (double));
      s = gsl_odeiv2_evolve_apply (d->e, d->c, d->s, sys, &t, t1, &h, y);

#ifdef DEBUG
      printf ("test_evolve_system at: %.5e %.5e %.5e %d\n", t, y[0], y[1],
              gsl_odeiv2_step_order (d->s));
#endif

      if (s != GSL_SUCCESS)
        {
          /* check that t and y are unchanged */
          gsl_test_abs (t, t_orig, 0.0, "%s t must be restored on failure",
                        gsl_odeiv2_step_name (d->s));

          for (i = 0; i < sys->dimension; i++)
            {
              gsl_test_abs (y[i], y_orig[i], 0.0,
                            "%s y must be restored on failure",
                            gsl_odeiv2_step_name (d->s), desc, i);
            }

          if (sys != &rhs_func_xsin)
            {
              /* apart from xsin, other functions should not return errors */
              gsl_test (s, "%s evolve_apply returned %d",
                        gsl_odeiv2_step_name (d->s), s);
              break;
            }
        }

      if (steps > 100000)
        {
          gsl_test (GSL_EFAILED,
                    "%s evolve_apply reached maxiter",
                    gsl_odeiv2_step_name (d->s));
          break;
        }

      steps++;
    }

  gsl_test (s, "%s %s [%g,%g], %d steps (nfe %d, nje %d) completed",
            gsl_odeiv2_step_name (d->s), desc, t0, t1, steps, nfe, nje);

  /* 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 * d->e->count * err_target,
                    "%s %s evolve(%d)", gsl_odeiv2_step_name (d->s), desc, i);
    }

  free (y_orig);
  gsl_odeiv2_driver_free (d);
}

int
sys_driver (const gsl_odeiv2_step_type * T,
            const gsl_odeiv2_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_odeiv2_driver *d =
    gsl_odeiv2_driver_alloc_standard_new (sys, T, h, epsabs, epsrel,
                                          1.0, 0.0);

  extern int nfe, nje;
  nfe = 0;
  nje = 0;

  while (t < t1)
    {
      s = gsl_odeiv2_evolve_apply (d->e, d->c, d->s, sys, &t, t1, &h, y);

#ifdef DEBUG
      printf ("sys_driver at: %.5e %.5e %.5e %d\n", t, y[0], y[1],
              gsl_odeiv2_step_order (d->s));
#endif

      if (s != GSL_SUCCESS)
        {
          gsl_test (s, "sys_driver: %s evolve_apply returned %d",
                    gsl_odeiv2_step_name (d->s), s);
          break;
        }

      if (steps > 1e7)
        {
          gsl_test (GSL_EMAXITER,
                    "sys_driver: %s evolve_apply reached maxiter at t=%g",
                    gsl_odeiv2_step_name (d->s), t);
          s = GSL_EMAXITER;
          break;
        }

      steps++;
    }

  gsl_test (s, "%s %s [%g,%g], %d steps (nfe %d, nje %d) completed",
            gsl_odeiv2_step_name (d->s), desc, t0, t1, steps, nfe, nje);

  gsl_odeiv2_driver_free (d);

  return s;
}

void
test_evolve_linear (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test linear evolve */

  double y[1];
  double yfin[1];

  y[0] = 1.0;
  yfin[0] = 9.0;
  test_evolve_system (T, &rhs_func_lin, 0.0, 4.0, h, y, yfin, err,
                      "linear[0,4]");
}

void
test_evolve_exp (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test exponential evolve */

  double y[1];
  double yfin[1];

  y[0] = 1.0;
  yfin[0] = exp (2.0);
  test_evolve_system (T, &rhs_func_exp, 0.0, 2.0, h, y, yfin, err,
                      "exp[0,2]");
}

void
test_evolve_sin (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test sinusoidal evolve */

  double y[2];
  double yfin[2];

  y[0] = 1.0;
  y[1] = 0.0;
  yfin[0] = cos (2.0);
  yfin[1] = sin (2.0);
  test_evolve_system (T, &rhs_func_sin, 0.0, 2.0, h, y, yfin, err,
                      "sine[0,2]");
}

void
test_evolve_xsin (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test sinusoidal evolve including a failing window */

  double y[2];
  double yfin[2];

  y[0] = 1.0;
  y[1] = 0.0;
  yfin[0] = cos (2.0);
  yfin[1] = sin (2.0);
  rhs_xsin_reset = 1;
  jac_xsin_reset = 1;
  test_evolve_system (T, &rhs_func_xsin, 0.0, 2.0, h, y, yfin, err,
                      "sine[0,2] w/errors");
}

void
test_evolve_stiff1 (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test classical stiff problem evolve, t=[0,1] */

  double y[2];
  double yfin[2];

  y[0] = 1.0;
  y[1] = 0.0;
  {
    double arg = 1.0;
    double e1 = exp (-arg);
    double e2 = exp (-1000.0 * arg);
    yfin[0] = 2.0 * e1 - e2;
    yfin[1] = -e1 + e2;
  }
  test_evolve_system (T, &rhs_func_stiff, 0.0, 1.0, h, y, yfin, err,
                      "stiff[0,1]");
}

void
test_evolve_stiff5 (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test classical stiff problem evolve, t=[0,5] */

  double y[2];
  double yfin[2];

  y[0] = 1.0;
  y[1] = 0.0;
  {
    double arg = 5.0;
    double e1 = exp (-arg);
    double e2 = exp (-1000.0 * arg);
    yfin[0] = 2.0 * e1 - e2;
    yfin[1] = -e1 + e2;
  }
  test_evolve_system (T, &rhs_func_stiff, 0.0, 5.0, h, y, yfin, err,
                      "stiff[0,5]");
}

void
test_evolve_negative_h (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Test evolution in negative direction */

  /* Tolerance factor in testing errors */
  const double factor = 10;

  const gsl_odeiv2_system sys = rhs_func_cos;

  double t = 0;
  double t1 = -4.0;

  double y = 0.0;
  double yfin = sin (t1);
  gsl_odeiv2_driver *d;

  /* Make initial h negative */
  h = -fabs (h);
  d = gsl_odeiv2_driver_alloc_standard_new (&sys, T, h, err, err, 1.0, 0.0);

  while (t > t1)
    {
      int status = gsl_odeiv2_evolve_apply (d->e, d->c, d->s,
                                            &sys, &t, t1, &h, &y);

      if (status != GSL_SUCCESS)
        {
          gsl_test (status, "%s evolve_apply returned %d for negative h",
                    gsl_odeiv2_step_name (d->s), status);
          break;
        }
    }

  gsl_test_abs (y, yfin, factor * d->e->count * err,
                "%s evolution with negative h", gsl_odeiv2_step_name (d->s));

  gsl_odeiv2_driver_free (d);
}

void
test_broken (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Check for gsl_odeiv2_evolve_apply. The user function fails at
     t>=10, which in this test causes step size to decrease below
     machine precision and return with a failure code.
   */

  /* Tolerance factor in testing errors */
  const double factor = 10;

  const gsl_odeiv2_system sys = rhs_func_broken;

  gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new (&sys, T, h, err, err);

  double t = 0;
  double t1 = 100.0;

  double y = 0.0;
  const double final_max_h = GSL_DBL_EPSILON;

  int status;
  while (t < t1)
    {
      status =
        gsl_odeiv2_evolve_apply (d->e, d->c, d->s, &sys, &t, t1, &h, &y);

      if (status != GSL_SUCCESS)
        {
          break;
        }
    }

  gsl_test_abs (h + final_max_h, final_max_h, factor * final_max_h,
                "%s test_broken: step size at break point",
                gsl_odeiv2_step_name (d->s));

  gsl_test_abs (t, 10.0, factor * err,
                "%s test_broken: point of break",
                gsl_odeiv2_step_name (d->s));

  /* GSL_FAILURE results from stepper failure, 123 from user function */

  if (status != GSL_FAILURE && status != 123)
    {
      gsl_test (status, "%s test_broken: evolve return value %d",
                gsl_odeiv2_step_name (d->s), status);
    }
  else
    {
      gsl_test (GSL_SUCCESS, "%s test_broken: evolve return value %d",
                gsl_odeiv2_step_name (d->s), status);
    }

  gsl_odeiv2_driver_free (d);
}

void
test_stepsize_fail (const gsl_odeiv2_step_type * T, double h)
{
  /* Check for gsl_odeiv2_evolve_apply. The user function works
     apparently fine (returns GSL_SUCCESS) but is faulty in this case.
     gsl_odeiv2_evolve_apply therefore decreases the step-size below
     machine precision and therefore stops with GSL_FAILURE.
   */

  /* Error tolerance */
  const double epsabs = 1e-16;
  const double epsrel = 1e-6;

  /* Tolerance factor in testing errors */
  const double factor = 10;

  const double final_max_h = GSL_DBL_EPSILON;
  const gsl_odeiv2_system sys = rhs_func_br;

  gsl_odeiv2_driver *d =
    gsl_odeiv2_driver_alloc_y_new (&sys, T, h, epsabs, epsrel);

  double t = 1.0;
  double t1 = 1e5;
  double y = 0.0;
  int status;

  while (t < t1)
    {
      status =
        gsl_odeiv2_evolve_apply (d->e, d->c, d->s, &sys, &t, t1, &h, &y);

      if (status != GSL_SUCCESS)
        {
          break;
        }
    }

  gsl_test_abs (h + final_max_h, final_max_h, factor * final_max_h,
                "%s test_stepsize_fail: step size at break point",
                gsl_odeiv2_step_name (d->s));

  gsl_test_abs (t, 1.0, 1e-6,
                "%s test_stepsize_fail: point of break",
                gsl_odeiv2_step_name (d->s));

  gsl_test_int (status, GSL_FAILURE,
                "%s test_stepsize_fail: evolve return value",
                gsl_odeiv2_step_name (d->s));

  gsl_odeiv2_driver_free (d);
}

void
test_user_break (const gsl_odeiv2_step_type * T, double h)
{
  /* Tests for user signaled immediate break */

  const double tol = 1e-8;

  gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new (&rhs_func_sin_ub, T,
                                                        h, tol, tol);

  double y[] = { 1.0, 0.0 };
  double t = 0.0;
  const double t1 = 8.25;

  int s = gsl_odeiv2_driver_apply (d, &t, t1, y);

  gsl_test ((s - GSL_EBADFUNC), "%s test_user_break returned %d",
            gsl_odeiv2_step_name (d->s), s);

  gsl_odeiv2_driver_free (d);
}

void
test_stepfn (const gsl_odeiv2_step_type * T)
{
  /* Test evolve on a small derivative change at t=0 */

  double epsabs = 1e-16;
  double epsrel = 1e-6;

  const gsl_odeiv2_system sys = rhs_func_stepfn;

  double t = 0.0;
  double h = 1e-6;
  double y = 0.0;
  int i = 0;
  int status = 0;

  gsl_odeiv2_driver *d =
    gsl_odeiv2_driver_alloc_y_new (&sys, T, h, epsabs, epsrel);

  while (t < 2 && i < 1000000)
    {
      status =
        gsl_odeiv2_evolve_apply (d->e, d->c, d->s, &sys, &t, 2, &h, &y);
#ifdef DEBUG
      printf ("test_stepfn at: i=%d status=%d t=%g h=%g y=%g\n",
			  i, status, t, h, y);
#endif

      if (status != GSL_SUCCESS)
        break;

      i++;
    }

  gsl_test (status, "evolve step function, return value (stepfn/%s): %d",
            gsl_odeiv2_step_name (d->s), status);

  gsl_test_abs (t, 2, 1e-16, "evolve step function, t (stepfn/%s)",
                gsl_odeiv2_step_name (d->s));

  gsl_test_rel (y, 1, epsrel, "evolve step function, y (stepfn/%s)",
                gsl_odeiv2_step_name (d->s));

  gsl_odeiv2_driver_free (d);
}

void
test_stepfn2 (const gsl_odeiv2_step_type * T)
{
  /* Test evolve on a large derivative change at t=0 */

  double epsabs = 1e-16;
  double epsrel = 1e-6;

  const gsl_odeiv2_system sys = rhs_func_stepfn2;

  double t = -1.0;
  double h = 1e-6;
  double y = 0.0;

  int i = 0;
  int status;
  const int maxiter = 100000;

  gsl_odeiv2_driver *d =
    gsl_odeiv2_driver_alloc_yp_new (&sys, T, h, epsabs, epsrel);

  while (t < 1.0 && i < maxiter)
    {
      status =
        gsl_odeiv2_evolve_apply (d->e, d->c, d->s, &sys, &t, 1.0, &h, &y);
#ifdef DEBUG
      printf ("test_stepfn2 at: i=%d status=%d t=%g h=%g y=%g\n",
			  i, status, t, h, y);
#endif
      if (status != GSL_SUCCESS)
        break;

      i++;
    }

  if (i >= maxiter)
    printf ("FAIL: evolve big step function, (stepfn2/%s) reached maxiter\n",
            gsl_odeiv2_step_name (d->s));

  gsl_test_abs (t, 1.0, 1e-16, "evolve big step function, t (stepfn2/%s)",
                gsl_odeiv2_step_name (d->s));
  gsl_test_rel (y, 1e300, epsrel, "evolve big step function, y (stepfn2/%s)",
                gsl_odeiv2_step_name (d->s));

  gsl_odeiv2_driver_free (d);
}

void
test_nonstiff_problems (void)
{
  /* Compares output of non-stiff (or only moderately stiff) problems
     with several steppers
   */

  const gsl_odeiv2_step_type *steppers[MAXNS];

  /* Required error tolerance for each stepper. */
  double err_target[MAXNS];

  /* initial values for each ode-solver */
  double y[MAXEQ * MAXNS];

  size_t i, k, p;

  /* Number of problems to test */
#define CONST_NONSTIFF_NPROB 4

  /* Problems, their names and number of equations */
  const gsl_odeiv2_system *prob[] =
    { &rhs_func_vl, &rhs_func_vanderpol, &rhs_func_stifftrig,
    &rhs_func_brusselator
  };
  const char *probname[] =
    { "volterra-lotka", "vanderpol", "stifftrig", "brusselator" };
  const size_t sd[] = { 2, 2, 1, 2 };

  /* Integration interval for problems */
  const double start[CONST_NONSTIFF_NPROB] = { 0.0 };
  const double end[] = { 9.0, 100.0, 1.5, 20.0 };

  const double epsabs = 1e-8;
  const double epsrel = 1e-8;
  const double initstepsize = 1e-5;

  /* Steppers */

  steppers[0] = gsl_odeiv2_step_rk4;
  err_target[0] = 1e-6;
  steppers[1] = gsl_odeiv2_step_rk2;
  err_target[1] = 1e-6;
  steppers[2] = gsl_odeiv2_step_rkf45;
  err_target[2] = 1e-6;
  steppers[3] = gsl_odeiv2_step_rkck;
  err_target[3] = 1e-6;
  steppers[4] = gsl_odeiv2_step_rk8pd;
  err_target[4] = 1e-6;
  steppers[5] = gsl_odeiv2_step_rk1imp;
  err_target[5] = 1e-3;
  steppers[6] = gsl_odeiv2_step_rk2imp;
  err_target[6] = 1e-5;
  steppers[7] = gsl_odeiv2_step_rk4imp;
  err_target[7] = 1e-6;
  steppers[8] = gsl_odeiv2_step_bsimp;
  err_target[8] = 1e-6;
  steppers[9] = gsl_odeiv2_step_msadams;
  err_target[9] = 1e-5;
  steppers[10] = gsl_odeiv2_step_msbdf;
  err_target[10] = 1e-5;
  steppers[11] = 0;

  /* Loop over problems */

  for (p = 0; p < CONST_NONSTIFF_NPROB; p++)
    {
      /* Initialize */

      for (i = 0; i < MAXNS * MAXEQ; i++)
        {
          y[i] = 0.0;
        }

      for (i = 0; i < MAXNS; i++)
        {
          switch (p)
            {
            case 0:
              y[i * sd[p]] = 2.725;
              y[i * sd[p] + 1] = 1.0;
              break;
            case 1:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 0.0;
              break;
            case 2:
              y[i * sd[p]] = 0.0;
              break;
            case 3:
              y[i * sd[p]] = 1.5;
              y[i * sd[p] + 1] = 3.0;
              break;
            default:
              gsl_test (GSL_EFAILED,
                        "test_nonstiff_problems: initialization error\n");
              return;
            }
        }

      /* Call each solver for the problem */

      for (i = 0; steppers[i] != 0; i++)
        {
          int s = sys_driver (steppers[i], prob[p], start[p], end[p],
                              initstepsize, &y[sd[p] * i],
                              epsabs, epsrel, probname[p]);

          if (s != GSL_SUCCESS)
            {
              gsl_test (s, "test_nonstiff_problems %s %s",
                        steppers[i]->name, probname[p]);
            }
        }

      /* Compare results */

      for (i = 1; steppers[i] != 0; i++)
        for (k = 0; k < sd[p]; k++)
          {
            const double val1 = y[k];
            const double val2 = y[sd[p] * i + k];
            gsl_test_rel (val1, val2,
                          (GSL_MAX (err_target[0], err_target[i])),
                          "%s/%s %s [%d]",
                          steppers[0]->name, steppers[i]->name,
                          probname[p], k);
          }
    }
}

void
test_stiff_problems (void)
{
  /* Compares output of stiff problems with several steppers */

  const gsl_odeiv2_step_type *steppers[MAXNS];

  /* Required error tolerance for each stepper. */
  double err_target[MAXNS];

  /* initial values for each ode-solver */
  double y[MAXEQ * MAXNS];

  size_t i, k, p;

  /* Number of problems to test */
#define CONST_STIFF_NPROB 3

  /* Problems, their names and number of equations */
  const gsl_odeiv2_system *prob[] =
    { &rhs_func_oregonator, &rhs_func_e5, &rhs_func_robertson };
  const char *probname[] = { "oregonator", "e5", "robertson" };
  const size_t sd[] = { 3, 4, 3 };

  /* Integration interval for problems */
  const double start[CONST_STIFF_NPROB] = { 0.0 };
  const double end[] = { 360.0, 1e4, 1e4 };

  const double epsabs = 1e-40;
  const double epsrel = 1e-7;
  const double initstepsize = 1e-5;

  /* Steppers */

  steppers[0] = gsl_odeiv2_step_bsimp;
  err_target[0] = 1e-6;
  steppers[1] = gsl_odeiv2_step_rk1imp;
  err_target[1] = 5e-3;
  steppers[2] = gsl_odeiv2_step_rk2imp;
  err_target[2] = 5e-5;
  steppers[3] = gsl_odeiv2_step_rk4imp;
  err_target[3] = 5e-5;
  steppers[4] = gsl_odeiv2_step_msbdf;
  err_target[4] = 1e-4;
  steppers[5] = 0;

  /* Loop over problems */

  for (p = 0; p < CONST_STIFF_NPROB; p++)
    {
      /* Initialize */

      for (i = 0; i < MAXNS * MAXEQ; i++)
        {
          y[i] = 0.0;
        }

      for (i = 0; i < MAXNS; i++)
        {
          switch (p)
            {
            case 0:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 2.0;
              y[i * sd[p] + 2] = 3.0;
              break;
            case 1:
              y[i * sd[p]] = 1.76e-3;
              y[i * sd[p] + 1] = 0.0;
              y[i * sd[p] + 2] = 0.0;
              y[i * sd[p] + 3] = 0.0;
              break;
            case 2:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 0.0;
              y[i * sd[p] + 2] = 0.0;
              break;
            default:
              gsl_test (GSL_EFAILED,
                        "test_stiff_problems: initialization error\n");
              return;
            }
        }

      /* Call each solver for the problem */

      for (i = 0; steppers[i] != 0; i++)
        {
          int s = sys_driver (steppers[i], prob[p], start[p], end[p],
                              initstepsize, &y[sd[p] * i],
                              epsabs, epsrel, probname[p]);

          if (s != GSL_SUCCESS)
            {
              gsl_test (s, "test_stiff_problems %s %s",
                        steppers[i]->name, probname[p]);
            }
        }

      /* Compare results */

      for (i = 1; steppers[i] != 0; i++)
        for (k = 0; k < sd[p]; k++)
          {
            const double val1 = y[k];
            const double val2 = y[sd[p] * i + k];
            gsl_test_rel (val1, val2,
                          (GSL_MAX (err_target[0], err_target[i])),
                          "%s/%s %s [%d]",
                          steppers[0]->name, steppers[i]->name,
                          probname[p], k);
          }
    }
}

void
test_extreme_problems (void)
{
  /* Compares output of numerically particularly demanding problems
     with several steppers */

  const gsl_odeiv2_step_type *steppers[MAXNS];

  /* Required error tolerance for each stepper. */
  double err_target[MAXNS];

  /* initial values for each ode-solver */
  double y[MAXEQ * MAXNS];

  size_t i, k, p;

  /* Number of problems to test */
#define CONST_EXTREME_NPROB 3

  /* Problems, their names and number of equations */
  const gsl_odeiv2_system *prob[] =
    { &rhs_func_e5, &rhs_func_robertson, &rhs_func_ringmod };
  const char *probname[] = { "e5_bigt", "robertson_bigt", "ringmod" };
  const size_t sd[] = { 4, 3, NRINGMOD };

  /* Integration interval for problems */

  const double start[CONST_EXTREME_NPROB] = { 0.0 };
  const double end[CONST_EXTREME_NPROB] = { 1e11, 1e11, 1e-5 };

  const double epsabs[CONST_EXTREME_NPROB] =
    { 1e1 * GSL_DBL_MIN, 1e1 * GSL_DBL_MIN, 1e-12 };
  const double epsrel[CONST_EXTREME_NPROB] = { 1e-12, 1e-12, 1e-12 };
  const double initstepsize[CONST_EXTREME_NPROB] = { 1e-5, 1e-5, 1e-10 };

  /* Steppers */

  steppers[0] = gsl_odeiv2_step_bsimp;
  err_target[0] = 1e-3;
  steppers[1] = gsl_odeiv2_step_msbdf;
  err_target[1] = 1e-3;
  steppers[2] = 0;

  /* Loop over problems */

  for (p = 0; p < CONST_EXTREME_NPROB; p++)
    {
      /* Initialize */

      for (i = 0; i < MAXNS * MAXEQ; i++)
        {
          y[i] = 0.0;
        }

      for (i = 0; i < MAXNS; i++)
        {
          switch (p)
            {
            case 0:
              y[i * sd[p]] = 1.76e-3;
              y[i * sd[p] + 1] = 0.0;
              y[i * sd[p] + 2] = 0.0;
              y[i * sd[p] + 3] = 0.0;
              break;
            case 1:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 0.0;
              y[i * sd[p] + 2] = 0.0;
              break;
            case 2:
              {
                size_t j;
                for (j = 0; j < NRINGMOD; j++)
                  {
                    y[i * sd[p] + j] = 0.0;
                  }
              }
              break;
            default:
              gsl_test (GSL_EFAILED,
                        "test_extreme_problems: initialization error\n");
              return;
            }
        }

      /* Call each solver for the problem */

      for (i = 0; steppers[i] != 0; i++)
        {
          int s = sys_driver (steppers[i], prob[p], start[p], end[p],
                              initstepsize[p], &y[sd[p] * i],
                              epsabs[p], epsrel[p], probname[p]);

          if (s != GSL_SUCCESS)
            {
              printf ("start=%.5e, initstepsize=%.5e\n", start[p],
                      initstepsize[p]);
              gsl_test (s, "test_extreme_problems %s %s", steppers[i]->name,
                        probname[p]);
            }
        }

      /* Compare results */

      for (i = 1; steppers[i] != 0; i++)
        for (k = 0; k < sd[p]; k++)
          {
            const double val1 = y[k];
            const double val2 = y[sd[p] * i + k];
            gsl_test_rel (val1, val2,
                          (GSL_MAX (err_target[0], err_target[i])),
                          "%s/%s %s [%d]",
                          steppers[0]->name, steppers[i]->name,
                          probname[p], k);
          }
    }
}

void
test_driver (const gsl_odeiv2_step_type * T)
{
  /* Tests for gsl_odeiv2_driver object */

  int s;
  const double tol = 1e-8;
  const double hmax = 1e-2;

  double y[] = { 1.0, 0.0 };
  double t = 0.0;
  const double tinit = 0.0;
  const double t1 = 8.25;
  const double t2 = 100;
  const double t3 = -2.5;
  const size_t minsteps = ceil (t1 / hmax);
  const size_t maxsteps = 20;
  const double hmin = 1e-10;

  const unsigned long int nfsteps = 100000;
  const double hfixed = 0.000025;

  gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new (&rhs_func_sin, T,
                                                        1e-3, tol, tol);
  gsl_odeiv2_driver_set_hmax (d, hmax);

  s = gsl_odeiv2_driver_apply (d, &t, t1, y);

  if (s != GSL_SUCCESS)
    {
      gsl_test (s, "%s test_driver apply returned %d",
                gsl_odeiv2_step_name (d->s), s);
    }

  /* Test that result is correct */

  gsl_test_rel (y[0], cos (t1), d->n * tol, "%s test_driver y0",
                gsl_odeiv2_step_name (d->s));
  gsl_test_rel (y[1], sin (t1), d->n * tol, "%s test_driver y1",
                gsl_odeiv2_step_name (d->s));

  /* Test that maximum step length is obeyed */

  if (d->n < minsteps)
    {
      gsl_test (1, "%s test_driver steps %d < minsteps %d \n",
                gsl_odeiv2_step_name (d->s), d->n, minsteps);
    }
  else
    {
      gsl_test (0, "%s test_driver max step length test",
                gsl_odeiv2_step_name (d->s));
    }

  /* Test changing integration direction from forward to backward */

  gsl_odeiv2_driver_reset_hstart (d, -1e-3);

  s = gsl_odeiv2_driver_apply (d, &t, tinit, y);

  if (s != GSL_SUCCESS)
    {
      gsl_test (s, "%s test_driver apply returned %d",
                gsl_odeiv2_step_name (d->s), s);
    }

  gsl_test_rel (y[0], cos (tinit), d->n * tol,
                "%s test_driver y0", gsl_odeiv2_step_name (d->s));
  gsl_test_rel (y[1], sin (tinit), d->n * tol,
                "%s test_driver y1", gsl_odeiv2_step_name (d->s));

  gsl_odeiv2_driver_free (d);

  /* Test that maximum number of steps is obeyed */

  d = gsl_odeiv2_driver_alloc_y_new (&rhs_func_sin, T, 1e-3, tol, tol);
  gsl_odeiv2_driver_set_hmax (d, hmax);
  gsl_odeiv2_driver_set_nmax (d, maxsteps);

  s = gsl_odeiv2_driver_apply (d, &t, t2, y);

  if (d->n != maxsteps + 1)
    {
      gsl_test (1, "%s test_driver steps %d, expected %d",
                gsl_odeiv2_step_name (d->s), d->n, maxsteps + 1);
    }
  else
    {
      gsl_test (0, "%s test_driver max steps test",
                gsl_odeiv2_step_name (d->s));
    }

  gsl_odeiv2_driver_free (d);

  /* Test that minimum step length is obeyed */

  d = gsl_odeiv2_driver_alloc_y_new (&rhs_func_broken, T, 1e-3, tol, tol);

  gsl_odeiv2_driver_set_hmin (d, hmin);
  y[0] = 0.0;
  t = 0.0;

  s = gsl_odeiv2_driver_apply (d, &t, t2, y);

  if (s != GSL_ENOPROG)
    {
      gsl_test (1, "%s test_driver min step test returned %d",
                gsl_odeiv2_step_name (d->s), s);
    }
  else
    {
      gsl_test (0, "%s test_driver min step test",
                gsl_odeiv2_step_name (d->s));
    }

  gsl_odeiv2_driver_free (d);

  /* Test negative integration direction */

  d = gsl_odeiv2_driver_alloc_y_new (&rhs_func_sin, T, -1e-3, tol, tol);

  y[0] = 1.0;
  y[1] = 0.0;
  t = 2.5;

  s = gsl_odeiv2_driver_apply (d, &t, t3, y);

  {
    const double tol = 1e-3;
    const double test = fabs (t - t3);
    const double val = fabs (sin (-5.0) - y[1]);

    if (test > GSL_DBL_EPSILON)
      {
        gsl_test (1,
                  "%s test_driver negative dir diff %e, expected less than %e",
                  gsl_odeiv2_step_name (d->s), test, GSL_DBL_EPSILON);
      }
    else if (val > tol)
      {
        gsl_test (1,
                  "%s test_driver negative dir val %e, expected less than %e",
                  gsl_odeiv2_step_name (d->s), val, tol);
      }
    else
      {
        gsl_test (s, "%s test_driver negative direction test",
                  gsl_odeiv2_step_name (d->s));
      }
  }

  /* Test driver_apply_fixed_step */

  gsl_odeiv2_driver_reset_hstart (d, 1e-3);
  s = gsl_odeiv2_driver_apply_fixed_step (d, &t, hfixed, nfsteps, y);

  if (s != GSL_SUCCESS)
    {
      gsl_test (s, "%s test_driver apply_fixed_step returned %d",
                gsl_odeiv2_step_name (d->s), s);
    }

  {
    const double tol = 1e-3;
    const double val = fabs (sin (-2.5) - y[1]);

    if (fabs (t) > nfsteps * GSL_DBL_EPSILON)
      {
        gsl_test (1,
                  "%s test_driver apply_fixed_step t %e, expected less than %e",
                  gsl_odeiv2_step_name (d->s), fabs (t),
                  nfsteps * GSL_DBL_EPSILON);
      }
    else if (val > tol)
      {
        gsl_test (1,
                  "%s test_driver apply_fixed_step val %e, expected less than %e",
                  gsl_odeiv2_step_name (d->s), val, tol);
      }
    else
      {
        gsl_test (s, "%s test_driver apply_fixed_step test",
                  gsl_odeiv2_step_name (d->s));
      }
  }

  gsl_odeiv2_driver_free (d);
}

void
benchmark_precision (void)
{
  /* Tests steppers with several error tolerances and evaluates their
     performance and precision.
   */

  /* Maximum number of tolerances to be tested */
#define MAXNT 12

  const gsl_odeiv2_step_type *steppers[MAXNS];

  /* Required error tolerance for each stepper. */
  double err_target[MAXNS];

  /* initial values for each ode-solver */
  double y[MAXEQ * MAXNS * MAXNT];

  /* precise results from e.g. analytical solution */
  double yres[MAXEQ];

  size_t i, j, k, p;

  /* Number of problems to test */
#define CONST_BENCHMARK_PRECISION_NPROB 3

  /* Problems, their names and number of equations */
  const gsl_odeiv2_system *prob[] =
    { &rhs_func_sin, &rhs_func_exp, &rhs_func_stiff };
  const char *probname[] =
    { "rhs_func_sin", "rhs_func_exp", "rhs_func_stiff" };
  const size_t sd[] = { 2, 1, 2 };

  /* Integration interval for problems */
  const double start[] = { 0.0, 0.0, 0.0 };
  const double end[] = { 2.4, 8.4, 1.2 };

  const double epsabs[] = { 1e-4, 1e-6, 1e-8, 1e-10, 1e-12, 1e-14, 0 };
  const double epsrel[] = { 1e-4, 1e-6, 1e-8, 1e-10, 1e-12, 1e-14, 0 };
  const double initstepsize = 1e-5;

  /* number of function and jacobian evaluations */
  extern int nfe, nje;
  int nnfe[MAXNS * MAXNT] = { 0.0 };
  int nnje[MAXNS * MAXNT] = { 0.0 };

  /* Steppers */

  steppers[0] = gsl_odeiv2_step_rk4;
  err_target[0] = 1e-6;
  steppers[1] = gsl_odeiv2_step_rk2;
  err_target[1] = 1e-6;
  steppers[2] = gsl_odeiv2_step_rkf45;
  err_target[2] = 1e-6;
  steppers[3] = gsl_odeiv2_step_rkck;
  err_target[3] = 1e-6;
  steppers[4] = gsl_odeiv2_step_rk8pd;
  err_target[4] = 1e-6;
  steppers[5] = gsl_odeiv2_step_rk1imp;
  err_target[5] = 1e-3;
  steppers[6] = gsl_odeiv2_step_rk2imp;
  err_target[6] = 1e-5;
  steppers[7] = gsl_odeiv2_step_rk4imp;
  err_target[7] = 1e-6;
  steppers[8] = gsl_odeiv2_step_bsimp;
  err_target[8] = 1e-6;
  steppers[9] = gsl_odeiv2_step_msadams;
  err_target[9] = 1e-5;
  steppers[10] = gsl_odeiv2_step_msbdf;
  err_target[10] = 1e-5;
  steppers[11] = 0;

  /* Loop over problems */

  for (p = 0; p < CONST_BENCHMARK_PRECISION_NPROB; p++)
    {
      /* Initialize */

      for (i = 0; i < MAXNS * MAXEQ * MAXNT; i++)
        {
          y[i] = 0.0;
        }

      for (i = 0; i < MAXNS * MAXNT; i++)
        {
          switch (p)
            {
            case 0:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 0.0;
              yres[0] = cos (2.4);
              yres[1] = sin (2.4);
              break;
            case 1:
              y[i * sd[p]] = 1.0;
              yres[0] = exp (8.4);
              break;
            case 2:
              y[i * sd[p]] = 1.0;
              y[i * sd[p] + 1] = 0.0;
              yres[0] = 2 * exp (-1.2) - exp (-1000 * 1.2);
              yres[1] = -exp (-1.2) + exp (-1000 * 1.2);
              break;
            default:
              gsl_test (GSL_EFAILED,
                        "benchmark_precision: initialization error\n");
              return;
            }
        }

      /* Call each solver for the problem */

      for (i = 0; steppers[i] != 0; i++)
        for (j = 0; epsrel[j] != 0; j++)
          {
            int s = sys_driver (steppers[i], prob[p], start[p], end[p],
                                initstepsize, &y[sd[p] * (j + i * MAXNT)],
                                epsabs[j], epsrel[j], probname[p]);

            if (s != GSL_SUCCESS)
              {
                for (k = 0; k < sd[p]; k++)
                  {
                    y[sd[p] * (j + i * MAXNT) + k] = GSL_NAN;
                  }
              }

            else
              {
                nnfe[j + i * MAXNT] = nfe;
                nnje[j + i * MAXNT] = nje;
              }
          }

      /* Print results */

      printf
        ("benchmark_precision: diff = (y_true - y) / y_true with %s\n          epsrel:   ",
         probname[p]);

      for (i = 0; epsrel[i] != 0.0; i++)
        {
          printf ("%12.0e ", epsrel[i]);
        }

      printf ("\n");

      for (i = 0; steppers[i] != 0; i++)
        {
          for (k = 0; k < sd[p]; k++)
            {
              printf ("%8s diff[%d]:   ", steppers[i]->name, (int) k);

              for (j = 0; epsrel[j] != 0; j++)
                {
                  const double diff =
                    (yres[k] - y[sd[p] * (j + i * MAXNT) + k]) / yres[k];
                  printf ("%12.5e ", diff);
                }

              printf ("\n");
            }
        }

      printf ("\n");

      /* Print number of function/jacobian evaluations */

      printf
        ("benchmark_precision: number of function/jacobian evaluations with %s\n          epsrel:   ",
         probname[p]);

      for (i = 0; epsrel[i] != 0.0; i++)
        {
          printf ("%12.0e          ", epsrel[i]);
        }

      printf ("\n");

      for (i = 0; steppers[i] != 0; i++)
        {
          printf ("%8s nfe/nje: ", steppers[i]->name);

          for (j = 0; epsrel[j] != 0; j++)
            {
              printf ("%9d %9d | ", nnfe[j + i * MAXNT], nnje[j + i * MAXNT]);
            }

          printf ("\n");
        }
      printf ("\n");

    }
}

void
test_evolve_temp (const gsl_odeiv2_step_type * T, double h, double err)
{
  /* Temporary test */

  double y[3];
  double yfin[3];

  y[0] = 1.0;
  y[1] = 0.0;
  y[2] = 0.0;
  yfin[0] = 0;
  yfin[1] = 0;
  yfin[2] = 0;
  test_evolve_system (T, &rhs_func_stiff, 0.0, 1.0, h, y, yfin, err, "temp");
}

/**********************************************************/
/* Main function                                          */
/**********************************************************/

int
main (void)
{

  /* Benchmark routine to compare stepper performance */
  /* benchmark_precision(); return 0; */

  /* Test single problem, for debugging purposes */
  /* test_evolve_temp (gsl_odeiv2_step_msadams, 1e-3, 1e-8); return 0; */
  int i;

  struct ptype
  {
    const gsl_odeiv2_step_type *type;
    double h;
  }
  p[MAXNS];

  struct ptype explicit_stepper[MAXNS];

  p[0].type = gsl_odeiv2_step_rk4;
  p[0].h = 1.0e-3;
  p[1].type = gsl_odeiv2_step_rk2;
  p[1].h = 1.0e-3;
  p[2].type = gsl_odeiv2_step_rkf45;
  p[2].h = 1.0e-3;
  p[3].type = gsl_odeiv2_step_rkck;
  p[3].h = 1.0e-3;
  p[4].type = gsl_odeiv2_step_rk8pd;
  p[4].h = 1.0e-3;
  p[5].type = gsl_odeiv2_step_rk1imp;
  p[5].h = 1.0e-3;
  p[6].type = gsl_odeiv2_step_rk2imp;
  p[6].h = 1.0e-3;
  p[7].type = gsl_odeiv2_step_rk4imp;
  p[7].h = 1.0e-3;
  p[8].type = gsl_odeiv2_step_bsimp;
  p[8].h = 1.0e-3;
  p[9].type = gsl_odeiv2_step_msadams;
  p[9].h = 1.0e-3;
  p[10].type = gsl_odeiv2_step_msbdf;
  p[10].h = 1.0e-3;
  p[11].type = 0;

  gsl_ieee_env_setup ();

  /* Basic tests for all steppers */

  for (i = 0; p[i].type != 0; i++)
    {
      test_stepper (p[i].type);
      test_evolve_linear (p[i].type, p[i].h, 1e-10);
      test_evolve_exp (p[i].type, p[i].h, 1e-5);
      test_evolve_sin (p[i].type, p[i].h, 1e-8);
      test_evolve_xsin (p[i].type, p[i].h, 1e-8);
      test_evolve_xsin (p[i].type, 0.1, 1e-8);
      test_evolve_stiff1 (p[i].type, p[i].h, 1e-7);
      test_evolve_stiff5 (p[i].type, p[i].h, 1e-7);
      test_evolve_negative_h (p[i].type, p[i].h, 1e-7);
      test_broken (p[i].type, p[i].h, 1e-8);
      test_stepsize_fail (p[i].type, p[i].h);
      test_user_break (p[i].type, p[i].h);
      test_driver (p[i].type);
    }

  /* Derivative test for explicit steppers */

  explicit_stepper[0].type = gsl_odeiv2_step_rk4;
  explicit_stepper[0].h = 1.0e-3;
  explicit_stepper[1].type = gsl_odeiv2_step_rk2;
  explicit_stepper[1].h = 1.0e-3;
  explicit_stepper[2].type = gsl_odeiv2_step_rkf45;
  explicit_stepper[2].h = 1.0e-3;
  explicit_stepper[3].type = gsl_odeiv2_step_rkck;
  explicit_stepper[3].h = 1.0e-3;
  explicit_stepper[4].type = gsl_odeiv2_step_rk8pd;
  explicit_stepper[4].h = 1.0e-3;
  explicit_stepper[5].type = gsl_odeiv2_step_msadams;
  explicit_stepper[5].h = 1.0e-3;
  explicit_stepper[6].type = 0;

  for (i = 0; explicit_stepper[i].type != 0; i++)
    {
      test_stepfn (explicit_stepper[i].type);
      test_stepfn2 (explicit_stepper[i].type);
    }

  /* Special tests */

  test_nonstiff_problems ();

  test_stiff_problems ();

  test_extreme_problems ();

  exit (gsl_test_summary ());
}