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

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

/* The Dirichlet probability distribution of order K-1 is

     p(\theta_1,...,\theta_K) d\theta_1 ... d\theta_K =
        (1/Z) \prod_i=1,K \theta_i^{alpha_i - 1} \delta(1 -\sum_i=1,K \theta_i)

   The normalization factor Z can be expressed in terms of gamma functions:

      Z = {\prod_i=1,K \Gamma(\alpha_i)} / {\Gamma( \sum_i=1,K \alpha_i)}

   The K constants, \alpha_1,...,\alpha_K, must be positive. The K parameters,
   \theta_1,...,\theta_K are nonnegative and sum to 1.

   The random variates are generated by sampling K values from gamma
   distributions with parameters a=\alpha_i, b=1, and renormalizing.
   See A.M. Law, W.D. Kelton, Simulation Modeling and Analysis (1991).

   Gavin E. Crooks <gec@compbio.berkeley.edu> (2002)
*/

static void ran_dirichlet_small (const gsl_rng * r, const size_t K, const double alpha[], double theta[]);

void
gsl_ran_dirichlet (const gsl_rng * r, const size_t K,
                   const double alpha[], double theta[])
{
  size_t i;
  double norm = 0.0;

  for (i = 0; i < K; i++)
    {
      theta[i] = gsl_ran_gamma (r, alpha[i], 1.0);
    }

  for (i = 0; i < K; i++)
    {
      norm += theta[i];
    }

  if (norm < GSL_SQRT_DBL_MIN)  /* Handle underflow */
    {
      ran_dirichlet_small (r, K, alpha, theta);
      return;
    }

  for (i = 0; i < K; i++)
    {
      theta[i] /= norm;
    }
}

/* When the values of alpha[] are small, scale the variates to avoid
   underflow so that the result is not 0/0.  Note that the Dirichlet
   distribution is defined by a ratio of gamma functions so we can
   take out an arbitrary factor to keep the values in the range of
   double precision. */

static void
ran_dirichlet_small (const gsl_rng * r, const size_t K,
                     const double alpha[], double theta[])
{
  size_t i;
  double norm = 0.0, umax = 0;

  for (i = 0; i < K; i++)
    {
      double u = log(gsl_rng_uniform_pos (r)) / alpha[i];

      theta[i] = u;

      if (u > umax || i == 0) {
        umax = u;
      }
    }

  for (i = 0; i < K; i++)
    {
      theta[i] = exp(theta[i] - umax);
    }

  for (i = 0; i < K; i++)
    {
      theta[i] = theta[i] * gsl_ran_gamma (r, alpha[i] + 1.0, 1.0);
    }

  for (i = 0; i < K; i++)
    {
      norm += theta[i];
    }

  for (i = 0; i < K; i++)
    {
      theta[i] /= norm;
    }
}

double
gsl_ran_dirichlet_pdf (const size_t K,
                       const double alpha[], const double theta[])
{
  return exp (gsl_ran_dirichlet_lnpdf (K, alpha, theta));
}

double
gsl_ran_dirichlet_lnpdf (const size_t K,
                         const double alpha[], const double theta[])
{
  /*We calculate the log of the pdf to minimize the possibility of overflow */
  size_t i;
  double log_p = 0.0;
  double sum_alpha = 0.0;

  for (i = 0; i < K; i++)
    {
      log_p += (alpha[i] - 1.0) * log (theta[i]);
    }

  for (i = 0; i < K; i++)
    {
      sum_alpha += alpha[i];
    }

  log_p += gsl_sf_lngamma (sum_alpha);

  for (i = 0; i < K; i++)
    {
      log_p -= gsl_sf_lngamma (alpha[i]);
    }

  return log_p;
}


#include <stdio.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_multifit.h>

double w[] = {	52.21, 53.12, 54.48, 55.84, 57.20,
		58.57, 59.93, 61.29, 63.11, 64.47,
		66.28, 68.10, 69.92, 72.19, 74.46 };
double h[] = {	1.47, 1.50, 1.52, 1.55, 1.57,
		1.60, 1.63, 1.65, 1.68, 1.70,
		1.73, 1.75, 1.78, 1.80, 1.83	};

int main()
{
	int n = sizeof(h)/sizeof(double);
	gsl_matrix *X = gsl_matrix_calloc(n, 3);
	gsl_vector *Y = gsl_vector_alloc(n);
	gsl_vector *beta = gsl_vector_alloc(3);

	for (int i = 0; i < n; i++) {
		gsl_vector_set(Y, i, w[i]);

		gsl_matrix_set(X, i, 0, 1);
		gsl_matrix_set(X, i, 1, h[i]);
		gsl_matrix_set(X, i, 2, h[i] * h[i]);
	}

	double chisq;
	gsl_matrix *cov = gsl_matrix_alloc(3, 3);
	gsl_multifit_linear_workspace * wspc = gsl_multifit_linear_alloc(n, 3);
	gsl_multifit_linear(X, Y, beta, cov, &chisq, wspc);

	printf("Beta:");
	for (int i = 0; i < 3; i++)
		printf("  %g", gsl_vector_get(beta, i));
	printf("\n");

	gsl_matrix_free(X);
	gsl_matrix_free(cov);
	gsl_vector_free(Y);
	gsl_vector_free(beta);
	gsl_multifit_linear_free(wspc);

}


#include <stdlib.h>
#include <stdio.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_expint.h>

#include "cosmocalc.h"
#include "haloprofs.h"

double fourierTransformNFW(double k, double m, double rvir, double c)
{
  double rs,rhos;
  double ukm;

  rs = rvir/c;
  rhos = m/4.0/M_PI/rs/rs/rs/(log(1.0+c) - c/(1.0+c));

  if(k > 0)
    ukm = 4.0*M_PI*rhos*rs*rs*rs/m
      *(sin(k*rs)*(gsl_sf_Si((1.0+c)*k*rs) - gsl_sf_Si(k*rs)) - sin(c*k*rs)/(1.0+c)/k/rs + cos(k*rs)*(gsl_sf_Ci((1.0+c)*k*rs) - gsl_sf_Ci(k*rs)));
  else
    ukm = 1.0;

  return ukm;
}

double NFWprof(double r, double m, double rvir, double c)
{
  double rs,rhos;

  rs = rvir/c;
  rhos = m/4.0/M_PI/rs/rs/rs/(log(1.0+c) - c/(1.0+c));

  return rhos/(r/rs)/(1+r/rs)/(1+r/rs);
}

double NFWprof_menc(double r, double m, double rvir, double c)
{
  double mc = log(1+c) - c/(1.0+c);
  double mr = c*r/rvir;
  mr = log(1.0 + mr) - mr/(1.0+mr);

  return mr/mc*m;
}

inline double _duffy2008_concNFW(double m, double a)
{
  return 6.71/pow(1.0/a,0.44)*pow(m/2e12,-0.091);
}

double concNFW(double m, double a)
{
  return _duffy2008_concNFW(m,a);
}

double duffy2008_concNFW(double m, double a)
{
  return _duffy2008_concNFW(m,a);
}

/*
double bh2012_concNFW(double m, double a)
{
  double nu = DELTAC/sigmaMtophat(m,a);

}

double prada2011_concNFW(double m, double a)
{

}
*/


/* roots/secant.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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

/* secant.c -- secant root finding algorithm

   The secant algorithm is a variant of the Newton algorithm with the
   derivative term replaced by a numerical estimate from the last two
   function evaluations.

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

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

   The exact derivative is used for the initial value of f'_est.

*/

#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;
    double df;
  }
secant_state_t;

static int secant_init (void * vstate, gsl_function_fdf * fdf, double * root);
static int secant_iterate (void * vstate, gsl_function_fdf * fdf, double * root);

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

  const double x = *root;

  GSL_FN_FDF_EVAL_F_DF (fdf, x, &(state->f), &(state->df));

  return GSL_SUCCESS;

}

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

  const double x = *root ;
  const double f = state->f;
  const double df = state->df;

  double x_new, f_new, df_new;

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

  x_new = x - (f / df);

  f_new = GSL_FN_FDF_EVAL_F(fdf, x_new) ;
  df_new = (f_new - f) / (x_new - x) ;

  *root = x_new ;

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

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

  if (!finite (df_new))
    {
      GSL_ERROR ("derivative value is not finite", GSL_EBADFUNC);
    }

  return GSL_SUCCESS;
}

static const gsl_root_fdfsolver_type secant_type =
{"secant",                              /* name */
 sizeof (secant_state_t),
 &secant_init,
 &secant_iterate};

const gsl_root_fdfsolver_type  * gsl_root_fdfsolver_secant = &secant_type;


#include "linearwaves.h"
#include <gsl/gsl_integration.h>
typedef struct GSL_params {
    double x;
    int m;
} GSL_params;

void init_params(void) {

    params.mp = 1e-5;
    params.softening = .6*.05;
    params.softening2 = params.softening*params.softening;
    params.a = 1;
    params.indirect = TRUE;
    return;

}

double potential(double phi, double x) {
    double res = -pow(x*x + params.a*params.a + params.softening2 - 2*params.a*x*cos(phi),-.5);
    if (params.indirect) {
        res += cos(phi)*params.a/(x*x);
    }
    return res;
}

double dr_potential(double phi, double x) {
    double res = ( x - params.a*cos(phi)) * pow(x*x + params.a*params.a + params.softening2 - 2*params.a*x*cos(phi),-1.5);

    if (params.indirect) {
        res -= 2* cos(phi)*params.a/(x*x*x);
    }
    return res;
}

double dp_potential(double phi, double x) {
    double res = params.a*x*sin(phi)* pow(x*x + params.a*params.a + params.softening2 - 2*params.a*x*cos(phi),-1.5);

    if (params.indirect) {
        res +=  sin(phi)*params.a/(x*x);
    }
    return res;
}

double pfunc(double phi, void *params) {
    GSL_params p = *(GSL_params *)params;
    double x  = p.x;
    int m = p.m;
    return cos(m*phi) * potential(phi,x);
}
double dpfunc(double phi, void *params) {
    GSL_params p = *(GSL_params *)params;
    double x  = p.x;
    int m = p.m;
    return cos(m*phi) * dr_potential(phi,x);
}

void force(double x, int m, double complex *res) {
    int nspace = 1000;
    int gsl_order = 5;
    gsl_integration_workspace *w = gsl_integration_workspace_alloc(nspace);

    gsl_function F1, F2;
    F1.function = &pfunc;
    F2.function = &dpfunc;
    GSL_params p;
    p.x = x;
    p.m = m;
    F1.params = &p;
    F2.params = &p;

    double tol = params.tol;
    double error;

    double res_r, dr_res_r;
    gsl_integration_qag(&F1,0,M_PI, tol, tol, nspace, gsl_order , w, &res_r, &error);
    gsl_integration_qag(&F2,0,M_PI, tol, tol, nspace, gsl_order , w, &dr_res_r, &error);
    res_r *= params.mp/M_PI;
    dr_res_r *= params.mp/M_PI;

    res[0] = dr_res_r;// *-1;
    res[1] = res_r ;//* -I * m/x;
    res[2] = 0;
    gsl_integration_workspace_free(w);
    return;
}


//
// Created by Harold on 2020/9/16.
//

#ifndef M_MATH_M_INTERP_H
#define M_MATH_M_INTERP_H

#include <gsl/gsl_interp.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_interp2d.h>
#include <gsl/gsl_spline2d.h>
#include <vector>
#include <algorithm>

namespace M_MATH {
    class Interpolation1D {
    public:
        enum InterpType {
            LINEAR,
            POLYNOMIAL,
            CSPLINE,
            CSPLINE_PERIODIC,
            AKIMA,
            AKIMA_PERIODIC,
            STEFFEN
        };

        static bool interpolate(double const* x,
                                double const* y,
                                size_t length,
                                InterpType type,
                                double const* n_x,
                                size_t n_length,
                                double* n_y);

        // this will create tmp var inside, better to use former one if possible
        template<typename IT_X, typename IT_Y, typename IT_NX, typename IT_NY>
        static bool interpolate(IT_X x_begin, IT_X x_end,
                                IT_Y y_begin, IT_Y y_end,
                                InterpType type,
                                IT_NX nx_begin, IT_NX nx_end,
                                IT_NY ny_begin);

    private:
        static const gsl_interp_type* InterpType2GSL(InterpType type);
    };

    class Interpolation2D {
    public:
        enum InterpType {
            BI_LINEAR,
            BI_CUBIC
        };

        static bool interpolate(double const* x,
                                double const* y,
                                double const* z,
                                size_t x_length,
                                size_t y_length,
                                InterpType type,
                                double const* n_x,
                                double const* n_y,
                                size_t n_x_length,
                                size_t n_y_length,
                                double* n_z);

