#include <stdio.h>
#include <gsl/gsl_sf_bessel.h>

int main(void)
{
  double x = 5.0;
  double y = gsl_sf_bessel_J0(x);
  printf("J0(%g) = %.18e\n", x, y);
  return 0;
}


/* examples/C/ssmfe/shift_invert.c */
/* Laplacian on a rectangular grid by shift-invert via LDLT factorization */
#include "spral.h"
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <cblas.h>

/* Headers that implements Laplacian and preconditioners and LDLT support */
#include "laplace2d.h"
#include "ldltf.h"

int main(void) {
   const int nx = 8;          /* grid points along x */
   const int ny = 8;          /* grid points along y */
   const int n = nx*ny;       /* problem size */
   const double sigma = 1.0;  /* shift */

   int ipiv[n];               /* LDLT pivot index */
   double lambda[n];          /* eigenvalues */
   double X[n][n];            /* eigenvectors */
   double A[n][n];            /* matrix */
   double LDLT[n][n];         /* factors */
   double work[n][n];         /* work array for dsytrf */
   struct spral_ssmfe_options options;    /* eigensolver options */
   struct spral_ssmfe_inform inform;      /* information */
   struct spral_ssmfe_rcid rci;           /* reverse communication data */
   void *keep;                            /* private data */

   /* Initialize options to default values */
   spral_ssmfe_default_options(&options);

   /* Set up then perform LDLT factorization of the shifted matrix */
   set_laplacian_matrix(nx, ny, n, A);
   for(int j=0; j<n; j++)
   for(int i=0; i<n; i++)
      LDLT[j][i] = (i==j) ? A[j][i] - sigma
                          : A[j][i];
   cwrap_dsytrf('L', n, &LDLT[0][0], n, ipiv, &work[0][0], n*n);

   /* Main loop */
   int left = num_neg_D(n, n, LDLT, ipiv);   /* all evalues to left of sigma */
   int right = 5;                            /* 5 evalues to right of sigma */
   rci.job = 0; keep = NULL;
   while(true) {
      spral_ssmfe_standard_shift_double(&rci, sigma, left, right, n, lambda,
            n, &X[0][0], n, &keep, &options, &inform);
      switch( rci.job ) {
      case 1:
         cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, n, rci.nx, n,
            1.0, &A[0][0], n, rci.x, n, 0.0, rci.y, n);
         break;
      case 2:
         // No preconditioning
         break;
      case 9:
         cblas_dcopy(n*rci.nx, rci.x, 1, rci.y, 1);
         cwrap_dsytrs('L', n, rci.nx, &LDLT[0][0], n, ipiv, rci.y, n);
         break;
      default:
         goto finished;
      }
   }
finished:
   printf("Eigenvalues near %e (took %d iterations)\n", sigma, inform.iteration);
   for(int i=0; i<inform.left+inform.right; i++)
      printf(" lambda[%1d] = %13.7e\n", i, lambda[i]);
   spral_ssmfe_free_double(&keep, &inform);

   /* Success */
   return 0;
}


#include <assert.h>
#include <math.h>
#include <gsl/gsl_randist.h>
#include "nmcalc.h"

void get_ab(struct variant_table *v, struct variant_counts **a, struct variant_counts **b);

// Convenience function to mimic MATLAB function
static inline double binopdf(unsigned int x, unsigned int n, double p) {
	return gsl_ran_binomial_pdf(x, p, n);
}

#define NONZERO_OR_NAN(X, NAN_CODE) ((X) == (X) ? (X) : nan(#NAN_CODE))

void nmcalc(struct context *context,
            struct variant_table *v,
            double prior_map_error,
            int ploidy,
            struct nm_entry *out)
{
	(void) context;

	double a_read_depth, b_read_depth;
	double a_mean_mq, b_mean_mq;

	double prior_hom, prior_het;
	double p_data_map_error, p_data_hom, p_data_het, p_data;
	double p_map_error;

	double per_read_pass, ab_frac;

	struct variant_counts *a, *b;

	get_ab(v, &a, &b);

	// Initialization of useful variables

	a_read_depth = (a->count_f + a->count_r) / 2.0;
	b_read_depth = (b->count_f + b->count_r) / 2.0;

	a_mean_mq = a->total_mq / NONZERO_OR_NAN(a_read_depth, 200);
	b_mean_mq = b->total_mq / NONZERO_OR_NAN(b_read_depth, 200);

	// Normal metrics calculation starts here

	// priors
	if (ploidy == 2) {
		prior_het = 2 * a->pop_af * b->pop_af;
	} else {
		prior_het = 0;
	}

	prior_hom = a->pop_af * a->pop_af;

	// likelihoods
	p_data_map_error = pow(10, -fmin(a_mean_mq, b_mean_mq)/10);
	p_data_hom = binopdf(b_read_depth, v->read_count_pass, pow(10, (-b_mean_mq / 10)));
	p_data_het = binopdf(b_read_depth, v->read_count_pass,  0.5);

	p_data = prior_map_error * p_data_map_error + prior_het * p_data_het + prior_hom * p_data_hom;

	// posteriors
	if (v->read_count_pass > 0) {
		p_map_error = prior_map_error * p_data_map_error / p_data;
	} else {
		p_map_error = nan("300");
	}

	// other metrics
	per_read_pass = v->read_count_pass / NONZERO_OR_NAN(v->read_count, 200);

	ab_frac = (a_read_depth + b_read_depth) / NONZERO_OR_NAN(v->read_count_pass, 200);

	out->pos = v->offset;

	if (ploidy == 1 || ploidy == 2) {
		out->norm_read_depth = (3-ploidy) * v->read_count_pass; // sneak
		out->prob_map_err = p_map_error;
		out->read_pass = per_read_pass;
		out->a_or_b = ab_frac;
	} else  {
		out->norm_read_depth = nan("101");
		out->prob_map_err = nan("102");
		out->read_pass = nan("103");
		out->a_or_b = nan("104");
	}
}


static char help[] =
"Solves structured-grid Poisson problem in 1D, 2D, 3D.  Option prefix fsh_.\n"
"Equation is\n"
"    - cx u_xx - cy u_yy - cz u_zz = f,\n"
"subject to Dirichlet boundary conditions.  Solves three different problems\n"
"where exact solution is known.  Uses DMDA and SNES.  Equation is put in form\n"
"F(u) = - grad^2 u - f.  Call-backs fully-rediscretize for the supplied grid.\n"
"Defaults to 2D, a SNESType of KSPONLY, and a KSPType of CG.\n\n";

#include <petsc.h>
#include "poissonfunctions.h"

// exact solutions  u(x,y),  for boundary condition and error calculation

static double u_exact_1Dmanupoly(double x, double y, double z, void *ctx) {
    return x*x * (1.0 - x*x);
}

static double u_exact_2Dmanupoly(double x, double y, double z, void *ctx) {
    return x*x * (1.0 - x*x) * y*y *(y*y - 1.0);
}

static double u_exact_3Dmanupoly(double x, double y, double z, void *ctx) {
    return x*x * (1.0 - x*x) * y*y * (y*y - 1.0) * z*z * (z*z - 1.0);
}

static double u_exact_1Dmanuexp(double x, double y, double z, void *ctx) {
    return - exp(x);
}

static double u_exact_2Dmanuexp(double x, double y, double z, void *ctx) {
    return - x * exp(y);
}

static double u_exact_3Dmanuexp(double x, double y, double z, void *ctx) {
    return - x * exp(y + z);
}

static double zero(double x, double y, double z, void *ctx) {
    return 0.0;
}

// right-hand-side functions  f(x,y) = - laplacian u

static double f_rhs_1Dmanupoly(double x, double y, double z, void *ctx) {
    PoissonCtx* user = (PoissonCtx*)ctx;
    return user->cx * 12.0 * x*x - 2.0;
}

static double f_rhs_2Dmanupoly(double x, double y, double z, void *ctx) {
    PoissonCtx* user = (PoissonCtx*)ctx;
    double aa, bb, ddaa, ddbb;
    aa = x*x * (1.0 - x*x);
    bb = y*y * (y*y - 1.0);
    ddaa = 2.0 * (1.0 - 6.0 * x*x);
    ddbb = 2.0 * (6.0 * y*y - 1.0);
    return - (user->cx * ddaa * bb + user->cy * aa * ddbb);
}

static double f_rhs_3Dmanupoly(double x, double y, double z, void *ctx) {
    PoissonCtx* user = (PoissonCtx*)ctx;
    double aa, bb, cc, ddaa, ddbb, ddcc;
    aa = x*x * (1.0 - x*x);
    bb = y*y * (y*y - 1.0);
    cc = z*z * (z*z - 1.0);
    ddaa = 2.0 * (1.0 - 6.0 * x*x);
    ddbb = 2.0 * (6.0 * y*y - 1.0);
    ddcc = 2.0 * (6.0 * z*z - 1.0);
    return - (user->cx * ddaa * bb * cc + user->cy * aa * ddbb * cc + user->cz * aa * bb * ddcc);
}

static double f_rhs_1Dmanuexp(double x, double y, double z, void *ctx) {
    return exp(x);
}

static double f_rhs_2Dmanuexp(double x, double y, double z, void *ctx) {
    return x * exp(y);  // note  f = - (u_xx + u_yy) = - u
}

static double f_rhs_3Dmanuexp(double x, double y, double z, void *ctx) {
    return 2.0 * x * exp(y + z);  // note  f = - laplacian u = - 2 u
}

// functions simply to put u_exact()=g_bdry() into a grid
// these are irritatingly-dimension-dependent inside ...
extern PetscErrorCode Form1DUExact(DMDALocalInfo*, Vec, PoissonCtx*);
extern PetscErrorCode Form2DUExact(DMDALocalInfo*, Vec, PoissonCtx*);
extern PetscErrorCode Form3DUExact(DMDALocalInfo*, Vec, PoissonCtx*);

//STARTPTRARRAYS
// arrays of pointers to functions:   ..._ptr[DIMS]
static void* residual_ptr[3]
    = {&Poisson1DFunctionLocal, &Poisson2DFunctionLocal, &Poisson3DFunctionLocal};

static void* jacobian_ptr[3]
    = {&Poisson1DJacobianLocal, &Poisson2DJacobianLocal, &Poisson3DJacobianLocal};

static void* getuexact_ptr[3]
    = {&Form1DUExact, &Form2DUExact, &Form3DUExact};
//ENDPTRARRAYS

typedef enum {MANUPOLY, MANUEXP, ZERO} ProblemType;
static const char* ProblemTypes[] = {"manupoly","manuexp","zero",
                                     "ProblemType", "", NULL};

// more arrays of pointers to functions:   ..._ptr[DIMS][PROBLEMS]
static void* g_bdry_ptr[3][3]
    = {{&u_exact_1Dmanupoly, &u_exact_1Dmanuexp, &zero},
       {&u_exact_2Dmanupoly, &u_exact_2Dmanuexp, &zero},
       {&u_exact_3Dmanupoly, &u_exact_3Dmanuexp, &zero}};

