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

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

#include "ccl.h"

/* --------- ROUTINE: h_over_h0 ---------
INPUT: scale factor, cosmology
TASK: Compute E(a)=H(a)/H0
*/
static double h_over_h0(double a, ccl_cosmology * cosmo, int *status)
{
  // Check if massive neutrinos are present - if not, we don't need to
  // compute their contribution
  double Om_mass_nu;
  if ((cosmo->params.N_nu_mass)>1e-12) {
    Om_mass_nu = ccl_Omeganuh2(
      a, cosmo->params.N_nu_mass, cosmo->params.m_nu, cosmo->params.T_CMB,
      status) / (cosmo->params.h) / (cosmo->params.h);
  }
  else {
    Om_mass_nu = 0;
  }

  /* Calculate h^2 using the formula (eqn 2 in the CCL paper):
    E(a)^2 = Omega_m a^-3 +
             Omega_l a^(-3*(1+w0+wa)) exp(3*wa*(a-1)) +
             Omega_k a^-2 +
             (Omega_g + Omega_nu_rel) a^-4 +
             Om_mass_nu
  */
  return sqrt(
    (cosmo->params.Omega_c + cosmo->params.Omega_b +
     cosmo->params.Omega_l *
       pow(a,-3*(cosmo->params.w0+cosmo->params.wa)) *
       exp(3*cosmo->params.wa*(a-1)) +
     cosmo->params.Omega_k * a +
     (cosmo->params.Omega_g + cosmo->params.Omega_nu_rel) / a +
     Om_mass_nu * a*a*a) / (a*a*a));
}

/* --------- ROUTINE: ccl_omega_x ---------
INPUT: cosmology object, scale factor, species label
TASK: Compute the density relative to critical, Omega(a) for a given species.
Possible values for "label":
ccl_species_crit_label <- critical (physical)
ccl_species_m_label <- matter
ccl_species_l_label <- DE
ccl_species_g_label <- radiation
ccl_species_k_label <- curvature
ccl_species_ur_label <- massless neutrinos
ccl_species_nu_label <- massive neutrinos
*/
double ccl_omega_x(ccl_cosmology * cosmo, double a, ccl_species_x_label label, int *status)
{
  // If massive neutrinos are present, compute the phase-space integral and
  // get OmegaNuh2. If not, set OmegaNuh2 to zero.
  double OmNuh2;
  if ((cosmo->params.N_nu_mass) > 0.0001) {
    // Call the massive neutrino density function just once at this redshift.
    OmNuh2 = ccl_Omeganuh2(a, cosmo->params.N_nu_mass, cosmo->params.m_nu,
                           cosmo->params.T_CMB, status);
  }
  else {
    OmNuh2 = 0.;
  }

  double hnorm = h_over_h0(a, cosmo, status);

  switch(label) {
    case ccl_species_crit_label :
      return 1.;
    case ccl_species_m_label :
      return (cosmo->params.Omega_c + cosmo->params.Omega_b) / (a*a*a) / hnorm / hnorm +
          OmNuh2 / (cosmo->params.h) / (cosmo->params.h) / hnorm / hnorm;
    case ccl_species_l_label :
      return
        cosmo->params.Omega_l *
        pow(a,-3 * (1 + cosmo->params.w0 + cosmo->params.wa)) *
        exp(3 * cosmo->params.wa * (a-1)) / hnorm / hnorm;
    case ccl_species_g_label :
      return cosmo->params.Omega_g / (a*a*a*a) / hnorm / hnorm;
    case ccl_species_k_label :
      return cosmo->params.Omega_k / (a*a) / hnorm / hnorm;
    case ccl_species_ur_label :
      return cosmo->params.Omega_nu_rel / (a*a*a*a) / hnorm / hnorm;
    case ccl_species_nu_label :
      return OmNuh2 / (cosmo->params.h) / (cosmo->params.h) / hnorm / hnorm;
    default:
      *status = CCL_ERROR_PARAMETERS;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_omega_x(): Species %d not supported\n", label);
      return NAN;
  }
}

/* --------- ROUTINE: ccl_rho_x ---------
INPUT: cosmology object, scale factor, species label
TASK: Compute rho_x(a), with x defined by species label.
Possible values for "label":
ccl_species_crit_label <- critical (physical)
ccl_species_m_label <- matter (physical)
ccl_species_l_label <- DE (physical)
ccl_species_g_label <- radiation (physical)
ccl_species_k_label <- curvature (physical)
ccl_species_ur_label <- massless neutrinos (physical)
ccl_species_nu_label <- massive neutrinos (physical)
*/
double ccl_rho_x(ccl_cosmology * cosmo, double a, ccl_species_x_label label, int is_comoving, int *status)
{
  double comfac;
  if (is_comoving) {
     comfac = a*a*a;
  } else {
      comfac = 1.0;
  }
  double hnorm = h_over_h0(a, cosmo, status);
  double rhocrit =
    ccl_constants.RHO_CRITICAL *
    (cosmo->params.h) *
    (cosmo->params.h) * hnorm * hnorm * comfac;

  return rhocrit * ccl_omega_x(cosmo, a, label, status);
}

/* --------- ROUTINE: ccl_mu_MG ---------
INPUT: cosmology object, scale factor
TASK: Compute mu(a) where mu is one of the the parameterizating functions
of modifications to GR in the quasistatic approximation.
*/

double ccl_mu_MG(ccl_cosmology * cosmo, double a, int *status)
{
    // This function can be extended to include other
    // z-dependences for mu in the future.
    return cosmo->params.mu_0 * ccl_omega_x(cosmo, a, ccl_species_l_label, status) / cosmo->params.Omega_l;
}

/* --------- ROUTINE: ccl_Sig_MG ---------
INPUT: cosmology object, scale factor
TASK: Compute Sigma(a) where Sigma is one of the the parameterizating functions
of modifications to GR in the quasistatic approximation.
*/

double ccl_Sig_MG(ccl_cosmology * cosmo, double a, int *status)
{
    // This function can be extended to include other
    // z-dependences for Sigma in the future.
    return cosmo->params.sigma_0 * ccl_omega_x(cosmo, a, ccl_species_l_label, status) / cosmo->params.Omega_l;
}

// Structure to hold parameters of chi_integrand
typedef struct {
  ccl_cosmology *cosmo;
  int * status;
} chipar;

/* --------- ROUTINE: chi_integrand ---------
INPUT: scale factor
TASK: compute the integrand of the comoving distance
*/
static double chi_integrand(double a, void * params_void)
{
  ccl_cosmology * cosmo = ((chipar *)params_void)->cosmo;
  int *status = ((chipar *)params_void)->status;

  return ccl_constants.CLIGHT_HMPC/(a*a*h_over_h0(a, cosmo, status));
}

/* --------- ROUTINE: growth_ode_system ---------
INPUT: scale factor
TASK: Define the ODE system to be solved in order to compute the growth (of the density)
*/
static int growth_ode_system(double a,const double y[],double dydt[],void *params)
{
  int status = 0;
  ccl_cosmology * cosmo = params;

  double hnorm=h_over_h0(a,cosmo, &status);
  double om=ccl_omega_x(cosmo, a, ccl_species_m_label, &status);

  dydt[1]=1.5*hnorm*a*om*y[0];
  dydt[0]=y[1]/(a*a*a*hnorm);

  return status;
}

/* --------- ROUTINE: growth_ode_system_muSig ---------
INPUT: scale factor
TASK: Define the ODE system to be solved in order to compute the growth (of the density)
* in the case in which we use the mu / Sigma quasistatic parameterisation of modified gravity
*/
static int growth_ode_system_muSig(double a,const double y[],double dydt[],void *params)
{
  int status = 0;
  ccl_cosmology * cosmo = params;

  double hnorm=h_over_h0(a,cosmo, &status);
  double om=ccl_omega_x(cosmo, a, ccl_species_m_label, &status);

  double mu = ccl_mu_MG(cosmo, a, &status);
  dydt[1]=1.5*hnorm*a*om*y[0]*(1. + mu);

  dydt[0]=y[1]/(a*a*a*hnorm);

  return status;
}

/* --------- ROUTINE: df_integrand ---------
INPUT: scale factor, spline object
TASK: Compute integrand from modified growth function
*/
static double df_integrand(double a,void * spline_void)
{
  if(a<=0)
    return 0;
  else {
    gsl_spline *df_a_spline=(gsl_spline *)spline_void;

    return gsl_spline_eval(df_a_spline,a,NULL)/a;
  }
}

/* --------- ROUTINE: growth_factor_and_growth_rate ---------
INPUT: scale factor, cosmology
TASK: compute the growth (D(z)) and the growth rate, logarithmic derivative (f?)
*/

static int growth_factor_and_growth_rate(double a, double *gf, double *fg, ccl_cosmology *cosmo, int *stat)
{
  if(a < cosmo->gsl_params.EPS_SCALEFAC_GROWTH) {
    *gf = a;
    *fg = 1;
    return 0;
  }
  else {
    int gslstatus;
    double y[2];
    double ainit = cosmo->gsl_params.EPS_SCALEFAC_GROWTH;

    // if mu0 == 0, call normal growth_ode_system, otherwise call growth_ode_system_muSig
    if (cosmo->params.mu_0 > 1e-12 || cosmo->params.mu_0 < -1e-12) {
      gsl_odeiv2_system sys = {growth_ode_system_muSig, NULL, 2, cosmo};

      gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new(
        &sys, gsl_odeiv2_step_rkck,
        0.1*cosmo->gsl_params.EPS_SCALEFAC_GROWTH, 0, cosmo->gsl_params.ODE_GROWTH_EPSREL);

      if (d == NULL) {
        return CCL_ERROR_MEMORY;
      }

      y[0] = cosmo->gsl_params.EPS_SCALEFAC_GROWTH;
      y[1] = (
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH *
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH *
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH *
        h_over_h0(cosmo->gsl_params.EPS_SCALEFAC_GROWTH, cosmo, stat));

      gslstatus = gsl_odeiv2_driver_apply(d, &ainit, a, y);
      gsl_odeiv2_driver_free(d);

      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: growth_factor_and_growth_rate():");
        return 0;
      }

      *gf = y[0];
      *fg = y[1]/(a*a*h_over_h0(a, cosmo, stat)*y[0]);
      return 0;
    }
    else {
      gsl_odeiv2_system sys = {growth_ode_system, NULL, 2, cosmo};

      gsl_odeiv2_driver *d = gsl_odeiv2_driver_alloc_y_new(
        &sys, gsl_odeiv2_step_rkck,
        0.1*cosmo->gsl_params.EPS_SCALEFAC_GROWTH, 0, cosmo->gsl_params.ODE_GROWTH_EPSREL);

      if (d == NULL) {
        return CCL_ERROR_MEMORY;
      }

      y[0] = cosmo->gsl_params.EPS_SCALEFAC_GROWTH;
      y[1] = (
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH *
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH *
        cosmo->gsl_params.EPS_SCALEFAC_GROWTH*
        h_over_h0(cosmo->gsl_params.EPS_SCALEFAC_GROWTH, cosmo, stat));

      gslstatus = gsl_odeiv2_driver_apply(d, &ainit, a, y);
      gsl_odeiv2_driver_free(d);

      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: growth_factor_and_growth_rate():");
        return 0;
      }

      *gf = y[0];
      *fg = y[1]/(a*a*h_over_h0(a, cosmo, stat)*y[0]);

      return 0;
    }
  }
}

/* --------- ROUTINE: compute_chi ---------
INPUT: scale factor, cosmology
OUTPUT: chi -> radial comoving distance
TASK: compute radial comoving distance at a
*/
void compute_chi(double a, ccl_cosmology *cosmo, double * chi, int * stat)
{
  int gslstatus;
  double result;
  chipar p;

  p.cosmo=cosmo;
  p.status=stat;

  gsl_integration_cquad_workspace * workspace = NULL;

  gsl_function F;
  F.function = &chi_integrand;
  F.params = &p;

  workspace = gsl_integration_cquad_workspace_alloc(cosmo->gsl_params.N_ITERATION);

  if (workspace == NULL) {
      *stat = CCL_ERROR_MEMORY;
  } else {
    //TODO: CQUAD is great, but slower than other methods. This could be sped up if it becomes an issue.
    gslstatus=gsl_integration_cquad(
      &F, a, 1.0, 0.0, cosmo->gsl_params.INTEGRATION_DISTANCE_EPSREL, workspace, &result, NULL, NULL);
    *chi=result/cosmo->params.h;

    if (gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: compute_chi():");
      *stat = CCL_ERROR_COMPUTECHI;
    }
  }

  gsl_integration_cquad_workspace_free(workspace);
}