        // this will create tmp var inside, better to use former one if possible
        template<typename IT_X, typename IT_Y, typename IT_Z, typename IT_NX, typename IT_NY, typename IT_NZ>
        static bool interpolate(IT_X x_begin, IT_X x_end,
                                IT_Y y_begin, IT_Y y_end,
                                IT_Z z_begin, IT_Z z_end,
                                InterpType type,
                                IT_NX nx_begin, IT_NX nx_end,
                                IT_NY ny_begin, IT_NY ny_end,
                                IT_NZ nz_begin);

    private:
        static const gsl_interp2d_type* InterpType2GSL(InterpType type);
    };

    const gsl_interp_type *Interpolation1D::InterpType2GSL(Interpolation1D::InterpType type) {
        switch (type) {
            case LINEAR:
                return gsl_interp_linear;
            case POLYNOMIAL:
                return gsl_interp_polynomial;
            case CSPLINE:
                return gsl_interp_cspline;
            case CSPLINE_PERIODIC:
                return gsl_interp_cspline_periodic;
            case AKIMA:
                return gsl_interp_akima;
            case AKIMA_PERIODIC:
                return gsl_interp_akima_periodic;
            case STEFFEN:
                return gsl_interp_steffen;
        }
        return nullptr;
    }

    bool Interpolation1D::interpolate(const double *x,
                                      const double *y,
                                      size_t length,
                                      Interpolation1D::InterpType type,
                                      const double *n_x,
                                      size_t n_length,
                                      double* n_y) {
        gsl_spline* spl = gsl_spline_alloc(InterpType2GSL(type), length);
        if (spl == nullptr)
            return false;
        gsl_interp_accel* acc = gsl_interp_accel_alloc();
        if (acc == nullptr) {
            return false;
        }
        gsl_spline_init(spl, x, y, length);
        for (auto i = 0; i < n_length; ++i)
            n_y[i] = gsl_spline_eval(spl, n_x[i], acc);
        gsl_spline_free(spl);
        gsl_interp_accel_free(acc);
        return true;
    }

    template<typename IT_X, typename IT_Y, typename IT_NX, typename IT_NY>
    bool Interpolation1D::interpolate(const IT_X x_begin, const IT_X x_end,
                                      const IT_Y y_begin, const IT_Y y_end,
                                      Interpolation1D::InterpType type,
                                      const IT_NX nx_begin, const IT_NX nx_end,
                                      IT_NY ny_begin) {
        auto len = std::min(std::distance(x_begin, x_end), std::distance(y_begin, y_end));
        auto n_len = std::distance(nx_begin, nx_end);
        std::vector<double> x_tmp(len), y_tmp(len);
        std::copy(x_begin, x_begin+len, x_tmp.begin());
        std::copy(y_begin, y_begin+len, y_tmp.begin());

        gsl_spline* spl = gsl_spline_alloc(InterpType2GSL(type), len);
        if (spl == nullptr)
            return false;
        gsl_interp_accel* acc = gsl_interp_accel_alloc();
        if (acc == nullptr) {
            return false;
        }
        gsl_spline_init(spl, x_tmp.data(), y_tmp.data(), len);
        for (auto i = 0; i < n_len; ++i)
            *(ny_begin+i) = gsl_spline_eval(spl, *(nx_begin+i), acc);
        gsl_spline_free(spl);
        gsl_interp_accel_free(acc);
        return true;
    }

    const gsl_interp2d_type *Interpolation2D::InterpType2GSL(Interpolation2D::InterpType type) {
        switch (type) {
            case BI_LINEAR:
                return gsl_interp2d_bilinear;
            case BI_CUBIC:
                return gsl_interp2d_bicubic;
        }
        return nullptr;
    }

    bool Interpolation2D::interpolate(const double *x,
                                      const double *y,
                                      const double *z,
                                      size_t x_length,
                                      size_t y_length,
                                      Interpolation2D::InterpType type,
                                      const double *n_x,
                                      const double *n_y,
                                      size_t n_x_length,
                                      size_t n_y_length,
                                      double *n_z) {
        gsl_spline2d* spl = gsl_spline2d_alloc(InterpType2GSL(type), x_length, y_length);
        if (spl == nullptr)
            return false;
        gsl_interp_accel *x_acc = gsl_interp_accel_alloc();
        if (x_acc == nullptr)
            return false;
        gsl_interp_accel *y_acc = gsl_interp_accel_alloc();
        if (y_acc == nullptr)
            return false;
        // zij = z[j * x_length + i]
        gsl_spline2d_init(spl, x, y, z, x_length, y_length);
        for (auto i = 0; i < n_x_length; ++i)
            for (auto j = 0; j < n_y_length; ++j)
                n_z[j * n_x_length + i] = gsl_spline2d_eval(spl, n_x[i], n_y[j], x_acc, y_acc);
        gsl_spline2d_free(spl);
        gsl_interp_accel_free(x_acc);
        gsl_interp_accel_free(y_acc);
        return true;
    }

    template<typename IT_X, typename IT_Y, typename IT_Z, typename IT_NX, typename IT_NY, typename IT_NZ>
    bool Interpolation2D::interpolate(const IT_X x_begin, const IT_X x_end,
                                      const IT_Y y_begin, const IT_Y y_end,
                                      const IT_Z z_begin, const IT_Z z_end,
                                      Interpolation2D::InterpType type,
                                      const IT_NX nx_begin, const IT_NX nx_end,
                                      const IT_NY ny_begin, const IT_NY ny_end,
                                      const IT_NZ nz_begin) {
        auto x_length = std::distance(x_begin, x_end);
        auto y_length = std::distance(y_begin, y_end);
        auto z_length = std::distance(z_begin, z_end);
        auto n_x_length = std::distance(nx_begin, nx_end);
        auto n_y_length = std::distance(ny_begin, ny_end);
        std::vector<double> x_tmp(x_length), y_tmp(y_length), z_tmp(z_length);
        std::copy(x_begin, x_end, x_tmp.begin());
        std::copy(y_begin, y_end, y_tmp.begin());
        std::copy(z_begin, z_end, z_tmp.begin());

        gsl_spline2d* spl = gsl_spline2d_alloc(InterpType2GSL(type), x_length, y_length);
        if (spl == nullptr)
            return false;
        gsl_interp_accel *x_acc = gsl_interp_accel_alloc();
        if (x_acc == nullptr)
            return false;
        gsl_interp_accel *y_acc = gsl_interp_accel_alloc();
        if (y_acc == nullptr)
            return false;
        // zij = z[j * x_length + i]
        gsl_spline2d_init(spl, x_tmp.data(), y_tmp.data(), z_tmp.data(), x_length, y_length);
        for (auto i = 0; i < n_x_length; ++i)
            for (auto j = 0; j < n_y_length; ++j)
                *(nz_begin + j * n_x_length + i) = gsl_spline2d_eval(spl, *(nx_begin + i), *(ny_begin + j), x_acc, y_acc);
        gsl_spline2d_free(spl);
        gsl_interp_accel_free(x_acc);
        gsl_interp_accel_free(y_acc);
        return true;
    }
}

#endif //M_MATH_M_INTERP_H


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

#include "../ellipsoid/ellipsoid.h"

#undef __FUNCT__
#define __FUNCT__ "TestNormalizationMPFR"
PetscErrorCode TestNormalizationMPFR()
{
  PetscErrorCode ierr;
  EllipsoidalSystem e;
  const PetscInt prec = 128;
  PetscReal xA = 3.0;
  PetscReal yB = 2.0;
  PetscReal zC = 1.0;
  mpfr_t a, b, c;
  mpfr_t a2, b2, c2;
  mpfr_t a3, b3, c3;
  mpfr_t temp1, temp2, temp3;
  mpfr_t pi;

  PetscFunctionBegin;
  mpfr_set_default_prec(4*prec);

  mpfr_inits(a, b, c, NULL);
  mpfr_inits(a2, b2, c2, NULL);
  mpfr_inits(a3, b3, c3, NULL);
  mpfr_inits(temp1, temp2, temp3, pi, NULL);

  mpfr_set_d(a, xA, MPFR_RNDN);
  mpfr_set_d(b, yB, MPFR_RNDN);
  mpfr_set_d(c, zC, MPFR_RNDN);

  //init ellipsoidal system
  printf("initEllipsoidalSystem...\n");
  ierr = initEllipsoidalSystem(&e, xA, yB, zC, prec);CHKERRQ(ierr);
  printf("done.\n");

  mpfr_mul(a2, a, a, MPFR_RNDN);
  mpfr_mul(a3, a2, a, MPFR_RNDN);
  mpfr_mul(b2, b, b, MPFR_RNDN);
  mpfr_mul(b3, b2, b, MPFR_RNDN);
  mpfr_mul(c2, c, c, MPFR_RNDN);
  mpfr_mul(c3, c2, c, MPFR_RNDN);

  mpfr_t firstTerm, secondTerm, LambdaD, LambdaDprime;
  mpfr_inits(firstTerm, secondTerm, LambdaD, LambdaDprime, NULL);

  //Dassios (B14)
  //firstTerm = (a*a + b*b + c*c)/3.0;
  mpfr_add(firstTerm, a2, b2, MPFR_RNDN);
  mpfr_add(firstTerm, firstTerm, c2, MPFR_RNDN);
  mpfr_div_d(firstTerm, firstTerm, 3.0, MPFR_RNDN);

  //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;
  mpfr_mul(temp1, a3, a, MPFR_RNDN);
  mpfr_mul(temp2, b2, c2, MPFR_RNDN);
  mpfr_sub(temp1, temp1, temp2, MPFR_RNDN);
  mpfr_mul(temp2, b3, b, MPFR_RNDN);
  mpfr_mul(temp3, a2, c2, MPFR_RNDN);
  mpfr_sub(temp2, temp2, temp3, MPFR_RNDN);
  mpfr_add(temp1, temp1, temp2, MPFR_RNDN);
  mpfr_mul(temp2, c3, c, MPFR_RNDN);
  mpfr_mul(temp3, a2, b2, MPFR_RNDN);
  mpfr_sub(temp2, temp2, temp3, MPFR_RNDN);
  mpfr_add(temp1, temp1, temp2, MPFR_RNDN);
  mpfr_sqrt(secondTerm, temp1, MPFR_RNDN);

  //double LambdaD = firstTerm + secondTerm;
  mpfr_add(LambdaD, firstTerm, secondTerm, MPFR_RNDN);

  //double LambdaDprime = firstTerm - secondTerm;
  mpfr_sub(LambdaDprime, firstTerm, secondTerm, MPFR_RNDN);

  mpfr_t hx, hy, hz;
  mpfr_inits(hx, hy, hz, NULL);

  //Dassios (B16)-(B20)
  //double hx = sqrt(b*b - c*c);
  mpfr_sub(temp1, b2, c2, MPFR_RNDN);
  mpfr_sqrt(hx, temp1, MPFR_RNDN);

  //double hy = e.k;
  mpfr_set(hy, e.hp_k, MPFR_RNDN);
  //double hz = e.h;
  mpfr_set(hz, e.hp_h, MPFR_RNDN);

  //set pi
  mpfr_const_pi(pi, MPFR_RNDN);

  mpfr_t analytic[9];
  mpfr_t approx[9], doubleApprox[9];
  for(PetscInt k=0; k < 9; ++k)
    mpfr_inits(analytic[k], approx[k], doubleApprox[k], NULL);

  //analytic[0] = 4*PETSC_PI
  mpfr_mul_d(analytic[0], pi, 4.0, MPFR_RNDN);
  printf("analytic[0] = %4.4e\n", mpfr_get_d(analytic[0], MPFR_RNDN));

  //analytic[1] = 4*PETSC_PI/3 * hy*hy*hz*hz
  mpfr_div_d(temp1, pi, 3.0, MPFR_RNDN);
  mpfr_mul_d(temp1, temp1, 4.0, MPFR_RNDN);
  mpfr_mul(temp2, hy, hy, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hz, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hz, MPFR_RNDN);
  mpfr_mul(analytic[1], temp1, temp2, MPFR_RNDN);

  //analytic[2] = 4*PETSC_PI/3 * hx*hx*hz*hz
  mpfr_div_d(temp1, pi, 3.0, MPFR_RNDN);
  mpfr_mul_d(temp1, temp1, 4.0, MPFR_RNDN);
  mpfr_mul(temp2, hx, hx, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hz, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hz, MPFR_RNDN);
  mpfr_mul(analytic[2], temp1, temp2, MPFR_RNDN);

  //analytic[3] = 4*PETSC_PI/3 * hx*hx*hy*hy
  mpfr_div_d(temp1, pi, 3.0, MPFR_RNDN);
  mpfr_mul_d(temp1, temp1, 4.0, MPFR_RNDN);
  mpfr_mul(temp2, hx, hx, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hy, MPFR_RNDN);
  mpfr_mul(temp2, temp2, hy, MPFR_RNDN);
  mpfr_mul(analytic[3], temp1, temp2, MPFR_RNDN);

  //analytic[4] = -8*PETSC_PI/5 * (LambdaD - LambdaDprime)*(LambdaD - a*a)*(LambdaD - b*b)*(LambdaD - c*c)

  //analytic[5] = 8*PETSC_PI/5 * (LambdaD - LambdaDprime)*(LambdaDprime - a*a)*(LambdaDprime - b*b)*(LambdaDprime - c*c),

  ierr = calcNormalizationMPFR(&e, 0, 0, approx+0);CHKERRQ(ierr);
  ierr = calcNormalization    (&e, 0, 0, doubleApprox+0);CHKERRQ(ierr);
  ierr = calcNormalizationMPFR(&e, 1, 0, approx+1);CHKERRQ(ierr);
  ierr = calcNormalizationMPFR(&e, 1, 1, approx+2);CHKERRQ(ierr);
  mpfr_t err[9];
  for(PetscInt k=0; k < 4; ++k) {
    mpfr_init(err[k]);
    mpfr_sub(err[k], approx[k], analytic[k], MPFR_RNDN);
    mpfr_div(err[k], err[k], analytic[k], MPFR_RNDN);
    mpfr_abs(err[k], err[k], MPFR_RNDN);
    mpfr_log10(err[k], err[k], MPFR_RNDN);
    printf("the error is %2.2f\n", mpfr_get_d(err[k], MPFR_RNDN));
  }

  for(PetscInt k=0; k < 9; ++k)
    mpfr_clears(analytic[k], approx[k], err[k], doubleApprox[k], NULL);
  mpfr_clears(hx, hy, hz, NULL);
  mpfr_clears(temp1, temp2, temp3, pi, NULL);
  mpfr_clears(a3, b3, c3, NULL);
  mpfr_clears(a2, b2, c2, NULL);
  mpfr_clears(a, b, c, NULL);
  PetscFunctionReturn(0);
}