static void* f_rhs_ptr[3][3]
    = {{&f_rhs_1Dmanupoly, &f_rhs_1Dmanuexp, &zero},
       {&f_rhs_2Dmanupoly, &f_rhs_2Dmanuexp, &zero},
       {&f_rhs_3Dmanupoly, &f_rhs_3Dmanuexp, &zero}};

static const char* InitialTypes[] = {"zeros","random",
                                     "InitialType", "", NULL};

int main(int argc,char **argv) {
    PetscErrorCode ierr;
    DM             da, da_after;
    SNES           snes;
    KSP            ksp;
    Vec            u_initial, u, u_exact;
    PoissonCtx     user;
    DMDALocalInfo  info;
    double         errinf, normconst2h, err2h;
    char           gridstr[99];
    PetscErrorCode (*getuexact)(DMDALocalInfo*,Vec,PoissonCtx*);

    // fish defaults:
    int            dim = 2;                  // 2D
    ProblemType    problem = MANUEXP;        // manufactured problem using exp()
    InitialType    initial = ZEROS;          // set u=0 for initial iterate
    PetscBool      gonboundary = PETSC_TRUE; // initial iterate has u=g on boundary

    // get options and configure context
    user.Lx = 1.0;
    user.Ly = 1.0;
    user.Lz = 1.0;
    user.cx = 1.0;
    user.cy = 1.0;
    user.cz = 1.0;
    PetscInitialize(&argc,&argv,NULL,help);
    ierr = PetscOptionsBegin(PETSC_COMM_WORLD,"fsh_", "options for fish.c", ""); CHKERRQ(ierr);
    ierr = PetscOptionsReal("-cx",
         "set coefficient of x term u_xx in equation",
         "fish.c",user.cx,&user.cx,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-cy",
         "set coefficient of y term u_yy in equation",
         "fish.c",user.cy,&user.cy,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-cz",
         "set coefficient of z term u_zz in equation",
         "fish.c",user.cz,&user.cz,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsInt("-dim",
         "dimension of problem (=1,2,3 only)",
         "fish.c",dim,&dim,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsBool("-initial_gonboundary",
         "set initial iterate to have correct boundary values",
         "fish.c",gonboundary,&gonboundary,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsEnum("-initial_type",
         "type of initial iterate",
         "fish.c",InitialTypes,(PetscEnum)initial,(PetscEnum*)&initial,NULL); CHKERRQ(ierr);
    ierr = PetscOptionsReal("-Lx",
         "set Lx in domain ([0,Lx] x [0,Ly] x [0,Lz], etc.)",
         "fish.c",user.Lx,&user.Lx,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-Ly",
         "set Ly in domain ([0,Lx] x [0,Ly] x [0,Lz], etc.)",
         "fish.c",user.Ly,&user.Ly,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-Lz",
         "set Ly in domain ([0,Lx] x [0,Ly] x [0,Lz], etc.)",
         "fish.c",user.Lz,&user.Lz,NULL);CHKERRQ(ierr);
    ierr = PetscOptionsEnum("-problem",
         "problem type; determines exact solution and RHS",
         "fish.c",ProblemTypes,(PetscEnum)problem,(PetscEnum*)&problem,NULL); CHKERRQ(ierr);
    ierr = PetscOptionsEnd(); CHKERRQ(ierr);
    user.g_bdry = g_bdry_ptr[dim-1][problem];
    user.f_rhs = f_rhs_ptr[dim-1][problem];
    if ( user.cx <= 0.0 || user.cy <= 0.0 || user.cz <= 0.0 ) {
        SETERRQ(PETSC_COMM_WORLD,2,"positivity required for coefficients cx,cy,cz\n");
    }
    if ((problem == MANUEXP) && ( user.cx != 1.0 || user.cy != 1.0 || user.cz != 1.0)) {
        SETERRQ(PETSC_COMM_WORLD,3,"cx=cy=cz=1 required for problem MANUEXP\n");
    }

//STARTCREATE
    // DMDA in chosen dimension
    switch (dim) {
        case 1:
            ierr = DMDACreate1d(PETSC_COMM_WORLD,
                DM_BOUNDARY_NONE,3,1,1, NULL, &da); CHKERRQ(ierr);
            break;
        case 2:
            ierr = DMDACreate2d(PETSC_COMM_WORLD,
                DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,
                3,3,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da); CHKERRQ(ierr);
            break;
        case 3:
            ierr = DMDACreate3d(PETSC_COMM_WORLD,
                DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,
                DMDA_STENCIL_STAR,
                3,3,3,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE,
                1,1,NULL,NULL,NULL,&da); CHKERRQ(ierr);
            break;
        default:
            SETERRQ(PETSC_COMM_WORLD,1,"invalid dim for DMDA creation\n");
    }
    ierr = DMSetApplicationContext(da,&user); CHKERRQ(ierr);
    ierr = DMSetFromOptions(da); CHKERRQ(ierr);
    ierr = DMSetUp(da); CHKERRQ(ierr);  // call BEFORE SetUniformCoordinates
    ierr = DMDASetUniformCoordinates(da,0.0,user.Lx,0.0,user.Ly,0.0,user.Lz); CHKERRQ(ierr);

    // create SNES supply call-backs
    ierr = SNESCreate(PETSC_COMM_WORLD,&snes); CHKERRQ(ierr);
    ierr = SNESSetDM(snes,da); CHKERRQ(ierr);
    ierr = DMDASNESSetFunctionLocal(da,INSERT_VALUES,
             (DMDASNESFunction)(residual_ptr[dim-1]),&user); CHKERRQ(ierr);
    ierr = DMDASNESSetJacobianLocal(da,
             (DMDASNESJacobian)(jacobian_ptr[dim-1]),&user); CHKERRQ(ierr);

    // default to KSPONLY+CG because problem is linear and SPD
    ierr = SNESSetType(snes,SNESKSPONLY); CHKERRQ(ierr);
    ierr = SNESGetKSP(snes,&ksp); CHKERRQ(ierr);
    ierr = KSPSetType(ksp,KSPCG); CHKERRQ(ierr);
    ierr = SNESSetFromOptions(snes); CHKERRQ(ierr);

    // initial iterate and solve
    ierr = DMGetGlobalVector(da,&u_initial); CHKERRQ(ierr);
    ierr = InitialState(da, initial, gonboundary, u_initial, &user); CHKERRQ(ierr);
    ierr = SNESSolve(snes,NULL,u_initial); CHKERRQ(ierr);
//ENDCREATE

//STARTGETSOLUTION
    // -snes_grid_sequence could change grid resolution
    ierr = DMRestoreGlobalVector(da,&u_initial); CHKERRQ(ierr);
    ierr = DMDestroy(&da); CHKERRQ(ierr);

    // evaluate error and report
    ierr = SNESGetSolution(snes,&u); CHKERRQ(ierr);  // SNES owns u; do not destroy it
    ierr = VecDuplicate(u,&u_exact); CHKERRQ(ierr);
    ierr = SNESGetDM(snes,&da_after); CHKERRQ(ierr); // SNES owns da_after; do not destroy it
    ierr = DMDAGetLocalInfo(da_after,&info); CHKERRQ(ierr);
    getuexact = getuexact_ptr[dim-1];
    ierr = (*getuexact)(&info,u_exact,&user); CHKERRQ(ierr);
    ierr = VecAXPY(u,-1.0,u_exact); CHKERRQ(ierr);   // u <- u + (-1.0) uexact
    ierr = VecDestroy(&u_exact); CHKERRQ(ierr);      // no longer needed
    ierr = VecNorm(u,NORM_INFINITY,&errinf); CHKERRQ(ierr);
    ierr = VecNorm(u,NORM_2,&err2h); CHKERRQ(ierr);
//ENDGETSOLUTION

    switch (dim) {
        case 1:
            normconst2h = PetscSqrtReal((double)(info.mx-1));
            snprintf(gridstr,99,"%d point 1D",info.mx);
            break;
        case 2:
            normconst2h = PetscSqrtReal((double)(info.mx-1)*(info.my-1));
            snprintf(gridstr,99,"%d x %d point 2D",info.mx,info.my);
            break;
        case 3:
            normconst2h = PetscSqrtReal((double)(info.mx-1)*(info.my-1)*(info.mz-1));
            snprintf(gridstr,99,"%d x %d x %d point 3D",info.mx,info.my,info.mz);
            break;
        default:
            SETERRQ(PETSC_COMM_WORLD,4,"invalid dim value in final report\n");
    }
    err2h /= normconst2h; // like continuous L2
    ierr = PetscPrintf(PETSC_COMM_WORLD,
                "problem %s on %s grid:\n"
                "  error |u-uexact|_inf = %.3e, |u-uexact|_h = %.3e\n",
                ProblemTypes[problem],gridstr,errinf,err2h); CHKERRQ(ierr);

    // destroy what we explicitly Created
    ierr = SNESDestroy(&snes); CHKERRQ(ierr);
    return PetscFinalize();
}

PetscErrorCode Form1DUExact(DMDALocalInfo *info, Vec u, PoissonCtx* user) {
  PetscErrorCode ierr;
  int          i;
  double       xmax[1], xmin[1], hx, x, *au;
  ierr = DMDAGetBoundingBox(info->da,xmin,xmax); CHKERRQ(ierr);
  hx = (xmax[0] - xmin[0]) / (info->mx - 1);
  ierr = DMDAVecGetArray(info->da, u, &au);CHKERRQ(ierr);
  for (i=info->xs; i<info->xs+info->xm; i++) {
      x = xmin[0] + i * hx;
      au[i] = user->g_bdry(x,0.0,0.0,user);
  }
  ierr = DMDAVecRestoreArray(info->da, u, &au);CHKERRQ(ierr);
  return 0;
}

PetscErrorCode Form2DUExact(DMDALocalInfo *info, Vec u, PoissonCtx* user) {
    PetscErrorCode ierr;
    int     i, j;
    double  xymin[2], xymax[2], hx, hy, x, y, **au;
    ierr = DMDAGetBoundingBox(info->da,xymin,xymax); CHKERRQ(ierr);
    hx = (xymax[0] - xymin[0]) / (info->mx - 1);
    hy = (xymax[1] - xymin[1]) / (info->my - 1);
    ierr = DMDAVecGetArray(info->da, u, &au);CHKERRQ(ierr);
    for (j=info->ys; j<info->ys+info->ym; j++) {
        y = xymin[1] + j * hy;
        for (i=info->xs; i<info->xs+info->xm; i++) {
            x = xymin[0] + i * hx;
            au[j][i] = user->g_bdry(x,y,0.0,user);
        }
    }
    ierr = DMDAVecRestoreArray(info->da, u, &au);CHKERRQ(ierr);
    return 0;
}

PetscErrorCode Form3DUExact(DMDALocalInfo *info, Vec u, PoissonCtx* user) {
    PetscErrorCode ierr;
    int    i, j, k;
    double xyzmin[3], xyzmax[3], hx, hy, hz, x, y, z, ***au;
    ierr = DMDAGetBoundingBox(info->da,xyzmin,xyzmax); CHKERRQ(ierr);
    hx = (xyzmax[0] - xyzmin[0]) / (info->mx - 1);
    hy = (xyzmax[1] - xyzmin[1]) / (info->my - 1);
    hz = (xyzmax[2] - xyzmin[2]) / (info->mz - 1);
    ierr = DMDAVecGetArray(info->da, u, &au);CHKERRQ(ierr);
    for (k=info->zs; k<info->zs+info->zm; k++) {
        z = xyzmin[2] + k * hz;
        for (j=info->ys; j<info->ys+info->ym; j++) {
            y = xyzmin[1] + j * hy;
            for (i=info->xs; i<info->xs+info->xm; i++) {
                x = xyzmin[0] + i * hx;
                au[k][j][i] = user->g_bdry(x,y,z,user);
            }
        }
    }
    ierr = DMDAVecRestoreArray(info->da, u, &au);CHKERRQ(ierr);
    return 0;
}


// Use the geodesic solver code to create a gsl implementation so you can
// compare the speeds.  The template needs to get close to ,ideally better than,
// exactly to the gsl run times

#include <stdio.h>
#include <iostream>
#include <chrono>
#include <math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_odeiv2.h>

const double alpha = 1.32754125e20;
int odefunc (double x, const double y[], double f[], void *params)
{
    f[0] = y[3];
    f[1] = y[4];
    f[2] = y[5];
    double r = sqrt(y[0]*y[0]+y[1]*y[1]+y[2]*y[2]);

    f[3] = -(alpha*y[0]) / (r*r*r);
    f[4] = -(alpha*y[1]) / (r*r*r);
    f[5] = -(alpha*y[2]) / (r*r*r);
    return GSL_SUCCESS;
}

int main ()
{
    double AU = 1.496e11; // astronomical unit
    double V = 30000.0; // initial velocity
    // initial conditions
    double y0[] = {0.0,AU,0.0,-V,0.0,0.0};
    double T0 = 0.0;
    double Tf = 7.2e6;
    double hi = 7.2e3/3;
    int dim = 6;
    gsl_odeiv2_system sys = {odefunc, NULL, dim, NULL};

    gsl_odeiv2_driver * d = gsl_odeiv2_driver_alloc_y_new (&sys, gsl_odeiv2_step_rkf45, hi, 1e-5, 0.0);
    auto Nruns = 5000;
    auto totalDuration = 0;
    auto t1 = std::chrono::high_resolution_clock::now();
    double T;
    for (int i = 1; i <= Nruns; i++)
    {
        T0 = 0.0;
        T = Tf;
        y0[0]=0.0;
        y0[1] = AU;
        y0[2] = 0.0;
        y0[3] = -V;
        y0[4] = 0.0;
        y0[5] = 0.0;
        gsl_odeiv2_driver_apply (d, &T0, T, y0);
    }

    auto t2 = std::chrono::high_resolution_clock::now();
    auto duration = std::chrono::duration_cast<std::chrono::microseconds>( t2 - t1 ).count();
    totalDuration += duration;
    std::cout << "GSL runs" << std::endl;
    std::cout << totalDuration/Nruns << std::endl;
    for(int j = 0 ; j < 6 ; j++)
    {
        std::cout << y0[j] << ",";
    }
    std::cout << std::endl;
    gsl_odeiv2_driver_free (d);
    return 0;
}


//
//  trsm.h
//  Linear Algebra Template Library
//
//  Created by Rodney James on 1/5/12.
//  Copyright (c) 2012 University of Colorado Denver. All rights reserved.
//

#ifndef _trsm_h
#define _trsm_h

/// @file trsm.h Solves triangular matrix equations.

#include <cctype>
#include "latl.h"

namespace LATL
{
   /// @brief Solves a real triangular matrix equation.
   ///
   /// For a real upper or lower triangular matrix A, real rectangular matrix B and real scalar alpha,
   ///
   ///        A*X=alpha*B  or  A'*X=alpha*B  or  X*A=alpha*B  or  X*A'=alpha*B
   /// is solved for the matrix X.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param side Specifies whether the matrix A appears on the left or right side as follows:
   ///
   ///        if side = 'L' or 'l' then A*X=alpha*B  or  A'*X=alpha*B is solved
   ///        if side = 'R' or 'r' then X*A=alpha*B  or  X*A'=alpha*B is solved
   /// @param uplo Specifies whether A is stored as upper or lower triangular.
   ///
   ///        if uplo = 'U' or 'u' then A is upper triangular
   ///        if uplo = 'L' or 'l' then A is lower triangular
   /// @param trans Specifies whether the transpose or conjugate transpose of A is to be used:
   ///
   ///        if trans = 'N' or 'n' then A*X=alpha*B or X*A=alpha*B is solved
   ///        if trans = 'T' or 't' then A'*X=alpha*B or X*A'=alpha*B is solved
   ///        if trans = 'C' or 'c' then A'*X=alpha*B or X*A'=alpha*B is solved
   /// @param diag specifies whether or not A is unit triangular as follows:
   ///
   ///        if diag = 'U' or 'u' then A is assumed to be unit triangular
   ///        if diag = 'N' or 'n' then A is not assumed to be unit triangular.
   /// If A is unit triangular, the diagonal elements are assumed to be unity and are not referenced.
   /// @param m Specifies the number of rows of the matrix B.  m>=0
   /// @param n Specifies the number of columns of the matrix B.  n>=0
   /// @param alpha Real scalar.
   /// @param A Pointer to real triangular matrix A.  The order of A is n if side = 'L' or 'l';
   /// the order of A is m is side = 'R' or 'r'.
   /// If uplo = 'U' or 'u, A is upper triangular and the lower triangular part is not referenced.
   /// If uplo = 'L' or 'l A is lower triangular and the upper triangular part is not referenced.
   /// @param ldA Column length of the matrix A.  If side='L' or 'l' then ldA>=n; if side='R' or 'r' then ldA>=m.
   /// @param B Pointer to real m-by-n matrix B.  On entry, B contains the right hand side matrix B.
   /// On exit, B is overwritten with the solution matrix X.
   /// @param ldB Column length of the matrix B.  ldB>=m.
   /// @ingroup BLAS

   template <typename real_t>
   int TRSM(char side, char uplo, char trans, char diag, int_t m, int_t n, real_t alpha, real_t *A, int_t ldA, real_t *B, int_t ldB)
   {
      using std::toupper;

      const real_t zero(0.0);
      const real_t one(1.0);
      int_t i,j,k;
      real_t *a,*b,*bt;
      real_t t;
      bool nounit;

      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);

      nounit=(diag=='N')?1:0;

      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      if(alpha==zero)
      {
         b=B;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               b[i]=zero;
            b+=ldB;
         }
      }
      else
      {
         if(side=='L')
         {
            if(trans=='N')
            {
               if(uplo=='U')
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a=A+m*ldA;
                     for(k=m-1;k>=0;k--)
                     {
                        a-=ldA;
                        if(nounit)
                           b[k]=b[k]/a[k];
                        for(i=0;i<k;i++)
                           b[i]-=b[k]*a[i];
                     }
                     b+=ldB;
                  }
               }
               else
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a=A;
                     for(k=0;k<m;k++)
                     {
                        if(nounit)
                           b[k]=b[k]/a[k];
                        for(i=k+1;i<m;i++)
                           b[i]-=b[k]*a[i];
                        a+=ldA;
                     }
                     b+=ldB;
                  }
               }
            }
            else
            {
               if(uplo=='U')
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A;
                     for(i=0;i<m;i++)
                     {
                        t=alpha*b[i];
                        for(k=0;k<i;k++)
                           t-=a[k]*b[k];
                        if(nounit)
                           t=t/a[i];
                        b[i]=t;
                        a+=ldA;
                     }
                     b+=ldB;
                  }
               }
               else
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A+m*ldA;
                     for(i=m-1;i>=0;i--)
                     {
                        a-=ldA;
                        t=alpha*b[i];
                        for(k=i+1;k<m;k++)
                           t-=a[k]*b[k];
                        if(nounit)
                           t=t/a[i];
                        b[i]=t;
                     }
                     b+=ldB;
                  }
               }
            }
         }
         else
         {
            if(trans=='N')
            {
               if(uplo=='U')
               {
                  b=B;
                  a=A;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     bt=B;
                     for(k=0;k<j;k++)
                     {
                        for(i=0;i<m;i++)
                           b[i]-=a[k]*bt[i];
                        bt+=ldB;
                     }
                     if(nounit)
                     {
                        t=one/a[j];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     a+=ldA;
                     b+=ldB;
                  }
               }
               else
               {
                  b=B+n*ldB;
                  a=A+n*ldA;
                  for(j=n-1;j>=0;j--)
                  {
                     a-=ldA;
                     b-=ldB;
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     bt=B+(j+1)*ldB;
                     for(k=j+1;k<n;k++)
                     {
                        for(i=0;i<m;i++)
                           b[i]-=a[k]*bt[i];
                        bt+=ldB;
                     }
                     if(nounit)
                     {
                        t=one/a[j];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                  }
               }
            }
            else
            {
               if(uplo=='U')
               {
                  b=B+n*ldB;
                  a=A+n*ldA;
                  for(k=n-1;k>=0;k--)
                  {
                     a-=ldA;
                     b-=ldB;
                     if(nounit)
                     {
                        t=one/a[k];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B;
                     for(j=0;j<k;j++)
                     {
                        t=a[j];
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                  }
               }
               else
               {
                  a=A;
                  b=B;
                  for(k=0;k<n;k++)
                  {
                     if(nounit)
                     {
                        t=one/a[k];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B+(k+1)*ldB;
                     for(j=k+1;j<n;j++)
                     {
                        t=a[j];
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a+=ldA;
                     b+=ldB;
                  }
               }
            }
         }
      }
      return 0;
   }

   /// @brief Solves a complex triangular matrix equation.
   ///
   /// For a complex upper or lower triangular matrix A, complex rectangular matrix B and complex scalar alpha,
   ///
   ///        A*X=alpha*B or A'*X=alpha*B or A.'*X=alpha*B or X*A=alpha*B or X*A'=alpha*B or X*A.'=alpha*B
   /// is solved for the matrix X.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param side Specifies whether the matrix A appears on the left or right side as follows:
   ///
   ///        if side = 'L' or 'l' then A*X=alpha*B  or  A'*X=alpha*B is solved
   ///        if side = 'R' or 'r' then X*A=alpha*B  or  X*A'=alpha*B is solved
   /// @param uplo Specifies whether A is stored as upper or lower triangular.
   ///
   ///        if uplo = 'U' or 'u' then A is upper triangular
   ///        if uplo = 'L' or 'l' then A is lower triangular
   /// @param trans Specifies whether the transpose of A is to be used or not:
   ///
   ///        if trans = 'N' or 'n' then A*X=alpha*B or X*A=alpha*B is solved
   ///        if trans = 'T' or 't' then A.'*X=alpha*B or X*A.'=alpha*B is solved
   ///        if trans = 'C' or 'c' then A'*X=alpha*B or X*A'=alpha*B is solved
   /// @param diag specifies whether or not A is unit triangular as follows:
   ///
   ///        if diag = 'U' or 'u' then A is assumed to be unit triangular
   ///        if diag = 'N' or 'n' then A is not assumed to be unit triangular.
   /// If A is unit triangular, the diagonal elements are assumed to be unity and are not referenced.
   /// @param m Specifies the number of rows of the matrix B.  m>=0
   /// @param n Specifies the number of columns of the matrix B.  n>=0
   /// @param alpha Complex scalar.
   /// @param A Pointer to complex triangular matrix A.  The order of A is n if side = 'L' or 'l';
   /// the order of A is m is side = 'R' or 'r'.
   /// If uplo = 'U' or 'u, A is upper triangular and the lower triangular part is not referenced.
   /// If uplo = 'L' or 'l A is lower triangular and the upper triangular part is not referenced.
   /// @param ldA Column length of the matrix A.  If side='L' or 'l' then ldA>=n; if side='R' or 'r' then ldA>=m.
   /// @param B Pointer to complex m-by-n matrix B.  On entry, B contains the right hand side matrix B.
   /// On exit, B is overwritten with the solution matrix X.
   /// @param ldB Column length of the matrix B.  ldB>=m.
   /// @ingroup BLAS

   template <typename real_t>
   int TRSM(char side, char uplo, char trans, char diag, int_t m, int_t n, complex<real_t> alpha, complex<real_t> *A, int_t ldA, complex<real_t> *B, int_t ldB)
   {

      using std::conj;
      using std::toupper;
      const complex<real_t> zero(0.0,0.0);
      const complex<real_t> one(1.0,0.0);
      int_t i,j,k;
      complex<real_t> *a,*b,*bt;
      complex<real_t> t;
      bool nounit;

      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);

      nounit=(diag=='N')?1:0;

      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      if(alpha==zero)
      {
         b=B;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               b[i]=zero;
            b+=ldB;
         }
      }
      else
      {
         if(side=='L')
         {
            if(trans=='N')
            {
               if(uplo=='U')
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a=A+m*ldA;
                     for(k=m-1;k>=0;k--)
                     {
                        a-=ldA;
                        if(nounit)
                           b[k]=b[k]/a[k];
                        for(i=0;i<k;i++)
                           b[i]-=b[k]*a[i];
                     }
                     b+=ldB;
                  }
               }
               else
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a=A;
                     for(k=0;k<m;k++)
                     {
                        if(nounit)
                           b[k]=b[k]/a[k];
                        for(i=k+1;i<m;i++)
                           b[i]-=b[k]*a[i];
                        a+=ldA;
                     }
                     b+=ldB;
                  }
               }
            }
            else if(trans=='T')
            {
               if(uplo=='U')
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A;
                     for(i=0;i<m;i++)
                     {
                        t=alpha*b[i];
                        for(k=0;k<i;k++)
                           t-=a[k]*b[k];
                        if(nounit)
                           t=t/a[i];
                        b[i]=t;
                        a+=ldA;
                     }
                     b+=ldB;
                  }
               }
               else
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A+m*ldA;
                     for(i=m-1;i>=0;i--)
                     {
                        a-=ldA;
                        t=alpha*b[i];
                        for(k=i+1;k<m;k++)
                           t-=a[k]*b[k];
                        if(nounit)
                           t=t/a[i];
                        b[i]=t;
                     }
                     b+=ldB;
                  }
               }
            }
            else if(trans=='C')
            {
               if(uplo=='U')
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A;
                     for(i=0;i<m;i++)
                     {
                        t=alpha*b[i];
                        for(k=0;k<i;k++)
                           t-=conj(a[k])*b[k];
                        if(nounit)
                           t=t/conj(a[i]);
                        b[i]=t;
                        a+=ldA;
                     }
                     b+=ldB;
                  }
               }
               else
               {
                  b=B;
                  for(j=0;j<n;j++)
                  {
                     a=A+m*ldA;
                     for(i=m-1;i>=0;i--)
                     {
                        a-=ldA;
                        t=alpha*b[i];
                        for(k=i+1;k<m;k++)
                           t-=conj(a[k])*b[k];
                        if(nounit)
                           t=t/conj(a[i]);
                        b[i]=t;
                     }
                     b+=ldB;
                  }
               }
            }
         }
         else
         {
            if(trans=='N')
            {
               if(uplo=='U')
               {
                  b=B;
                  a=A;
                  for(j=0;j<n;j++)
                  {
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     bt=B;
                     for(k=0;k<j;k++)
                     {
                        for(i=0;i<m;i++)
                           b[i]-=a[k]*bt[i];
                        bt+=ldB;
                     }
                     if(nounit)
                     {
                        t=one/a[j];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     a+=ldA;
                     b+=ldB;
                  }
               }
               else
               {
                  b=B+n*ldB;
                  a=A+n*ldA;
                  for(j=n-1;j>=0;j--)
                  {
                     a-=ldA;
                     b-=ldB;
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     bt=B+(j+1)*ldB;
                     for(k=j+1;k<n;k++)
                     {
                        for(i=0;i<m;i++)
                           b[i]-=a[k]*bt[i];
                        bt+=ldB;
                     }
                     if(nounit)
                     {
                        t=one/a[j];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                  }
               }
            }
            else if(trans=='T')
            {
               if(uplo=='U')
               {
                  b=B+n*ldB;
                  a=A+n*ldA;
                  for(k=n-1;k>=0;k--)
                  {
                     a-=ldA;
                     b-=ldB;
                     if(nounit)
                     {
                        t=one/a[k];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B;
                     for(j=0;j<k;j++)
                     {
                        t=a[j];
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                  }
               }
               else
               {
                  a=A;
                  b=B;
                  for(k=0;k<n;k++)
                  {
                     if(nounit)
                     {
                        t=one/a[k];
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B+(k+1)*ldB;
                     for(j=k+1;j<n;j++)
                     {
                        t=a[j];
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a+=ldA;
                     b+=ldB;
                  }
               }
            }
            else if(trans=='C')
            {
               if(uplo=='U')
               {
                  b=B+n*ldB;
                  a=A+n*ldA;
                  for(k=n-1;k>=0;k--)
                  {
                     a-=ldA;
                     b-=ldB;
                     if(nounit)
                     {
                        t=one/conj(a[k]);
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B;
                     for(j=0;j<k;j++)
                     {
                        t=conj(a[j]);
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                  }
               }
               else
               {
                  a=A;
                  b=B;
                  for(k=0;k<n;k++)
                  {
                     if(nounit)
                     {
                        t=one/conj(a[k]);
                        for(i=0;i<m;i++)
                           b[i]*=t;
                     }
                     bt=B+(k+1)*ldB;
                     for(j=k+1;j<n;j++)
                     {
                        t=conj(a[j]);
                        for(i=0;i<m;i++)
                           bt[i]-=t*b[i];
                        bt+=ldB;
                     }
                     for(i=0;i<m;i++)
                        b[i]*=alpha;
                     a+=ldA;
                     b+=ldB;
                  }
               }
            }
         }
      }
      return 0;
   }

#ifdef __latl_cblas
#include <cblas.h>

   template <> int TRSM<float>(char side, char uplo, char trans, char diag, int_t m, int_t n, float alpha, float *A, int_t ldA, float *B, int_t ldB)
   {
      using std::toupper;
      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);
      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_SIDE Side=(side=='L')?CblasLeft:CblasRight;
      const CBLAS_UPLO Uplo=(uplo=='U')?CblasUpper:CblasLower;
      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_DIAG Diag=(diag=='N')?CblasNonUnit:CblasUnit;

      cblas_strsm(CblasColMajor,Side,Uplo,Trans,Diag,m,n,alpha,A,ldA,B,ldB);

      return 0;
   }

   template <> int TRSM<double>(char side, char uplo, char trans, char diag, int_t m, int_t n, double alpha, double *A, int_t ldA, double *B, int_t ldB)
   {
      using std::toupper;
      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);
      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_SIDE Side=(side=='L')?CblasLeft:CblasRight;
      const CBLAS_UPLO Uplo=(uplo=='U')?CblasUpper:CblasLower;
      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_DIAG Diag=(diag=='N')?CblasNonUnit:CblasUnit;

      cblas_dtrsm(CblasColMajor,Side,Uplo,Trans,Diag,m,n,alpha,A,ldA,B,ldB);

      return 0;
   }
   template <> int TRSM<float>(char side, char uplo, char trans, char diag, int_t m, int_t n, complex<float> alpha, complex<float> *A, int_t ldA, complex<float> *B, int_t ldB)
   {
      using std::toupper;
      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);
      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_SIDE Side=(side=='L')?CblasLeft:CblasRight;
      const CBLAS_UPLO Uplo=(uplo=='U')?CblasUpper:CblasLower;
      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_DIAG Diag=(diag=='N')?CblasNonUnit:CblasUnit;

      cblas_ctrsm(CblasColMajor,Side,Uplo,Trans,Diag,m,n,&alpha,A,ldA,B,ldB);

      return 0;
   }

   template <> int TRSM<double>(char side, char uplo, char trans, char diag, int_t m, int_t n, complex<double> alpha, complex<double> *A, int_t ldA, complex<double> *B, int_t ldB)
   {
      using std::toupper;
      side=toupper(side);
      uplo=toupper(uplo);
      trans=toupper(trans);
      diag=toupper(diag);
      if((side!='L')&&(side!='R'))
         return -1;
      else if((uplo!='U')&&(uplo!='L'))
         return -2;
      else if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -3;
      else if((diag!='U')&&(diag!='N'))
         return -4;
      else if(m<0)
         return -5;
      else if(n<0)
         return -6;
      else if(ldA<((side=='L')?m:n))
         return -9;
      else if(ldB<m)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_SIDE Side=(side=='L')?CblasLeft:CblasRight;
      const CBLAS_UPLO Uplo=(uplo=='U')?CblasUpper:CblasLower;
      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_DIAG Diag=(diag=='N')?CblasNonUnit:CblasUnit;

      cblas_ztrsm(CblasColMajor,Side,Uplo,Trans,Diag,m,n,&alpha,A,ldA,B,ldB);

      return 0;
   }
#endif
}
#endif


/* specfunc/test_bessel.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * 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.
 */

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_sf.h>
#include "test_sf.h"

static double J[100];
static double Y[100];
static double I[100];
static double K[100];

int test_bessel(void)
{
  gsl_sf_result r;
  int i;
  int s = 0;
  int sa;

  TEST_SF(s, gsl_sf_bessel_J0_e, (0.1, &r),     0.99750156206604003230,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J0_e, (2.0, &r),     0.22389077914123566805,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J0_e, (100.0, &r),   0.019985850304223122424,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J0_e, (1.0e+10, &r), 2.1755917502468917269e-06, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_J1_e, (0.1, &r),      0.04993752603624199756,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J1_e, (2.0, &r),      0.57672480775687338720,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J1_e, (100.0, &r),   -0.07714535201411215803,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_J1_e, (1.0e+10, &r), -7.676508175684157103e-06, TEST_TOL4, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Jn_e, (4, 0.1, &r),     2.6028648545684032338e-07, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (5, 2.0, &r),     0.007039629755871685484,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (10, 20.0, &r),   0.18648255802394508321,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (100, 100.0, &r), 0.09636667329586155967,    TEST_TOL0, GSL_SUCCESS);

  /* exercise the BUG#3 problem */
  TEST_SF(s, gsl_sf_bessel_Jn_e, (2, 900.0, &r), -0.019974345269680646400, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (2, 15000.0, &r), -0.0020455820181216382666, TEST_TOL4, GSL_SUCCESS);

#ifdef TEST_LARGE
  TEST_SF(s, gsl_sf_bessel_Jn_e, (0, 1.0e+10, &r), 2.1755917502468917269e-06, TEST_SQRT_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (1, 1.0e+10, &r), -7.676508175684157103e-06, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jn_e, (0, 20000, &r), 0.00556597490495494615709982972, TEST_TOL4, GSL_SUCCESS);
#endif

  /*  Testcase demonstrating long calculation time:
      Time spent in gsl_sf_bessel_J_CF1 for large x<1000 and n<5
      grows in proportion to x
      Jonny Taylor <j.m.taylor@durham.ac.uk>  */
  TEST_SF(s, gsl_sf_bessel_Jn_e, (45, 900.0, &r),     0.02562434700634278108,    TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Y0_e, (0.1, &r),         -1.5342386513503668441,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y0_e, (2, &r),            0.5103756726497451196,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y0_e, (256.0, &r),       -0.03381290171792454909 ,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y0_e, (4294967296.0, &r), 3.657903190017678681e-06, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Y1_e, (0.1, &r),         -6.45895109470202698800,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y1_e, (2, &r),           -0.10703243154093754689,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y1_e, (100.0, &r),       -0.020372312002759793305,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Y1_e, (4294967296.0, &r), 0.000011612249378370766284, TEST_TOL4, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Yn_e, (4, 0.1, &r),            -305832.29793353160319,    TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Yn_e, (5, 2, &r),              -9.935989128481974981,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Yn_e, (100, 100.0, &r),        -0.16692141141757650654,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Yn_e, (100, 4294967296.0, &r),  3.657889671577715808e-06, TEST_SQRT_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Yn_e, (1000, 4294967296.0, &r), 3.656551321485397501e-06, 2.0e-05, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Yn_e, (2, 15000.0, &r), -0.006185217273358617849, TEST_TOL4, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_I0_scaled_e, (1e-10, &r),   0.99999999990000000001,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_scaled_e, (0.1, &r),     0.90710092578230109640,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_scaled_e, (2, &r),       0.30850832255367103953,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_scaled_e, (100.0, &r),   0.03994437929909668265,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_scaled_e, (65536.0, &r), 0.0015583712551952223537, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_I1_scaled_e, (0.1, &r),     0.04529844680880932501,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I1_scaled_e, (2, &r),       0.21526928924893765916,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I1_scaled_e, (100.0, &r),   0.03974415302513025267,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I1_scaled_e, (65536.0, &r), 0.0015583593657207350452, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_In_scaled_e, (  -4,    0.1, &r), 2.3575258620054605307e-07, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_scaled_e, (   4,    0.1, &r), 2.3575258620054605307e-07, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_scaled_e, (   5,    2.0, &r), 0.0013297610941881578142, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_scaled_e, ( 100,  100.0, &r), 1.7266862628167695785e-22, TEST_TOL0, GSL_SUCCESS);

  /* BJG: the "exact" values in the following two tests were originally computed from the
     taylor series for I_nu using "long double" and rescaling.  The last few digits
     were inaccurate due to cumulative roundoff.

     BJG: 2006/05 I have now replaced these with the term asymptotic
     expansion from A&S 9.7.1 which should be fully accurate. */

  TEST_SF(s, gsl_sf_bessel_In_scaled_e, (   2,    1e7, &r), 1.261566024466416433e-4, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_scaled_e, (   2,    1e8, &r), 3.989422729212649531e-5, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_I0_e, (0.1, &r), 1.0025015629340956014, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_e, (2.0, &r), 2.2795853023360672674, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I0_e, (100.0, &r), 1.0737517071310738235e+42, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_I1_e, (0.1, &r), 0.05006252604709269211,      TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I1_e, (2.0, &r), 1.59063685463732906340,      TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_I1_e, (100.0, &r), 1.0683693903381624812e+42, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_In_e, (   4,    0.1, &r), 2.6054690212996573677e-07, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_e, (   5,    2.0, &r), 0.009825679323131702321,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_In_e, ( 100,  100.0, &r), 4.641534941616199114e+21,  TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_K0_scaled_e, (0.1, &r), 2.6823261022628943831, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K0_scaled_e, (2.0, &r), 0.8415682150707714179, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K0_scaled_e, (100.0, &r), 0.1251756216591265789, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_K1_scaled_e, (0.1, &r), 10.890182683049696574, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K1_scaled_e, (2.0, &r), 1.0334768470686885732, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K1_scaled_e, (100.0, &r), 0.1257999504795785293, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Kn_scaled_e, (   4,    0.1, &r), 530040.2483725626207, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Kn_scaled_e, (   5,    2.0, &r), 69.68655087607675118, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Kn_scaled_e, ( 100,  100.0, &r), 2.0475736731166756813e+19, TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_K0_e, (0.1, &r), 2.4270690247020166125, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K0_e, (2.0, &r), 0.11389387274953343565, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K0_e, (100.0, &r), 4.656628229175902019e-45, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_K1_e, (0.1, &r), 9.853844780870606135,       TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K1_e, (2.0, &r), 0.13986588181652242728,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_K1_e, (100.0, &r), 4.679853735636909287e-45, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Kn_e, (   4,    0.1, &r), 479600.2497925682849,     TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Kn_e, (   5,    2.0, &r), 9.431049100596467443,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Kn_e, ( 100,  100.0, &r), 7.617129630494085416e-25, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_j0_e, (-10.0, &r), -0.05440211108893698134, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j0_e, (0.001, &r), 0.9999998333333416667, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j0_e, (  1.0, &r), 0.84147098480789650670, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j0_e, ( 10.0, &r), -0.05440211108893698134, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j0_e, (100.0, &r), -0.005063656411097587937, TEST_TOL1, GSL_SUCCESS);
#ifdef FIXME
  TEST_SF(s,  gsl_sf_bessel_j0_e, (1048576.0, &r), 3.1518281938718287624e-07, TEST_TOL2, GSL_SUCCESS);
#endif

  /* these values are from Mathematica */
#ifdef FIXME
  TEST_SF(s,  gsl_sf_bessel_j0_e, (1.0e18, &r), -9.9296932074040507620955e-19, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j0_e, (1.0e20, &r), -6.4525128526578084420581e-21, TEST_TOL0, GSL_SUCCESS);
#endif

  TEST_SF(s,  gsl_sf_bessel_j1_e, (-10.0, &r), -0.07846694179875154709, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j1_e, (0.01, &r), 0.003333300000119047399, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j1_e, (  1.0, &r), 0.30116867893975678925, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j1_e, ( 10.0, &r), 0.07846694179875154709, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j1_e, (100.0, &r), -0.008673825286987815220, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j1_e, (1048576.0, &r), -9.000855242905546158e-07, TEST_TOL0, GSL_SUCCESS);

  /*TEST_SF(s,  gsl_sf_bessel_j1_e, (1.0e18, &r), -1.183719902187107336049e-19, TEST_TOL0, GSL_SUCCESS);*/

  TEST_SF(s,  gsl_sf_bessel_j2_e, (-10.0, &r), 0.07794219362856244547, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j2_e, (0.01, &r), 6.666619047751322551e-06, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j2_e, (  1.0, &r), 0.06203505201137386110, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j2_e, ( 10.0, &r), 0.07794219362856244547, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j2_e, (100.0, &r), 0.004803441652487953480, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_j2_e, (1048576.0, &r), -3.1518539455252413111e-07, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_jl_e, (0, 0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_jl_e, (1,       10.0, &r),   0.07846694179875154709000, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (5,        1.0, &r),   0.00009256115861125816357, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (10,      10.0, &r),   0.06460515449256426427,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (100,    100.0, &r),   0.010880477011438336539,   TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (2000, 1048576.0, &r), 7.449384239168568534e-07,  TEST_SQRT_TOL0, GSL_SUCCESS);

  /* related to BUG#3 problem */
  TEST_SF(s, gsl_sf_bessel_jl_e, (2, 900.0, &r),   -0.0011089115568832940086,  TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_jl_e, (2, 15000.0, &r), -0.00005955592033075750554, TEST_TOL4, GSL_SUCCESS);

  /* Bug report by Mario Santos, value computed from AS 10.1.8 */
  TEST_SF(s,  gsl_sf_bessel_jl_e, (100, 1000.0, &r), -0.00025326311230945818285, TEST_TOL4, GSL_SUCCESS);

  /* Bug reported by Koichi Takahashi <ktakahashi@molsci.org>,
     computed from Pari besseljh(n,x) and AS 10.1.1 */

  TEST_SF(s,  gsl_sf_bessel_jl_e, (30, 3878.62, &r), -0.00023285567034330878410434732790, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (49, 9912.63, &r), 5.2043354544842669214485107019E-5 , TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (49, 9950.35, &r), 5.0077368819565969286578715503E-5 , TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_jl_e, (52, 9930.51, &r), -7.4838588266727718650124475651E-6 , TEST_TOL4, GSL_SUCCESS);

  /* bug report #37209 */
  TEST_SF(s,  gsl_sf_bessel_jl_e, (364, 36.62, &r), 1.118907148986954E-318, TEST_TOL0, GSL_SUCCESS);
  /*TEST_SF(s,  gsl_sf_bessel_jl_e, (149, 1.0, &r), 2.6599182755508469E-307, TEST_TOL0, GSL_SUCCESS);*/

  TEST_SF(s,  gsl_sf_bessel_y0_e, (0.001, &r), -999.99950000004166670, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y0_e, (  1.0, &r), -0.5403023058681397174, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y0_e, ( 10.0, &r), 0.08390715290764524523, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y0_e, (100.0, &r), -0.008623188722876839341, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y0_e, (65536.0, &r), 0.000011014324202158573930, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y0_e, (4294967296.0, &r), 2.0649445131370357007e-10, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_y1_e, ( 0.01, &r), -10000.499987500069444, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y1_e, (  1.0, &r), -1.3817732906760362241, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y1_e, ( 10.0, &r), 0.06279282637970150586, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y1_e, (100.0, &r), 0.004977424523868819543, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y1_e, (4294967296.0, &r), 1.0756463271573404688e-10, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_y2_e, ( 0.01, &r), -3.0000500012499791668e+06, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y2_e, (  1.0, &r), -3.605017566159968955, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y2_e, ( 10.0, &r), -0.06506930499373479347, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y2_e, (100.0, &r), 0.008772511458592903927, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_y2_e, (4294967296.0, &r), -2.0649445123857054207e-10, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_bessel_yl_e, (0,        0.01, &r), -99.995000041666528,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (0,        1.0, &r),  -0.54030230586813972,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (1,       10.0, &r),   0.062792826379701506,   TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (5,        1.0, &r),  -999.44034339223641,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (10,       0.01, &r), -6.5473079797378378e+30, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (10,      10.0, &r),  -0.172453672088057849,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (100,      1.0, &r),  -6.6830794632586775e+186, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (100,    100.0, &r),  -0.0229838504915622811,   TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_bessel_yl_e, (2000, 1048576.0, &r), 5.9545201447146155e-07,  TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_i0_scaled_e, (0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i0_scaled_e, (0.1, &r), 0.9063462346100907067, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i0_scaled_e, (2.0, &r), 0.24542109027781645493, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i0_scaled_e, (100.0, &r), 0.005000000000000000000, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_i1_scaled_e, (0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i1_scaled_e, (0.1, &r), 0.030191419289002226846, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i1_scaled_e, (2.0, &r), 0.131868364583275317610, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i1_scaled_e, (100.0, &r), 0.004950000000000000000, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_i2_scaled_e, (0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i2_scaled_e, (0.1, &r), 0.0006036559400239012567, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i2_scaled_e, (2.0, &r), 0.0476185434029034785100, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_i2_scaled_e, (100.0, &r), 0.0048515000000000000000, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   0, 0.0,   &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   1, 0.0,   &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   4, 0.001, &r), 1.0571434341190365013e-15, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   4,   0.1, &r), 9.579352242057134927e-08,  TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   5,   2.0, &r), 0.0004851564602127540059,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, (   5, 100.0, &r), 0.004300446777500000000,   TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_il_scaled_e, ( 100, 100.0, &r), 1.3898161964299132789e-23, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_k0_scaled_e, (0.1, &r), 15.707963267948966192, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k0_scaled_e, (2.0, &r), 0.7853981633974483096, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k0_scaled_e, (100.0, &r), 0.015707963267948966192, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_k1_scaled_e, (0.1, &r), 172.78759594743862812, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k1_scaled_e, (2.0, &r), 1.1780972450961724644, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k1_scaled_e, (100.0, &r), 0.015865042900628455854, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_k2_scaled_e, (0.1, &r), 5199.335841691107810, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k2_scaled_e, (2.0, &r), 2.5525440310417070063, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_k2_scaled_e, (100.0, &r), 0.016183914554967819868, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_kl_scaled_e, (   4, 1.0/256.0, &r), 1.8205599816961954439e+14, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_kl_scaled_e, (   4, 1.0/8.0, &r),   6.1173217814406597530e+06, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_kl_scaled_e, (   5,   2.0, &r),     138.10735829492005119,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_kl_scaled_e, ( 100, 100.0, &r),     3.985930768060258219e+18,  TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Jnu_e, (0.0001, 1.0, &r),         0.7652115411876708497,  TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (0.0001, 10.0, &r),       -0.2459270166445205,     TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (0.0009765625, 10.0, &r), -0.2458500798634692,     TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (0.75, 1.0, &r),           0.5586524932048917478,  TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (0.75, 10.0, &r),         -0.04968928974751508135, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, ( 1.0, 0.001, &r), 0.0004999999375000026,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, ( 1.0,   1.0, &r), 0.4400505857449335160,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, ( 1.75,  1.0, &r), 0.168593922545763170103,     TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (30.0,   1.0, &r), 3.482869794251482902e-42,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (30.0, 100.0, &r), 0.08146012958117222297,    TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (10.0,   1.0, &r), 2.6306151236874532070e-10, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (10.0, 100.0, &r), -0.05473217693547201474,   TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (10.2, 100.0, &r), -0.03548919161046526864,   TEST_TOL2, GSL_SUCCESS);

  /* related to BUG#3 problem */
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (2.0, 900.0, &r),   -0.019974345269680646400,  TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Jnu_e, (2.0, 15000.0, &r), -0.0020455820181216382666, TEST_TOL4, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Ynu_e, (0.0001, 1.0, &r),  0.08813676933044478439,    TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (0.0001,10.0, &r),  0.05570979797521875261,    TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, ( 0.75,  1.0, &r), -0.6218694174429746383,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, ( 0.75, 10.0, &r),  0.24757063446760384953,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, ( 1.0, 0.001, &r), -636.6221672311394281,      TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, ( 1.0,   1.0, &r), -0.7812128213002887165,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (30.0,   1.0, &r), -3.0481287832256432162e+39, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (30.0, 100.0, &r),  0.006138839212010033452,   TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (10.0,   1.0, &r), -1.2161801427868918929e+08, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (10.0, 100.0, &r),  0.05833157423641492875,    TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Ynu_e, (10.2, 100.0, &r),  0.07169383985546287091,    TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (0.0001,10.0, &r), 0.12783333709581669672,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, ( 1.0, 0.001, &r), 0.0004995003123542213370,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, ( 1.0,   1.0, &r), 0.20791041534970844887,    TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (30.0,   1.0, &r), 1.3021094983785914437e-42, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (30.0, 100.0, &r), 0.0004486987756920986146,  TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (10.0,   1.0, &r), 1.0127529864692066036e-10, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (10.0, 100.0, &r), 0.024176682718258828365,   TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_scaled_e, (10.2, 100.0, &r), 0.023691628843913810043,   TEST_TOL3, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Inu_e, (0.0001,10.0, &r), 2815.7166269770030352,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, ( 1.0, 0.001, &r), 0.0005000000625000026042,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, ( 1.0,   1.0, &r), 0.5651591039924850272,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, (30.0,   1.0, &r), 3.539500588106447747e-42,  TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, (30.0, 100.0, &r), 1.2061548704498434006e+40, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, (10.0,   1.0, &r), 2.7529480398368736252e-10, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, (10.0, 100.0, &r), 6.498975524720147799e+41,  TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Inu_e, (10.2, 100.0, &r), 6.368587361287030443e+41,  TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (0.0001,10.0, &r), 0.3916319346235421817, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, ( 1.0, 0.001, &r), 1000.9967345590684524, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, ( 1.0,   1.0, &r), 1.6361534862632582465, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (30.0,   1.0, &r), 1.2792629867539753925e+40, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (30.0, 100.0, &r), 10.673443449954850040, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (10.0,   1.0, &r), 4.912296520990198599e+08, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (10.0, 100.0, &r), 0.20578687173955779807, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (10.0, 1000.0, &r), 0.04165905142800565788, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (10.0, 1.0e+8, &r), 0.00012533147624060789938, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_scaled_e, (10.2, 100.0, &r), 0.20995808355244385075, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_Knu_e, (0.0001,0.001, &r), 7.023689431812884141,      TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (0.0001,10.0, &r), 0.000017780062324654874306, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, ( 1.0, 0.001, &r), 999.9962381560855743,      TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, ( 1.0,   1.0, &r), 0.6019072301972345747,     TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (10.0, 0.001, &r), 1.8579455483904008064e+38, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (10.0,   1.0, &r), 1.8071328990102945469e+08, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (10.0, 100.0, &r), 7.655427977388100611e-45,  TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (10.2, 100.0, &r), 7.810600225948217841e-45,  TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (30.0,   1.0, &r), 4.706145526783626883e+39,  TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_Knu_e, (30.0, 100.0, &r), 3.970602055959398739e-43,  TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (0.0001,1.0e-100, &r), 5.439794449319847, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (0.0001,0.0001, &r), 2.232835507214331, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (0.0001,10.0, &r), -10.93743282256098, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, ( 1.0, 1.0e-100, &r), 230.2585092994045, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, ( 1.0, 1.0e-10, &r), 23.025850929940456840, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, ( 1.0, 0.001, &r), 6.907751517131146, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, ( 1.0,   1.0, &r), -0.5076519482107523309, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (30.0, 1.0e-100, &r), 6999.113586185543475, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (30.0,   1.0, &r), 91.34968784026325464, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (30.0, 100.0, &r), -97.63224126416760932, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (100.0, 1.0e-100, &r), 23453.606706185466825, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (100.0, 1.0, &r), 427.7532510250188083, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (100.0, 100.0, &r), -55.53422771502921431, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (1000.0, 1.0e-100, &r), 236856.183755993135, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (10000.0, 1.0e-100, &r), 2.39161558914890695e+06, TEST_TOL0, GSL_SUCCESS);

  /* [bug #31528] gsl_sf_bessel_lnKnu overflows for large nu */

  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (180.0, 2.2, &r), 735.1994170369583930752590258, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_lnKnu_e, (3500.5, 1500.0, &r), 1731.220077116482710070986699, TEST_TOL1, GSL_SUCCESS);

  sa = 0;
  gsl_sf_bessel_Jn_array(3, 38, 1.0, J);
  sa += ( test_sf_frac_diff(J[0],  0.0195633539826684059190  ) > TEST_TOL1);
  sa += ( test_sf_frac_diff(J[1],  0.0024766389641099550438  ) > TEST_TOL1);
  sa += ( test_sf_frac_diff(J[10], 1.9256167644801728904e-14 ) > TEST_TOL1);
  sa += ( test_sf_frac_diff(J[35], 6.911232970971626272e-57  ) > TEST_TOL1);
  gsl_test(sa, "  gsl_sf_bessel_Jn_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_Yn_array(3, 38, 1.0, Y);
  sa += ( test_sf_frac_diff(Y[0],  -5.821517605964728848      ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[1],  -33.27842302897211870      ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[10], -1.2753618701519837595e+12 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[35], -1.2124435663593357154e+54 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_Yn_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_In_scaled_array(3, 38, 1.0, I);
  sa += ( test_sf_frac_diff(I[0],  0.0081553077728142938170  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(I[1],  0.0010069302573377758637  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(I[10], 7.341518665628926244e-15  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(I[35], 2.5753065298357542893e-57 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_In_scaled_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_In_array(3, 38, 1.0, Y);
  sa += ( test_sf_frac_diff(Y[0],   0.0221684249243319024760  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[1],   0.0027371202210468663251  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[10],  1.9956316782072007564e-14 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[35],  7.000408942764452901e-57  ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_In_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_Kn_array(3, 38, 1.0, K);
  sa += ( test_sf_frac_diff(K[0],  7.101262824737944506 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[1],  44.23241584706284452 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[10], 1.9215763927929940846e+12 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[35], 1.8789385023806051223e+54 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_Kn_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_Kn_scaled_array(3, 38, 1.0, K);
  sa += ( test_sf_frac_diff(K[0],  19.303233695596904277 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[1],  120.23617222591483717 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[10], 5.223386190525076473e+12 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[35], 5.107484387813251411e+54 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_Kn_scaled_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_jl_array(50, 1.0, J);
  sa += ( test_sf_frac_diff(J[0],  0.84147098480789650670   ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(J[1],  0.30116867893975678925   ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(J[10], 7.116552640047313024e-11 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(J[50], 3.615274717489787311e-81 ) > TEST_TOL2 );
  gsl_test(sa, "  gsl_sf_bessel_jl_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_jl_steed_array(99, 1.0, J);
  sa += ( test_sf_frac_diff(J[0],  0.84147098480789650670   ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(J[1],  0.30116867893975678925   ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(J[10], 7.116552640047313024e-11 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(J[50], 3.615274717489787311e-81 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(J[80], 1.136352423414503264e-144 ) > TEST_TOL1 );
  gsl_test(sa, "  gsl_sf_bessel_jl_steed_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_yl_array(50, 1.0, Y);
  sa += ( test_sf_frac_diff(Y[0],  -0.5403023058681397174 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[1],  -1.3817732906760362241 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[10], -6.722150082562084436e+08  ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(Y[50], -2.7391922846297571576e+78 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_yl_array");
  s += sa;

  {
    double Y0[1];
    sa = 0;
    gsl_sf_bessel_yl_array(0, 1.0, Y0);
    sa += ( test_sf_frac_diff(Y0[0],  -0.5403023058681397174 ) > TEST_TOL0 );
    gsl_test(sa, "  gsl_sf_bessel_yl_array (lmax=0)");
    s += sa;
  }

  sa = 0;
  gsl_sf_bessel_il_scaled_array(50, 1.0, I);
  sa += ( test_sf_frac_diff(I[0],  0.43233235838169365410 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[1],  0.13533528323661269189 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[10], 2.7343719371837065460e-11 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[50], 1.3429606061892023653e-81 ) > TEST_TOL2 );
  gsl_test(sa, "  gsl_sf_bessel_il_scaled_array");
  s += sa;

  sa = 0;
  gsl_sf_bessel_il_scaled_array(50, 0.0, I);
  sa += ( test_sf_frac_diff(I[0],  1.0 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[1],  0.0 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[10], 0.0 ) > TEST_TOL2 );
  sa += ( test_sf_frac_diff(I[50], 0.0 ) > TEST_TOL2 );
  gsl_test(sa, "  gsl_sf_bessel_il_scaled_array (L=0)");
  s += sa;

  sa = 0;
  gsl_sf_bessel_kl_scaled_array(50, 1.0, K);
  sa += ( test_sf_frac_diff(K[0],  1.5707963267948966192     ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[1],  3.1415926535897932385     ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[10], 2.7231075458948147010e+09 ) > TEST_TOL0 );
  sa += ( test_sf_frac_diff(K[50], 1.1578440432804522544e+79 ) > TEST_TOL0 );
  gsl_test(sa, "  gsl_sf_bessel_kl_scaled_array");
  s += sa;

  {
    double K0[1];
    sa = 0;
    gsl_sf_bessel_kl_scaled_array(0, 1.0, K0);
    sa += ( test_sf_frac_diff(K[0],  1.5707963267948966192     ) > TEST_TOL0 );
    gsl_test(sa, "  gsl_sf_bessel_kl_scaled_array (lmax=0)");
    s += sa;
  }

  sa = 0;
  sa += ( gsl_sf_bessel_zero_J0_e(0, &r) != GSL_EINVAL );
  sa += ( r.val != 0.0 );
  s += sa;
  TEST_SF(s, gsl_sf_bessel_zero_J0_e, ( 1,  &r),  2.404825557695771, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J0_e, ( 2,  &r),  5.520078110286304, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J0_e, (20,  &r), 62.048469190227081, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J0_e, (25,  &r), 77.756025630388058, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J0_e, (100, &r), 313.37426607752784, TEST_TOL1, GSL_SUCCESS);

  sa = 0;
  sa += ( gsl_sf_bessel_zero_J1_e(0, &r) != GSL_SUCCESS );
  sa += ( r.val != 0.0 );
  s += sa;
  TEST_SF(s, gsl_sf_bessel_zero_J1_e, ( 1,  &r), 3.831705970207512, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J1_e, ( 2,  &r), 7.015586669815619, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J1_e, (20,  &r), 63.61135669848124, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J1_e, (25,  &r), 79.32048717547630, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_J1_e, (100, &r), 314.9434728377672, TEST_TOL2, GSL_SUCCESS);

  sa = 0;
  sa += ( gsl_sf_bessel_zero_Jnu_e(0.0, 0, &r) != GSL_EINVAL );
  sa += ( r.val != 0.0 );
  s += sa;
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (0.0,  1,  &r),  2.404825557695771, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (0.0,  2,  &r),  5.520078110286304, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (0.0, 20,  &r), 62.048469190227081, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (0.0, 25,  &r), 77.756025630388058, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (0.0, 100, &r), 313.37426607752784, TEST_TOL1, GSL_SUCCESS);

  sa = 0;
  sa += ( gsl_sf_bessel_zero_Jnu_e(1.0, 0, &r) != GSL_SUCCESS );
  sa += (r.val != 0.0);
  s += sa;
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 1, &r),  4.4934094579090641, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 1, &r),  8.7714838159599540, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 2, &r),  7.7252518369377072, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 2, &r),  12.338604197466944, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 3, &r),  10.904121659428900, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 3, &r),  15.700174079711671, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 4, &r),  14.066193912831473, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 4, &r),  18.980133875179921, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 5, &r),  17.220755271930768, TEST_TOL1, GSL_SUCCESS);

  /* Something wrong with the tolerances on these */
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 5, &r),  22.217799896561268, TEST_SQRT_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 8.0, 5, &r),  26.266814641176644, TEST_SQRT_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (20.0, 5, &r),  41.413065513892636, TEST_SQRT_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 6, &r),  20.371302959287563, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 6, &r),  25.430341154222704, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 8.0, 6, &r),  29.545659670998550, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 7, &r),  23.519452498689007, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 7, &r),  28.626618307291138, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 8.0, 7, &r),  32.795800037341462, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 8, &r),  26.666054258812674, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 8, &r),  31.811716724047763, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (10.0, 8, &r),  38.761807017881651, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 9, &r),  29.811598790892959, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 9, &r),  34.988781294559295, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (10.0, 9, &r),  42.004190236671805, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 1.5, 10, &r),  32.956389039822477, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 10, &r),  38.159868561967132, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 10, &r),  52.017241278881633, TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 11,  &r), 41.326383254047406, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 11,  &r), 55.289204146560061, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 12,  &r), 44.4893191232197314, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 12,  &r), 58.5458289043850856, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 13,  &r), 47.6493998066970948, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 13,  &r), 61.7897598959450550, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 14,  &r), 50.8071652030063595, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 14,  &r), 65.0230502510422545, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 15,  &r), 53.9630265583781707, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 15,  &r), 68.2473219964207837, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 16,  &r), 57.1173027815042647, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 16,  &r), 71.4638758850226630, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 17,  &r), 60.2702450729428077, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 17,  &r), 74.6737687121404241, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 18,  &r), 63.4220540458757799, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 18,  &r), 77.8778689734863729, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 19,  &r), 66.5728918871182703, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 19,  &r), 81.0768977206328326, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 5.0, 20,  &r), 69.722891161716742,  TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (15.0, 20,  &r), 84.271459069716442,  TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 23.0, 11,  &r), 65.843393469524653, TEST_TOL6, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 30.0, 11,  &r), 74.797306585175426, TEST_TOL6, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 32.0, 15,  &r), 90.913637691861741, TEST_TOL6, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 50.0, 15,  &r), 113.69747988073942, TEST_TOL6, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (  5.0, 22,  &r), 76.020793430591605, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 10.0, 22,  &r), 83.439189796105756, TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, ( 12.0, 22,  &r), 86.345496520534055, TEST_TOL6, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (100.0, 22,  &r), 199.82150220122519, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_bessel_zero_Jnu_e, (500.0, 22,  &r), 649.34132440891735, TEST_TOL2, GSL_SUCCESS);

  sa = 0;
  for(i=0; i<100; i++) {
    J[i] = i/10.0;
  }
  gsl_sf_bessel_sequence_Jnu_e(2.0, GSL_MODE_DEFAULT, 100, J);
  sa += ( test_sf_frac_diff(J[1],  0.0012489586587999188454 ) > TEST_TOL1 );
  sa += ( test_sf_frac_diff(J[20], 0.3528340286156377192 ) > TEST_TOL4 );
  sa += ( test_sf_frac_diff(J[50], 0.0465651162777522155 ) > TEST_TOL4 );
  gsl_test(sa, "  gsl_sf_sequence_Jnu_e(2)");
  s += sa;

  sa = 0;
  for(i=0; i<100; i++) {
    J[i] = i;
  }
  gsl_sf_bessel_sequence_Jnu_e(12.0, GSL_MODE_DEFAULT, 100, J);
  sa += ( test_sf_frac_diff(J[1],   4.999718179448405289e-13 ) > TEST_TOL1 );
  sa += ( test_sf_frac_diff(J[5],   7.627813166084551355e-05 ) > TEST_TOL1 );
  sa += ( test_sf_frac_diff(J[7],   2.655620035894568062e-03 ) > TEST_TOL3 );
  sa += ( test_sf_frac_diff(J[10],  6.337025497015601509e-02 ) > TEST_TOL3 );
  sa += ( test_sf_frac_diff(J[15],  0.23666584405476805591 ) > TEST_TOL3 );
  sa += ( test_sf_frac_diff(J[30],  0.14825335109966010021 ) > TEST_TOL3 );
  sa += ( test_sf_frac_diff(J[70],  0.04109913716555364262 ) > TEST_TOL4 );
  sa += ( test_sf_frac_diff(J[99], -0.0015052760501176728  ) > TEST_TOL5 );
  gsl_test(sa, "  gsl_sf_sequence_Jnu_e(12)");
  s += sa;

  sa = 0;
  for(i=0; i<100; i++) {
    J[i] = i * 20;
  }
  gsl_sf_bessel_sequence_Jnu_e(1000.0, GSL_MODE_DEFAULT, 100, J);
  sa += ( test_sf_frac_diff(J[50],  0.04473067294796404088 ) > TEST_TOL5 );
  sa += ( test_sf_frac_diff(J[99],  0.01400619760349853902 ) > TEST_TOL6 );
  gsl_test(sa, "  gsl_sf_sequence_Jnu_e(1000)");
  s += sa;

  return s;
}