//Root finding for a(chi)
typedef struct {
  double chi;
  ccl_cosmology *cosmo;
  int * status;
} Fpar;

static double fzero(double a,void *params)
{
  double chi,chia,a_use=a;

  chi=((Fpar *)params)->chi;
  compute_chi(a_use,((Fpar *)params)->cosmo,&chia, ((Fpar *)params)->status);

  return chi-chia;
}

static double dfzero(double a,void *params)
{
  ccl_cosmology *cosmo=((Fpar *)params)->cosmo;
  int *stat = ((Fpar *)params)->status;

  chipar p;
  p.cosmo=cosmo;
  p.status=stat;

  return chi_integrand(a,&p)/cosmo->params.h;
}

static void fdfzero(double a,void *params,double *f,double *df)
{
  *f=fzero(a,params);
  *df=dfzero(a,params);
}

/* --------- ROUTINE: a_of_chi ---------
INPUT: comoving distance chi, cosmology, stat, a_old, gsl_root_fdfsolver
OUTPUT: scale factor
TASK: compute the scale factor that corresponds to a given comoving distance chi
Note: This routine uses a root solver to find an a such that compute_chi(a) = chi.
The root solver uses the derivative of compute_chi (which is chi_integrand) and
the value itself.
*/
static void a_of_chi(double chi, ccl_cosmology *cosmo, int* stat, double *a_old, gsl_root_fdfsolver *s)
{
  if(chi==0) {
    *a_old=1;
  }
  else {
    Fpar p;
    gsl_function_fdf FDF;
    double a_previous,a_current=*a_old;

    p.cosmo=cosmo;
    p.chi=chi;
    p.status=stat;
    FDF.f=&fzero;
    FDF.df=&dfzero;
    FDF.fdf=&fdfzero;
    FDF.params=&p;
    gsl_root_fdfsolver_set(s,&FDF,a_current);

    int iter=0, gslstatus;
    do {
      iter++;
      gslstatus=gsl_root_fdfsolver_iterate(s);
      if(gslstatus!=GSL_SUCCESS) ccl_raise_gsl_warning(gslstatus, "ccl_background.c: a_of_chi():");
      a_previous=a_current;
      a_current=gsl_root_fdfsolver_root(s);
      gslstatus=gsl_root_test_delta(a_current, a_previous, 0, cosmo->gsl_params.ROOT_EPSREL);
    } while(gslstatus==GSL_CONTINUE && iter <= cosmo->gsl_params.ROOT_N_ITERATION);

    *a_old=a_current;

    // Allows us to pass a status to h_over_h0 for the neutrino integral calculation.
    if(gslstatus==GSL_SUCCESS) {
      *stat = *(p.status);
    }
    else {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: a_of_chi():");
      *stat = CCL_ERROR_COMPUTECHI;
    }
  }
}

/* ----- ROUTINE: ccl_cosmology_compute_distances ------
INPUT: cosmology
TASK: if not already there, make a table of comoving distances and of E(a)
*/

void ccl_cosmology_compute_distances(ccl_cosmology * cosmo, int *status)
{
  //Do nothing if everything is computed already
  if(cosmo->computed_distances)
    return;

  // Create logarithmically and then linearly-spaced values of the scale factor
  int na = cosmo->spline_params.A_SPLINE_NA+cosmo->spline_params.A_SPLINE_NLOG-1;
  double * a = ccl_linlog_spacing(
    cosmo->spline_params.A_SPLINE_MINLOG, cosmo->spline_params.A_SPLINE_MIN,
    cosmo->spline_params.A_SPLINE_MAX, cosmo->spline_params.A_SPLINE_NLOG,
    cosmo->spline_params.A_SPLINE_NA);
  // Allocate arrays for all three of E(a), chi(a), and a(chi)
  double *E_a = malloc(sizeof(double)*na);
  double *chi_a = malloc(sizeof(double)*na);
  // Allocate E(a) and chi(a) splines
  gsl_spline * E = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  gsl_spline * chi = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  // a(chi) spline allocated below

  //Check for too little memory
  if (a == NULL || E_a == NULL || chi_a == NULL || E == NULL || chi == NULL) {
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(
      cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
  }

  //Check for messed up scale factor conditions
  if (!*status){
    if ((fabs(a[0]-cosmo->spline_params.A_SPLINE_MINLOG)>1e-5) ||
        (fabs(a[na-1]-cosmo->spline_params.A_SPLINE_MAX)>1e-5) ||
        (a[na-1]>1.0)) {
      *status = CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_cosmology_compute_distances(): Error "
        "creating first logarithmic and then linear spacing in a\n");
    }
  }

  // Fill in E(a) - note, this step cannot change the status variable
  if (!*status)
    for (int i=0; i<na; i++)
      E_a[i] = h_over_h0(a[i], cosmo, status);

  // Create a E(a) spline
  if (!*status){
    if (gsl_spline_init(E, a, E_a, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  E(a) spline\n");
    }
  }

  // Compute chi(a)
  if (!*status){
    for (int i=0; i<na; i++)
      compute_chi(a[i], cosmo, &chi_a[i], status);
    if (*status){
      *status = CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): chi(a) integration error \n");
    }
  }

  // Initialize chi(a) spline
  if (!*status){
    if (gsl_spline_init(chi, a, chi_a, na)){//in Mpc
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  chi(a) spline\n");
    }
  }

  if (*status){ //If there was an error, free the GSL splines and return
    gsl_spline_free(E); // Note: you are allowed to call gsl_free() on NULL
    gsl_spline_free(chi);
    E = NULL;
    chi = NULL;
  }

  // Set up the boundaries for the a(chi) spline
  double dchi, chi0, chif, a0, af;
  if(!*status){
    dchi=5.;
    chi0=chi_a[na-1];
    chif=chi_a[0];
    a0=a[na-1];
    af=a[0];
  }

  //TODO: The interval in chi (5. Mpc) should be made a macro
  free(a); //Free these, in preparation for making a(chi) splines
  free(E_a);
  free(chi_a);
  a = NULL;
  E_a = NULL;
  chi_a = NULL;
  //Note: you are allowed to call free() on NULL

  ////////////////////////////////////////////////////////////////////////////////////////////////////
  //Below here na (length of some arrays) changes, so this function has to be split at this point.
  ////////////////////////////////////////////////////////////////////////////////////////////////////

  na = (int)((chif-chi0)/dchi);
  dchi  = (chif-chi0)/na; // <=5, since na is an integer
  //Allocate new arrays for a and chi(a)
  chi_a = ccl_linear_spacing(chi0, chif, na);
  a     = malloc(sizeof(double)*na);
  //Allocate space for GSL root finders
  const gsl_root_fdfsolver_type *T=gsl_root_fdfsolver_newton;
  gsl_root_fdfsolver *s = NULL;
  gsl_spline *achi;

  s = gsl_root_fdfsolver_alloc(T);
  achi = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);

  //Check for too little memory
  if (!*status){
    if (a == NULL || chi_a == NULL || s == NULL || achi == NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
    }
    else if (fabs(chi_a[0]-chi0) > 1e-5 || fabs(chi_a[na-1]-chif) > 1e-5) { //Check for messed up chi conditions
      *status = CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating linear spacing in chi\n");
    }
  }

  // Calculate a(chi)
  if (!*status){
    a[0]=a0; a[na-1]=af;
    for(int i=1;i<na-1;i++) {
      // we are using the previous value as a guess here to help the root finder
      // as long as we use small steps in a this should be fine
      a_of_chi(chi_a[i],cosmo, status, &a0, s);
      a[i]=a0;
    }
    if(*status) {
      *status = CCL_ERROR_ROOT;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): a(chi) root-finding error \n");
    }
  }

  // Initialize the a(chi) spline
  if (!*status){
    if(gsl_spline_init(achi, chi_a, a, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  a(chi) spline\n");
    }
  }

  free(a);
  free(chi_a); //Note: you are allowed to call free() on NULL
  gsl_root_fdfsolver_free(s);
  if (*status){//If there was an error, free the GSL splines and return
    gsl_spline_free(E); //Note: you are allowed to call gsl_free() on NULL
    gsl_spline_free(chi);
    gsl_spline_free(achi);
  }

  if (*status == 0) {
    //If there were no errors, attach the splines to the cosmo struct and end the function.
    cosmo->data.E             = E;
    cosmo->data.chi           = chi;
    cosmo->data.achi          = achi;
    cosmo->computed_distances = true;
  }
}

/* ----- ROUTINE: ccl_cosmology_distances_from_input ------
INPUT: cosmology, scale factor array, comoving distance chi computed at the scale factor array values
TASK: if not already there, make a table of comoving distances from an input array
*/
void ccl_cosmology_distances_from_input(ccl_cosmology * cosmo, int na, double a[], double chi_a[], double E_a[],
   int *status)
{
  double *chi_a_reversed = NULL;
  double *a_reversed = NULL;

  //Do nothing if everything is computed already
  if(cosmo->computed_distances)
    return;

  // Allocate E(a), chi(a) and a(chi) splines
  gsl_spline * E = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  gsl_spline * chi = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  gsl_spline * achi = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);

  //Check for too little memory
  if (a == NULL || E_a == NULL || chi_a == NULL || E == NULL || chi == NULL || achi == NULL) {
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(
      cosmo, "ccl_background.c: ccl_cosmology_distances_from_input(): ran out of memory\n");
  }

  // Update the minimum scale factor value used by the user, which is necessary because it is used in ccl_tracers.c
  cosmo->spline_params.A_SPLINE_MIN = a[0];

  // Initialize a E(a) spline
  if (!*status){
    if (gsl_spline_init(E, a, E_a, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_distances_from_input(): Error creating  E(a) spline\n");
    }
  }

  // Initialize chi(a) spline
  if (!*status){
    if (gsl_spline_init(chi, a, chi_a, na)){//in Mpc
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_distances_from_input(): Error creating  chi(a) spline\n");
    }
  }

  // Reverse the order of chi(a) so that we can initialize the a(chi) spline, which needs monotonically decreasing x-array.
  if (!*status) {
    chi_a_reversed = malloc(na*sizeof(double));
    a_reversed = malloc(na*sizeof(double));
    if (chi_a_reversed == NULL || a_reversed == NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_distances_from_input(): ran out of memory\n");
    }
    else {
      for (int i=0; i<na; i++) {
        chi_a_reversed[i] = chi_a[na-1-i];
        a_reversed[i] = a[na-1-i];
      }
    }
  }

  // Initialize a(chi) spline
  if (!*status){
    if (gsl_spline_init(achi, chi_a_reversed, a_reversed, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_distances_from_input(): Error creating  chi(a) spline\n");
    }
  }
  free(chi_a_reversed);
  free(a_reversed);

  if (*status){ //If there was an error, free the GSL splines and return
    gsl_spline_free(E); // Note: you are allowed to call gsl_free() on NULL
    gsl_spline_free(chi);
    gsl_spline_free(achi);
    E = NULL;
    chi = NULL;
    achi = NULL;
  }

  if (*status == 0) {
    //If there were no errors, attach the splines to the cosmo struct and end the function.
    cosmo->data.E             = E;
    cosmo->data.chi           = chi;
    cosmo->data.achi          = achi;
    cosmo->computed_distances = true;
  }

  return;
}

/* ----- ROUTINE: ccl_cosmology_growth_from_input ------
INPUT: cosmology, scale factor array, growth array, growth rate array
TASK: if not already there, create growth splines with the input arrays and store them.
*/
void ccl_cosmology_growth_from_input(ccl_cosmology* cosmo, int na, double a[],
                                     double growth_arr[], double fgrowth_arr[], int* status)
{
  int chistatus;
  if (cosmo->computed_growth)
    return;

  double *growth_normed = NULL;
  gsl_spline * growth = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  gsl_spline * fgrowth = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
  //The last element corresponds to a=1 (which is checked for in python).
  double growth0 = growth_arr[na-1];

  if (growth == NULL || fgrowth == NULL) {
    *status = CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_growth_from_input(): ran out of memory\n");
  }

  // Need to normalize the growth factor
  if (*status == 0) {
    growth_normed = malloc(na*sizeof(double));
    if (growth_normed == NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
           cosmo, "ccl_background.c: ccl_cosmology_growth_from_input(): ran out of memory\n");
    }
  }

  if (*status == 0) {
    for(int ia=0; ia<na; ia++)
      growth_normed[ia] = growth_arr[ia]/growth0;

    chistatus = gsl_spline_init(growth, a, growth_normed, na);
    if (chistatus) {
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_growth_from_input(): Error creating D(a) spline\n");
    }
  }

  if (*status == 0) {
    chistatus = gsl_spline_init(fgrowth, a, fgrowth_arr, na);
    if (chistatus) {
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_growth_from_input(): Error creating f(a) spline\n");
    }
  }

  if (*status){ //If there was an error, free the GSL splines and return
    gsl_spline_free(growth);
    gsl_spline_free(fgrowth);
    growth = NULL;
    fgrowth = NULL;
  }

  if (*status == 0) {
    // assign all the splines we've just made to the structure.
    cosmo->data.growth = growth;
    cosmo->data.fgrowth = fgrowth;
    cosmo->data.growth0 = growth0;
    cosmo->computed_growth = true;
  }

  free(growth_normed);
}