#undef __FUNCT__
#define __FUNCT __ "main"
PetscErrorCode main(int argc, char **argv)
{
  PetscErrorCode ierr;

  PetscFunctionBeginUser;

  ierr = PetscInitialize(&argc, &argv, NULL, NULL);CHKERRQ(ierr);

  ierr = TestNormalizationMPFR();

  ierr = PetscFinalize();

}


#ifndef NEURAL_MATRIX_H_
#define NEURAL_MATRIX_H_

#include <vector>
#include <functional>
#include <iostream>
#include <iomanip>
#include <cmath>
#include <cassert>

#include <gsl/gsl_blas.h>

namespace neural {
    class Matrix {
        double *_data;
        int _rows;
        int _cols;

    public:
        Matrix(int rows, int cols);
        Matrix(int rows, int cols, double val);
        Matrix(int rows, int cols, double data[]);
        Matrix(int rows, int cols, std::vector<double> data);
        Matrix(std::vector<std::vector<double>> data);

        /**
         * Copy and move semantics
         */
        Matrix(const Matrix &rhs);
        Matrix(Matrix &&rhs);
        Matrix &operator=(const Matrix &rhs);
        Matrix &operator=(Matrix &&rhs);

        ~Matrix();

        /**
         * Addition operator
         */
        const Matrix operator+(const Matrix &rhs) const;

        /**
         * Subtraction operator
         */
        const Matrix operator-(const Matrix &rhs) const;

        /**
         * Matrix multiplication
         */
        const Matrix operator*(const Matrix &rhs) const;

        /**
         * Scale operator
         */
        const Matrix operator*(const double factor) const;

        /**
         * Division operator
         */
        const Matrix operator/(const double factor) const;

        /**
         * Hadamard operator
         */
        const Matrix operator^(const Matrix &rhs) const;

        /**
         * In-place addition operator
         */
        void operator+=(const Matrix &rhs);

        /**
         * In-place subtraction operator
         */
        void operator-=(const Matrix &rhs);

        /**
         * In-place matrix multiplication
         */
        void operator*=(const Matrix &rhs);

        /**
         * In-place scale operator
         */
        void operator*=(const double factor);

        /**
         * In-place division operator
         */
        void operator/=(const double factor);

        /**
         * In-place hadamard operator
         */
        void operator^=(const Matrix &rhs);

        /**
         * Call a function on each item of the matrix
         */
        void map(std::function<double(double&)> function);

        /**
         * Get the transpose of the matrix
         */
        Matrix transpose() const;

        /**
         * Calculate the Euclidean norm of the matrix
         */
        double norm();

        /**
         * Make all values zero
         */
        void zero();

        /**
         * Fetch a value from the matrix
         */
        inline double get_at(const int row, const int col) const {
            return _data[row * _cols + col];
        }

        /**
         * Set a value in the matrix
         */
        inline void set_at(const int row, const int col, const double value) {
            _data[row * _cols + col] = value;
        }

        /**
         * Get the number of rows in the matrix;
         */
        inline int get_rows() const {
            return _rows;
        }

        /**
         * Get the number of columns in the matrix
         */
        inline int get_cols() const {
            return _cols;
        }

        /**
         * Get the pointer to the matrix data
         */
        inline double *data() const {
            return _data;
        }

        /**
         * Pretty print the matrix for debugging
         */
        void print() const;
    };
}

#endif


static char help[] = "A structured-grid Poisson solver using DMDA+KSP.\n\n";

#include <petsc.h>

extern PetscErrorCode formMatrix(DM, Mat);
extern PetscErrorCode formExact(DM, Vec);
extern PetscErrorCode formRHS(DM, Vec);

//STARTMAIN
int main(int argc,char **args) {
    PetscErrorCode ierr;
    DM            da;
    Mat           A;
    Vec           b,u,uexact;
    KSP           ksp;
    PetscReal     errnorm;
    DMDALocalInfo info;

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

    // change default 9x9 size using -da_grid_x M -da_grid_y N
    ierr = DMDACreate2d(PETSC_COMM_WORLD,
                 DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DMDA_STENCIL_STAR,
                 9,9,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da); CHKERRQ(ierr);

    // create linear system matrix A
    ierr = DMSetFromOptions(da); CHKERRQ(ierr);
    ierr = DMSetUp(da); CHKERRQ(ierr);
    ierr = DMCreateMatrix(da,&A); CHKERRQ(ierr);
    ierr = MatSetFromOptions(A); CHKERRQ(ierr);

    // create RHS b, approx solution u, exact solution uexact
    ierr = DMCreateGlobalVector(da,&b); CHKERRQ(ierr);
    ierr = VecDuplicate(b,&u); CHKERRQ(ierr);
    ierr = VecDuplicate(b,&uexact); CHKERRQ(ierr);

    // fill vectors and assemble linear system
    ierr = formExact(da,uexact); CHKERRQ(ierr);
    ierr = formRHS(da,b); CHKERRQ(ierr);
    ierr = formMatrix(da,A); CHKERRQ(ierr);

    // create and solve the linear system
    ierr = KSPCreate(PETSC_COMM_WORLD,&ksp); CHKERRQ(ierr);
    ierr = KSPSetOperators(ksp,A,A); CHKERRQ(ierr);
    ierr = KSPSetFromOptions(ksp); CHKERRQ(ierr);
    ierr = KSPSolve(ksp,b,u); CHKERRQ(ierr);

    // report on grid and numerical error
    ierr = VecAXPY(u,-1.0,uexact); CHKERRQ(ierr);    // u <- u + (-1.0) uxact
    ierr = VecNorm(u,NORM_INFINITY,&errnorm); CHKERRQ(ierr);
    ierr = DMDAGetLocalInfo(da,&info);CHKERRQ(ierr);
    ierr = PetscPrintf(PETSC_COMM_WORLD,
                "on %d x %d grid:  error |u-uexact|_inf = %g\n",
                info.mx,info.my,errnorm); CHKERRQ(ierr);

    VecDestroy(&u);  VecDestroy(&uexact);  VecDestroy(&b);
    MatDestroy(&A);  KSPDestroy(&ksp);  DMDestroy(&da);
    return PetscFinalize();
}
//ENDMAIN

//STARTMATRIX
PetscErrorCode formMatrix(DM da, Mat A) {
    PetscErrorCode ierr;
    DMDALocalInfo  info;
    MatStencil     row, col[5];
    PetscReal      hx, hy, v[5];
    PetscInt       i, j, ncols;

    ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
    hx = 1.0/(info.mx-1);  hy = 1.0/(info.my-1);
    for (j = info.ys; j < info.ys+info.ym; j++) {
        for (i = info.xs; i < info.xs+info.xm; i++) {
            row.j = j;           // row of A corresponding to (x_i,y_j)
            row.i = i;
            col[0].j = j;        // diagonal entry
            col[0].i = i;
            ncols = 1;
            if (i==0 || i==info.mx-1 || j==0 || j==info.my-1) {
                v[0] = 1.0;      // on boundary: trivial equation
            } else {
                v[0] = 2*(hy/hx + hx/hy); // interior: build a row
                if (i-1 > 0) {
                    col[ncols].j = j;    col[ncols].i = i-1;
                    v[ncols++] = -hy/hx;
                }
                if (i+1 < info.mx-1) {
                    col[ncols].j = j;    col[ncols].i = i+1;
                    v[ncols++] = -hy/hx;
                }
                if (j-1 > 0) {
                    col[ncols].j = j-1;  col[ncols].i = i;
                    v[ncols++] = -hx/hy;
                }
                if (j+1 < info.my-1) {
                    col[ncols].j = j+1;  col[ncols].i = i;
                    v[ncols++] = -hx/hy;
                }
            }
            ierr = MatSetValuesStencil(A,1,&row,ncols,col,v,INSERT_VALUES); CHKERRQ(ierr);
        }
    }
    ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr);
    return 0;
}
//ENDMATRIX

//STARTEXACT
PetscErrorCode formExact(DM da, Vec uexact) {
    PetscErrorCode ierr;
    PetscInt       i, j;
    PetscReal      hx, hy, x, y, **auexact;
    DMDALocalInfo  info;

    ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
    hx = 1.0/(info.mx-1);  hy = 1.0/(info.my-1);
    ierr = DMDAVecGetArray(da, uexact, &auexact);CHKERRQ(ierr);
    for (j = info.ys; j < info.ys+info.ym; j++) {
        y = j * hy;
        for (i = info.xs; i < info.xs+info.xm; i++) {
            x = i * hx;
            auexact[j][i] = x*x * (1.0 - x*x) * y*y * (y*y - 1.0);
        }
    }
    ierr = DMDAVecRestoreArray(da, uexact, &auexact);CHKERRQ(ierr);
    return 0;
}

PetscErrorCode formRHS(DM da, Vec b) {
    PetscErrorCode ierr;
    PetscInt       i, j;
    PetscReal      hx, hy, x, y, f, **ab;
    DMDALocalInfo  info;

    ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
    hx = 1.0/(info.mx-1);  hy = 1.0/(info.my-1);
    ierr = DMDAVecGetArray(da, b, &ab);CHKERRQ(ierr);
    for (j=info.ys; j<info.ys+info.ym; j++) {
        y = j * hy;
        for (i=info.xs; i<info.xs+info.xm; i++) {
            x = i * hx;
            if (i==0 || i==info.mx-1 || j==0 || j==info.my-1) {
                ab[j][i] = 0.0;  // on boundary: 1*u = 0
            } else {
                f = 2.0 * ( (1.0 - 6.0*x*x) * y*y * (1.0 - y*y)
                    + (1.0 - 6.0*y*y) * x*x * (1.0 - x*x) );
                ab[j][i] = hx * hy * f;
            }
        }
    }
    ierr = DMDAVecRestoreArray(da, b, &ab); CHKERRQ(ierr);
    return 0;
}
//ENDEXACT


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

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_deriv.h>

static void
central_deriv (const gsl_function * f, double x, double h,
               double *result, double *abserr_round, double *abserr_trunc)
{
  /* Compute the derivative using the 5-point rule (x-h, x-h/2, x,
     x+h/2, x+h). Note that the central point is not used.

     Compute the error using the difference between the 5-point and
     the 3-point rule (x-h,x,x+h). Again the central point is not
     used. */

  double fm1 = GSL_FN_EVAL (f, x - h);
  double fp1 = GSL_FN_EVAL (f, x + h);

  double fmh = GSL_FN_EVAL (f, x - h / 2);
  double fph = GSL_FN_EVAL (f, x + h / 2);

  double r3 = 0.5 * (fp1 - fm1);
  double r5 = (4.0 / 3.0) * (fph - fmh) - (1.0 / 3.0) * r3;

  double e3 = (fabs (fp1) + fabs (fm1)) * GSL_DBL_EPSILON;
  double e5 = 2.0 * (fabs (fph) + fabs (fmh)) * GSL_DBL_EPSILON + e3;

  /* The next term is due to finite precision in x+h = O (eps * x) */

  double dy = GSL_MAX (fabs (r3 / h), fabs (r5 / h)) *(fabs (x) / h) * GSL_DBL_EPSILON;

  /* The truncation error in the r5 approximation itself is O(h^4).
     However, for safety, we estimate the error from r5-r3, which is
     O(h^2).  By scaling h we will minimise this estimated error, not
     the actual truncation error in r5. */

  *result = r5 / h;
  *abserr_trunc = fabs ((r5 - r3) / h); /* Estimated truncation error O(h^2) */
  *abserr_round = fabs (e5 / h) + dy;   /* Rounding error (cancellations) */
}