//STARTWHOLE
static char help[] = "Solve a 4x4 linear system using KSP.\n";

#include <petsc.h>

int main(int argc,char **args) {
    PetscErrorCode ierr;
    Vec        x, b;
    Mat        A;
    KSP        ksp;
    PetscInt   i, j[4] = {0, 1, 2, 3};                // j = column index
    PetscReal  ab[4] = {7.0, 1.0, 1.0, 3.0},          // vector entries
               aA[4][4] = {{ 1.0,  2.0,  3.0,  0.0},  // matrix entries
                           { 2.0,  1.0, -2.0, -3.0},
                           {-1.0,  1.0,  1.0,  0.0},
                           { 0.0,  1.0,  1.0, -1.0}};

    ierr = PetscInitialize(&argc,&args,NULL,help); if (ierr) return ierr;

    ierr = VecCreate(PETSC_COMM_WORLD,&b); CHKERRQ(ierr);
    ierr = VecSetSizes(b,PETSC_DECIDE,4); CHKERRQ(ierr);
    ierr = VecSetFromOptions(b); CHKERRQ(ierr);
    ierr = VecSetValues(b,4,j,ab,INSERT_VALUES); CHKERRQ(ierr);
    ierr = VecAssemblyBegin(b); CHKERRQ(ierr);
    ierr = VecAssemblyEnd(b); CHKERRQ(ierr);

    ierr = MatCreate(PETSC_COMM_WORLD,&A); CHKERRQ(ierr);
    ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,4,4); CHKERRQ(ierr);
    ierr = MatSetFromOptions(A); CHKERRQ(ierr);
    ierr = MatSetUp(A); CHKERRQ(ierr);
    for (i=0; i<4; i++) {   // set entries one row at a time
        ierr = MatSetValues(A,1,&i,4,j,aA[i],INSERT_VALUES); CHKERRQ(ierr);
    }
    ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);

    ierr = KSPCreate(PETSC_COMM_WORLD,&ksp); CHKERRQ(ierr);
    ierr = KSPSetOperators(ksp,A,A); CHKERRQ(ierr);
    ierr = KSPSetFromOptions(ksp); CHKERRQ(ierr);
    ierr = VecDuplicate(b,&x); CHKERRQ(ierr);
    ierr = KSPSolve(ksp,b,x); CHKERRQ(ierr);
    ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);

    KSPDestroy(&ksp);  MatDestroy(&A);
    VecDestroy(&x);  VecDestroy(&b);
    return PetscFinalize();
}
//ENDWHOLE