/* ----- ROUTINE: ccl_cosmology_compute_growth ------
INPUT: cosmology
TASK: if not already there, make a table of growth function and growth rate
      normalize growth to input parameter growth0
*/
void ccl_cosmology_compute_growth(ccl_cosmology* cosmo, int* status)
{
  if (cosmo->computed_growth)
    return;

  // Create logarithmically and then linearly-spaced values of the scale factor
  int chistatus = 0, na = cosmo->spline_params.A_SPLINE_NA+cosmo->spline_params.A_SPLINE_NLOG-1;
  double *a = NULL;
  gsl_integration_cquad_workspace * workspace = NULL;
  gsl_function F;
  gsl_spline *df_a_spline = NULL;
  double *df_arr = NULL;
  gsl_spline *df_z_spline = NULL;
  int status_mg = 0, gslstatus;
  double growth0, fgrowth0;
  double *y = NULL;
  double *y2 = NULL;
  double df, integ;

  if (*status == 0) {
    a = ccl_linlog_spacing(
      cosmo->spline_params.A_SPLINE_MINLOG, cosmo->spline_params.A_SPLINE_MIN,
      cosmo->spline_params.A_SPLINE_MAX, cosmo->spline_params.A_SPLINE_NLOG,
      cosmo->spline_params.A_SPLINE_NA);

    if (a == NULL ||
        (fabs(a[0]-cosmo->spline_params.A_SPLINE_MINLOG) > 1e-5) ||
        (fabs(a[na-1]-cosmo->spline_params.A_SPLINE_MAX) > 1e-5) ||
        (a[na-1] > 1.0)) {
      *status = CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_cosmology_compute_growth(): "
        "Error creating logarithmically and then linear spacing in a\n");
    }
  }

  if(cosmo->params.has_mgrowth) {
    if (*status == 0) {
      df_arr = malloc(na*sizeof(double));

      if(df_arr == NULL) {
        *status = CCL_ERROR_MEMORY;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
      }
    }

    // Generate spline for Delta f(z) that we will then interpolate into an array of a
    if (*status == 0) {
      df_z_spline = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, cosmo->params.nz_mgrowth);
      if (df_z_spline == NULL) {
        *status = CCL_ERROR_MEMORY;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
      }
    }

    if (*status == 0) {
      chistatus = gsl_spline_init(df_z_spline,cosmo->params.z_mgrowth,
                                  cosmo->params.df_mgrowth,
                                  cosmo->params.nz_mgrowth);

      if(chistatus) {
        *status = CCL_ERROR_SPLINE;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating Delta f(z) spline\n");
      }
    }

    if (*status == 0) {
      for (int i=0; i<na; i++) {
        if(a[i]>0) {
          double z=1./a[i]-1.;

          if(z<=cosmo->params.z_mgrowth[0])
            df_arr[i]=cosmo->params.df_mgrowth[0];
          else if(z>cosmo->params.z_mgrowth[cosmo->params.nz_mgrowth-1])
            df_arr[i]=cosmo->params.df_mgrowth[cosmo->params.nz_mgrowth-1];
          else
              chistatus |= gsl_spline_eval_e(df_z_spline,z,NULL,&df_arr[i]);
        } else {
            df_arr[i]=0;
        }
      }
      if(chistatus) {
        *status = CCL_ERROR_SPLINE;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error evaluating Delta f(z) spline\n");
      }
    }

    // Generate Delta(f) spline
    if (*status == 0) {
      df_a_spline = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE,na);

      if (df_a_spline == NULL) {
        *status = CCL_ERROR_MEMORY;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
      }
    }

    if (*status == 0) {
      chistatus = gsl_spline_init(df_a_spline, a, df_arr, na);

      if (chistatus) {
        *status = CCL_ERROR_SPLINE;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating Delta f(a) spline\n");
      }
    }

    if (*status == 0) {
      workspace = gsl_integration_cquad_workspace_alloc(cosmo->gsl_params.N_ITERATION);
      F.function = &df_integrand;
      F.params = df_a_spline;
    }
  }

  // allocate space for y, which will be all three
  // of E(a), chi(a), D(a) and f(a) in turn.
  if (*status == 0) {
    y = malloc(sizeof(double)*na);
    if (y == NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
    }
  }

  if (*status == 0) {
    y2 = malloc(sizeof(double)*na);
    if (y2 == NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
    }
  }

  if (*status == 0) {
    // Get the growth factor and growth rate at z=0
    chistatus |= growth_factor_and_growth_rate(1., &growth0, &fgrowth0, cosmo, status);

    // Get the growth factor and growth rate at other redshifts
    for(int i=0; i<na; i++) {
      chistatus |= growth_factor_and_growth_rate(a[i], &(y[i]), &(y2[i]), cosmo, status);

      if(cosmo->params.has_mgrowth) {
        if(a[i]>0) {
          // Add modification to f
          gslstatus = gsl_spline_eval_e(df_a_spline, a[i], NULL, &df);
          if (gslstatus != GSL_SUCCESS) {
            ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_cosmology_compute_growth():");
            status_mg |= gslstatus;
          }
          y2[i] += df;

          // Multiply D by exp(-int(df))
          gslstatus = gsl_integration_cquad(
            &F, a[i], 1.0, 0.0, cosmo->gsl_params.INTEGRATION_DISTANCE_EPSREL,
            workspace, &integ, NULL, NULL);
          if (gslstatus != GSL_SUCCESS) {
            ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_cosmology_compute_growth():");
            status_mg |= gslstatus;
          }
          y[i] *= exp(-integ);
        }
      }
      // Normalizing to the growth factor to the growth today
      y[i] /= growth0;
    }

    if (chistatus || status_mg || *status) {
      if (chistatus) {
        *status = CCL_ERROR_INTEG;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): integral for linear growth factor didn't converge\n");
      }
      if(status_mg) {
        *status = CCL_ERROR_INTEG;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): integral for MG growth factor didn't converge\n");
      }
    }
  }

  gsl_spline *growth = NULL;
  gsl_spline *fgrowth = NULL;

  if (*status == 0) {
    growth = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);
    fgrowth = gsl_spline_alloc(cosmo->spline_params.A_SPLINE_TYPE, na);

    if (growth == NULL || fgrowth == NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): ran out of memory\n");
    }
  }

  if (*status == 0) {
    chistatus = gsl_spline_init(growth, a, y, na);

    if (chistatus) {
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating D(a) spline\n");
    }
  }

  if (*status == 0) {
    chistatus = gsl_spline_init(fgrowth, a, y2, na);
    if (chistatus) {
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating f(a) spline\n");
    }
  }

  if (*status == 0) {
    // assign all the splines we've just made to the structure.
    cosmo->data.growth = growth;
    cosmo->data.fgrowth = fgrowth;
    cosmo->data.growth0 = growth0;
    cosmo->computed_growth = true;
  }
  else {
    gsl_spline_free(growth);
    gsl_spline_free(fgrowth);
  }

  free(a);
  free(y);
  free(y2);
  free(df_arr);
  gsl_spline_free(df_z_spline);
  gsl_spline_free(df_a_spline);
  gsl_integration_cquad_workspace_free(workspace);
}

//Expansion rate normalized to 1 today

double ccl_h_over_h0(ccl_cosmology * cosmo, double a, int* status)
{

  if(!cosmo->computed_distances) {
    *status = CCL_ERROR_DISTANCES_INIT;
    ccl_cosmology_set_status_message(
      cosmo,
      "ccl_background.c: ccl_h_over_h0(): distance splines have not been precomputed!");
    return NAN;
  }

  double h_over_h0;
  int gslstatus = gsl_spline_eval_e(cosmo->data.E, a, NULL, &h_over_h0);
  if(gslstatus != GSL_SUCCESS) {
    ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_h_over_h0():");
    *status = gslstatus;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_h_over_h0(): Scale factor outside interpolation range.\n");
    return NAN;
  }

  return h_over_h0;
}

void ccl_h_over_h0s(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_h_over_h0(cosmo, a[i], &_status);
    *status |= _status;
  }
}

// Distance-like function examples, all in Mpc
double ccl_comoving_radial_distance(ccl_cosmology * cosmo, double a, int * status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    return 0.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    return NAN;
  }
  else {
    if(!cosmo->computed_distances) {
      *status = CCL_ERROR_DISTANCES_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_comoving_radial_distance(): distance splines have not been precomputed!");
      return NAN;
    }

    double crd;
    int gslstatus = gsl_spline_eval_e(cosmo->data.chi, a, NULL, &crd);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_comoving_radial_distance():");
      *status = gslstatus;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_comoving_radial_distance(): Scale factor outside interpolation range.\n");
      return NAN;
    }
    return crd;
  }
}

void ccl_comoving_radial_distances(ccl_cosmology * cosmo, int na, double a[], double output[], int* status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_comoving_radial_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_sinn(ccl_cosmology *cosmo, double chi, int *status)
{
  //////
  //         { sin(x)  , if k==1
  // sinn(x)={  x      , if k==0
  //         { sinh(x) , if k==-1
  switch(cosmo->params.k_sign) {
  case -1:
    return sinh(cosmo->params.sqrtk * chi) / cosmo->params.sqrtk;
  case 1:
    return sin(cosmo->params.sqrtk*chi) / cosmo->params.sqrtk;
  case 0:
    return chi;
  default:
    *status = CCL_ERROR_PARAMETERS;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_sinn: ill-defined cosmo->params.k_sign = %d",
                                     cosmo->params.k_sign);
    return NAN;
  }
}

double ccl_comoving_angular_distance(ccl_cosmology * cosmo, double a, int* status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    return 0.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    return NAN;
  }
  else {
    if (!cosmo->computed_distances) {
      *status = CCL_ERROR_DISTANCES_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_comoving_angular_distance(): distance splines have not been precomputed!");
      return NAN;
    }

    double chi;
    int gslstatus = gsl_spline_eval_e(cosmo->data.chi, a, NULL, &chi);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_comoving_angular_distance():");
      *status |= gslstatus;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_comoving_angular_distance(): Scale factor outside interpolation range.\n");
      return NAN;
    }
    return ccl_sinn(cosmo,chi,status);
  }
}

void ccl_comoving_angular_distances(ccl_cosmology * cosmo, int na, double a[],
                                    double output[], int* status)
{
  int _status;

  for (int i=0; i < na; i++) {
    _status = 0;
    output[i] = ccl_comoving_angular_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_angular_diameter_distance(ccl_cosmology * cosmo, double a1, double a2, int* status)
{
  if(a1>1. || a2>1. || a1<a2) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo,"ccl_background.c: ccl_angular_diameter_distance(): error on input scale factor.");
    return NAN;
  } else {
      if (!cosmo->computed_distances) {
          *status = CCL_ERROR_DISTANCES_INIT;
          ccl_cosmology_set_status_message(cosmo,"ccl_background.c: ccl_angular_diameter_distance(): distance splines have not been precomputed!");
          return NAN;
      }
      double chi1,chi2;
      int gslstatus = gsl_spline_eval_e(cosmo->data.chi, a1, NULL, &chi1);
      if(gslstatus != GSL_SUCCESS) {
          ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_angular_diameter_distance():");
          *status |= gslstatus;
          ccl_cosmology_set_status_message(cosmo,"ccl_background.c: ccl_angular_diameter_distance(): Scale factor outside interpolation range.\n");
          return NAN;
      }
      gslstatus = gsl_spline_eval_e(cosmo->data.chi, a2, NULL, &chi2);
      if(gslstatus != GSL_SUCCESS) {
          ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_angular_diameter_distance():");
          *status |= gslstatus;
          ccl_cosmology_set_status_message(cosmo,"ccl_background.c: ccl_angular_diameter_distance(): Scale factor outside interpolation range.\n");
          return NAN;
      }
      return a2*ccl_sinn(cosmo,chi2-chi1,status);
  }
}

void ccl_angular_diameter_distances(ccl_cosmology * cosmo, int na, double a1[], double a2[],
                                    double output[], int* status)
{
  int _status;

  for (int i=0; i < na; i++) {
    _status = 0;
    output[i] = ccl_angular_diameter_distance(cosmo, a1[i], a2[i], &_status);
    *status |= _status;
  }
}