int
gsl_deriv_central (const gsl_function * f, double x, double h,
                   double *result, double *abserr)
{
  double r_0, round, trunc, error;
  central_deriv (f, x, h, &r_0, &round, &trunc);
  error = round + trunc;

  if (round < trunc && (round > 0 && trunc > 0))
    {
      double r_opt, round_opt, trunc_opt, error_opt;

      /* Compute an optimised stepsize to minimize the total error,
         using the scaling of the truncation error (O(h^2)) and
         rounding error (O(1/h)). */

      double h_opt = h * pow (round / (2.0 * trunc), 1.0 / 3.0);
      central_deriv (f, x, h_opt, &r_opt, &round_opt, &trunc_opt);
      error_opt = round_opt + trunc_opt;

      /* Check that the new error is smaller, and that the new derivative
         is consistent with the error bounds of the original estimate. */

      if (error_opt < error && fabs (r_opt - r_0) < 4.0 * error)
        {
          r_0 = r_opt;
          error = error_opt;
        }
    }

  *result = r_0;
  *abserr = error;

  return GSL_SUCCESS;
}

static void
forward_deriv (const gsl_function * f, double x, double h,
               double *result, double *abserr_round, double *abserr_trunc)
{
  /* Compute the derivative using the 4-point rule (x+h/4, x+h/2,
     x+3h/4, x+h).

     Compute the error using the difference between the 4-point and
     the 2-point rule (x+h/2,x+h).  */

  double f1 = GSL_FN_EVAL (f, x + h / 4.0);
  double f2 = GSL_FN_EVAL (f, x + h / 2.0);
  double f3 = GSL_FN_EVAL (f, x + (3.0 / 4.0) * h);
  double f4 = GSL_FN_EVAL (f, x + h);

  double r2 = 2.0*(f4 - f2);
  double r4 = (22.0 / 3.0) * (f4 - f3) - (62.0 / 3.0) * (f3 - f2) +
    (52.0 / 3.0) * (f2 - f1);

  /* Estimate the rounding error for r4 */

  double e4 = 2 * 20.67 * (fabs (f4) + fabs (f3) + fabs (f2) + fabs (f1)) * GSL_DBL_EPSILON;

  /* The next term is due to finite precision in x+h = O (eps * x) */

  double dy = GSL_MAX (fabs (r2 / h), fabs (r4 / h)) * fabs (x / h) * GSL_DBL_EPSILON;

  /* The truncation error in the r4 approximation itself is O(h^3).
     However, for safety, we estimate the error from r4-r2, which is
     O(h).  By scaling h we will minimise this estimated error, not
     the actual truncation error in r4. */

  *result = r4 / h;
  *abserr_trunc = fabs ((r4 - r2) / h); /* Estimated truncation error O(h) */
  *abserr_round = fabs (e4 / h) + dy;
}

int
gsl_deriv_forward (const gsl_function * f, double x, double h,
                   double *result, double *abserr)
{
  double r_0, round, trunc, error;
  forward_deriv (f, x, h, &r_0, &round, &trunc);
  error = round + trunc;

  if (round < trunc && (round > 0 && trunc > 0))
    {
      double r_opt, round_opt, trunc_opt, error_opt;

      /* Compute an optimised stepsize to minimize the total error,
         using the scaling of the estimated truncation error (O(h)) and
         rounding error (O(1/h)). */

      double h_opt = h * pow (round / (trunc), 1.0 / 2.0);
      forward_deriv (f, x, h_opt, &r_opt, &round_opt, &trunc_opt);
      error_opt = round_opt + trunc_opt;

      /* Check that the new error is smaller, and that the new derivative
         is consistent with the error bounds of the original estimate. */

      if (error_opt < error && fabs (r_opt - r_0) < 4.0 * error)
        {
          r_0 = r_opt;
          error = error_opt;
        }
    }

  *result = r_0;
  *abserr = error;

  return GSL_SUCCESS;
}

int
gsl_deriv_backward (const gsl_function * f, double x, double h,
                    double *result, double *abserr)
{
  return gsl_deriv_forward (f, x, -h, result, abserr);
}


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

int
main (void)
{
  double c  = GSL_CONST_MKSA_SPEED_OF_LIGHT;
  double au = GSL_CONST_MKSA_ASTRONOMICAL_UNIT;
  double minutes = GSL_CONST_MKSA_MINUTE;

  /* distance stored in meters */
  double r_earth = 1.00 * au;
  double r_mars  = 1.52 * au;

  double t_min, t_max;

  t_min = (r_mars - r_earth) / c;
  t_max = (r_mars + r_earth) / c;

  printf ("light travel time from Earth to Mars:\n");
  printf ("minimum = %.1f minutes\n", t_min / minutes);
  printf ("maximum = %.1f minutes\n", t_max / minutes);

  return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <gsl/gsl_sf_expint.h>
#include "SE_trans.h"

#define ALPHA 0.99
#define DOMD 3.14

double f(double t)
{
  return 0.25 * ((1+t) * log1p(t) + (1-t) * log1p(-t) - 2 * M_LN2) / M_LN2;
}

double G(double x)
{
  return 0.25 * x * SE_trans_div(-1, 1, x) / M_LN2;
}

double J(int j, double h, double x)
{
  return h * (0.5 + M_1_PI * gsl_sf_Si(M_PI * (x / h - j)));
}

double Fapp(double t, int m)
{
  double h = sqrt(M_PI*DOMD / (ALPHA*m));

  int j;
  double sum1 = 0;
  double sum2 = 0;

  for (j = -m; j <  0; j++) {
    sum1 += G(j*h) * J(j, h, SE_trans_inv(-1, 1, t));
  }
  for (j =  m; j >= 0; j--) {
    sum2 += G(j*h) * J(j, h, SE_trans_inv(-1, 1, t));
  }

  return (sum1 + sum2);
}

int main()
{
  int i;
  int n;
  double t;
  double err, maxerr;
  clock_t start, end;
  double time;

  int STEP = 1000;

  for (n = 3; n <= 150; n += 6) {
    start = clock();

    maxerr = 0;
    for (i = - STEP + 1; i <= STEP - 1; i++) {
      t = (double)i / (double)(STEP);

      err = fabs(f(t) - Fapp(t, n));
      maxerr = fmax(err, maxerr);
    }
    end = clock();

    time = (double)(end - start) / CLOCKS_PER_SEC;
    printf("%d\t%e\t%e\n", n, err, time);
  }

  return EXIT_SUCCESS;
}


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

#include "../ellipsoid/ellipsoid.h"
#include "../ellipsoid/ellSolv.h"
#include "../constants.h"
#include "testFunctions.h"

#undef __FUNCT__
#define __FUNCT__ "main"
PetscErrorCode main(int argc, char **argv)
{

  PetscErrorCode ierr;
  EllipsoidalSystem e;
  PetscInt prec = 64;
  PetscReal a = 3.0;
  PetscReal b = 2.0;
  PetscReal c = 1.0;
  double doubleEnp;
  mpfr_t x;
  mpfr_t mpfrEnp;
  PetscFunctionBeginUser;

  ierr = PetscInitialize(&argc, &argv, NULL, NULL);CHKERRQ(ierr);
  ierr = PetscLogDefaultBegin();CHKERRQ(ierr);

  mpfr_inits(mpfrEnp, x, NULL);

  ierr = initEllipsoidalSystem(&e, a, b, c, prec);CHKERRQ(ierr);

  mpfr_set_d(x, 1.0, MPFR_RNDN);
  //calculate with double
  ierr = calcLame(&e, 3, 4, 1.0, 1, 1, &doubleEnp);
  //calculate with high precision
  ierr = CalcLameMPFR(&e, 3, 4, x, 1, 1, &mpfrEnp);

  printf("Enp(double): %18.18f\n", doubleEnp);
  printf("Enp(mpfr):   %18.18f\n", mpfr_get_d(mpfrEnp, MPFR_RNDN));

  mpfr_clears(mpfrEnp, x, NULL);
  ierr = PetscFinalize();CHKERRQ(ierr);
  PetscFunctionReturn(0);
}


/*
    This section is aimed to calculate the gaussian integrals that occurs in everywhere

    This part is greatly inspired by May, Andrew James. Density fitting in explicitly correlated electronic structure theory. Diss. University of Bristol, 2006.
 */

/*

Here is the table of the relation between the names and the definition:

S   <a|b>
J   (a|b) = <a|1/r_{12}|b>
G   (a|e^{-\gamma r_{12}^2}|b)
F   (a|f_{12}|b) = (a|c_i exp(-\gamma_i r_{12}^2)|b)
GJ  (a|e^{-\gamma r_{12}^2 r_12^{-1}}|b)
FJ  (a|f_{12} r_{12}^{-1}|b)
FF  (a|f_{12}^2|b)
FT  (ab|[\hat{t}_1, f_{12}]|c) = (ab|[- \frac{1}{2} \nabla ^2, f_{12}]|c)
FTF (a|\frac{1}{2}[f_12,[\hat{t}_1 + \hat{t}_2, f_{12}]]|b)
F-F (a|f_{12}|b|f_{23}|c)
J-F (a|r_{12}^{-1}|b|f_{23}|c)
X   (ab|[\hat{t}_1,r_{12}]|c)
Y   (ab|[\hat{t}_1,r_{12}^{-1}])
Z   (a|\frac{1}{r_{1Z}}|b)

Currently only S integrals and J integrals are supported.

 */

#ifndef __BASIS_H__
#define __BASIS_H__
#include "basis.h"
#endif

#include <math.h>

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf.h>

typedef struct gaussian_chain{
    double R[3];
    int a[3];

    double exponent;

    double coefficient;

    gaussian_chain * NEXT;

}gaussian_chain;

gaussian_chain * gaussian_chain_calloc();

void gaussian_chain_free(gaussian_chain * HEAD);

double gaussian_chain_get(gaussian_chain * HEAD,double x, double y, double z);
double orbital_get(orbital * orbital,double x, double y, double z);

double Gamma(double z);
double Boys(double x, int n);
double Binomials(int n, int k);

double f(int k, int a, int b, double PA, double PB);
double tranformation_coefficient(int a[3], int b[3], int p[3], double PA[3], double PB[3], double xi, double AB);

double SIntegral(double ra[3], double rb[3], int ax, int ay, int az, int bx, int by, int bz, double alpha,double beta);
double JIntegral(double ra[3], double rb[3], int ax, int ay, int az, int bx, int by, int bz, double alpha,double beta, int m);
double ZIntegral(double ra[3], double rb[3], double rz[3], int ax, int ay, int az, int bx, int by, int bz, double alpha, double beta, int m);

double gaussian_chain_SIntegral(gaussian_chain * a, gaussian_chain * b);
double gaussian_chain_JIntegral(gaussian_chain * a, gaussian_chain * b);
double gaussian_chain_ZIntegral(gaussian_chain * a, gaussian_chain * b, double rz[3]);
double gaussian_chain_full_SIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);
double gaussian_chain_full_JIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);
double gaussian_chain_full_ZIntegral(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD, double rz[3]);

void gaussian_chain_derivative(gaussian_chain * dest, gaussian_chain * src, int key);
void gaussian_chain_second_derivative(gaussian_chain * dest, gaussian_chain * src, int key);
void gaussian_chain_laplacian(gaussian_chain * dest, gaussian_chain * src);

double gaussian_chain_kinetic_energy(gaussian_chain * a_HEAD, gaussian_chain * b_HEAD);

void single_electron_transform(gaussian_chain * HEAD, orbital * a);
void two_electron_transform(gaussian_chain * HEAD, orbital * a, orbital * b);

double orbital_SIntegral(orbital * a,orbital * b);
double orbital_JIntegral(orbital * a,orbital * b);
double orbital_ZIntegral(orbital * a,orbital * b, double rz[3]);
//double orbital_GIntegral(orbital *,orbital *);
//double orbital_FIntegral(orbital *,orbital *);
//double orbital_GJIntegral(orbital *,orbital *);
//double orbital_FJIntegral(orbital *,orbital *);
//double orbital_FFIntegral(orbital *,orbital *);

double two_electron_JIntegral(orbital * a_1, orbital * b_1, orbital * c_2, orbital * d_2);

double orbital_kinetic_energy(orbital * a, orbital * b);

void orbital_S_matrix(gsl_matrix * dest, orbital * HEAD);


/*
 * Calculation of Integral
 */
#include <stdio.h>

#include <gsl/gsl_rng.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_monte_vegas.h>

#include "timer.h"

double g (double *t, size_t dim, void *params);