/*
* C functions for the NIG marginal distribution.
*
* This file is part of Fieldosophy, a toolkit for random fields.
*
* Copyright (C) 2021 Anders Gunnar Felix Hildeman <fieldosophySPDEC@gmail.com>
*
* This Source Code is subject to the terms of the BSD 3-Clause License.
* If a copy of the license was not distributed with this file, you can obtain one at https://opensource.org/licenses/BSD-3-Clause.
*
*
* Author: Anders Gunnar Felix Hildeman
* Date: 2020-04
*/

#include <stdio.h>
#include <string.h>
#include <math.h>
#include <omp.h>
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>

extern "C"
{

    // Make sure that alpha tilde is not too large
    void NIG_filterParams( double *pAlphaTilde, double *pBetaTilde)
    {
        if (*pAlphaTilde > 100.0d)
        {
            *pBetaTilde = *pBetaTilde * ( 100.0d / (*pAlphaTilde) );
            *pAlphaTilde = 100.0d;
        }

        return;
    }

    // Modified Bessel function of the second kind
    double Kv(const int v, const double x)
    {
        double lOut = 0.0d;
        int status;

        gsl_sf_result result;

        switch(v)
        {
        case 0:
            status = gsl_sf_bessel_K0_e(x, &result);
            break;
        case 1:
            status = gsl_sf_bessel_K1_e(x, &result);
            break;
        default:
            status = gsl_sf_bessel_Kn_e(v, x, &result);
            break;
        }

        // If some kind of error
        if (status != 0)
        {
            //printf("Error code: %d in Kv", status);
            lOut = GSL_NAN;
        }
        else
        {
            lOut = result.val;
        }

        return lOut;
    }

    // Logarithm of modified Bessel function of second kind
    double lKv(const int v, const double x)
    {
        double lOut = Kv( v, x );
        // Logarithmize
        lOut = log( lOut );

        return lOut;
    }

    // logarithm of PDF for NIG distribution
    unsigned int NIG_lpdf( double * const pX, const unsigned int pN, const double alphaTilde, const double betaTilde, const double mu, const double delta )
    {
        // turn off gsl error handler
        gsl_set_error_handler_off();

        // Loop through each element in vector
        #pragma omp parallel for
        for ( unsigned int iter = 0; iter < pN; iter++)
        {
            // Get normalized data value
            const double lCur = (pX[iter] - mu) / delta;
            // Compute q function
            const double lQ = sqrt( (1.0d + lCur * lCur) );
            // Compute bessel function
            const double lLogK = lKv(1, alphaTilde * lQ);

            // compute log pdf
            double lCurOut = lLogK;
            lCurOut -= log(lQ);
            lCurOut += betaTilde * lCur;
            // Add constants
            lCurOut += log( alphaTilde / M_PI ) + sqrt( alphaTilde * alphaTilde - betaTilde * betaTilde );
            lCurOut -= log(delta);

            // Store full log pdf
            pX[iter] = lCurOut;
        }

        return pN;
    }

    // Compute log-likelihood
    double NIG_logLikelihood( double * lOut, const double * const pX, const unsigned int pN, const double alphaTilde, const double betaTilde, const double mu, const double delta )
    {
        // Copy content
        memcpy( lOut, pX, sizeof(double) * pN );

        // Compute log-pdf
        NIG_lpdf( lOut, pN, alphaTilde, betaTilde, mu, delta );
        // Sum
        double lSum = 0.0d;
        for (unsigned int iter = 0; iter < pN; iter++)
        {
            lSum += lOut[iter];
        }

        return lSum;
    }

    // EM-algorithm for finding MLE of NIG
    unsigned int NIG_MLE( double * const pLogLik, double * const pX, const unsigned int pN,
        double * const pAlphaTilde, double * const pBetaTilde, double * const pMu, double * const pDelta,
        const double pXBar, const unsigned int pM, const double pTol )
    {

        // turn off gsl error handler
        gsl_set_error_handler_off();

        // Init
        double lAlphaTilde = *pAlphaTilde;
        double lBetaTilde = *pBetaTilde;
        double lMu = *pMu;
        double lDelta = *pDelta;
        // Filter tilde parameters
        NIG_filterParams( &lAlphaTilde, &lBetaTilde);

        // Preallocate arrays
        double * lTempArray1 = (double*) malloc(sizeof(double) * pN);
        double * lTempArray2 = (double*) malloc(sizeof(double) * pN);
        if (lTempArray1 == NULL || lTempArray2 == NULL)
            return 1;

        // Compute log-likelihood
        *pLogLik = NIG_logLikelihood( lTempArray1, pX, pN, lAlphaTilde, lBetaTilde, lMu, lDelta );

        // If likelihood is bad
        if (isnan(*pLogLik))
            return 1;

        // Iterate EM-algorithm
        for (unsigned int iter = 0; iter < pM; iter++)
        {
            // --- E-step ---

            double lSBar = 0.0d;
            double lWBar = 0.0d;
            #pragma omp parallel for reduction(+:lSBar) reduction(+:lWBar)
            for (unsigned int iter2 = 0; iter2 < pN; iter2++)
            {
                const double lPhiSqrt = sqrt( 1.0d + ( (pX[iter2]-lMu)/lDelta ) * ( (pX[iter2]-lMu)/lDelta )  );
                // compute besselk function values
                const double lK0 = Kv( 0, lAlphaTilde * lPhiSqrt );
                const double lK1 = Kv( 1, lAlphaTilde * lPhiSqrt );
                const double lK2 = Kv( 2, lAlphaTilde * lPhiSqrt );
                // Compute pseudo values
                lTempArray1[iter2] = ( lDelta * lPhiSqrt * lK0 ) / ( (lAlphaTilde * lK1) / lDelta ); // S
                lTempArray2[iter2] = ( (lAlphaTilde * lK2) / lDelta ) / ( lDelta * lPhiSqrt * lK1 ); // W
                lSBar += lTempArray1[iter2];
                lWBar += lTempArray2[iter2];
            }
            lSBar /= ((double)pN);
            lWBar /= ((double)pN);

            // --- M-step ---

            // Compute delta
            lDelta = sqrt( 1.0d / ( lWBar - (1.0d / lSBar) ) );
            double lGamma = lDelta / lSBar;
            // Compute beta
            double lBeta = 0.0d;
            for (unsigned int iter2 = 0; iter2 < pN; iter2++)
            {
                lBeta += pX[iter2] * lTempArray2[iter2];
            }
            lBeta = lBeta - pXBar * lWBar * ((double)pN);
            lBeta /= ( (double)pN - lSBar * lWBar * ((double)pN) );
            lBetaTilde = lBeta * lDelta;
            // Compute alpha
            double lAlpha = sqrt( lGamma * lGamma + lBeta * lBeta );
            lAlphaTilde = lAlpha * lDelta;
            // Filter tilde values
            NIG_filterParams( &lAlphaTilde, &lBetaTilde);
            lGamma = sqrt( lAlphaTilde * lAlphaTilde - lBetaTilde * lBetaTilde ) / lDelta;
            // Compute mu
            lMu = pXBar - lBetaTilde / lGamma;

            // Compute loglik
            const double llLikNew = NIG_logLikelihood( lTempArray1, pX, pN, lAlphaTilde, lBetaTilde, lMu, lDelta );

            // If likelihood is bad
            if (isnan(llLikNew))
                return(iter+2);    // Mark that likelihood went bad during iterations

            // Compute likelihood difference
            const double lLLikDiff = llLikNew - *pLogLik;

            // If new likelihood is higher
            if (lLLikDiff > 0)
            {
                // Set new log-likelihood as old one
                *pLogLik = llLikNew;
                // Update output parameters
                *pAlphaTilde = lAlphaTilde;
                *pBetaTilde = lBetaTilde;
                *pMu = lMu;
                *pDelta = lDelta;

                // If should break due to tolerance
                if ( lLLikDiff < pTol )
                    break;
            }

        }   // end of EM-iterations

        // Free allocated arrays
        free(lTempArray1);
        free(lTempArray2);

         // Return no problem
         return( 0 );
    }

}