double ccl_luminosity_distance(ccl_cosmology * cosmo, double a, int* status)
{
  return ccl_comoving_angular_distance(cosmo, a, status) / a;
}

void ccl_luminosity_distances(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_luminosity_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_distance_modulus(ccl_cosmology * cosmo, double a, int* status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: distance_modulus undefined for a=1.\n");
    return NAN;
  } else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    return NAN;
  } else {
    if (!cosmo->computed_distances) {
      *status = CCL_ERROR_DISTANCES_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_distance_modulus(): distance splines have not been precomputed!");
      return NAN;
    }
    /* distance modulus = 5 * log10(d) - 5
       Since d in CCL is in Mpc, you get
         5*log10(10^6) - 5 = 30 - 5 = 25
      for the constant.
    */
    return 5 * log10(ccl_luminosity_distance(cosmo, a, status)) + 25;
  }
}

void ccl_distance_moduli(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_distance_modulus(cosmo, a[i], &_status);
    *status |= _status;
  }
}

//Scale factor for a given distance
double ccl_scale_factor_of_chi(ccl_cosmology * cosmo, double chi, int * status)
{
  if((chi < 1.e-8) && (chi>=0.)) {
    return 1.;
  }
  else if(chi<0.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: distance cannot be smaller than 0.\n");
    return NAN;
  }
  else {
    if (!cosmo->computed_distances) {
      *status = CCL_ERROR_DISTANCES_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_scale_factor_of_chi(): distance splines have not been precomputed!");
      return NAN;
    }
    double a;
    int gslstatus = gsl_spline_eval_e(cosmo->data.achi, chi, NULL, &a);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_scale_factor_of_chi():");
      *status |= gslstatus;
    }
    return a;
  }
}

void ccl_scale_factor_of_chis(ccl_cosmology * cosmo, int nchi, double chi[], double output[], int * status)
{
  int _status;

  for (int i=0; i<nchi; i++) {
    _status = 0;
    output[i] = ccl_scale_factor_of_chi(cosmo, chi[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_factor(ccl_cosmology * cosmo, double a, int * status)
{
  if(a==1.){
    return 1.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(
      cosmo, "ccl_background.c: scale factor cannot be larger than 1.");
    return NAN;
  }
  else {
    if (!cosmo->computed_growth){
      *status = CCL_ERROR_GROWTH_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_growth_factor(): growth factor splines have not been precomputed!");
      return NAN;
    }
    if (*status != CCL_ERROR_NOT_IMPLEMENTED) {
      double D;
      int gslstatus = gsl_spline_eval_e(cosmo->data.growth, a, NULL, &D);
      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_growth_factor():");
        *status |= gslstatus;
        ccl_cosmology_set_status_message(
          cosmo, "ccl_background.c: ccl_growth_factor(): Scale factor outside interpolation range.");
        return NAN;
      }
      return D;
    }
    else {
      return NAN;
    }
  }
}

void ccl_growth_factors(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_factor(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_factor_unnorm(ccl_cosmology * cosmo, double a, int * status)
{

  if (!cosmo->computed_growth) {
    *status = CCL_ERROR_GROWTH_INIT;
    ccl_cosmology_set_status_message(
      cosmo,
      "ccl_background.c: ccl_growth_factor_unnorm(): growth factor splines have not been precomputed!");
  }

  if (*status != CCL_ERROR_NOT_IMPLEMENTED) {
      return cosmo->data.growth0 * ccl_growth_factor(cosmo, a, status);
  } else {
    return NAN;
  }
}

void ccl_growth_factors_unnorm(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_factor_unnorm(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_rate(ccl_cosmology * cosmo, double a, int * status)
{
  if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    return NAN;
  } else {
    if (!cosmo->computed_growth) {
      *status = CCL_ERROR_GROWTH_INIT;
      ccl_cosmology_set_status_message(
        cosmo,
        "ccl_background.c: ccl_growth_rate(): growth rate splines have not been precomputed!");
    }
    if(*status != CCL_ERROR_NOT_IMPLEMENTED) {
      double g;
      int gslstatus = gsl_spline_eval_e(cosmo->data.fgrowth, a, NULL ,&g);
      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_growth_rate():");
        *status |= gslstatus;
        ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_growth_rate(): Scale factor outside interpolation range.\n");
        return NAN;
      }
      return g;
    } else {
        return NAN;
    }
  }
}

void ccl_growth_rates(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_rate(cosmo, a[i], &_status);
    *status |= _status;
  }
}


/* randist/fdist.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 James Theiler, Brian Gough
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include <config.h>
#include <math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/* The F distribution has the form

   p(x) dx = (nu1^(nu1/2) nu2^(nu2/2) Gamma((nu1 + nu2)/2) /
   Gamma(nu1/2) Gamma(nu2/2)) *
   x^(nu1/2 - 1) (nu2 + nu1 * x)^(-nu1/2 -nu2/2) dx

   The method used here is the one described in Knuth */

double
gsl_ran_fdist (const gsl_rng * r, const double nu1, const double nu2)
{

  double Y1 =  gsl_ran_gamma (r, nu1 / 2, 2.0);
  double Y2 =  gsl_ran_gamma (r, nu2 / 2, 2.0);

  double f = (Y1 * nu2) / (Y2 * nu1);

  return f;
}

double
gsl_ran_fdist_pdf (const double x, const double nu1, const double nu2)
{
  if (x < 0)
    {
      return 0 ;
    }
  else
    {
      double p;
      double lglg = (nu1 / 2) * log (nu1) + (nu2 / 2) * log (nu2) ;

      double lg12 = gsl_sf_lngamma ((nu1 + nu2) / 2);
      double lg1 = gsl_sf_lngamma (nu1 / 2);
      double lg2 = gsl_sf_lngamma (nu2 / 2);

      p = exp (lglg + lg12 - lg1 - lg2)
	* pow (x, nu1 / 2 - 1) * pow (nu2 + nu1 * x, -nu1 / 2 - nu2 / 2);

      return p;
    }
}


#include <stdio.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_deriv.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spline.h>
#include <gbpLib.h>
#include <gbpInterpolate.h>

double interpolate_integral(interp_info *interp, double x_lo, double x_hi) {
    double x_lo_interp;
    double x_hi_interp;
    double x_lo_tmp;
    double x_hi_tmp;
    double x_min;
    double x_max;
    double y_x_min;
    double y_x_max;
    double r_val;
    double alpha;
    int    flag_error = GBP_FALSE;

    x_min   = ((interp_info *)interp)->x[0];
    x_max   = ((interp_info *)interp)->x[((interp_info *)interp)->n - 1];
    y_x_min = ((interp_info *)interp)->y[0];
    y_x_max = ((interp_info *)interp)->y[((interp_info *)interp)->n - 1];

    r_val       = 0.;
    x_lo_interp = x_lo;
    x_hi_interp = x_hi;

    if(x_hi > x_lo) {
        // Extrapolate integral to low-x assuming dI prop. to x^alpha
        if(x_lo < x_min) {
            x_lo_tmp = x_lo;
            x_hi_tmp = GBP_MIN(x_hi, x_min);
            alpha    = interpolate_derivative(interp, ((interp_info *)interp)->x[0]);
            if(alpha < -1. && x_lo_tmp * x_hi_tmp == 0.) {
                fprintf(stderr, "ERROR: integration extrapolation to low-x is divergent! (alpha=%lf)\n", alpha);
                flag_error = GBP_TRUE;
            } else
                r_val += (y_x_min / (alpha + 1.)) * (pow(x_hi_tmp / x_min, alpha + 1.) - pow(x_lo_tmp / x_min, alpha + 1.));
            x_lo_interp = x_min;
        }

        // Extrapolate integral to high-x assuming dI prop. to x^alpha
        if(x_hi > x_max) {
            x_lo_tmp = GBP_MAX(x_max, x_lo);
            x_hi_tmp = x_hi;
            alpha    = interpolate_derivative(interp, ((interp_info *)interp)->x[((interp_info *)interp)->n - 1]);
            if(alpha < 0. && x_lo_tmp * x_hi_tmp == 0.) {
                fprintf(stderr, "ERROR: integration extrapolation to high-x is divergent! (alpha=%lf)\n", alpha);
                flag_error = GBP_TRUE;
            } else
                r_val += (y_x_min / (alpha + 1.)) * (pow(x_hi_tmp / x_min, alpha + 1.) - pow(x_lo_tmp / x_min, alpha + 1.));
            x_hi_interp = x_max;
        }

        r_val += gsl_interp_eval_integ(((interp_info *)interp)->interp,
                                       ((interp_info *)interp)->x,
                                       ((interp_info *)interp)->y,
                                       x_lo_interp,
                                       x_hi_interp,
                                       ((interp_info *)interp)->accel);
    }
    return (r_val);
}


/* randist/gauss.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2006 James Theiler, Brian Gough
 * Copyright (C) 2006 Charles Karney
 *
 * 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 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

#include <config.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/* Of the two methods provided below, I think the Polar method is more
 * efficient, but only when you are actually producing two random
 * deviates.  We don't produce two, because then we'd have to save one
 * in a static variable for the next call, and that would screws up
 * re-entrant or threaded code, so we only produce one.  This makes
 * the Ratio method suddenly more appealing.
 *
 * [Added by Charles Karney] We use Leva's implementation of the Ratio
 * method which avoids calling log() nearly all the time and makes the
 * Ratio method faster than the Polar method (when it produces just one
 * result per call).  Timing per call (gcc -O2 on 866MHz Pentium,
 * average over 10^8 calls)
 *
 *   Polar method: 660 ns
 *   Ratio method: 368 ns
 *
 */

/* Polar (Box-Mueller) method; See Knuth v2, 3rd ed, p122 */

double
gsl_ran_gaussian (const gsl_rng * r, const double sigma)
{
  double x, y, r2;

  do
    {
      /* choose x,y in uniform square (-1,-1) to (+1,+1) */
      x = -1 + 2 * gsl_rng_uniform_pos (r);
      y = -1 + 2 * gsl_rng_uniform_pos (r);

      /* see if it is in the unit circle */
      r2 = x * x + y * y;
    }
  while (r2 > 1.0 || r2 == 0);

  /* Box-Muller transform */
  return sigma * y * sqrt (-2.0 * log (r2) / r2);
}

/* Ratio method (Kinderman-Monahan); see Knuth v2, 3rd ed, p130.
 * K+M, ACM Trans Math Software 3 (1977) 257-260.
 *
 * [Added by Charles Karney] This is an implementation of Leva's
 * modifications to the original K+M method; see:
 * J. L. Leva, ACM Trans Math Software 18 (1992) 449-453 and 454-455. */

double
gsl_ran_gaussian_ratio_method (const gsl_rng * r, const double sigma)
{
  double u, v, x, y, Q;
  const double s = 0.449871;    /* Constants from Leva */
  const double t = -0.386595;
  const double a = 0.19600;
  const double b = 0.25472;
  const double r1 = 0.27597;
  const double r2 = 0.27846;

  do                            /* This loop is executed 1.369 times on average  */
    {
      /* Generate a point P = (u, v) uniform in a rectangle enclosing
         the K+M region v^2 <= - 4 u^2 log(u). */

      /* u in (0, 1] to avoid singularity at u = 0 */
      u = 1 - gsl_rng_uniform (r);

      /* v is in the asymmetric interval [-0.5, 0.5).  However v = -0.5
         is rejected in the last part of the while clause.  The
         resulting normal deviate is strictly symmetric about 0
         (provided that v is symmetric once v = -0.5 is excluded). */
      v = gsl_rng_uniform (r) - 0.5;

      /* Constant 1.7156 > sqrt(8/e) (for accuracy); but not by too
         much (for efficiency). */
      v *= 1.7156;

      /* Compute Leva's quadratic form Q */
      x = u - s;
      y = fabs (v) - t;
      Q = x * x + y * (a * y - b * x);

      /* Accept P if Q < r1 (Leva) */
      /* Reject P if Q > r2 (Leva) */
      /* Accept if v^2 <= -4 u^2 log(u) (K+M) */
      /* This final test is executed 0.012 times on average. */
    }
  while (Q >= r1 && (Q > r2 || v * v > -4 * u * u * log (u)));

  return sigma * (v / u);       /* Return slope */
}

double
gsl_ran_gaussian_pdf (const double x, const double sigma)
{
  double u = x / fabs (sigma);
  double p = (1 / (sqrt (2 * M_PI) * fabs (sigma))) * exp (-u * u / 2);
  return p;
}

double
gsl_ran_ugaussian (const gsl_rng * r)
{
  return gsl_ran_gaussian (r, 1.0);
}

double
gsl_ran_ugaussian_ratio_method (const gsl_rng * r)
{
  return gsl_ran_gaussian_ratio_method (r, 1.0);
}

double
gsl_ran_ugaussian_pdf (const double x)
{
  return gsl_ran_gaussian_pdf (x, 1.0);
}


//This is a simple example meant to test your capabilities with basic library linking functionality. All you have to do is return the output to modelica.

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

double sf_bessel(double x)
{
	double y = gsl_sf_bessel_J0 (x);
	return y;
}

//The main function has been provided solely for the sake of testing the function. It will be removed when the problem set is formally passed on.
/*
int main(void)
{
	double x = 5;
	double a = sf_bessel(x);

	printf("a = %f \n",a);
	return 0;
}
*/


#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <float.h>
#include <math.h>
#include <time.h>
#include <sys/time.h>
#include <cblas.h>

/* Your function must have the following signature: */

void sgemm( int m, int n, float *A, float *C );

/* The benchmarking program */

int main( int argc, char **argv )
{
	srand(time(NULL));

	if(argc != 3)
	{
		printf("Incorrect number of arguments!\n");
		printf("Usage: ./bench-test M N\n");
		exit(0);
	}

	int m  = atoi(argv[1]);
	int n  = atoi(argv[2]);

	// Change these values to modify range checking
	if(m < 1000 || m > 10000 || n < 32 || n > 10000)
	{
		printf("Dimensions provided are out of the range of matrices we will be testing!  Change tester.c to modify range checking.\n");
		exit(0);
	}

	/* Allocate and fill 2 random matrices A, C */
	float *A = (float*) malloc( m * n * sizeof(float) );
	float *C = (float*) malloc( m * m * sizeof(float) );

	for( int i = 0; i < m*n; i++ ) A[i] = 2 * drand48() - 1;
	for( int i = 0; i < m*m; i++ ) C[i] = 2 * drand48() - 1;

	/* measure Gflop/s rate; time a sufficiently long sequence of calls to eliminate noise */
	double Gflop_s, seconds = -1.0;
	for( int n_iterations = 1; seconds < 0.1; n_iterations *= 2 )
	{
		/* warm-up */
		sgemm( m, n, A, C );

		/* measure time */
		struct timeval start, end;
		gettimeofday( &start, NULL );
		for( int i = 0; i < n_iterations; i++ )
			sgemm( m,n, A, C );
		gettimeofday( &end, NULL );
		seconds = (end.tv_sec - start.tv_sec) + 1.0e-6 * (end.tv_usec - start.tv_usec);

		/* compute Gflop/s rate */
		Gflop_s = 2e-9 * n_iterations * m * m * n / seconds;
	}

	printf( "%d by %d matrix \t %g Gflop/s\n", m, n, Gflop_s );

	/* Ensure that error does not exceed the theoretical error bound */

	/* Set initial C to 0 and do matrix multiply of A*B */
	memset( C, 0, sizeof( float ) * m * m );
	sgemm( m,n, A, C );

	/* Subtract A*B from C using standard sgemm (note that this should be 0 to within machine roundoff) */
	cblas_sgemm( CblasColMajor,CblasNoTrans,CblasTrans, m,m,n, -1, A,m, A,m, 1, C,m );

	/* Subtract the maximum allowed roundoff from each element of C */
	for( int i = 0; i < m*n; i++ ) A[i] = fabs( A[i] );
	for( int i = 0; i < m*m; i++ ) C[i] = fabs( C[i] );
	cblas_sgemm( CblasColMajor,CblasNoTrans,CblasTrans, m,m,n, -3.0*FLT_EPSILON*n, A,m, A,m, 1, C,m );

	/* After this test if any element in C is still positive something went wrong in square_sgemm */
	for( int i = 0; i < m * m; i++ )
	  	if( C[i] > 0 ) {
			printf( "FAILURE: error in matrix multiply exceeds an acceptable margin\n" );
		return -1;
	}

	/* release memory */
	free( C );
	free( A );
	return 0;
}


static char help[] =
"ODE system solver example using TS, but with Jacobian.  Sets TS type to\n"
"implicit Crank-Nicolson.  Compare ode.c.\n\n";

#include <petsc.h>

extern PetscErrorCode ExactSolution(PetscReal, Vec);
extern PetscErrorCode FormRHSFunction(TS, PetscReal, Vec, Vec, void*);
extern PetscErrorCode FormRHSJacobian(TS, PetscReal, Vec, Mat, Mat, void*);

int main(int argc,char **argv) {
  PetscErrorCode ierr;
  PetscInt   steps;
  PetscReal  t0 = 0.0, tf = 20.0, dt = 0.1, err;
  Vec        y, yexact;
  Mat        J;
  TS         ts;

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

  ierr = VecCreate(PETSC_COMM_WORLD,&y); CHKERRQ(ierr);
  ierr = VecSetSizes(y,PETSC_DECIDE,2); CHKERRQ(ierr);
  ierr = VecSetFromOptions(y); CHKERRQ(ierr);
  ierr = VecDuplicate(y,&yexact); CHKERRQ(ierr);

  ierr = TSCreate(PETSC_COMM_WORLD,&ts); CHKERRQ(ierr);
  ierr = TSSetProblemType(ts,TS_NONLINEAR); CHKERRQ(ierr);
  ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,NULL); CHKERRQ(ierr);

//STARTMATJ
  ierr = MatCreate(PETSC_COMM_WORLD,&J); CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,2,2); CHKERRQ(ierr);
  ierr = MatSetFromOptions(J); CHKERRQ(ierr);
  ierr = MatSetUp(J); CHKERRQ(ierr);
  ierr = TSSetRHSJacobian(ts,J,J,FormRHSJacobian,NULL); CHKERRQ(ierr);
  ierr = TSSetType(ts,TSCN); CHKERRQ(ierr);
//ENDMATJ

  // set time axis
  ierr = TSSetTime(ts,t0); CHKERRQ(ierr);
  ierr = TSSetMaxTime(ts,tf); CHKERRQ(ierr);
  ierr = TSSetTimeStep(ts,dt); CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP); CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts); CHKERRQ(ierr);

  // set initial values and solve
  ierr = TSGetTime(ts,&t0); CHKERRQ(ierr);
  ierr = ExactSolution(t0,y); CHKERRQ(ierr);
  ierr = TSSolve(ts,y); CHKERRQ(ierr);

  // compute error and report
  ierr = TSGetStepNumber(ts,&steps); CHKERRQ(ierr);
  ierr = TSGetTime(ts,&tf); CHKERRQ(ierr);
  ierr = ExactSolution(tf,yexact); CHKERRQ(ierr);
  ierr = VecAXPY(y,-1.0,yexact); CHKERRQ(ierr);    // y <- y - yexact
  ierr = VecNorm(y,NORM_INFINITY,&err); CHKERRQ(ierr);
  ierr = PetscPrintf(PETSC_COMM_WORLD,
              "error at tf = %.3f with %d steps:  |y-y_exact|_inf = %g\n",
              tf,steps,err); CHKERRQ(ierr);

  MatDestroy(&J);
  VecDestroy(&y);  VecDestroy(&yexact);  TSDestroy(&ts);
  return PetscFinalize();
}