int main (void)
{
    double res, err;
    double dist, dmin = 1.001, dmax = 4.;
    size_t dim = 6;
    int np = 20;
    double vegas[20], vegaserr[20];
    double time1, time2;

    double dstep = (dmax - dmin) / (np - 1);

    double xl[] = { 0., 0., 0., 0., 0., 0. };
    double xu[] = { 1., 1., 1., 1., 1., 1. };

    gsl_rng *r = gsl_rng_alloc (gsl_rng_taus2);
    unsigned long seed = 1UL;

    gsl_rng_set (r, seed);

    size_t calls = 1000000;

    gsl_monte_function G = { &g, dim, &dist };

    gsl_monte_vegas_state *sv = gsl_monte_vegas_alloc (dim);

    gsl_monte_vegas_init (sv);

    dist = dmin;

// Vegas algorithm calculation

    timer_start ();

    // printf ("# Dist      Energy     ErrEst    Dipole\n");
    for (int i = 0; i < np; i++)
    {
        gsl_monte_vegas_integrate (&G, xl, xu, dim, calls / 5, r, sv, &res,
            &err);

        do
        {
            gsl_monte_vegas_integrate (&G, xl, xu, dim, calls, r, sv, &res,
                &err);
        }

        while (fabs (gsl_monte_vegas_chisq (sv) - 1.0) > 0.2);

        //printf ("% .6f  % .6f % .6f  % .6f\n", dist, res, err,
        //    -2. / pow (dist, 3.));

        //fflush (stdout);
        vegas[i] = res;
        vegaserr[i] = err;

        dist += dstep;
    }

    time1 = timer_stop ();

    gsl_monte_vegas_free (sv);

    dist = dmin;
    printf ("# Dist      HMC        Vegas      Verr       Dipole    Difference\n");

    double t[6];

// Calculation using homemade Monte Carlo algorithm

    timer_start ();

    for (int i = 0; i < np; i++)
    {
        double sum = 0.;

        for (int j = 0; j < (int) calls; j++)
        {
            for (int m = 0; m < (int) dim; m++)
            {
                t[m] = gsl_rng_uniform (r);
            }
            sum += g (t, dim, &dist);
        }
        double energy = sum / calls;
        double difference = fabs (energy - vegas[i]);

        printf ("% .6f  % .6f % .6f  % .6f  % .6f  % .6f\n",
            dist, energy, vegas[i], vegaserr[i], -2./pow(dist, 3.), difference );
        dist += dstep;

     }

   time2 = timer_stop ();
    printf ("Time Vegas: %.2f Time HMC: %.2f\n", time1, time2);
    printf ("Speedup: %.2f\n", time1 / time2);

    gsl_rng_free (r);

    return 0;
}


#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_blas.h>

#ifndef gauge_config
#include "config.h"
#define gauge_config 1

#define sq(x) ((x)*(x))
#define cb(x) ((x)*(x)*(x))
#endif

// SU(2) Matrix
// only the first row carries useful information (Lang p.80)
// note that for the first row must be normalized, i.e. |a|^2+ |b|^2 = 1
// use su2_normalize() for this
typedef struct{
  gsl_complex a;
  gsl_complex b;
} su2_matrix;

// SU(2) matrix methods --------------------------------------

// print matrix
void su2_print(const su2_matrix A){
  printf("%f + i*%f \t", GSL_REAL(A.a), GSL_IMAG(A.a));
  printf("%f + i*%f \n", GSL_REAL(A.b), GSL_IMAG(A.b));
}

// the identity matrix
su2_matrix su2_unit(){
  su2_matrix u;
  u.a=GSL_COMPLEX_ONE;
  u.b=GSL_COMPLEX_ZERO;
  return u;
}

// normalize matrix
su2_matrix su2_norm(const su2_matrix A){
  su2_matrix result;
  double norm = sqrt(gsl_complex_abs2(A.a)+gsl_complex_abs2(A.b));
  result.a = gsl_complex_div(A.a,gsl_complex_rect(norm,0));
  result.b = gsl_complex_div(A.b,gsl_complex_rect(norm,0));
  return result;
}

// multiply matrices
su2_matrix su2_mul(const su2_matrix A, const su2_matrix B){
  su2_matrix result;
  result.a = gsl_complex_sub(gsl_complex_mul(A.a,B.a), gsl_complex_mul(A.b,gsl_complex_conjugate(B.b))); // ac-bd*
  result.b = gsl_complex_add(gsl_complex_mul(A.a,B.b), gsl_complex_mul(A.b,gsl_complex_conjugate(B.a))); // ad+bc*
  return result;
}

// inverse matrix
su2_matrix su2_inv(const su2_matrix A){
  su2_matrix result;
  result.a = gsl_complex_conjugate(A.a);
  result.b = gsl_complex_sub(GSL_COMPLEX_ZERO,A.b);
  return result;
}

// generate random matrix
su2_matrix su2_rand(const gsl_rng* r){
  su2_matrix result;
  result.a = gsl_complex_rect(1,eps*(gsl_rng_uniform(r)*2-1));
  result.b = gsl_complex_rect(0,eps*(gsl_rng_uniform(r)*2-1));
  return su2_norm(result);
}

double su2_trace(const su2_matrix A){
  return 2*GSL_REAL(A.a);
}

// end of SU(2) matrix methods ---------------------------------------------


#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_multifit.h>