PetscErrorCode ExactSolution(PetscReal t, Vec y) {
    PetscReal *ay;
    VecGetArray(y,&ay);
    ay[0] = t - PetscSinReal(t);
    ay[1] = 1.0 - PetscCosReal(t);
    VecRestoreArray(y,&ay);
    return 0;
}

PetscErrorCode FormRHSFunction(TS ts, PetscReal t, Vec y, Vec g,
                               void *ptr) {
    const PetscReal *ay;
    PetscReal       *ag;
    VecGetArrayRead(y,&ay);
    VecGetArray(g,&ag);
    ag[0] = ay[1];            // = g_1(t,y)
    ag[1] = - ay[0] + t;      // = g_2(t,y)
    VecRestoreArrayRead(y,&ay);
    VecRestoreArray(g,&ag);
    return 0;
}

//STARTJACOBIAN
PetscErrorCode FormRHSJacobian(TS ts, PetscReal t, Vec y, Mat J, Mat P,
                               void *ptr) {
    PetscErrorCode ierr;
    PetscInt   row[2] = {0, 1},  col[2] = {0, 1};
    PetscReal  v[4] = { 0.0, 1.0,
                       -1.0, 0.0};
    ierr = MatSetValues(P,2,row,2,col,v,INSERT_VALUES); CHKERRQ(ierr);
    ierr = MatAssemblyBegin(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    ierr = MatAssemblyEnd(P,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    if (J != P) {
        ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
        ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    }
    return 0;
}
//ENDJACOBIAN


#include <stdio.h>
#include <math.h>
#include <stdlib.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

/*
Adapted from C code from Darren Wilkinson's blog
https://darrenjw.wordpress.com/2011/07/16/gibbs-sampler-in-various-languages-revisited/
To build:
gcc -O3 gibbs_gsl.c -I/usr/local/include -L/usr/local/lib -lgsl -lgslcblas -lm -o gibbs_gsl
To run:
time ./gibbs_gsl
*/

/* Arrays xa and ya are passed by reference */
void gibbs(int N, int thin, double **xa, double **ya)
{
  int i,j;
  gsl_rng *r = gsl_rng_alloc(gsl_rng_mt19937);
  double x=0;
  double y=0;
  for (i=0;i<N;i++) {
    for (j=0;j<thin;j++) {
      x=gsl_ran_gamma(r,3.0,1.0/(y*y+4));
      y=1.0/(x+1)+gsl_ran_gaussian(r,1.0/sqrt(2*x+2));
    }
    (*xa)[i]=x; /* Note how the arrays are dereferenced */
    (*ya)[i]=y;
  }
  free(r);
}

int main()
{
  int N=50000;
  int thin=1000;
  double *xa,*ya;
  xa = (double *)malloc(sizeof(double)*N);
  ya = (double *)malloc(sizeof(double)*N);
  gibbs(N,thin,&xa,&ya);
  return(0);
}


#include <stdio.h>      //printf
#include <string.h>     //memset
#include <time.h>       //time
#include <cblas.h>      //cblas_scopy, cblas_sscal, cblas_sgemm
#include <sys/times.h>  //times
#include <unistd.h>     //sysconf
#include <math.h>       //fabsf
#include <xmmintrin.h>  //_mm_malloc
#define  ALIGN 16

float* gen_matrix(int order, float range){
    float* m = _mm_malloc(order * order * sizeof(float), ALIGN);
    srand(time(NULL));
    for(int i = 0; i < order * order; ++i)
        m[i] = ((float)rand() / (float)(RAND_MAX)) * range;
    return m;
}

void transpose_matrix(float* m, int order){
    for(int i = 0; i < order; ++i)
        for(int j = i; j < order; ++j){
            float tmp = m[i * order + j];
            m[i * order + j] = m[j * order + i];
            m[j * order + i] = tmp;
        }
}

void print_matrix(float* m, int order, FILE* out){
    fprintf(out, "Order: %d\n", order);
    for(int i = 0; i < order; ++i){
        for(int j = 0; j < order; ++j)
            fprintf(out, "%.4f ", m[i * order + j]);
        fprintf(out, "\n");
    }
    fprintf(out, "\n");
}

void get_matrix_norms(float* m, int order, float* l1_norm, float* max_norm){
    *l1_norm = 0;
    *max_norm = 0;
    for(int i = 0; i < order; ++i){
        float row_sum = 0;
        float col_sum = 0;
        for(int j = 0; j < order; ++j){
            row_sum += fabs(m[i * order + j]);
            col_sum += fabs(m[j * order + i]);
        }
        if(*l1_norm < col_sum)
            *l1_norm = col_sum;
        if(*max_norm < row_sum)
            *max_norm = row_sum;
    }
}

float* get_identity_matrix(int order){
    float* m = _mm_malloc(order * order * sizeof(float), ALIGN);
    memset(m, 0, order * order * sizeof(float));
    for(int i = 0; i < order; ++i)
        m[i * order + i] = 1;
    return m;
}

float* invert_matrix(float* A, int order, int iter_number){
    float* B = _mm_malloc(order * order * sizeof(float), ALIGN);
    cblas_scopy(order * order, A, 1, B, 1);
    transpose_matrix(B, order);
    float l1_norm, max_norm;
    get_matrix_norms(A, order, &l1_norm, &max_norm);
    cblas_sscal(order * order, 1.0 / (l1_norm * max_norm), B, 1);
    float* R = get_identity_matrix(order);
    cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, order, order, order, -1, B, order, A, order, 1, R, order);
    float* R_1_deg = _mm_malloc(order * order * sizeof(float), ALIGN);
    cblas_scopy(order * order, R, 1, R_1_deg, 1);
    float* tmp = NULL;
    float* inv_A = get_identity_matrix(order);
    for(int i = 0; i < iter_number; ++i){
        tmp = _mm_malloc(order * order * sizeof(float), ALIGN);
        cblas_saxpy(order * order, 1, R, 1, inv_A, 1);
        cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, order, order, order, 1, R, order, R_1_deg, order, 0, tmp,
                    order);
        _mm_free(R);
        R = tmp;
    }
    cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, order, order, order, 1, inv_A, order, B, order, 0.0, tmp,
            order);
    _mm_free(inv_A);
    inv_A = tmp;
    _mm_free(B);
    _mm_free(R_1_deg);
    return inv_A;
}

int main(){
    FILE* input = fopen("input.txt", "r");
    FILE* output = fopen("output.txt", "w");
    int N = 0, M = 0;
    fscanf(input, "%d%d", &N, &M);
    float* A = gen_matrix(N, 5.0);
    time_t start_real = time(NULL);
    float* inv_A = invert_matrix(A, N, M);
    time_t finish_real = time(NULL);
    float* rez = _mm_malloc(N * N * sizeof(float), ALIGN);
    cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, N, N, N, 1, inv_A, N, A, N, 0, rez, N);
    print_matrix(rez, N, output);
    printf("Total real time: %ld sec.\n", finish_real - start_real);
    _mm_free(A);
    _mm_free(inv_A);
    _mm_free(rez);
    fclose(input);
    fclose(output);
    return 0;
}

The 2nd course/Computers and devices/laboratory work #7/with_cblas/cblas.c


/* specfunc/gsl_sf_coupling.h
 *
 * 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 2 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* Author:  G. Jungman */

#ifndef __GSL_SF_COUPLING_H__
#define __GSL_SF_COUPLING_H__

#include <gsl/gsl_sf_result.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

/* 3j Symbols:  / ja jb jc \
 *              \ ma mb mc /
 *
 * exceptions: GSL_EDOM, GSL_EOVRFLW
 */
int gsl_sf_coupling_3j_e(int two_ja, int two_jb, int two_jc,
                            int two_ma, int two_mb, int two_mc,
			    gsl_sf_result * result
			    );
double gsl_sf_coupling_3j(int two_ja, int two_jb, int two_jc,
                          int two_ma, int two_mb, int two_mc
                          );

/* 6j Symbols:  / ja jb jc \
 *              \ jd je jf /
 *
 * exceptions: GSL_EDOM, GSL_EOVRFLW
 */
int gsl_sf_coupling_6j_e(int two_ja, int two_jb, int two_jc,
                            int two_jd, int two_je, int two_jf,
			    gsl_sf_result * result
			    );
double gsl_sf_coupling_6j(int two_ja, int two_jb, int two_jc,
                          int two_jd, int two_je, int two_jf
                          );

/* 9j Symbols:  / ja jb jc \
 *              | jd je jf |
 *              \ jg jh ji /
 *
 * exceptions: GSL_EDOM, GSL_EOVRFLW
 */
int gsl_sf_coupling_9j_e(int two_ja, int two_jb, int two_jc,
                            int two_jd, int two_je, int two_jf,
			    int two_jg, int two_jh, int two_ji,
			    gsl_sf_result * result
			    );
double gsl_sf_coupling_9j(int two_ja, int two_jb, int two_jc,
                          int two_jd, int two_je, int two_jf,
                          int two_jg, int two_jh, int two_ji
                          );

__END_DECLS

#endif /* __GSL_SF_COUPLING_H__ */


/* roots/newton.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Reid Priedhorsky, Brian Gough
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* newton.c -- newton root finding algorithm

   This is the classical Newton-Raphson iteration.

   x[i+1] = x[i] - f(x[i])/f'(x[i])

*/

#include <config.h>

#include <stddef.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <float.h>

#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_roots.h>

#include "roots.h"

typedef struct
  {
    double f, df;
  }
newton_state_t;

static int newton_init (void * vstate, gsl_function_fdf * fdf, double * root);
static int newton_iterate (void * vstate, gsl_function_fdf * fdf, double * root);

static int
newton_init (void * vstate, gsl_function_fdf * fdf, double * root)
{
  newton_state_t * state = (newton_state_t *) vstate;

  const double x = *root ;

  state->f = GSL_FN_FDF_EVAL_F (fdf, x);
  state->df = GSL_FN_FDF_EVAL_DF (fdf, x) ;

  return GSL_SUCCESS;

}

static int
newton_iterate (void * vstate, gsl_function_fdf * fdf, double * root)
{
  newton_state_t * state = (newton_state_t *) vstate;

  double root_new, f_new, df_new;

  if (state->df == 0.0)
    {
      GSL_ERROR("derivative is zero", GSL_EZERODIV);
    }

  root_new = *root - (state->f / state->df);

  *root = root_new ;

  GSL_FN_FDF_EVAL_F_DF(fdf, root_new, &f_new, &df_new);

  state->f = f_new ;
  state->df = df_new ;

  if (!finite(f_new))
    {
      GSL_ERROR ("function not continuous", GSL_EBADFUNC);
    }

  if (!finite (df_new))
    {
      GSL_ERROR ("function not differentiable", GSL_EBADFUNC);
    }

  return GSL_SUCCESS;
}

static const gsl_root_fdfsolver_type newton_type =
{"newton",				/* name */
 sizeof (newton_state_t),
 &newton_init,
 &newton_iterate};

const gsl_root_fdfsolver_type  * gsl_root_fdfsolver_newton = &newton_type;


#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_roots.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_sf_expint.h>
#include "ccl.h"

//maths helper function for NFW profile
static double helper_fx(double x){
    double f;
    f = log(1.+x)-x/(1.+x);
    return f;
}

//cosmo: ccl cosmology object containing cosmological parameters
//c: halo concentration, needs to be consistent with halo size definition
//halomass: halo mass
//massdef_delta: mass definition, overdensity relative to mean matter density
//a: scale factor
//r: radii at which to calculate output
//nr: number of radii for calculation
//rho_r: stores densities at r
//returns void
void ccl_halo_profile_nfw(ccl_cosmology *cosmo, double c, double halomass,
                          double massdef_delta_m, double a, double *r, int nr,
                          double *rho_r, int *status) {

    //haloradius: halo radius for mass definition
    //rs: scale radius
    double haloradius, rs;

    haloradius = r_delta(cosmo, halomass, a, massdef_delta_m, status);
    rs = haloradius/c;

    //rhos: NFW density parameter
    double rhos;

    rhos = halomass/(4.*M_PI*(rs*rs*rs)*helper_fx(c));

    int i;
    double x;
    for(i=0; i < nr; i++) {
        x = r[i]/rs;
        rho_r[i] = rhos/(x*(1.+x)*(1.+x));
    }
    return;
}

//cosmo: ccl cosmology object containing cosmological parameters
//c: halo concentration, needs to be consistent with halo size definition
//halomass: halo mass
//massdef_delta: mass definition, overdensity relative to mean matter density
//a: scale factor
//rp: radius at which to calculate output
//nr: number of radii for calculation
//sigma_r: stores surface mass density (integrated along line of sight) at given projected rp
//returns void
void ccl_projected_halo_profile_nfw(ccl_cosmology *cosmo, double c,
                                    double halomass, double massdef_delta_m,
                                    double a, double *rp, int nr, double *sigma_r,
                                    int *status) {

    //haloradius: halo radius for mass definition
    //rs: scale radius
    double haloradius, rs;

    haloradius = r_delta(cosmo, halomass, a, massdef_delta_m, status);
    rs = haloradius/c;

    //rhos: NFW density parameter
    double rhos;

    rhos = halomass/(4.*M_PI*(rs*rs*rs)*helper_fx(c));

    double x;

    int i;
    for(i=0; i < nr; i++){

        x = rp[i]/rs;
        if (x==1.){
            sigma_r[i] = 2.*rs*rhos/3.;
        }
        else if (x<1.){
            sigma_r[i] = 2.*rs*rhos*(1.-2.*atanh(sqrt(fabs((1.-x)/(1.+x))))/sqrt(fabs(1.-x*x)))/(x*x-1.);
        }
        else {
            sigma_r[i] = 2.*rs*rhos*(1.-2.*atan(sqrt(fabs((1.-x)/(1.+x))))/sqrt(fabs(1.-x*x)))/(x*x-1.);
        }
    }
    return;

}

//maths helper function assuming NFW approximation
static double helper_solve_cvir(double c, void *rhs_pointer){
    double rhs = *(double*)rhs_pointer;
    return (log(1.+c)-c/(1.+c))/(c*c*c) - rhs;
}

//solve for cvir from different mass definition iteratively, assuming NFW profile.
static double solve_cvir(ccl_cosmology *cosmo, double rhs, double initial_guess, int *status){

    int rootstatus;
    int iter = 0, max_iter = 100;
    const gsl_root_fsolver_type *T;
    gsl_root_fsolver *s;
    double cvir;
    double c_lo = 0.1, c_hi = initial_guess*100.;
    gsl_function F;

    F.function = &helper_solve_cvir;
    F.params = &rhs;

    T = gsl_root_fsolver_brent;
    s = gsl_root_fsolver_alloc (T);
    if (s != NULL) {
      gsl_root_fsolver_set (s, &F, c_lo, c_hi);

      do
        {
          iter++;
          gsl_root_fsolver_iterate (s);
          cvir = gsl_root_fsolver_root (s);
          c_lo = gsl_root_fsolver_x_lower (s);
          c_hi = gsl_root_fsolver_x_upper (s);
          rootstatus = gsl_root_test_interval (c_lo, c_hi, 0, 0.0001);
        }
      while (rootstatus == GSL_CONTINUE && iter < max_iter);

      gsl_root_fsolver_free(s);

      // Check for errors
      if (rootstatus != GSL_SUCCESS) {
          ccl_raise_gsl_warning(rootstatus, "ccl_haloprofile.c: solve_cvir():");
          *status = CCL_ERROR_PROFILE_ROOT;
          ccl_cosmology_set_status_message(cosmo, "ccl_haloprofile.c: solve_cvir(): Root finding failure\n");
          return NAN;
      } else {
          return cvir;
      }
    }
    else {
      *status = CCL_ERROR_MEMORY;
      return NAN;
    }
}

// Structure to hold parameters of integrand_einasto
typedef struct{
  ccl_cosmology *cosmo;
  double alpha, rs;
} Int_Einasto_Par;

static double integrand_einasto(double r, void *params){

    Int_Einasto_Par *p = (Int_Einasto_Par *)params;
    double alpha = p->alpha;
    double rs = p->rs;

    return 4.*M_PI*r*r*exp(-2.*(pow(r/rs,alpha)-1)/alpha);
}

//integrate einasto profile to get normalization of rhos
static double integrate_einasto(ccl_cosmology *cosmo, double R, double alpha, double rs, int *status){
    int qagstatus;
    double result = 0, eresult;
    Int_Einasto_Par ipar;
    gsl_function F;
    gsl_integration_workspace *w = NULL;

    w = gsl_integration_workspace_alloc(1000);

    if (w == NULL) {
      *status = CCL_ERROR_MEMORY;
    }

    if (*status == 0) {
      // Structure required for the gsl integration
      ipar.cosmo = cosmo;
      ipar.alpha = alpha;
      ipar.rs = rs;
      F.function = &integrand_einasto;
      F.params = &ipar;

      // Actually does the integration
      qagstatus = gsl_integration_qag(
        &F, 0, R, 0, 0.0001, 1000, 3, w,
        &result, &eresult);

      // Check for errors
      if (qagstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(qagstatus, "ccl_haloprofile.c: integrate_einasto():");
        *status = CCL_ERROR_PROFILE_INT;
        ccl_cosmology_set_status_message(cosmo, "ccl_haloprofile.c: integrate_einasto(): Integration failure\n");
        result = NAN;
      }
    }

  // Clean up
  gsl_integration_workspace_free(w);

  return result;
}