int
main()
{
  const size_t n = 1000; /* number of observations */
  const size_t p = 2;    /* number of model parameters */
  size_t i;
  gsl_rng *r = gsl_rng_alloc(gsl_rng_default);
  gsl_matrix *X = gsl_matrix_alloc(n, p);
  gsl_vector *y = gsl_vector_alloc(n);

  for (i = 0; i < n; ++i)
    {
      /* generate first random variable u */
      double ui = 5.0 * gsl_ran_gaussian(r, 1.0);

      /* set v = u + noise */
      double vi = ui + gsl_ran_gaussian(r, 0.001);

      /* set y = u + v + noise */
      double yi = ui + vi + gsl_ran_gaussian(r, 1.0);

      /* since u =~ v, the matrix X is ill-conditioned */
      gsl_matrix_set(X, i, 0, ui);
      gsl_matrix_set(X, i, 1, vi);

      /* rhs vector */
      gsl_vector_set(y, i, yi);
    }

  {
    const size_t npoints = 200;                   /* number of points on L-curve and GCV curve */
    gsl_multifit_linear_workspace *w =
      gsl_multifit_linear_alloc(n, p);
    gsl_vector *c = gsl_vector_alloc(p);          /* OLS solution */
    gsl_vector *c_lcurve = gsl_vector_alloc(p);   /* regularized solution (L-curve) */
    gsl_vector *c_gcv = gsl_vector_alloc(p);      /* regularized solution (GCV) */
    gsl_vector *reg_param = gsl_vector_alloc(npoints);
    gsl_vector *rho = gsl_vector_alloc(npoints);  /* residual norms */
    gsl_vector *eta = gsl_vector_alloc(npoints);  /* solution norms */
    gsl_vector *G = gsl_vector_alloc(npoints);    /* GCV function values */
    double lambda_l;                              /* optimal regularization parameter (L-curve) */
    double lambda_gcv;                            /* optimal regularization parameter (GCV) */
    double G_gcv;                                 /* G(lambda_gcv) */
    size_t reg_idx;                               /* index of optimal lambda */
    double rcond;                                 /* reciprocal condition number of X */
    double chisq, rnorm, snorm;

    /* compute SVD of X */
    gsl_multifit_linear_svd(X, w);

    rcond = gsl_multifit_linear_rcond(w);
    fprintf(stderr, "matrix condition number = %e\n\n", 1.0 / rcond);

    /* unregularized (standard) least squares fit, lambda = 0 */
    gsl_multifit_linear_solve(0.0, X, y, c, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0);

    fprintf(stderr, "=== Unregularized fit ===\n");
    fprintf(stderr, "best fit: y = %g u + %g v\n",
      gsl_vector_get(c, 0), gsl_vector_get(c, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* calculate L-curve and find its corner */
    gsl_multifit_linear_lcurve(y, reg_param, rho, eta, w);
    gsl_multifit_linear_lcorner(rho, eta, &reg_idx);

    /* store optimal regularization parameter */
    lambda_l = gsl_vector_get(reg_param, reg_idx);

    /* regularize with lambda_l */
    gsl_multifit_linear_solve(lambda_l, X, y, c_lcurve, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0) + pow(lambda_l * snorm, 2.0);

    fprintf(stderr, "\n=== Regularized fit (L-curve) ===\n");
    fprintf(stderr, "optimal lambda: %g\n", lambda_l);
    fprintf(stderr, "best fit: y = %g u + %g v\n",
            gsl_vector_get(c_lcurve, 0), gsl_vector_get(c_lcurve, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* calculate GCV curve and find its minimum */
    gsl_multifit_linear_gcv(y, reg_param, G, &lambda_gcv, &G_gcv, w);

    /* regularize with lambda_gcv */
    gsl_multifit_linear_solve(lambda_gcv, X, y, c_gcv, &rnorm, &snorm, w);
    chisq = pow(rnorm, 2.0) + pow(lambda_gcv * snorm, 2.0);

    fprintf(stderr, "\n=== Regularized fit (GCV) ===\n");
    fprintf(stderr, "optimal lambda: %g\n", lambda_gcv);
    fprintf(stderr, "best fit: y = %g u + %g v\n",
            gsl_vector_get(c_gcv, 0), gsl_vector_get(c_gcv, 1));
    fprintf(stderr, "residual norm = %g\n", rnorm);
    fprintf(stderr, "solution norm = %g\n", snorm);
    fprintf(stderr, "chisq/dof = %g\n", chisq / (n - p));

    /* output L-curve and GCV curve */
    for (i = 0; i < npoints; ++i)
      {
        printf("%e %e %e %e\n",
               gsl_vector_get(reg_param, i),
               gsl_vector_get(rho, i),
               gsl_vector_get(eta, i),
               gsl_vector_get(G, i));
      }

    /* output L-curve corner point */
    printf("\n\n%f %f\n",
           gsl_vector_get(rho, reg_idx),
           gsl_vector_get(eta, reg_idx));

    /* output GCV curve corner minimum */
    printf("\n\n%e %e\n",
           lambda_gcv,
           G_gcv);

    gsl_multifit_linear_free(w);
    gsl_vector_free(c);
    gsl_vector_free(c_lcurve);
    gsl_vector_free(reg_param);
    gsl_vector_free(rho);
    gsl_vector_free(eta);
    gsl_vector_free(G);
  }

  gsl_rng_free(r);
  gsl_matrix_free(X);
  gsl_vector_free(y);

  return 0;
}


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_sort.h>

#include "cosmocalc.h"

gsl_spline *cosmocalc_aexpn2comvdist_spline = NULL;
gsl_interp_accel *cosmocalc_aexpn2comvdist_acc = NULL;
gsl_spline *cosmocalc_comvdist2aexpn_spline = NULL;
gsl_interp_accel *cosmocalc_comvdist2aexpn_acc = NULL;
double DH_sqrtok;

/* function for integration using gsl integration */
static double comvdist_integ_funct(double a, void *p)
{
  return 1.0/a/a/hubble_noscale(a);
}

double comvdist_exact(double a)
{
#define WORKSPACE_NUM 100000
#define ABSERR 0.0
#define RELERR 1e-8

  gsl_integration_workspace *workspace;
  gsl_function F;
  double result,abserr;

  workspace = gsl_integration_workspace_alloc((size_t) WORKSPACE_NUM);

  F.function = &comvdist_integ_funct;
  gsl_integration_qag(&F,a,1.0,ABSERR,RELERR,(size_t) WORKSPACE_NUM,GSL_INTEG_GAUSS51,workspace,&result,&abserr);

  gsl_integration_workspace_free(workspace);

#undef ABSERR
#undef RELERR
#undef WORKSPACE_NUM

  return result*DH;
}

/* init function  - some help from Gadget-2 applied here */
void init_cosmocalc_comvdist_table(void)
{
#define WORKSPACE_NUM 100000
#define ABSERR 0.0
#define RELERR 1e-8

  static int initFlag = 1;
  static int currCosmoNum;

  gsl_integration_workspace *workspace;
  gsl_function F;
  long i;
  double result,abserr,afact;
  double comvdist_table[COSMOCALC_COMVDIST_TABLE_LENGTH];
  double aexpn_table[COSMOCALC_COMVDIST_TABLE_LENGTH];
  size_t sindex[COSMOCALC_COMVDIST_TABLE_LENGTH];
  double tmpDouble[COSMOCALC_COMVDIST_TABLE_LENGTH];

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;

      if(cosmoData.OmegaK != 0.0)
	DH_sqrtok = DH/sqrt(fabs(cosmoData.OmegaK));
      else
	DH_sqrtok = 1.0;

      workspace = gsl_integration_workspace_alloc((size_t) WORKSPACE_NUM);

      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH-1;++i)
	{
	  afact = (AEXPN_MAX - AEXPN_MIN_DIST)/(COSMOCALC_COMVDIST_TABLE_LENGTH-1.0)*((double) i) + AEXPN_MIN_DIST;
	  F.function = &comvdist_integ_funct;
	  F.params = &(cosmoData.OmegaM);
	  gsl_integration_qag(&F,afact,1.0,ABSERR,RELERR,(size_t) WORKSPACE_NUM,GSL_INTEG_GAUSS51,workspace,&result,&abserr);
	  aexpn_table[i] = afact;
	  comvdist_table[i] = result*DH;
	}
      aexpn_table[i] = 1.0;
      comvdist_table[i] = 0.0;

      gsl_integration_workspace_free(workspace);
#undef ABSERR
#undef RELERR
#undef WORKSPACE_NUM

      //init the spline and accelerators
      if(cosmocalc_aexpn2comvdist_spline != NULL)
	gsl_spline_free(cosmocalc_aexpn2comvdist_spline);
      cosmocalc_aexpn2comvdist_spline = gsl_spline_alloc(GSL_SPLINE_TYPE,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      gsl_spline_init(cosmocalc_aexpn2comvdist_spline,aexpn_table,comvdist_table,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      if(cosmocalc_aexpn2comvdist_acc != NULL)
	gsl_interp_accel_reset(cosmocalc_aexpn2comvdist_acc);
      else
	cosmocalc_aexpn2comvdist_acc = gsl_interp_accel_alloc();

      //sort the distances properly
      gsl_sort_index(sindex,comvdist_table,(size_t) 1,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	tmpDouble[i] = comvdist_table[sindex[i]];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	comvdist_table[i] = tmpDouble[i];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	tmpDouble[i] = aexpn_table[sindex[i]];
      for(i=0;i<COSMOCALC_COMVDIST_TABLE_LENGTH;++i)
	aexpn_table[i] = tmpDouble[i];

      if(cosmocalc_comvdist2aexpn_spline != NULL)
	gsl_spline_free(cosmocalc_comvdist2aexpn_spline);
      cosmocalc_comvdist2aexpn_spline = gsl_spline_alloc(GSL_SPLINE_TYPE,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      gsl_spline_init(cosmocalc_comvdist2aexpn_spline,comvdist_table,aexpn_table,(size_t) (COSMOCALC_COMVDIST_TABLE_LENGTH));
      if(cosmocalc_comvdist2aexpn_acc != NULL)
	gsl_interp_accel_reset(cosmocalc_comvdist2aexpn_acc);
      else
	cosmocalc_comvdist2aexpn_acc = gsl_interp_accel_alloc();
    }
}

double acomvdist(double dist)
{
  static int initFlag = 1;
  static int currCosmoNum;

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;
      init_cosmocalc_comvdist_table();
    }

  return gsl_spline_eval(cosmocalc_comvdist2aexpn_spline,dist,cosmocalc_comvdist2aexpn_acc);
}

double comvdist(double a)
{
  static int initFlag = 1;
  static int currCosmoNum;

  if(initFlag == 1 || currCosmoNum != cosmoData.cosmoNum)
    {
      initFlag = 0;
      currCosmoNum = cosmoData.cosmoNum;
      init_cosmocalc_comvdist_table();
    }

  return gsl_spline_eval(cosmocalc_aexpn2comvdist_spline,a,cosmocalc_aexpn2comvdist_acc);
}

//NOTE: you must call comvdist *FIRST* to init DH_sqrtok!
double angdist(double a)
{
  double cd;
  cd = comvdist(a);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh(cd/DH_sqrtok)*a;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin(cd/DH_sqrtok)*a;
  else
    return cd*a;
}

double lumdist(double a)
{
  double cd;
  cd = comvdist(a);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh(cd/DH_sqrtok)/a;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin(cd/DH_sqrtok)/a;
  else
    return cd/a;
}

double angdistdiff(double amin, double amax)
{
  double cdmin,cdmax;
  assert(amin <= amax);
  cdmin = comvdist(amin);
  cdmax = comvdist(amax);

  if(cosmoData.OmegaK > 0.0)
    return DH_sqrtok*sinh((cdmin-cdmax)/DH_sqrtok)*amin;
  else if(cosmoData.OmegaK < 0)
    return DH_sqrtok*sin((cdmin-cdmax)/DH_sqrtok)*amin;
  else
    return (cdmin-cdmax)*amin;
}


/*
 * Reinforcement Learning Book / Exercise 4.7
 *
 * $ sudo apt-get install libgsl-dev libgsl2
 * $ gcc car_rental2.c -lgsl -lgslcblas -lm -o car_rental2
 */

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

#define Size 20
#define Iteration 100
#define Rent1_mean 3
#define Rent2_mean 4
#define Return1_mean 3
#define Return2_mean 2

// Global variables
float value[Size + 1][Size + 1];
int policy[Size + 1][Size + 1];

void show_value(){
    printf("[");
    for (int c1 = 0; c1 <= Size; c1++) {
        printf("[");
        for (int c2 = 0; c2 <= Size; c2++) {
            printf("%3.0f", value[c1][c2]);
            if (c2 < Size) {
                printf(", ");
            }
        }
        printf("]");
        if (c1 < Size) {
            printf(",\n ");
        }
    }
    printf("]\n");
}

void show_policy(){
    printf("[");
    for (int c1 = 0; c1 <= Size; c1++) {
        printf("[");
        for (int c2 = 0; c2 <= Size; c2++) {
            printf("%2d", policy[c1][c2]);
            if (c2 < Size) {
                printf(", ");
            }
        }
        printf("]");
        if (c1 < Size) {
            printf(",\n ");
        }
    }
    printf("]\n");
}

float calc_q_val(int c1, int c2, int a){
    float q_val = 0;
    int _c1, _c2;
    float c1_rent_prob, c2_rent_prob, c1_return_prob, c2_return_prob, prob;

    // Moving cars
    c1 -= a;
    c2 += a;
    if (a > 0) {
        q_val -= 2*(a-1);
    } else {
        q_val -= 2*abs(a);
    }
    if (c1 > 10) q_val -= 4;
    if (c2 > 10) q_val -= 4;

    for (int c1_rent = 0; c1_rent <= c1; c1_rent++) {
        for (int c2_rent = 0; c2_rent <= c2; c2_rent++) {
            for (int c1_return = 0; c1_return <= Size-(c1-c1_rent); c1_return++) {
                for (int c2_return = 0; c2_return <= Size-(c2-c2_rent); c2_return++) {
                    _c1 = c1 - c1_rent + c1_return;
                    _c2 = c2 - c2_rent + c2_return;

                    if (c1_rent == c1) {
                        c1_rent_prob = 1;
                        for (int n = 0; n < c1_rent; n++) {
                            c1_rent_prob -= gsl_ran_poisson_pdf(n, Rent1_mean);
                        }
                    } else {
                        c1_rent_prob = gsl_ran_poisson_pdf(c1_rent, Rent1_mean);
                    }

                    if (c2_rent == c2) {
                        c2_rent_prob = 1;
                        for (int n = 0; n < c2_rent; n++) {
                            c2_rent_prob -= gsl_ran_poisson_pdf(n, Rent2_mean);
                        }
                    } else {
                        c2_rent_prob = gsl_ran_poisson_pdf(c2_rent, Rent2_mean);
                    }

                    if (c1_return == Size-(c1-c1_rent)) {
                        c1_return_prob = 1;
                        for (int n = 0; n < c1_return; n++) {
                            c1_return_prob -= gsl_ran_poisson_pdf(n, Return1_mean);
                        }
                    } else {
                        c1_return_prob = gsl_ran_poisson_pdf(c1_return, Return1_mean);
                    }

                    if (c2_return == Size-(c2-c2_rent)) {
                        c2_return_prob = 1;
                        for (int n = 0; n < c2_return; n++) {
                            c2_return_prob -= gsl_ran_poisson_pdf(n, Return2_mean);
                        }
                    } else {
                        c2_return_prob = gsl_ran_poisson_pdf(c2_return, Return2_mean);
                    }

                    prob = c1_rent_prob * c2_rent_prob * c1_return_prob * c2_return_prob;
                    q_val += prob * (10 * (c1_rent + c2_rent) + 0.9 * value[_c1][_c2]);
                }
            }
        }
    }
    return q_val;
}

int min(int a, int b){
    if (a < b) {
        return a;
    } else {
        return b;
    }
}

void run() {
    float q_val;
    float value_update;
    int policy_update;

    for (int c1 = 0; c1 <= Size; c1++) {
        for (int c2 = 0; c2 <= Size; c2++) {
            value[c1][c2] = 0;
            policy[c1][c2] = 0;
        }
    }

    printf("# Iteration 0\n");
    show_policy();
    show_value();

    for (int i = 1; i < Iteration; i++) {
        for (int c1 = 0; c1 <= Size; c1++) {
            for (int c2 = 0; c2 <= Size; c2++) {
                int update = 0;
                for (int a = -min(c2, 5); a <= min(c1, 5); a++) {
                    q_val = calc_q_val(c1, c2, a);
                    if (update == 0 || q_val > value_update) {
                        value_update = q_val;
                        policy_update = a;
                        update = 1;
                    }
                }
                value[c1][c2] = value_update;
                policy[c1][c2] = policy_update;
            }
        }
        printf("# Iteration %d\n", i);
        show_policy();
        show_value();
    }
}

int main() {
    run();
}


static char help[] = "Stiff ODE system.  Compare odejac.c.\n\n";

#include <petsc.h>

/* PYTHON:
import numpy as np
from scipy.linalg import expm
B = np.array([[0, 1, 0], [-1, 0, 0.1], [0, 0, -101]])
y = np.dot(expm(10*B),np.array([1.0,1.0,1.0]).transpose())
print y
RESULT:
[-1.383623   -0.29588643  0.        ]
*/

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

int main(int argc,char **argv) {
  PetscErrorCode ierr;
  const int N = 3;
  int       steps;
  Vec       y;
  Mat       J;
  TS        ts;

  PetscInitialize(&argc,&argv,(char*)0,help);

  ierr = VecCreate(PETSC_COMM_WORLD,&y); CHKERRQ(ierr);
  ierr = VecSetSizes(y,PETSC_DECIDE,N); CHKERRQ(ierr);
  ierr = VecSetFromOptions(y); CHKERRQ(ierr);
  ierr = MatCreate(PETSC_COMM_WORLD,&J); CHKERRQ(ierr);
  ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,N,N); CHKERRQ(ierr);
  ierr = MatSetFromOptions(J); CHKERRQ(ierr);
  ierr = MatSetUp(J); 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);
  ierr = TSSetRHSJacobian(ts,J,J,FormRHSJacobian,NULL); CHKERRQ(ierr);

  ierr = TSSetType(ts,TSRK); CHKERRQ(ierr);
  ierr = TSSetTime(ts,0.0); CHKERRQ(ierr);
  ierr = TSSetMaxTime(ts,10.0); CHKERRQ(ierr);
  ierr = TSSetTimeStep(ts,1.0); CHKERRQ(ierr);
  ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_MATCHSTEP); CHKERRQ(ierr);
  ierr = TSSetFromOptions(ts); CHKERRQ(ierr);  // can override defaults

  ierr = VecSet(y,1.0); CHKERRQ(ierr);
  ierr = TSSolve(ts,y); CHKERRQ(ierr);

  ierr = VecView(y,PETSC_VIEWER_STDOUT_WORLD); CHKERRQ(ierr);
  ierr = TSGetStepNumber(ts,&steps); CHKERRQ(ierr);
  ierr = PetscPrintf(PETSC_COMM_WORLD,
              "total steps = %d\n",steps); CHKERRQ(ierr);

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

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

PetscErrorCode FormRHSJacobian(TS ts, double t, Vec y, Mat J, Mat P,
                               void *ptr) {
    PetscErrorCode ierr;
    int    j[3] = {0, 1, 2};
    double v[9] = { 0.0, 1.0, 0.0,
                   -1.0, 0.0, 0.1,
                    0.0, 0.0, -101.0};
    ierr = MatSetValues(P,3,j,3,j,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;
}


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

/* number of data points to fit */
#define N        200

/* number of fit coefficients */
#define NCOEFFS  12

/* nbreak = ncoeffs + 2 - k = ncoeffs - 2 since k = 4 */
#define NBREAK   (NCOEFFS - 2)

int
main (void)
{
  const size_t n = N;
  const size_t ncoeffs = NCOEFFS;
  const size_t nbreak = NBREAK;
  size_t i, j;
  gsl_bspline_workspace *bw;
  gsl_vector *B;
  double dy;
  gsl_rng *r;
  gsl_vector *c, *w;
  gsl_vector *x, *y;
  gsl_matrix *X, *cov;
  gsl_multifit_linear_workspace *mw;
  double chisq, Rsq, dof, tss;

  gsl_rng_env_setup();
  r = gsl_rng_alloc(gsl_rng_default);

  /* allocate a cubic bspline workspace (k = 4) */
  bw = gsl_bspline_alloc(4, nbreak);
  B = gsl_vector_alloc(ncoeffs);

  x = gsl_vector_alloc(n);
  y = gsl_vector_alloc(n);
  X = gsl_matrix_alloc(n, ncoeffs);
  c = gsl_vector_alloc(ncoeffs);
  w = gsl_vector_alloc(n);
  cov = gsl_matrix_alloc(ncoeffs, ncoeffs);
  mw = gsl_multifit_linear_alloc(n, ncoeffs);

  /* this is the data to be fitted */
  for (i = 0; i < n; ++i)
    {
      double sigma;
      double xi = (15.0 / (N - 1)) * i;
      double yi = cos(xi) * exp(-0.1 * xi);

      sigma = 0.1 * yi;
      dy = gsl_ran_gaussian(r, sigma);
      yi += dy;

      gsl_vector_set(x, i, xi);
      gsl_vector_set(y, i, yi);
      gsl_vector_set(w, i, 1.0 / (sigma * sigma));

      printf("%f %f\n", xi, yi);
    }

  /* use uniform breakpoints on [0, 15] */
  gsl_bspline_knots_uniform(0.0, 15.0, bw);

  /* construct the fit matrix X */
  for (i = 0; i < n; ++i)
    {
      double xi = gsl_vector_get(x, i);

      /* compute B_j(xi) for all j */
      gsl_bspline_eval(xi, B, bw);

      /* fill in row i of X */
      for (j = 0; j < ncoeffs; ++j)
        {
          double Bj = gsl_vector_get(B, j);
          gsl_matrix_set(X, i, j, Bj);
        }
    }

  /* do the fit */
  gsl_multifit_wlinear(X, w, y, c, cov, &chisq, mw);

  dof = n - ncoeffs;
  tss = gsl_stats_wtss(w->data, 1, y->data, 1, y->size);
  Rsq = 1.0 - chisq / tss;

  fprintf(stderr, "chisq/dof = %e, Rsq = %f\n",
                   chisq / dof, Rsq);

  printf("\n\n");

  /* output the smoothed curve */
  {
    double xi, yi, yerr;

    for (xi = 0.0; xi < 15.0; xi += 0.1)
      {
        gsl_bspline_eval(xi, B, bw);
        gsl_multifit_linear_est(B, c, cov, &yi, &yerr);
        printf("%f %f\n", xi, yi);
      }
  }

  gsl_rng_free(r);
  gsl_bspline_free(bw);
  gsl_vector_free(B);
  gsl_vector_free(x);
  gsl_vector_free(y);
  gsl_matrix_free(X);
  gsl_vector_free(c);
  gsl_vector_free(w);
  gsl_matrix_free(cov);
  gsl_multifit_linear_free(mw);

  return 0;
} /* main() */


#define _XOPEN_SOURCE 500
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <sys/time.h>
#include <getopt.h>
#include <pthread.h>
#include <cblas.h>
#include <omp.h>

#define WALLTIME(t) ((double)(t).tv_sec + 1e-6 * (double)(t).tv_usec)
#define min(x,y) (((x) < (y)) ? (x) : (y))

void options ( int argc, char **argv );

const char *usage =
"\t-k <int>\n"
"\t-m <int>\n"
"\t-n <int>\n"
"\t-t <int>\n";

//Global variables and definitions
int num_threads = 4;

double
    *A, *B,
    *C_serial, *C_openmp, *C_pthreads, *C_blas,
    alpha = 1.0, beta = 0.0;

int
    m = 1024, n = 1024, k = 1024;

void print_matrices()
{
	size_t i, j;
	printf (" Top left corner of matrix A: \n");
	for (i=0; i<min(m,6); i++) {
		for (j=0; j<min(k,6); j++) {
			printf ("%12.0f", A[j+i*k]);
		}
		printf ("\n");
	}

	printf ("\n Top left corner of matrix B: \n");
	for (i=0; i<min(k,6); i++) {
		for (j=0; j<min(n,6); j++) {
			printf ("%12.0f", B[j+i*n]);
		}
		printf ("\n");
	}

	printf ("\n Top left corner of matrix C: \n");
	for (i=0; i<min(m,6); i++) {
		for (j=0; j<min(n,6); j++) {
			printf ("%12.5G", C_serial[j+i*n]);
		}
		printf ("\n");
	}
}

//TODO: Pthreads - function

//TODO end

int
main ( int argc, char **argv )
{
    options ( argc, argv );
    A = (double *)malloc( m*k*sizeof( double ) );
    B = (double *)malloc( k*n*sizeof( double ) );
    C_serial = (double *)malloc( m*n*sizeof( double ) );
    C_openmp = (double *)malloc( m*n*sizeof( double ) );
    C_pthreads = (double *)malloc( m*n*sizeof( double ) );
    C_blas = (double *)malloc( m*n*sizeof( double ) );

    int i, j;

    /* Initialize with dummy data */
    for ( i = 0; i < (m*k); i++ )
        A[i] = (double)(i+1);
    for ( i = 0; i < (k*n); i++ )
        B[i] = (double)(-i-1);
    for ( i = 0; i < (m*n); i++ ){
        C_serial[i] = 0.0;
        C_openmp [i] = 0.0;
        C_pthreads[i] = 0.0;
        C_blas[i] = 0.0;
    }

    struct timeval start, end;

    double total_time_serial = 0;
    double total_time_openmp = 0;
    double total_time_pthreads = 0;
    double total_time_blas = 0;

    /*
     * DGEMM (Double-precision GEneral Matrix Multiply)
     * Example: A general multiplication between two matricies A and B, accumulating in C.
     */
    // A has m rows and k columns
    // B has k rows and n columns
    // C has m rows and n columns
    double sum = 0;
    int p;

    gettimeofday( &start, NULL );
    for (i = 0; i < m; i++) {
    	for (j = 0; j < n; j++) {
    	    sum = 0;
    	    for (p = 0; p < k; p++) {
                sum = sum + A[i * k + p] * B[p * n + j];
    	    }
    	    C_serial[i * n + j] = sum;
        }
    }
    gettimeofday ( &end, NULL );
    total_time_serial = (WALLTIME(end)-WALLTIME(start));
    //print_matrices();

//TODO: OpenMP
    gettimeofday( &start, NULL );
    for (i = 0; i < m; i++) {
    	for (j = 0; j < n; j++) {
    	    sum = 0;
    	    for (p = 0; p < k; p++) {
                sum = sum + A[i * k + p] * B[p * n + j];
    	    }
    	    C_openmp[i * n + j] = sum;
    	}
    }
    gettimeofday ( &end, NULL );
    total_time_openmp = (WALLTIME(end)-WALLTIME(start));
//TODO end

//TODO: Pthreads - spawn threads
    gettimeofday( &start, NULL );

    gettimeofday ( &end, NULL );
    total_time_pthreads = (WALLTIME(end)-WALLTIME(start));
//TODO end

    gettimeofday( &start, NULL );
    // Documentation for GEMM:
    // https://software.intel.com/content/www/us/en/develop/documentation/onemkl-developer-reference-c/top/blas-and-sparse-blas-routines/blas-routines/blas-level-3-routines/cblas-gemm.html
    cblas_dgemm(
    	CblasRowMajor, 	// Formating of the matrix, RowMajor or ColMajor
    	CblasNoTrans, 	// The form of Matrix A
    	CblasNoTrans, 	// The form of Matrix B
    	m,		// Number of rows in A and in C
    	n, 		// Number of columns in B and C
    	k, 		// Number of columns in A and rows of B
    	alpha, 	  	// Scalar alpha of multiplication with A
    	A, 		// The A matrix
    	k, 		// Leading dimension of A, k if CblasRowMajor and NoTrans
    	B, 		// The B matrix
    	n, 		// Leading dimension of B, n if CblasRowMajor and NoTrans
    	beta,         	// Scalar beta of multiplication with C
    	C_blas, 		// The C matrix, this is also the output matrix
    	n		// Leading dimension of C, n if CblasRowMajor
    );
    gettimeofday ( &end, NULL );
    //print_matrices();
    total_time_blas = (WALLTIME(end)-WALLTIME(start));

    bool openmp_correct = true;
    bool pthreads_correct = true;
    bool blas_correct = true;

    for(i = 0; i < m; i++){
        for(j = 0; j < n; j++){
            if(C_openmp[i*n+j] != C_serial[i*n+j])
                openmp_correct = false;
            if(C_pthreads[i*n+j] != C_serial[i*n+j])
                pthreads_correct = false;
            if(C_blas[i*n+j] != C_serial[i*n+j])
                blas_correct = false;
        }
    }

    printf ( "Manual\t\t\tTime:\t%es\n", total_time_serial );

    printf("OpenMP:\t  %s\t", openmp_correct ? "CORRECT" : "INCORRECT");
    printf ( "Time:\t%es\t", total_time_openmp );
    printf ( "Speedup: %.2lfx\n", total_time_serial/total_time_openmp );

    printf("Pthreads: %s\t", pthreads_correct ? "CORRECT" : "INCORRECT");
    printf ( "Time:\t%es\t", total_time_pthreads );
    printf ( "Speedup: %.2lfx\n", total_time_serial/total_time_pthreads );

    printf("BLAS:\t  %s\t", blas_correct ? "CORRECT" : "INCORRECT");
    printf ( "Time:\t%es\t", total_time_blas );
    printf ( "Speedup: %.2lfx\n", total_time_serial/total_time_blas );

    free ( A );
    free ( B );
    free ( C_serial );
    free ( C_openmp );
    free ( C_pthreads );
    free ( C_blas );

    exit ( EXIT_SUCCESS );
}

void
options ( int argc, char **argv )
{
    int o;
    while ( (o = getopt(argc,argv,"k:m:n:t:h")) != -1 )
    switch ( o )
    {
        case 'k': k = strtol ( optarg, NULL, 10 ); break;
        case 'm': m = strtol ( optarg, NULL, 10 ); break;
        case 'n': n = strtol ( optarg, NULL, 10 ); break;
        case 't': num_threads = strtol ( optarg, NULL, 10 ); break;
        case 'h':
            fprintf ( stderr, "%s", usage );
            exit ( EXIT_FAILURE );
            break;
    }
}


/* randist/cauchy.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., 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>

/* The Cauchy probability distribution is

   p(x) dx = (1/(pi a)) (1 + (x/a)^2)^(-1) dx

   It is also known as the Lorentzian probability distribution */

double
gsl_ran_cauchy (const gsl_rng * r, const double a)
{
  double u;
  do
    {
      u = gsl_rng_uniform (r);
    }
  while (u == 0.5);

  return a * tan (M_PI * u);
}

double
gsl_ran_cauchy_pdf (const double x, const double a)
{
  double u = x / a;
  double p = (1 / (M_PI * a)) / (1 + u * u);
  return p;
}


/* expfit.c -- model functions for exponential + background */

#include <math.h>
#include <stddef.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>

struct usertype {
  size_t n;
  double * y;
  double * sigma;
};

int expb_f (const gsl_vector * x, void *data,
        gsl_vector * f) {
  size_t n = ((struct usertype *)data)->n;
  double *y = ((struct usertype *)data)->y;
  double *sigma = ((struct usertype *) data)->sigma;

  double A = gsl_vector_get (x, 0);
  double lambda = gsl_vector_get (x, 1);
  double b = gsl_vector_get (x, 2);

  size_t i;

  for (i = 0; i < n; i++)
    {
      /* Model Yi = A * exp(-lambda * i) + b */
      double t = i;
      double Yi = A * exp (-lambda * t) + b;
      gsl_vector_set (f, i, (Yi - y[i])/sigma[i]);
    }

  return GSL_SUCCESS;
}

int expb_df (const gsl_vector * x, void *params,
         gsl_matrix * J) {

  struct usertype *myparams = (struct usertype *) params;

  int n = myparams->n;
  double *sigma = myparams->sigma;

  double A = gsl_vector_get (x, 0);
  double lambda = gsl_vector_get (x, 1);

  size_t i;

  /*for (i = 0; i<10; i++){
    printf("sigma[%z] = %5.3f\n",i,sigma[i]);
    }*/

  for (i = 0; i < n; i++)
    {
      /* Jacobian matrix J(i,j) = dfi / dxj, */
      /* where fi = (Yi - yi)/sigma[i],      */
      /*       Yi = A * exp(-lambda * i) + b  */
      /* and the xj are the parameters (A,lambda,b) */
      double t = i;
      double s = sigma[i];
      double e = exp(-lambda * t);
      gsl_matrix_set (J, i, 0, e/s);
      gsl_matrix_set (J, i, 1, -t * A * e/s);
      gsl_matrix_set (J, i, 2, 1/s);
    }
  return GSL_SUCCESS;
}

int expb_fdf (const gsl_vector * x, void *data,
          gsl_vector * f, gsl_matrix * J) {

  expb_f (x, data, f);
  expb_df (x, data, J);

  return GSL_SUCCESS;
}

void eval_F ( int fstatus, const int n, const int m,
	      const double *x, double *f, const void *params){

  // first, convert x from an array into a gsl_vector...
  gsl_vector * x_gsl = gsl_vector_alloc(n);
  int i;
  for (i = 0; i < n; i++) {
    gsl_vector_set(x_gsl,i,x[i]);
  }

  // then call the expb_f function
  gsl_vector * f_gsl =  gsl_vector_alloc(m);

  expb_f ( x_gsl,  params,  f_gsl);

  // then convert f back into an array...
  //  f = f_gsl->data;
  for (i = 0; i < m; i++){
    f[i] = gsl_vector_get( f_gsl,i);
    //    f[i] = f_gsl->data[i];
  }

  gsl_vector_free(x_gsl);
  gsl_vector_free(f_gsl);

}

void eval_J  ( int fstatus, const int n, const int m,
	       const double *x, double *J, const void *params){

  // first, convert x from an array into a gsl_vector...
  gsl_vector * x_gsl = gsl_vector_alloc(n);
  int i;
  int jj;
  for (i = 0; i < n; i++) {
    gsl_vector_set(x_gsl,i,x[i]);
  }

  // then call the expb_f function
  gsl_matrix * J_gsl = gsl_matrix_alloc(40,3);
  expb_df (x_gsl, params, J_gsl);

  // then convert J into an array...
  // (find better way...)
  gsl_matrix * J_gsl_t = gsl_matrix_alloc(3,40);
  gsl_matrix_transpose_memcpy(J_gsl_t, J_gsl);
  for ( i = 0; i < m*n; i++){
    J[i] = J_gsl_t->data[i];
  }
  // the following code loses the pointer to J (maybe...)
  // J = J_gsl_t->data;
  gsl_vector_free(x_gsl);
  gsl_matrix_free(J_gsl);
  gsl_matrix_free(J_gsl_t);

}

void eval_HF ( int fstatus, const int n, const int m,
	       const double *x, const double *f, double *hf, const void *params){

}


#include <stdlib.h>
#include <stdio.h>
#include "linterp.h"
#include "qspline.h"
#include "cspline.h"
#include <gsl/gsl_spline.h>

#define NUM_DATAPOINTS 9

/** Read a txt file with two columns seperated by tab and read all the items
 * into the arrays x and y.
 **/
void read_data(double *x, double *y){
    FILE *infile = fopen("xy_data.txt", "r");
    for (int i = 0; i < NUM_DATAPOINTS; ++i){
        int items = fscanf(infile, "%lf\t%lf\n", &x[i], &y[i]);
        if (items == EOF){
            break;
        }
    }
    fclose(infile);
}

void exerciseA(){
    FILE *outfile = fopen("out1.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    gsl_interp_accel *acc = gsl_interp_accel_alloc ();
    gsl_spline *spline = gsl_spline_alloc (gsl_interp_linear, NUM_DATAPOINTS);

    gsl_spline_init (spline, x, y, NUM_DATAPOINTS);

    double val = 0.1;
    do {
        double interp_val = linterp(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = linterp_integ(NUM_DATAPOINTS, x, y, val);
        double y_gsl = gsl_spline_eval(spline, val, acc);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, y_gsl);
        val += 0.1;
    } while (val < 8);
    gsl_spline_free (spline);
    gsl_interp_accel_free (acc);
    free(x), free(y);
    fclose(outfile);
}

void exerciseB(){
    FILE *outfile = fopen("out2.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    double val = 0.1;
    do {
        double interp_val = qspline_eval(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = qspline_integ(NUM_DATAPOINTS, x, y, val);
        double interp_val_deriv = qspline_deriv(NUM_DATAPOINTS, x, y, val);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, interp_val_deriv);
        val += 0.1;
    } while (val < 8);
    free(x), free(y);
    fclose(outfile);
}

void exerciseC(){
    FILE *outfile = fopen("out3.txt", "w");
    double *x, *y;
    x = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    y = (double *) malloc(sizeof(double *) * NUM_DATAPOINTS);
    read_data(x, y);

    gsl_interp_accel *acc = gsl_interp_accel_alloc ();
    gsl_spline *spline = gsl_spline_alloc (gsl_interp_cspline, NUM_DATAPOINTS);

    gsl_spline_init (spline, x, y, NUM_DATAPOINTS);

    double val = 0.1;
    do {
        double interp_val = cspline_eval(NUM_DATAPOINTS, x, y, val);
        double interp_val_integ = cspline_integ(NUM_DATAPOINTS, x, y, val);
        double y_gsl = gsl_spline_eval(spline, val, acc);
        fprintf(outfile, "%f\t%f\t%f\t%f\n", val, interp_val, interp_val_integ, y_gsl);
        val += 0.1;
    } while (val < 8);
    gsl_spline_free (spline);
    gsl_interp_accel_free (acc);
    free(x), free(y);
    fclose(outfile);
}

int main(){
    exerciseA();
    exerciseB();
    exerciseC();
    return 0;
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#ifndef NOMPI
#include <mpi.h>
#endif
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>

#include "allvars.h"
#include "proto.h"

/*! \file driftfac.c
 *  \brief compute loop-up tables for prefactors in cosmological integration
 */

static double logTimeBegin;
static double logTimeMax;

/*! This function computes look-up tables for factors needed in
 *  cosmological integrations. The (simple) integrations are carried out
 *  with the GSL library.  Separate factors are computed for the "drift",
 *  and the gravitational and hydrodynamical "kicks".  The lookup-table is
 *  used for reasons of speed.
 */
void init_drift_table(void)
{
#define WORKSIZE 100000
  int i;
  double result, abserr;
  gsl_function F;
  gsl_integration_workspace *workspace;

  logTimeBegin = log(All.TimeBegin);
  logTimeMax = log(All.TimeMax);

  workspace = gsl_integration_workspace_alloc(WORKSIZE);

  for(i = 0; i < DRIFT_TABLE_LENGTH; i++)
    {
      F.function = &drift_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      DriftTable[i] = result;

      F.function = &gravkick_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      GravKickTable[i] = result;

      F.function = &hydrokick_integ;
      gsl_integration_qag(&F, exp(logTimeBegin), exp(logTimeBegin + ((logTimeMax - logTimeBegin) / DRIFT_TABLE_LENGTH) * (i + 1)), 0,
			  1.0e-8, WORKSIZE, GSL_INTEG_GAUSS41, workspace, &result, &abserr);
      HydroKickTable[i] = result;
    }

  gsl_integration_workspace_free(workspace);
}

/*! This function integrates the cosmological prefactor for a drift step
 *  between time0 and time1. The value returned is * \f[ \int_{a_0}^{a_1}
 *  \frac{{\rm d}a}{H(a)} * \f]
 */
double get_drift_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * DriftTable[0];
  else
    df1 = DriftTable[i1 - 1] + (DriftTable[i1] - DriftTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * DriftTable[0];
  else
    df2 = DriftTable[i2 - 1] + (DriftTable[i2] - DriftTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! This function integrates the cosmological prefactor for a kick step of
 *  the gravitational force.
 */
double get_gravkick_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * GravKickTable[0];
  else
    df1 = GravKickTable[i1 - 1] + (GravKickTable[i1] - GravKickTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * GravKickTable[0];
  else
    df2 = GravKickTable[i2 - 1] + (GravKickTable[i2] - GravKickTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! This function integrates the cosmological prefactor for a kick step of
 *  the hydrodynamical force.
 */
double get_hydrokick_factor(int time0, int time1)
{
  double a1, a2, df1, df2, u1, u2;
  int i1, i2;

  /* note: will only be called for cosmological integration */

  a1 = logTimeBegin + time0 * All.Timebase_interval;
  a2 = logTimeBegin + time1 * All.Timebase_interval;

  u1 = (a1 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i1 = (int) u1;
  if(i1 >= DRIFT_TABLE_LENGTH)
    i1 = DRIFT_TABLE_LENGTH - 1;

  if(i1 <= 1)
    df1 = u1 * HydroKickTable[0];
  else
    df1 = HydroKickTable[i1 - 1] + (HydroKickTable[i1] - HydroKickTable[i1 - 1]) * (u1 - i1);

  u2 = (a2 - logTimeBegin) / (logTimeMax - logTimeBegin) * DRIFT_TABLE_LENGTH;
  i2 = (int) u2;
  if(i2 >= DRIFT_TABLE_LENGTH)
    i2 = DRIFT_TABLE_LENGTH - 1;

  if(i2 <= 1)
    df2 = u2 * HydroKickTable[0];
  else
    df2 = HydroKickTable[i2 - 1] + (HydroKickTable[i2] - HydroKickTable[i2 - 1]) * (u2 - i2);

  return df2 - df1;
}

/*! Integration kernel for drift factor computation.
 */
double drift_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * a * a * a);
}

/*! Integration kernel for gravitational kick factor computation.
 */
double gravkick_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * a * a);
}

/*! Integration kernel for hydrodynamical kick factor computation.
 */
double hydrokick_integ(double a, void *param)
{
  double h;

  h = All.Omega0 / (a * a * a) + (1 - All.Omega0 - All.OmegaLambda) / (a * a) + All.OmegaLambda;
  h = All.Hubble * sqrt(h);

  return 1 / (h * pow(a, 3 * GAMMA_MINUS1) * a);
}

double growthfactor_integ(double a, void *param)
{
  double s;

  s = All.Omega0 + (1 - All.Omega0 - All.OmegaLambda) * a + All.OmegaLambda * a * a * a;
  s = sqrt(s);

  return pow(sqrt(a) / s, 3);
}


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

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

#include "ccl.h"

/*
 * convert_concentration_single finds the concentration c'
 * for a mass definition with overdensity Delta' given
 * the concentration c for a mass definition with overdensity
 * Delta assuming an NFW density profile.
 *
 * To do so, it solves the following equation numerically:
 *    c^3 * f(c) = Delta' f(c')
 * where f(x) = x^3 * (x + 1) / ((1+x) * log(x + 1) - x).
 *
 * The equation is solved using a Newton-Raphson approach.
 * The functions nfw_fx, nfw_f, nfw_df and nfw_fdf implement
 * the function whose zero we try to find and its derivative.
 *
 * ccl_convert_concentration does the same thing for an
 * array of input concentrations.
 */

static double nfw_fx(double x)
{
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    return xp1*x*x*x*den;
  }
  else {
    return 2*x;
  }
}

static double nfw_f(double x,void *params)
{
  double offset = *((double *)params);
  return nfw_fx(x)-offset;
}

static double nfw_df(double x,void *params)
{
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    return x*x*(3*xp1*xp1*lxp1-x*(4*x+3))*den*den;
  }
  else {
    return 2;
  }
}

static void nfw_fdf(double x,void *params,
		    double *y, double *dy)
{
  double offset = *((double *)params);
  if(x>0.01) {
    double xp1=1+x;
    double lxp1=log(xp1);
    double den=1./(xp1*lxp1-x);
    *y=xp1*x*x*x*den-offset;
    *dy=x*x*(3*xp1*xp1*lxp1-x*(4*x+3))*den*den;
  }
  else {
    *y=2*x-offset;
    *dy=2;
  }
}

static int convert_concentration_single(double d_factor, double c_old,
					double *c_new, double c_start)
{
  double c0, offset = d_factor * nfw_fx(c_old);
  int status, iter=0, max_iter=100;
  gsl_function_fdf FDF;
  gsl_root_fdfsolver *s=NULL;
  FDF.f = &nfw_f;
  FDF.df = &nfw_df;
  FDF.fdf = &nfw_fdf;
  FDF.params = &offset;

  s=gsl_root_fdfsolver_alloc(gsl_root_fdfsolver_newton);
  if (s==NULL)
    return CCL_ERROR_MEMORY;

  gsl_root_fdfsolver_set (s, &FDF, c_start);
  *c_new = c_start;
  do
    {
      iter++;
      c0 = *c_new;
      status = gsl_root_fdfsolver_iterate (s);
      *c_new = gsl_root_fdfsolver_root (s);
      status = gsl_root_test_delta (*c_new, c0, 0, 1e-4);

    }
  while (status == GSL_CONTINUE && iter < max_iter);
  gsl_root_fdfsolver_free (s);

  return status;
}

void ccl_convert_concentration(ccl_cosmology *cosmo,
			       double delta_old, int nc, double c_old[],
			       double delta_new, double c_new[],int *status)
{
  if(nc<=0)
    return;

  int ii,st=0;
  double d_factor = delta_old/delta_new;
  for(ii=0;ii<nc;ii++) {
    double c_new_h;
    st=convert_concentration_single(d_factor, c_old[ii], &(c_new[ii]), c_old[ii]);
    if(st!=GSL_SUCCESS) {
      *status=CCL_ERROR_ROOT;
      ccl_cosmology_set_status_message(cosmo,
				       "ccl_mass_conversion.c: NR solver failed to find a root\n");
      return;
    }
  }
}