//cosmo: ccl cosmology object containing cosmological parameters
//c: halo concentration, needs to be consistent with halo size definition
//halomass: halo mass
//massdef_delta: mass definition, overdensity relative to mean matter density
//a: scale factor
//r: radii at which to calculate output
//nr: number of radii for calculation
//rho_r: stores densities at r
//returns void
void ccl_halo_profile_einasto(ccl_cosmology *cosmo, double c, double halomass,
                              double massdef_delta_m, double a, double *r, int nr,
                              double *rho_r, int *status) {

    //haloradius: halo radius for mass definition
    //rs: scale radius
    double haloradius, rs;

    haloradius = r_delta(cosmo, halomass, a, massdef_delta_m, status);
    rs = haloradius/c;

    //nu: peak height, https://arxiv.org/pdf/1401.1216.pdf eqn1
    //alpha: Einasto parameter, https://arxiv.org/pdf/1401.1216.pdf eqn5
    double nu;
    double alpha;  //calibrated relation with nu, with virial mass
    double Mvir;
    double Delta_v;

    Delta_v = Dv_BryanNorman(cosmo, a, status); //virial definition, if odelta is this, the definition is virial.

    if (massdef_delta_m<Delta_v+1 && massdef_delta_m>Delta_v-1){   //allow rounding of virial definition
        Mvir = halomass;
    }
    else{
        double rhs; //NFW equation for cvir: f(Rvir/Rs)/f(c)=(Rvir^3*Delta_v)/(R^3*massdef) -> f(cvir)/cvir^3 = rhs
        rhs = (helper_fx(c)*(rs*rs*rs)*Delta_v)/((haloradius*haloradius*haloradius)*massdef_delta_m);
        Mvir = halomass*helper_fx(solve_cvir(cosmo, rhs, c, status))/helper_fx(c);
    }

    nu = 1.686/ccl_sigmaM(cosmo, log10(Mvir), a, status); //delta_c_Tinker
    alpha = 0.155 + 0.0095*nu*nu;

    //rhos: scale density
    double rhos;

    rhos = halomass/integrate_einasto(cosmo, haloradius, alpha, rs, status); //normalize

    int i;
    for(i=0; i < nr; i++) {
        rho_r[i] = rhos*exp(-2.*(pow(r[i]/rs,alpha)-1.)/alpha);
    }

    return;

}

// Structure to hold parameters of integrand_hernquist
typedef struct{
  ccl_cosmology *cosmo;
  double rs;
} Int_Hernquist_Par;

static double integrand_hernquist(double r, void *params){

    Int_Hernquist_Par *p = (Int_Hernquist_Par *)params;
    double rs = p->rs;

    return 4.*M_PI*r*r/((r/rs)*(1.+r/rs)*(1.+r/rs)*(1.+r/rs));
}

//integrate hernquist profile to get normalization of rhos
static double integrate_hernquist(ccl_cosmology *cosmo, double R, double rs, int *status){
    int qagstatus;
    double result = 0, eresult;
    Int_Hernquist_Par ipar;
    gsl_function F;
    gsl_integration_workspace *w = NULL;

    w = gsl_integration_workspace_alloc(1000);

    if (w == NULL) {
      *status = CCL_ERROR_MEMORY;
    }

    if (*status == 0) {
      // Structure required for the gsl integration
      ipar.cosmo = cosmo;
      ipar.rs = rs;
      F.function = &integrand_hernquist;
      F.params = &ipar;

      // Actually does the integration
      qagstatus = gsl_integration_qag(
        &F, 0, R, 0, 0.0001, 1000, 3, w,
        &result, &eresult);

      // Check for errors
      if (qagstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(qagstatus, "ccl_haloprofile.c: integrate_hernquist():");
        *status = CCL_ERROR_PROFILE_INT;
        ccl_cosmology_set_status_message(cosmo, "ccl_haloprofile.c: integrate_hernquist(): Integration failure\n");
        result = NAN;
      }
    }

    // Clean up
    gsl_integration_workspace_free(w);

    return result;
}

//cosmo: ccl cosmology object containing cosmological parameters
//c: halo concentration, needs to be consistent with halo size definition
//halomass: halo mass
//massdef_delta: mass definition, overdensity relative to mean matter density
//a: scale factor
//r: radii at which to calculate output
//nr: number of radii for calculation
//rho_r: stores densities at r
//returns void
void ccl_halo_profile_hernquist(ccl_cosmology *cosmo, double c, double halomass,
                                double massdef_delta_m, double a, double *r, int nr,
                                double *rho_r, int *status) {

    //haloradius: halo radius for mass definition
    //rs: scale radius
    double haloradius, rs;

    haloradius = r_delta(cosmo, halomass, a, massdef_delta_m, status);
    rs = haloradius/c;

    //rhos: scale density
    double rhos;

    rhos = halomass/integrate_hernquist(cosmo, haloradius, rs, status); //normalize

    int i;
    double x;
    for(i=0; i < nr; i++) {
        x = r[i]/rs;
        rho_r[i] = rhos/(x*pow((1.+x),3));
    }

    return;

}


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

#include "ellipsoid/ellipsoid.h"

int testCoordinateTransform()
{
  //Verify that the ellipsoidal to Cartesian transformation is a bijection
  //the tolerance is 10 significant figures
  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, 3.0, 2.0, 1.0, 32);

  double relErrorX, relErrorY, relErrorZ;

  //loop over octants
  for(int sx=-1; sx<=1; sx+=2) { //sx = [-1,1]
    for(int sy=-1; sy<=1; sy+=2) { //sy = [-1,1]
      for(int sz=-1; sz<=1; sz+=2) { //sz = [-1,1]
	//loop over brick in cartesian space
	for(double x=4; x<5+tol; x+=1.5) {
	  for(double y=4; y<5+tol; y+=1.5) {
	    for(double z=4; z<5+tol; z+=1.5) {
	      Point temp = { .x1 = sx*x, .x2 = sy*y, .x3 = sz*z };
	      cartesianToEllipsoidal(&e, &temp);
	      ellipsoidToCartesian(&e, &temp);
	      relErrorX = fabs(sx*x - temp.x1)/x;
	      relErrorY = fabs(sy*y - temp.x2)/y;
	      relErrorZ = fabs(sz*z - temp.x3)/z;
	      //check error
	      if( relErrorX > tol ||
		  relErrorY > tol ||
		  relErrorZ > tol) {
		printf("testCoordinateTransform failed\n");
		printf("relative error(x): %16.16f\n", relErrorX);
		printf("relative error(y): %16.16f\n", relErrorY);
		printf("relative error(z): %16.16f\n", relErrorZ);
		return 0;
	      }
	    }
	  }
	}
      }
    }
  }
  return 1;
}

int testLameType()
{

  static char formula1[18] = "K^0_1 L^0_1 M^0_1";
  static char formula2[30] = "K^0_2 K^1_2 L^0_2 M^0_2 N^0_2";
  static char formula3[66] = "K^0_5 K^1_5 K^2_5 L^0_5 L^1_5 L^2_5 M^0_5 M^1_5 M^2_5 N^0_5 N^1_5";

  char **checks = (char**) malloc(sizeof(char*)*3);
  checks[0] = (char*) malloc(sizeof(char)*17);
  checks[1] = (char*) malloc(sizeof(char)*29);
  checks[2] = (char*) malloc(sizeof(char)*65);

  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, 3.0, 2.0, 1.0, 32);
  int index[3] = { 1, 2, 5 };
  int k;
  int n;
  for(int i=0; i<3; ++i) {
    n = index[i];
    for(int p=0; p < 2*n + 1; ++p) {
      k = p*6;
      checks[i][k]   = getLameTypeT(n, p);
      checks[i][k+1] = '^';
      checks[i][k+2] = getLameTypeTp(n, p) + '0';
      checks[i][k+3] = '_';
      checks[i][k+4] = n + '0';
      if( p != 2*n )
	checks[i][k+5] = ' ';
    }
  }
  //check first string
  for(int i=0; i < 17; ++i) {
    if(checks[0][i] != formula1[i]) {
      return 0;
    }
  }
  //check second string
  for(int i=0; i < 29; ++i) {
    if(checks[1][i] != formula2[i]) {
      return 0;
    }
  }
  //check first string
  for(int i=0; i < 65; ++i) {
    if(checks[2][i] != formula3[i]) {
      return 0;
    }
  }
  free(checks[0]);
  free(checks[1]);
  free(checks[2]);
  free(checks);
  return 1;
}

int testI()
{
  //Using results from Dassios, test the computation of I^p_n for n = 0, 1, 2
  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, 3.0, 2.0, 1.0, 32);
  double a = e.a;
  double b = e.b;
  double c = e.c;
  double h = e.h;
  double k = e.k;
  double l = a;
  double rootSum = sqrt((a*a*a*a - b*b*c*c) + (b*b*b*b - a*a*c*c) + (c*c*c*c - a*a*b*b));
  double DassiosLambda = (1/3.)*(a*a + b*b + c*c) + (1/3.)*rootSum;
  double DassiosLambdaPrime = (1/3.)*(a*a + b*b + c*c) - (1/3.)*rootSum;

  double errors[18];
  int derror[18] = { 1, 2, 3, 3, 4, 4, 5, 5, 6, 6, 6, 7, 8, 9, 10, 11, 12, 13 };
  int ecount = 0;
  //Dassios D1 error
  double lhs = 3 * (DassiosLambda + DassiosLambdaPrime);
  double rhs = 2 * (a*a + b*b + c*c);
  errors[ecount] = fabs(lhs - rhs); ecount++;
  //Dassios D2 error
  lhs = 3 * DassiosLambda * DassiosLambdaPrime;
  rhs = a*a*b*b + a*a*c*c + b*b*c*c;
  errors[ecount] = fabs(lhs - rhs); ecount ++;
  //Dassios D3 error
  lhs = ((-1)*(b*b - c*c)*(DassiosLambda - a*a)) + (k*k*(DassiosLambda - b*b)) + (-h*h*(DassiosLambda - c*c));
  rhs = ((-1)*(b*b - c*c)*(DassiosLambdaPrime - a*a)) + (k*k*(DassiosLambdaPrime - b*b)) + (-h*h*(DassiosLambdaPrime - c*c));
  errors[ecount] = fabs(lhs-0); ecount++;
  errors[ecount ] = fabs(rhs-0); ecount++;
  //Dassios D4 error
  lhs = (-a*a*(b*b - c*c)*(DassiosLambda - a*a)) + (b*b*k*k*(DassiosLambda - b*b)) + (-c*c*h*h*(DassiosLambda - c*c));
  rhs = (-a*a*(b*b - c*c)*(DassiosLambdaPrime - a*a)) + (b*b*k*k*(DassiosLambdaPrime - b*b)) + (-c*c*h*h*(DassiosLambdaPrime - c*c));
  double analytical = h*h*k*k*(b*b - c*c);
  errors[ecount] = fabs(lhs - analytical); ecount++;
  errors[ecount] = fabs(rhs - analytical); ecount++;
  //Dassios D5 error
  double alpha[3] = { a, b, c };
  lhs = 0;
  rhs = 0;
  for(int i=0; i<3; ++i) {
    lhs += alpha[i]*alpha[i]/(alpha[i]*alpha[i] - DassiosLambda);
    rhs += alpha[i]*alpha[i]/(alpha[i]*alpha[i] - DassiosLambdaPrime);
  }
  errors[ecount] = fabs(lhs - 3); ecount++;
  errors[ecount] = fabs(rhs - 3); ecount++;
  //Dassios D6 error
  double anal1 = h*h*k*k*(b*b - c*c);
  double num1  = 3*(b*b - c*c)*(DassiosLambda - a*a)*(DassiosLambdaPrime - a*a);
  double anal2 = -h*h*k*k*(b*b - c*c);
  double num2  = 3*k*k*(DassiosLambda - b*b)*(DassiosLambdaPrime - b*b);
  double anal3 = h*h*k*k*(b*b - c*c);
  double num3  = 3*h*h*(DassiosLambda - c*c)*(DassiosLambdaPrime - c*c);
  errors[ecount] = fabs(num1 - anal1); ecount++;
  errors[ecount] = fabs(num2 - anal2); ecount++;
  errors[ecount] = fabs(num3 - anal3); ecount++;

  //Calculate I^p_n
  int nmax = 2;
  int Isize = 0;
  for(int n=0; n < nmax+1; ++n) {
    for(int p=0; p < 2*n+1; ++p) {
      Isize++;
    }
  }
  double *Ival = (double*) malloc(sizeof(double)*Isize);
  int i=0;
  for(int n=0; n < nmax+1; ++n) {
    for(int p=0; p < 2*n+1; ++p) {
      calcI(&e, n, p, l, 1, 1, Ival+i); //Ival[i] = calcI(&e, n, p, l, 1, 1);
      i++;
    }
  }

  //Dassios D7: their h_3 = our h and their h_2 = our k
  double analyticalSumTest1 = 1.0/(l*sqrt(l*l - h*h)*sqrt(l*l - k*k));
  double numericalSumTest1 = 0;
  for(int k=1; k<4; ++k) {
    numericalSumTest1 += Ival[k];
  }
  errors[ecount] = fabs(analyticalSumTest1 - numericalSumTest1); ecount++;

  //Dassios D8: their alpha1 = our a, their alpha2 = our b, their alpha3 = our c
  double analyticalSumTest2 = Ival[0] - (l*l - a*a)/(l*sqrt(l*l - h*h)*sqrt(l*l - k*k));
  double numericalSumTest2 = a*a*Ival[1] + b*b*Ival[2] + c*c*Ival[3];
  errors[ecount] = fabs(analyticalSumTest2 - numericalSumTest2); ecount++;
  //Dassios D9: their Lambda = our DassiosLambda, their LambdaPrime = our DassiosLambdaPrime
  double analyticalSumTest3 = 1.0/(2.0*(DassiosLambda - a*a + l*l)*l*sqrt(l*l - h*h)*sqrt(l*l - k*k)) - (1.0/2.0)*(Ival[1]/(DassiosLambda - a*a) + Ival[2]/(DassiosLambda - b*b) + Ival[3]/(DassiosLambda - c*c));
  double numericalSumTest3 = Ival[4];
  errors[ecount] = fabs(analyticalSumTest3 - numericalSumTest3); ecount++;
  //Dassios D10: their Lambda = our DassiosLambda, their LambdaPrime = our DassiosLambdaPrime
  double analyticalSumTest4 = 1.0/(2.0*(DassiosLambdaPrime - a*a + l*l)*l*sqrt(l*l - h*h)*sqrt(l*l - k*k)) - (1.0/2.0)*(Ival[1]/(DassiosLambdaPrime - a*a) + Ival[2]/(DassiosLambdaPrime - b*b) + Ival[3]/(DassiosLambdaPrime - c*c));
  double numericalSumTest4 = Ival[5];
  errors[ecount] = fabs(analyticalSumTest4 - numericalSumTest4); ecount++;
  //Dassios D11: their h1*h1 = our (b*b - c*c)
  double analyticalSumTest5 = (1.0/(h*h)) * (Ival[2] - Ival[1]);
  double numericalSumTest5 = Ival[6];
  errors[ecount] = fabs(analyticalSumTest5 - numericalSumTest5); ecount++;
  //Dassios D12: their h1*h1 = our (b*b - c*c)
  double analyticalSumTest6 = (1.0/(k*k)) * (Ival[3] - Ival[1]);
  double numericalSumTest6 = Ival[7];
  errors[ecount] = fabs(analyticalSumTest6 - numericalSumTest6); ecount++;
  //Dassios D13: their h1*h1 = our (b*b - c*c)
  double analyticalSumTest7 = (1.0/(b*b - c*c)) * (Ival[3] - Ival[2]);
  double numericalSumTest7 = Ival[8];
  errors[ecount] = fabs(analyticalSumTest7 - numericalSumTest7); ecount++;

  //checking errors
  for(int i=0; i < 18; ++i) {
    if(errors[i] > tol) {
      printf("Dassios D%d failed with error %8.8e\n", derror[i], errors[i]);
      free(Ival);
      return 0;
    }
  }

  free(Ival);
  return 1;
}

int testNormalization()
{
  //Check calculated \gamma^p_n against analytic results for n = 0, 1, 2
  double a = 3.0;
  double b = 2.0;
  double c = 1.0;
  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, a, b, c, 32);
  //Dassios (B14)
  double firstTerm = (a*a + b*b + c*c)/3.0;
  double secondTerm = sqrt((a*a*a*a - b*b*c*c) + (b*b*b*b - a*a*c*c) + (c*c*c*c - a*a*b*b))/3.0;
  double LambdaD = firstTerm + secondTerm;
  double LambdaDprime = firstTerm - secondTerm;
  //Dassios (B16)-(B20)
  double hx = sqrt(b*b - c*c);
  double hy = e.k;
  double hz = e.h;
  double analytic[9] = { 4*PETSC_PI,
			 4*PETSC_PI/3 * hy*hy*hz*hz,
			 4*PETSC_PI/3 * hx*hx*hz*hz,
			 4*PETSC_PI/3 * hx*hx*hy*hy,
			 -8*PETSC_PI/5 * (LambdaD - LambdaDprime)*(LambdaD - a*a)*(LambdaD - b*b)*(LambdaD - c*c),
			 8*PETSC_PI/5 * (LambdaD - LambdaDprime)*(LambdaDprime - a*a)*(LambdaDprime - b*b)*(LambdaDprime - c*c),
			 4*PETSC_PI/15 * hx*hx*hy*hy*hz*hz*hz*hz,
			 4*PETSC_PI/15 * hx*hx*hy*hy*hy*hy*hz*hz,
			 4*PETSC_PI/15 * hx*hx*hx*hx*hy*hy*hz*hz };
  printf("analytic[0] = %4.4e\n", analytic[0]);
  printf("analytic[1] = %4.4e\n", analytic[1]);
  double value, estimate, error;
  int counter = 0;
  for(int n=0; n<3; ++n) {
    for(int p=0; p<2*n+1; ++p) {
      value = analytic[counter];
      calcNormalization(&e, n, p, &estimate);
      error = estimate - value;
      if(fabs(error) > tol) {
	printf("testnormalization failed iteration %d at (n,p) = (%d,%d) with error %8.8e\n", counter, n, p, fabs(error));
	return 0;
      }
      counter++;
    }
  }
  return 1;

}

void testfunc(mpfr_t *x, mpfr_t *val, FuncInfo4 *ctx)
{
  double a2 = (*ctx).a2;
  double b2 = (*ctx).b2;
  double c2 = (*ctx).c2;
  double botVar = (*ctx).botVar;

  mpfr_t temp, s;
  mpfr_init2(temp, mpfr_get_prec(*x));
  mpfr_init2(s   , mpfr_get_prec(*x));
  //change of variables
  //s = (1-x)/x
  mpfr_d_sub(s, 1.0, *x, MPFR_RNDZ);
  mpfr_div(s, s, *x, MPFR_RNDN);

  mpfr_add_d(temp, s, a2, MPFR_RNDN);
  mpfr_add_d(*val, s, b2, MPFR_RNDN);
  mpfr_mul(*val, *val, temp, MPFR_RNDN);
  mpfr_add_d(temp, s, c2, MPFR_RNDN);
  mpfr_mul(*val, *val, temp, MPFR_RNDN);
  mpfr_sqrt(*val, *val, MPFR_RNDN);

  mpfr_add_d(temp, s, botVar, MPFR_RNDN);
  mpfr_mul(*val, *val, temp, MPFR_RNDN);

  mpfr_d_div(*val, 1.0, *val, MPFR_RNDN);

  //multiply by dt = ds * (1+t)^2
  mpfr_add_d(temp, s, 1.0, MPFR_RNDN);
  mpfr_mul(temp, temp, temp, MPFR_RNDN);
  mpfr_mul(*val, *val, temp, MPFR_RNDN);
  //mpfr_clears(temp, s, NULL);
}

int testSurfaceOperatorEigenvalues()
{
  EllipsoidalSystem e;
  double a = 3.0;
  double b = 2.0;
  double c = 1.0;
  initEllipsoidalSystem(&e, a, b, c, 32);
  double l = a;
  int n = 1;
  double analytic[3];
  mpfr_t integral;

  mpfr_t mpfrzero, mpfrone;
  mpfr_inits(mpfrzero, mpfrone, integral, NULL);
  mpfr_set_d(mpfrzero, 0.0, MPFR_RNDN);
  mpfr_set_d(mpfrone, 1.0, MPFR_RNDN);

  //Integrals are from Ritter, need to transform integrals to finite interval
  FuncInfo4 ctx = { &e, a*a, b*b, c*c, a*a };
  integrateMPFR((PetscErrorCode (*)(mpfr_t*, mpfr_t*, void*)) testfunc, &e, mpfrzero, mpfrone, 14, &integral, &ctx);
  analytic[0] = (a*b*c * mpfr_get_d(integral, MPFR_RNDN) - 1.0)/2.0;
  ctx.botVar = b*b;
  integrateMPFR((PetscErrorCode (*)(mpfr_t*, mpfr_t*, void*)) testfunc, &e, mpfrzero, mpfrone, 14, &integral, &ctx);
  analytic[1] = (a*b*c * mpfr_get_d(integral, MPFR_RNDN) - 1.0)/2.0;
  ctx.botVar = c*c;
  integrateMPFR((PetscErrorCode (*)(mpfr_t*, mpfr_t*, void*)) testfunc, &e, mpfrzero, mpfrone, 14, &integral, &ctx);
  analytic[2] = (a*b*c * mpfr_get_d(integral, MPFR_RNDN) - 1.0)/2.0;

  double *ev = (double*) malloc(sizeof(double)*(3));
  for(int p=0; p < 3; ++p)
    calcSurfaceOperatorEigenvalues(&e, n, p, l, 1, 1, ev+p); //ev[p] = calcSurfaceOperatorEigenvalues(&e, n, p, l, 1, 1);
  for(int p=0; p < 3; ++p) {
    if(fabs(ev[p] - analytic[p]) > tol) {
      printf("analytic (%8.8e) doesn't match numerical (%8.8e), error = (%8.8e) for integral %d\n", analytic[p], ev[p], fabs(ev[p] - analytic[p]), p+1);
      return 0;
    }
  }
  mpfr_clears(mpfrzero, mpfrone, integral, NULL);
  free(ev);
  return 1;

}

int compareIntegration()
{

  //int n, p given in calcNormalization
  int n = 1;
  int p = 1;

  int digits = 32;

  //set up ellipsoidal system
  EllipsoidalSystem e;
  double xA = 3.0;
  double yB = 2.0;
  double zC = 1.0;
  initEllipsoidalSystem(&e, xA, yB, zC, digits);

  mpfr_t bound_a, bound_b;
  mpfr_inits2(4*digits, bound_a, bound_b, NULL);

  FuncInfo2 ctx1 = { .e = &e, .n = n, .p = p, .numeratorType = 0, .denomSign = 1 };

  mpfr_t a, b, c;
  mpfr_inits(a, b, c, NULL);
  double integralMPFR, integralMidpoint;

  integrateMPFR((PetscErrorCode (*)(mpfr_t*, mpfr_t*, void*)) normFunction1, &e, e.hp_h, e.hp_k, 14, &integralMPFR, &ctx1);
  integrateMidpoint((PetscErrorCode (*)(mpfr_t*, mpfr_t*, void*)) normFunction1, e.hp_h, e.hp_k, 10, &integralMidpoint, &ctx1);

  printf("MPFR integral is: %15.15f\n", integralMPFR);
  printf("Midpoint integral is: %15.15f\n", integralMidpoint);
  printf("oh wow\n");

  mpfr_clears(a, b, c, NULL);

  return 0;
}

int main(int argc, char **argv)
{
  mpfr_set_default_prec(4*64);
  /*
  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, 3.0, 2.0, 1.0);
  printf("h: %15.15f\nh2: %15.15f\nk: %15.15f\nk2: %15.15f\n", e.h, e.h2, e.k, e.k2);
  int n = 1;
  int p = 1;
  double l = 1.0;

  //printf("calcLame(1, 1, 1.0) = %15.15f\n", calcLame(&e, 1, 1, 1.0));

  printf("calcNormalization(%d, %d, %15.15f) = %15.15f\n", n, p, l, calcNormalization(&e, n, p));
  */

  if(testCoordinateTransform())
    printf("testCoordinateTransform         passed\n");
  else
    printf("testCoordinateTransform         failed\n");
  if(testLameType())
    printf("testLameType                    passed\n");
  else
    printf("testLameType                    failed\n");
  if(testI())
    printf("testI                           passed\n");
  else
    printf("testI                           failed\n");
  if(testNormalization())
    printf("testNormalization               passed\n");
  else
    printf("testNormalization               failed\n");
  if(testSurfaceOperatorEigenvalues())
    printf("testSurfaceOperatorEigenvalues  passed\n");
  else
    printf("testSurfaceOperatorEigenvalues  failed\n");

  //compareIntegration();

  /*
  double h = .1;
  mpfr_t x, val;
  EllipsoidalSystem e;
  initEllipsoidalSystem(&e, 3.0, 2.0, 1.0);
  FuncInfo2 ctx1 = { .e = &e, .n = 1, .p = 2, .numeratorType = 0, .denomSign = -1 };
  mpfr_inits2(4*16, x, val, NULL);
  for(int k=0; k < 10; ++k) {
    mpfr_set_d(x, k*h, MPFR_RNDN);
    normFunction1(&x, &val, &ctx1);
    printf("normfunction1(%8.8f) = %15.15f\n", k*h, mpfr_get_d(val, MPFR_RNDN));
  }
  */
  return 0;
}