/* linalg/cholesky_band.c
 *
 * Copyright (C) 2018, 2019, 2020 Patrick Alken
 *
 * 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 <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_cblas.h>

static double cholesky_band_norm1(const gsl_matrix * A);
static int cholesky_band_Ainv(CBLAS_TRANSPOSE_t TransA, gsl_vector * x, void * params);

/*
gsl_linalg_cholesky_band_decomp()
  Cholesky decomposition of a square symmetric positive definite banded
matrix

Inputs: A - matrix in banded format, N-by-ndiag where N is the size of
            the matrix and ndiag is the number of nonzero diagonals.

Notes:
1) The main diagonal of the Cholesky factor is stored in the first column
of A; the first subdiagonal in the second column and so on.

2) If ndiag > 1, the 1-norm of A is stored in A(N,ndiag) on output

3) At each diagonal element, the matrix is factored as

A(j:end,j:end) = [ A11 A21^T ] = [ alpha  0 ] [ alpha v^T ]
                 [ A21 A22   ]   [   v    L ] [   0   L^T ]

where:

alpha = sqrt(A(j,j))
v = A(j+1:end, j) / alpha
A22 = L L^T + v v^T

So we start at A(1,1) and work right. Pseudo-code is:

loop j = 1, ..., N
  alpha = sqrt(A(j,j))
  A(j+1:end, j) := A(j+1:end, j) / alpha     (DSCAL)
  A(j+1:end, j+1:end) -= v v^T               (DSYR)

Due to the banded structure, v has at most p non-zero elements, where
p is the lower bandwidth
*/

int
gsl_linalg_cholesky_band_decomp(gsl_matrix * A)
{
  const size_t N = A->size1;     /* size of matrix */
  const size_t ndiag = A->size2; /* number of diagonals in band, including main diagonal */

  if (ndiag > N)
    {
      GSL_ERROR ("invalid matrix dimensions", GSL_EBADLEN);
    }
  else
    {
      const size_t p = ndiag - 1; /* lower bandwidth */
      const int kld = (int) GSL_MAX(1, p);
      size_t j;

      if (ndiag > 1)
        {
          /*
           * calculate 1-norm of A and store in lower right of matrix, which is not accessed
           * by rest of routine. gsl_linalg_cholesky_band_rcond() will use this later. If
           * A is diagonal, there is no empty slot to store the 1-norm, so the rcond routine
           * will have to reconstruct it from the Cholesky factor.
           */
          double Anorm = cholesky_band_norm1(A);
          gsl_matrix_set(A, N - 1, p, Anorm);
        }

      for (j = 0; j < N; ++j)
        {
          double ajj = gsl_matrix_get(A, j, 0);
          size_t lenv;

          if (ajj <= 0.0)
            {
              GSL_ERROR("matrix is not positive definite", GSL_EDOM);
            }

          ajj = sqrt(ajj);
          gsl_matrix_set(A, j, 0, ajj);

          /* number of elements in v, which will normally be p, unless we
           * are in lower right corner of matrix */
          lenv = GSL_MIN(p, N - j - 1);

          if (lenv > 0)
            {
              gsl_vector_view v = gsl_matrix_subrow(A, j, 1, lenv);
              gsl_matrix_view m = gsl_matrix_submatrix(A, j + 1, 0, lenv, lenv);

              gsl_blas_dscal(1.0 / ajj, &v.vector);

              m.matrix.tda = kld;
              gsl_blas_dsyr(CblasUpper, -1.0, &v.vector, &m.matrix);
            }
        }

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_cholesky_band_solve (const gsl_matrix * LLT,
                                const gsl_vector * b,
                                gsl_vector * x)
{
  if (LLT->size1 != b->size)
    {
      GSL_ERROR ("matrix size must match b size", GSL_EBADLEN);
    }
  else if (LLT->size1 != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else
    {
      int status;

      /* copy x <- b */
      gsl_vector_memcpy (x, b);

      status = gsl_linalg_cholesky_band_svx(LLT, x);

      return status;
    }
}

int
gsl_linalg_cholesky_band_svx (const gsl_matrix * LLT, gsl_vector * x)
{
  if (LLT->size1 != x->size)
    {
      GSL_ERROR ("matrix size must match solution size", GSL_EBADLEN);
    }
  else
    {
      /* solve for c using forward-substitution, L c = b */
      cblas_dtbsv(CblasColMajor, CblasLower, CblasNoTrans, CblasNonUnit,
                  (int) LLT->size1, (int) (LLT->size2 - 1), LLT->data, LLT->tda,
                  x->data, x->stride);

      /* perform back-substitution, L^T x = c */
      cblas_dtbsv(CblasColMajor, CblasLower, CblasTrans, CblasNonUnit,
                  (int) LLT->size1, (int) (LLT->size2 - 1), LLT->data, LLT->tda,
                  x->data, x->stride);

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_cholesky_band_solvem (const gsl_matrix * LLT,
                                 const gsl_matrix * B,
                                 gsl_matrix * X)
{
  if (LLT->size1 != B->size1)
    {
      GSL_ERROR ("LLT size1 must match B size1", GSL_EBADLEN);
    }
  else if (LLT->size1 != X->size1)
    {
      GSL_ERROR ("LLT size1 must match solution size1", GSL_EBADLEN);
    }
  else if (B->size2 != X->size2)
    {
      GSL_ERROR ("B size2 must match X size2", GSL_EBADLEN);
    }
  else
    {
      int status;

      /* copy X <- B */
      gsl_matrix_memcpy (X, B);

      status = gsl_linalg_cholesky_band_svxm(LLT, X);

      return status;
    }
}

int
gsl_linalg_cholesky_band_svxm (const gsl_matrix * LLT, gsl_matrix * X)
{
  if (LLT->size1 != X->size1)
    {
      GSL_ERROR ("LLT size1 must match solution size1", GSL_EBADLEN);
    }
  else
    {
      int status;
      const size_t nrhs = X->size2;
      size_t j;

      for (j = 0; j < nrhs; ++j)
        {
          gsl_vector_view xj = gsl_matrix_column(X, j);

          status = gsl_linalg_cholesky_band_svx (LLT, &xj.vector);
          if (status)
            return status;
        }

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_cholesky_band_invert (const gsl_matrix * LLT, gsl_matrix * Ainv)
{
  if (Ainv->size1 != Ainv->size2)
    {
      GSL_ERROR("Ainv must be square", GSL_ENOTSQR);
    }
  else if (LLT->size1 != Ainv->size1)
    {
      GSL_ERROR("cholesky matrix has different dimensions from Ainv", GSL_EBADLEN);
    }
  else
    {
      int status;

      /* unpack Cholesky factor into lower triangle of Ainv */
      status = gsl_linalg_cholesky_band_unpack(LLT, Ainv);
      if (status)
        return status;

      /* call the standard Cholesky inversion routine */
      status = gsl_linalg_cholesky_invert(Ainv);
      if (status)
        return status;

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_cholesky_band_unpack (const gsl_matrix * LLT, gsl_matrix * L)
{
  const size_t N = LLT->size1;

  if (N != L->size1)
    {
      GSL_ERROR("L matrix does not match LLT dimensions", GSL_EBADLEN);
    }
  else if (L->size1 != L->size2)
    {
      GSL_ERROR("L matrix is not square", GSL_ENOTSQR);
    }
  else
    {
      const size_t p = LLT->size2 - 1; /* lower bandwidth */
      size_t i;

      for (i = 0; i < p + 1; ++i)
        {
          gsl_vector_const_view v = gsl_matrix_const_subcolumn(LLT, i, 0, N - i);
          gsl_vector_view w = gsl_matrix_subdiagonal(L, i);

          gsl_vector_memcpy(&w.vector, &v.vector);
        }

      /* zero out remaining subdiagonals */
      for (i = p + 1; i < N; ++i)
        {
          gsl_vector_view w = gsl_matrix_subdiagonal(L, i);
          gsl_vector_set_zero(&w.vector);
        }

      return GSL_SUCCESS;
    }
}

int
gsl_linalg_cholesky_band_rcond (const gsl_matrix * LLT, double * rcond, gsl_vector * work)
{
  const size_t N = LLT->size1;

  if (work->size != 3 * N)
    {
      GSL_ERROR ("work vector must have length 3*N", GSL_EBADLEN);
    }
  else
    {
      int status;
      const size_t ndiag = LLT->size2;
      double Anorm;    /* ||A||_1 */
      double Ainvnorm; /* ||A^{-1}||_1 */

      if (ndiag == 1)
        {
          /* diagonal matrix, compute 1-norm since it has not been stored */
          gsl_vector_const_view v = gsl_matrix_const_column(LLT, 0);
          Anorm = gsl_vector_max(&v.vector);
          Anorm = Anorm * Anorm;
        }
      else
        {
          /* 1-norm is stored in A(N, ndiag) by gsl_linalg_cholesky_band_decomp() */
          Anorm = gsl_matrix_get(LLT, N - 1, ndiag - 1);
        }

      *rcond = 0.0;

      /* return if matrix is singular */
      if (Anorm == 0.0)
        return GSL_SUCCESS;

      status = gsl_linalg_invnorm1(N, cholesky_band_Ainv, (void *) LLT, &Ainvnorm, work);
      if (status)
        return status;

      if (Ainvnorm != 0.0)
        *rcond = (1.0 / Anorm) / Ainvnorm;

      return GSL_SUCCESS;
    }
}

/*
gsl_linalg_cholesky_band_scale()
  This function computes scale factors diag(S), such that

diag(S) A diag(S)

has a condition number within a factor N of the matrix
with the smallest condition number over all possible
diagonal scalings. See Corollary 7.6 of:

N. J. Higham, Accuracy and Stability of Numerical Algorithms (2nd Edition),
SIAM, 2002.

Inputs: A - symmetric positive definite matrix
        S - (output) scale factors, S_i = 1 / sqrt(A_ii)
*/

int
gsl_linalg_cholesky_band_scale(const gsl_matrix * A, gsl_vector * S)
{
  const size_t N = A->size1;     /* size of matrix */
  const size_t ndiag = A->size2; /* number of diagonals in band, including main diagonal */

  if (ndiag > N)
    {
      GSL_ERROR ("invalid matrix dimensions", GSL_EBADLEN);
    }
  else if (N != S->size)
    {
      GSL_ERROR("S must have length N", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      /* compute S_i = 1/sqrt(A_{ii}) */
      for (i = 0; i < N; ++i)
        {
          double Aii = gsl_matrix_get(A, i, 0);

          if (Aii <= 0.0)
            gsl_vector_set(S, i, 1.0); /* matrix not positive definite */
          else
            gsl_vector_set(S, i, 1.0 / sqrt(Aii));
        }

      return GSL_SUCCESS;
    }
}

/*
gsl_linalg_cholesky_band_scale_apply()
  This function applies scale transformation to A:

A <- diag(S) A diag(S)

Inputs: A - (input/output)
            on input, symmetric positive definite matrix in banded format
            on output, diag(S) * A * diag(S) in banded format
        S - (input) scale factors
*/

int
gsl_linalg_cholesky_band_scale_apply(gsl_matrix * A, const gsl_vector * S)
{
  const size_t N = A->size1;     /* size of matrix */
  const size_t ndiag = A->size2; /* number of diagonals in band, including main diagonal */

  if (ndiag > N)
    {
      GSL_ERROR ("invalid matrix dimensions", GSL_EBADLEN);
    }
  else if (N != S->size)
    {
      GSL_ERROR("S must have length N", GSL_EBADLEN);
    }
  else
    {
      size_t i, j;

      for (j = 0; j < N; ++j)
        {
          double sj = gsl_vector_get(S, j);

          for (i = j; i < GSL_MIN(N, j + ndiag); ++i)
            {
              double si = gsl_vector_get(S, i);
              double * ptr = gsl_matrix_ptr(A, j, i - j);
              *ptr *= sj * si;
            }
        }

      return GSL_SUCCESS;
    }
}

/* compute 1-norm of symmetric banded matrix */
static double
cholesky_band_norm1(const gsl_matrix * A)
{
  const size_t N = A->size1;
  const size_t ndiag = A->size2; /* number of diagonals in band, including main diagonal */
  double value;

  if (ndiag == 1)
    {
      /* diagonal matrix */
      gsl_vector_const_view v = gsl_matrix_const_column(A, 0);
      CBLAS_INDEX_t idx = gsl_blas_idamax(&v.vector);
      value = gsl_vector_get(&v.vector, idx);
    }
  else
    {
      size_t j;

      value = 0.0;
      for (j = 0; j < N; ++j)
        {
          size_t ncol = GSL_MIN(ndiag, N - j); /* number of elements in column j below and including main diagonal */
          gsl_vector_const_view v = gsl_matrix_const_subrow(A, j, 0, ncol);
          double sum = gsl_blas_dasum(&v.vector);
          size_t k, l;

          /* sum now contains the absolute sum of elements below and including main diagonal for column j; we
           * have to add the symmetric elements above the diagonal */
          k = j;
          l = 1;
          while (k > 0 && l < ndiag)
            {
              double Akl = gsl_matrix_get(A, --k, l++);
              sum += fabs(Akl);
            }

          value = GSL_MAX(value, sum);
        }
    }

  return value;
}

/* x := A^{-1} x = A^{-t} x, A = L L^T */
static int
cholesky_band_Ainv(CBLAS_TRANSPOSE_t TransA, gsl_vector * x, void * params)
{
  gsl_matrix * LLT = (gsl_matrix * ) params;

  (void) TransA; /* unused parameter warning */

  /* compute x := L^{-1} x */
  cblas_dtbsv(CblasColMajor, CblasLower, CblasNoTrans, CblasNonUnit,
              (int) LLT->size1, (int) (LLT->size2 - 1), LLT->data, LLT->tda,
              x->data, x->stride);

  /* compute x := L^{-T} x */
  cblas_dtbsv(CblasColMajor, CblasLower, CblasTrans, CblasNonUnit,
              (int) LLT->size1, (int) (LLT->size2 - 1), LLT->data, LLT->tda,
              x->data, x->stride);

  return GSL_SUCCESS;
}


/*
 # This file is part of the Astrometry.net suite.
 # Licensed under a 3-clause BSD style license - see LICENSE
 */

#include <assert.h>
#include <gsl/gsl_matrix_double.h>
#include <gsl/gsl_vector_double.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_errno.h>
#include <stdarg.h>

#include "os-features.h"
#include "gslutils.h"
#include "errors.h"

static void errhandler(const char * reason,
                       const char * file,
                       int line,
                       int gsl_errno) {
    ERROR("GSL error: \"%s\" in %s:%i (gsl errno %i = %s)",
          reason, file, line,
          gsl_errno,
          gsl_strerror(gsl_errno));
}

void gslutils_use_error_system() {
    gsl_set_error_handler(errhandler);
}

int gslutils_invert_3x3(const double* A, double* B) {
    gsl_matrix* LU;
    gsl_permutation *p;
    gsl_matrix_view mB;
    int rtn = 0;
    int signum;

    p = gsl_permutation_alloc(3);
    gsl_matrix_const_view mA = gsl_matrix_const_view_array(A, 3, 3);
    mB = gsl_matrix_view_array(B, 3, 3);
    LU = gsl_matrix_alloc(3, 3);

    gsl_matrix_memcpy(LU, &mA.matrix);
    if (gsl_linalg_LU_decomp(LU, p, &signum) ||
        gsl_linalg_LU_invert(LU, p, &mB.matrix)) {
        ERROR("gsl_linalg_LU_decomp() or _invert() failed.");
        rtn = -1;
    }

    gsl_permutation_free(p);
    gsl_matrix_free(LU);
    return rtn;
}

void gslutils_matrix_multiply(gsl_matrix* C,
                              const gsl_matrix* A, const gsl_matrix* B) {
    gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, A, B, 0.0, C);
}

int gslutils_solve_leastsquares_v(gsl_matrix* A, int NB, ...) {
    int i, res;
    gsl_vector**  B = malloc(NB * sizeof(gsl_vector*));
    // Whoa, three-star programming!
    gsl_vector*** X = malloc(NB * sizeof(gsl_vector**));
    gsl_vector*** R = malloc(NB * sizeof(gsl_vector**));

    gsl_vector** Xtmp = malloc(NB * sizeof(gsl_vector*));
    gsl_vector** Rtmp = malloc(NB * sizeof(gsl_vector*));

    va_list va;
    va_start(va, NB);
    for (i=0; i<NB; i++) {
        B[i] = va_arg(va, gsl_vector*);
        X[i] = va_arg(va, gsl_vector**);
        R[i] = va_arg(va, gsl_vector**);
    }
    va_end(va);

    res = gslutils_solve_leastsquares(A, B, Xtmp, Rtmp, NB);
    for (i=0; i<NB; i++) {
        if (X[i])
            *(X[i]) = Xtmp[i];
        else
            gsl_vector_free(Xtmp[i]);
        if (R[i])
            *(R[i]) = Rtmp[i];
        else
            gsl_vector_free(Rtmp[i]);
    }
    free(Xtmp);
    free(Rtmp);
    free(X);
    free(R);
    free(B);
    return res;
}

int gslutils_solve_leastsquares(gsl_matrix* A, gsl_vector** B,
                                gsl_vector** X, gsl_vector** resids,
                                int NB) {
    int i;
    gsl_vector *tau, *resid = NULL;
    Unused int ret;
    int M, N;

    M = A->size1;
    N = A->size2;

    for (i=0; i<NB; i++) {
        assert(B[i]);
        assert(B[i]->size == M);
    }

    tau = gsl_vector_alloc(MIN(M, N));
    assert(tau);

    ret = gsl_linalg_QR_decomp(A, tau);
    assert(ret == 0);
    // A,tau now contains a packed version of Q,R.

    for (i=0; i<NB; i++) {
        if (!resid) {
            resid = gsl_vector_alloc(M);
            assert(resid);
        }
        X[i] = gsl_vector_alloc(N);
        assert(X[i]);
        ret = gsl_linalg_QR_lssolve(A, tau, B[i], X[i], resid);
        assert(ret == 0);
        if (resids) {
            resids[i] = resid;
            resid = NULL;
        }
    }

    gsl_vector_free(tau);
    if (resid)
        gsl_vector_free(resid);

    return 0;
}


/**
  * Copyright 2019 José Manuel Abuín Mosquera <josemanuel.abuin@usc.es>
  *
  * This file is part of Matrix Market Suite.
  *
  * Matrix Market Suite 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.
  *
  * Matrix Market Suite 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 Matrix Market Suite. If not, see <http://www.gnu.org/licenses/>.
  */

#include <cblas.h>
#include "ConjugateGradientSolver.h"

int ConjugateGradientSolver(unsigned long *II, unsigned long *J, double *A, unsigned long M, unsigned long N, unsigned long long nz, double *b, unsigned long M_Vector, unsigned long N_Vector, unsigned long long nz_vector, double *x, int iterationNumber) {

	//A*x=b

        double *Ap=(double *) malloc(nz_vector * sizeof(double));
        double *r=(double *) malloc(nz_vector * sizeof(double));
        double *p=(double *) malloc(nz_vector * sizeof(double));
	//double *x=(double *) calloc(nz_vector,sizeof(double));

	//r = b-A*x
	//If we take x=0 the init multiplication is avoided and r=b

	memcpy(r, b, N*sizeof(double));

	//p=r

	memcpy(p, r, N*sizeof(double));

	//rsold = r*r
	double rsold = cblas_ddot(N,r,1,r,1);

	int stop = 0;

	double alphaCG = 0.0;

	double rsnew = 0.0;
	unsigned long k = 0;

	unsigned long maxIterations = M*2;

	if(iterationNumber != 0 ){
		maxIterations = iterationNumber;
	}

	//int i  = 0;

	while(!stop){

		//Ap=A*p
		// for(i=0; i<M; i++){
		//	Ap[i] = 0.0;
		// }
		cblas_dgemv(CblasRowMajor, CblasNoTrans, M,N , 1.0, A, N, p, 1, 0.0, Ap, 1);

		//alphaCG=rsold/(p'*Ap)
		alphaCG = rsold/cblas_ddot(N,p,1,Ap,1);

		//x=x+alphaCG*p
		cblas_daxpy(N,alphaCG,p,1,x,1);

		//r=r-alphaCG*Ap
		cblas_daxpy(N,-alphaCG,Ap,1,r,1);

		//rsnew = r'*r
		rsnew = cblas_ddot(N,r,1,r,1);

		if((sqrt(rsnew)<=EPSILON)||(k == maxIterations)){
			stop = 1;
		}

		//p=r+rsnew/rsold*p
		cblas_dscal(N, rsnew/rsold, p, 1);
		cblas_daxpy(N,1.0,r,1,p,1);

		rsold = rsnew;

		k++;
	}

	//memcpy(b, x, N*sizeof(double));

        free(Ap);
        free(r);
        free(p);
	//free(x);

	fprintf(stderr, "[%s] Number of iterations %lu\n",__func__,k);

	return 1;
}


/* SO3.c */

// SO(3) Lie group implemented with GNU GSL
// cf. wikipedia, "Rotation_group_SO(3)#Infinitesimal_rotations"

// EY note : 20160519 Bizarrely, matrix multiplication isn't implemented in a straightforward manner with the gsl_matrix class; see blas (which I don't know what it is yet) and dgemm for the libraries, and SO3blas.c in this repo for that implementation

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

// Function prototype
// gsl_matrix commute(gsl_matrix, gsl_matrix);

int main(void)
{
  gsl_matrix *L_x = gsl_matrix_calloc(3,3);
  gsl_matrix *L_y = gsl_matrix_calloc(3,3);
  gsl_matrix *L_z = gsl_matrix_calloc(3,3);

  gsl_matrix_set(L_x,1,2,-1);
  gsl_matrix_set(L_x,2,1,1);

  gsl_matrix_set(L_y,0,2,1);
  gsl_matrix_set(L_y,2,0,-1);

  gsl_matrix_set(L_z,0,1,-1);
  gsl_matrix_set(L_z,1,0,1);

  for (int i=0;i<3;i++)
    for (int j=0;j<3;j++)
      printf("m(%d,%d) = %g\n", i, j,
	     gsl_matrix_get(L_x,i,j));

  for (int i=0;i<3;i++)
    for (int j=0;j<3;j++)
      printf("m(%d,%d) = %g\n", i, j,
	     gsl_matrix_get(L_y,i,j));

 for (int i=0;i<3;i++)
   for (int j=0;j<3;j++)
      printf("m(%d,%d) = %g\n", i, j,
	     gsl_matrix_get(L_z,i,j));

  gsl_matrix_free(L_x);
  gsl_matrix_free(L_y);
  gsl_matrix_free(L_z);

  return 0;
}

//gsl_matrix commute(gsl_matrix x, gsl_matrix y)
//{

//}


#include <stdio.h>
#include <stdlib.h>
#include <cblas.h>
#include "matrix.h"

void Matrix_Multiply(Matrix a, Matrix b, Matrix c) {
    /* for dimentions:
     * a[m*k],b[k*n],c[m*n]
     * We use:
     * RowMajor, NoTrans, NoTrans, m, n, k, 1, A, k, B, n, 0, C, n);
     */

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, a.rows, b.cols, a.cols,
                1, a.values, a.cols, b.values, b.cols, 0, c.values, b.cols);
}

void Matrix_Print(Matrix m) {
    printf("=====\n");
    printf("rows: %lld, columns: %lld\n", m.rows, m.cols);
    for (int i = 0; i < m.rows; i++) {
        for (int j = 0; j < m.cols; j++) {
            printf("%lf ", m.values[i * m.cols + j]);
        }
        printf("\n");
    }
}

void Matrix_Add(Matrix a, Matrix b, Matrix c) {
    for (int i = 0; i < a.rows * a.cols; i++) {
        c.values[i] = a.values[i] + b.values[i];
    }
}

void Matrix_Scale(Matrix a, double n) {
    cblas_dscal(a.rows * a.cols, n, a.values, 1);
}

void Matrix_Test(void) {
    double *A, *B, *C;
    int m, n, k, i;
    double alpha, beta;
    m = 2000, k = 200, n = 1000;
    printf(
            " Initializing data for matrix multiplication C=A*B for matrix \n"
                    " A(%ix%i) and matrix B(%ix%i)\n",
            m, k, k, n);
    alpha = 1.0;
    beta = 0.0;

    A = (double *) malloc(m * k * sizeof(double));
    B = (double *) malloc(k * n * sizeof(double));
    C = (double *) malloc(m * n * sizeof(double));
    if (A == NULL || B == NULL || C == NULL) {
        printf("\n ERROR: Can't allocate memory for matrices. Aborting... \n\n");
        free(A);
        free(B);
        free(C);
        return;
    }

    printf(" Intializing matrix data \n");
    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[i] = 0.0;
    }

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans, m, n, k, alpha, A, k,
                B, n, beta, C, n);
    printf("\n Computations completed.\n");
    free(A);
    free(B);
    free(C);
}


/* fft/hc_main.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 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 <stdlib.h>
#include <math.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_fft_halfcomplex.h>

#include "hc_pass.h"

int
FUNCTION(gsl_fft_halfcomplex,backward) (BASE data[], const size_t stride,
                                        const size_t n,
                                        const TYPE(gsl_fft_halfcomplex_wavetable) * wavetable,
                                        TYPE(gsl_fft_real_workspace) * work)
{
  int status = FUNCTION(gsl_fft_halfcomplex,transform) (data, stride, n, wavetable, work) ;
  return status ;
}

int
FUNCTION(gsl_fft_halfcomplex,inverse) (BASE data[], const size_t stride,
                                       const size_t n,
                                       const TYPE(gsl_fft_halfcomplex_wavetable) * wavetable,
                                       TYPE(gsl_fft_real_workspace) * work)
{
  int status = FUNCTION(gsl_fft_halfcomplex,transform) (data, stride, n, wavetable, work);

  if (status)
    {
      return status;
    }

  /* normalize inverse fft with 1/n */

  {
    const double norm = 1.0 / n;
    size_t i;
    for (i = 0; i < n; i++)
      {
        data[stride*i] *= norm;
      }
  }
  return status;
}

int
FUNCTION(gsl_fft_halfcomplex,transform) (BASE data[], const size_t stride, const size_t n,
                                         const TYPE(gsl_fft_halfcomplex_wavetable) * wavetable,
                                         TYPE(gsl_fft_real_workspace) * work)
{
  BASE * const scratch = work->scratch;

  BASE * in;
  BASE * out;
  size_t istride, ostride ;

  size_t factor, product, q;
  size_t i;
  size_t nf;
  int state;
  int product_1;
  int tskip;
  TYPE(gsl_complex) *twiddle1, *twiddle2, *twiddle3, *twiddle4;

  if (n == 0)
    {
      GSL_ERROR ("length n must be positive integer", GSL_EDOM);
    }

  if (n == 1)
    {                           /* FFT of one data point is the identity */
      return 0;
    }

  if (n != wavetable->n)
    {
      GSL_ERROR ("wavetable does not match length of data", GSL_EINVAL);
    }

  if (n != work->n)
    {
      GSL_ERROR ("workspace does not match length of data", GSL_EINVAL);
    }

  nf = wavetable->nf;
  product = 1;
  state = 0;

  for (i = 0; i < nf; i++)
    {
      factor = wavetable->factor[i];
      product_1 = product;
      product *= factor;
      q = n / product;

      tskip = (q + 1) / 2 - 1;

      if (state == 0)
        {
          in = data;
          istride = stride;
          out = scratch;
          ostride = 1;
          state = 1;
        }
      else
        {
          in = scratch;
          istride = 1;
          out = data;
          ostride = stride;
          state = 0;
        }

      if (factor == 2)
        {
          twiddle1 = wavetable->twiddle[i];
          FUNCTION(fft_halfcomplex,pass_2) (in, istride, out, ostride,
                                            product, n, twiddle1);
        }
      else if (factor == 3)
        {
          twiddle1 = wavetable->twiddle[i];
          twiddle2 = twiddle1 + tskip;
          FUNCTION(fft_halfcomplex,pass_3) (in, istride, out, ostride,
                                            product, n, twiddle1, twiddle2);
        }
      else if (factor == 4)
        {
          twiddle1 = wavetable->twiddle[i];
          twiddle2 = twiddle1 + tskip;
          twiddle3 = twiddle2 + tskip;
          FUNCTION(fft_halfcomplex,pass_4) (in, istride, out, ostride,
                                            product, n, twiddle1, twiddle2,
                                            twiddle3);
        }
      else if (factor == 5)
        {
          twiddle1 = wavetable->twiddle[i];
          twiddle2 = twiddle1 + tskip;
          twiddle3 = twiddle2 + tskip;
          twiddle4 = twiddle3 + tskip;
          FUNCTION(fft_halfcomplex,pass_5) (in, istride, out, ostride,
                                            product, n, twiddle1, twiddle2,
                                            twiddle3, twiddle4);
        }
      else
        {
          twiddle1 = wavetable->twiddle[i];
          FUNCTION(fft_halfcomplex,pass_n) (in, istride, out, ostride,
                                            factor, product, n, twiddle1);
        }
    }

  if (state == 1)               /* copy results back from scratch to data */
    {
      for (i = 0; i < n; i++)
        {
          data[stride*i] = scratch[i] ;
        }
    }

  return 0;

}


#ifndef SIR_H
#define SIR_H

#include <gsl/gsl_odeiv.h>
#include <gsl/gsl_errno.h>
#include <iostream>
#include "DiffEq_Sim.h"

using namespace std;

class SIR : public DiffEq_Sim {

    private:
        const double beta;
        const double gamma;

    public:
        SIR() : beta(0.0), gamma(0.0) { nbins=3;}
        SIR(double b, double g): beta(b), gamma(g) { nbins=3; }
        ~SIR() {};

        void initialize( double S, double I, double R) {
            y = new double[nbins];
            y[0] = S; y[1] = I; y[2] = R;
        }

        void derivative(double const y[], double dydt[]) {
            dydt[0] = -beta*y[0]*y[1];
            dydt[1] = +beta*y[0]*y[1] - gamma*y[1];
            dydt[2] = +gamma*y[1];
        }

};

#endif


#pragma once

#include "rev/Utilities.h"
#include <algorithm>
#include <cstddef>
#include <glm/glm.hpp>
#include <gsl/gsl_assert>
#include <gsl/span>
#include <limits>
#include <vector>

namespace rev {

template <typename PointType>
struct WeightedControlPoint {
    PointType point;
    typename PointType::value_type weight;
};

template <typename PointType>
class NurbsCurve {
public:
    using ControlPointType = WeightedControlPoint<PointType>;
    using ValueType = typename PointType::value_type;

    NurbsCurve(size_t order, gsl::span<const ValueType> knots,
        gsl::span<const ControlPointType> controlPoints)
        : _order(order)
        , _knots(knots.begin(), knots.end())
        , _controlPoints(controlPoints.begin(), controlPoints.end())
    {
        Expects(order > 1);
        Expects(static_cast<size_t>(controlPoints.size()) >= order);
        Expects(knots.size() == (controlPoints.size() + order));
    }

    ValueType getStart() const { return _knots.front(); }

    ValueType getEnd() const { return _knots.back(); }

    PointType operator[](ValueType position) const
    {
        auto knotsBegin = _knots.begin();
        auto knotsEnd = _knots.end();
        auto spanStart = std::lower_bound(knotsBegin, knotsEnd, position);
        size_t controlPointIndex = std::distance(knotsBegin, spanStart);
        if (controlPointIndex == 0) {
            // Before the first knot. Just return the value of the first control
            // point.
            return _controlPoints.front().point;
        }

        if (spanStart == knotsEnd) {
            // We're past the last knot. Just return the value of the last control
            // point.
            return _controlPoints.back().point;
        }

        size_t controlPointsToProcess = _order;
        size_t controlPointCount = _controlPoints.size();
        if (controlPointIndex > controlPointCount) {
            controlPointsToProcess -= (controlPointIndex - controlPointCount);
        }

        PointType numerator{ 0 };
        ValueType denominator{ 0 };
        do {
            controlPointIndex--;
            auto& controlPoint = _controlPoints[controlPointIndex];
            ValueType weightedBasis
                = basisValue(position, controlPointIndex, _order) * controlPoint.weight;
            numerator += weightedBasis * _controlPoints[controlPointIndex].point;
            denominator += weightedBasis;
            controlPointsToProcess--;
        } while (controlPointIndex && controlPointsToProcess);
        return numerator / denominator;
    }

private:
    ValueType basisValue(ValueType position, size_t controlPointIndex, size_t order) const
    {
        auto& controlPoint = _controlPoints[controlPointIndex];
        ValueType firstKnot = _knots[controlPointIndex];
        ValueType lastKnot = _knots[controlPointIndex + order];
        if (order == 2) {
            // Triangle function
            ValueType middleKnot = _knots[controlPointIndex + 1];
            if (position < middleKnot) {
                return rampUp(position, firstKnot, middleKnot);
            } else {
                return rampDown(position, middleKnot, lastKnot);
            }
        } else {
            size_t lowerOrder = order - 1;
            ValueType secondKnot = _knots[controlPointIndex + 1];
            ValueType secondToLastKnot = _knots[controlPointIndex + lowerOrder];

            ValueType result{ 0 };
            if (position < secondToLastKnot) {
                result += rampUp(position, firstKnot, secondToLastKnot)
                    * basisValue(position, controlPointIndex, lowerOrder);
            }

            if (position > secondKnot) {
                result += rampDown(position, secondKnot, lastKnot)
                    * basisValue(position, controlPointIndex + 1, lowerOrder);
            }

            return result;
        }
    }

    ValueType rampUp(ValueType value, ValueType bottom, ValueType top) const
    {
        if (nearEqual(top, bottom)) {
            return 0.5;
        }
        return (value - bottom) / (top - bottom);
    }

    ValueType rampDown(ValueType value, ValueType bottom, ValueType top) const
    {
        if (nearEqual(top, bottom)) {
            return 0.5;
        }
        return (top - value) / (top - bottom);
    }

    size_t _order;
    std::vector<ValueType> _knots;
    std::vector<ControlPointType> _controlPoints;
};
} // namespace rev


/* specfunc/gegenbauer.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_gegenbauer.h"

#include "error.h"

/* See: [Thompson, Atlas for Computing Mathematical Functions] */

int
gsl_sf_gegenpoly_1_e(double lambda, double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(lambda == 0.0) {
    result->val = 2.0*x;
    result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    result->val = 2.0*lambda*x;
    result->err = 4.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
}

int
gsl_sf_gegenpoly_2_e(double lambda, double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(lambda == 0.0) {
    const double txx = 2.0*x*x;
    result->val  = -1.0 + txx;
    result->err  = 2.0 * GSL_DBL_EPSILON * fabs(txx);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    result->val = lambda*(-1.0 + 2.0*(1.0+lambda)*x*x);
    result->err = GSL_DBL_EPSILON * (2.0 * fabs(result->val) + fabs(lambda));
    return GSL_SUCCESS;
  }
}

int
gsl_sf_gegenpoly_3_e(double lambda, double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(lambda == 0.0) {
    result->val = x*(-2.0 + 4.0/3.0*x*x);
    result->err = GSL_DBL_EPSILON * (2.0 * fabs(result->val) + fabs(x));
    return GSL_SUCCESS;
  }
  else {
    double c = 4.0 + lambda*(6.0 + 2.0*lambda);
    result->val = 2.0*lambda * x * ( -1.0 - lambda + c*x*x/3.0 );
    result->err = GSL_DBL_EPSILON * (2.0 * fabs(result->val) + fabs(lambda * x));
    return GSL_SUCCESS;
  }
}

int
gsl_sf_gegenpoly_n_e(int n, double lambda, double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(lambda <= -0.5 || n < 0) {
    DOMAIN_ERROR(result);
  }
  else if(n == 0) {
    result->val = 1.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else if(n == 1) {
    return gsl_sf_gegenpoly_1_e(lambda, x, result);
  }
  else if(n == 2) {
    return gsl_sf_gegenpoly_2_e(lambda, x, result);
  }
  else if(n == 3) {
    return gsl_sf_gegenpoly_3_e(lambda, x, result);
  }
  else {
    if(lambda == 0.0 && (x >= -1.0 || x <= 1.0)) {
      /* 2 T_n(x)/n */
      const double z = n * acos(x);
      result->val = 2.0 * cos(z) / n;
      result->err = 2.0 * GSL_DBL_EPSILON * fabs(z * result->val);
      return GSL_SUCCESS;
    }
    else {
      int k;
      gsl_sf_result g2;
      gsl_sf_result g3;
      int stat_g2 = gsl_sf_gegenpoly_2_e(lambda, x, &g2);
      int stat_g3 = gsl_sf_gegenpoly_3_e(lambda, x, &g3);
      int stat_g  = GSL_ERROR_SELECT_2(stat_g2, stat_g3);
      double gkm2 = g2.val;
      double gkm1 = g3.val;
      double gk = 0.0;
      for(k=4; k<=n; k++) {
        gk = (2.0*(k+lambda-1.0)*x*gkm1 - (k+2.0*lambda-2.0)*gkm2) / k;
	gkm2 = gkm1;
	gkm1 = gk;
      }
      result->val = gk;
      result->err = 2.0 * GSL_DBL_EPSILON * 0.5 * n * fabs(gk);
      return stat_g;
    }
  }
}

int
gsl_sf_gegenpoly_array(int nmax, double lambda, double x, double * result_array)
{
  int k;

  /* CHECK_POINTER(result_array) */

  if(lambda <= -0.5 || nmax < 0) {
    GSL_ERROR("domain error", GSL_EDOM);
  }

  /* n == 0 */
  result_array[0] = 1.0;
  if(nmax == 0) return GSL_SUCCESS;

  /* n == 1 */
  if(lambda == 0.0)
    result_array[1] = 2.0*x;
  else
    result_array[1] = 2.0*lambda*x;

  /* n <= nmax */
  for(k=2; k<=nmax; k++) {
    double term1 = 2.0*(k+lambda-1.0) * x * result_array[k-1];
    double term2 = (k+2.0*lambda-2.0)	  * result_array[k-2];
    result_array[k] = (term1 - term2) / k;
  }

  return GSL_SUCCESS;
}

/*-*-*-*-*-*-*-*-*-* Functions w/ Natural Prototypes *-*-*-*-*-*-*-*-*-*-*/

#include "eval.h"

double gsl_sf_gegenpoly_1(double lambda, double x)
{
  EVAL_RESULT(gsl_sf_gegenpoly_1_e(lambda, x, &result));
}

double gsl_sf_gegenpoly_2(double lambda, double x)
{
  EVAL_RESULT(gsl_sf_gegenpoly_2_e(lambda, x, &result));
}

double gsl_sf_gegenpoly_3(double lambda, double x)
{
  EVAL_RESULT(gsl_sf_gegenpoly_3_e(lambda, x, &result));
}

double gsl_sf_gegenpoly_n(int n, double lambda, double x)
{
  EVAL_RESULT(gsl_sf_gegenpoly_n_e(n, lambda, x, &result));
}


/* min/golden.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 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.
 */

/* goldensection.c -- goldensection minimum finding algorithm */

#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_min.h>

#include "min.h"

typedef struct
  {
    double dummy;
  }
goldensection_state_t;

static int goldensection_init (void * vstate, gsl_function * f, double x_minimum, double f_minimum, double x_lower, double f_lower, double x_upper, double f_upper);
static int goldensection_iterate (void * vstate, gsl_function * f, double * x_minimum, double * f_minimum, double * x_lower, double * f_lower, double * x_upper, double * f_upper);

static int
goldensection_init (void * vstate, gsl_function * f, double x_minimum, double f_minimum, double x_lower, double f_lower, double x_upper, double f_upper)
{
  goldensection_state_t * state = (goldensection_state_t *) vstate;

  /* no initialization required, prevent warnings about unused variables */

  state = 0;
  f = 0;
  x_minimum = 0;
  f_minimum = 0;
  x_lower = 0;
  f_lower = 0;
  x_upper = 0;
  f_upper = 0;

  return GSL_SUCCESS;
}

static int
goldensection_iterate (void * vstate, gsl_function * f, double * x_minimum, double * f_minimum, double * x_lower, double * f_lower, double * x_upper, double * f_upper)
{
  goldensection_state_t * state = (goldensection_state_t *) vstate;

  const double x_center = *x_minimum ;
  const double x_left = *x_lower ;
  const double x_right = *x_upper ;

  const double f_min = *f_minimum;

  const double golden = 0.3819660; /* golden = (3 - sqrt(5))/2 */

  const double w_lower = (x_center - x_left);
  const double w_upper = (x_right - x_center);

  double x_new, f_new;

  state = 0 ; /* avoid warning about unused parameters */

  x_new = x_center + golden * ((w_upper > w_lower) ? w_upper : -w_lower) ;

  SAFE_FUNC_CALL (f, x_new, &f_new);

  if (f_new < f_min)
    {
      *x_minimum = x_new ;
      *f_minimum = f_new ;
      return GSL_SUCCESS;
    }
  else if (x_new < x_center && f_new > f_min)
    {
      *x_lower = x_new ;
      *f_lower = f_new ;
      return GSL_SUCCESS;
    }
  else if (x_new > x_center && f_new > f_min)
    {
      *x_upper = x_new ;
      *f_upper = f_new ;
      return GSL_SUCCESS;
    }
  else
    {
      return GSL_FAILURE;
    }
}

static const gsl_min_fminimizer_type goldensection_type =
{"goldensection",                               /* name */
 sizeof (goldensection_state_t),
 &goldensection_init,
 &goldensection_iterate};

const gsl_min_fminimizer_type  * gsl_min_fminimizer_goldensection = &goldensection_type;


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

#include <ndlinear/gsl_multifit_ndlinear.h>

#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_laguerre.h>
#include <gsl/gsl_sf_legendre.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_multifit.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_bspline.h>
#include <gsl/gsl_statistics.h>

/* dimension of fit */
#define N_DIM            3

/* number of basis functions for each variable */
#define N_SUM_R          10
#define N_SUM_THETA      10
#define N_SUM_PHI        9

#define R_MAX            3.0

double
psi_real_exact(int k, int l, int m, double r, double theta, double phi)
{
  double R, T, P;

  R = pow(r, (double) l) *
      exp(-r*r) *
      gsl_sf_laguerre_n(k, l + 0.5, 2 * r * r);
  T = gsl_sf_legendre_sphPlm(l, m, cos(theta));
  P = cos(m * phi);

  return (R * T * P);
}

/* basis functions for each variable */

int
basis_r(double r, double y[], void *params)
{
  gsl_bspline_workspace *bw = params;
  gsl_vector_view v = gsl_vector_view_array(y, N_SUM_R);
  int s;

  /* use B-splines for r dependence */
  s = gsl_bspline_eval(r, &v.vector, bw);

  return s;
}

int
basis_theta(double theta, double y[], void *params)
{
  size_t i;

  /* use Legendre polynomials for theta dependence */
  for (i = 0; i < N_SUM_THETA; ++i)
    y[i] = gsl_sf_legendre_Pl(i, cos(theta));

  return GSL_SUCCESS;
}

int
basis_phi(double phi, double y[], void *params)
{
  size_t i;

  /* use standard Fourier basis (sin/cos) for phi dependence */
  for (i = 0; i < N_SUM_PHI; ++i)
    {
      if ((i % 2) == 0)
        y[i] = cos((double)(i/2) * phi);
      else
        y[i] = sin((double)((i+1)/2) * phi);
    }

  return GSL_SUCCESS;
}

int
main(int argc, char *argv[])
{
  const size_t ndim = N_DIM; /* dimension of fit */
  const size_t ndata = 3000; /* number of data points to fit */
  size_t N[N_DIM];           /* upper bounds on model sums */
  int (*u[N_DIM])(double x, double y[], void *params);
  size_t i;                  /* looping */
  int k, l, m;               /* quantum numbers */
  gsl_rng *rng_p;
  gsl_bspline_workspace *bspline_p;
  gsl_multifit_linear_workspace *multifit_p;
  gsl_multifit_ndlinear_workspace *ndlinear_p;
  gsl_vector *data;          /* psi data */
  gsl_matrix *vars;          /* parameters corresponding to psi data */
  gsl_matrix *X;             /* matrix for least squares fit */
  gsl_vector *coeffs;        /* fit coefficients */
  gsl_matrix *cov;           /* covariance matrix */
  double chisq;              /* chi^2 */
  double Rsq;                /* R^2 */
  size_t ncoeffs;            /* total number of fit coefficients */

  gsl_rng_env_setup();

  k = 5;
  l = 4;
  m = 2;

  N[0] = N_SUM_R;
  N[1] = N_SUM_THETA;
  N[2] = N_SUM_PHI;

  u[0] = &basis_r;
  u[1] = &basis_theta;
  u[2] = &basis_phi;

  rng_p = gsl_rng_alloc(gsl_rng_default);
  bspline_p = gsl_bspline_alloc(4, N_SUM_R - 2);
  ndlinear_p = gsl_multifit_ndlinear_alloc(ndim, N, u, bspline_p);

  ncoeffs = gsl_multifit_ndlinear_ncoeffs(ndlinear_p);

  multifit_p = gsl_multifit_linear_alloc(ndata, ncoeffs);
  data = gsl_vector_alloc(ndata);
  vars = gsl_matrix_alloc(ndata, ndim);
  X = gsl_matrix_alloc(ndata, ncoeffs);
  coeffs = gsl_vector_alloc(ncoeffs);
  cov = gsl_matrix_alloc(ncoeffs, ncoeffs);

  gsl_bspline_knots_uniform(0.0, R_MAX, bspline_p);

  /* this is the data to be fitted */

  for (i = 0; i < ndata; ++i)
    {
      double r = gsl_rng_uniform(rng_p) * R_MAX;
      double theta = gsl_rng_uniform(rng_p) * M_PI;
      double phi = gsl_rng_uniform(rng_p) * 2.0 * M_PI;
      double psi = psi_real_exact(k, l, m, r, theta, phi);
      double dpsi = gsl_ran_gaussian(rng_p, 0.05 * psi);

      /* keep track of (r, theta, phi) points */
      gsl_matrix_set(vars, i, 0, r);
      gsl_matrix_set(vars, i, 1, theta);
      gsl_matrix_set(vars, i, 2, phi);

      /* fill in RHS data vector */
      gsl_vector_set(data, i, psi + dpsi);
    }

  /* construct the design matrix X */
  gsl_multifit_ndlinear_design(vars, X, ndlinear_p);

  /* now do the actual least squares fit */
  gsl_multifit_linear(X, data, coeffs, cov, &chisq, multifit_p);

  /* compute R^2 */
  Rsq = 1.0 - chisq / gsl_stats_tss(data->data, 1, data->size);

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

  /* now print out the model and the exact solution and compute rms error */
  {
    double eps_rms = 0.0;
    double volume = 0.0;
    double r, theta, phi;
    double dr = 0.05;
    double dtheta = 5.0 * M_PI / 180.0;
    double dphi = 5.0 * M_PI / 180.0;
    double x[N_DIM];
    gsl_vector_view xv = gsl_vector_view_array(x, N_DIM);
    double psi;
    double psi_model;
    double err;

    for (r = 0.01; r < R_MAX; r += dr)
      {
        for (theta = 0.0; theta < M_PI; theta += dtheta)
          {
            for (phi = 0.0; phi < 2.0 * M_PI; phi += dphi)
              {
                double dV = r * r * sin(theta) * dr * dtheta * dphi;

                x[0] = r;
                x[1] = theta;
                x[2] = phi;

                /* compute model value for this (r, theta, phi) */
                psi_model = gsl_multifit_ndlinear_calc(&xv.vector,
                                                       coeffs,
                                                       ndlinear_p);

                /* compute exact value for this (r, theta, phi) */
                psi = psi_real_exact(k, l, m, r, theta, phi);

                err = psi_model - psi;
                eps_rms += err * err * dV;
                volume += dV;

                if (phi == 0.0)
                  printf("%e %e %e %e\n", r, theta, psi, psi_model);
              }
          }
        printf("\n");
      }

    eps_rms /= volume;
    eps_rms = sqrt(eps_rms);
    fprintf(stderr, "rms error over all parameter space = %e\n", eps_rms);
  }

  gsl_rng_free(rng_p);
  gsl_bspline_free(bspline_p);
  gsl_multifit_ndlinear_free(ndlinear_p);
  gsl_multifit_linear_free(multifit_p);
  gsl_vector_free(data);
  gsl_matrix_free(vars);
  gsl_matrix_free(X);
  gsl_vector_free(coeffs);
  gsl_matrix_free(cov);

  return 0;
} /* main() */


#include <mpi.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_math.h>

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

/*! \file second_order.c
 *  \brief produce actual ICs from special 2nd order lpt ICs
 */

double F1_Omega(double a)
{
  double omega_a;

  omega_a = All.Omega0 / (All.Omega0 + a * (1 - All.Omega0 - All.OmegaLambda) + a * a * a * All.OmegaLambda);

  return pow(omega_a, 5.0 / 9);
}

double F2_Omega(double a)
{
  double omega_a;

  omega_a = All.Omega0 / (All.Omega0 + a * (1 - All.Omega0 - All.OmegaLambda) + a * a * a * All.OmegaLambda);

  return 2.0 * pow(omega_a, 6.0 / 11);
}

void second_order_ics(void)
{
  int i, j;
  double a, hubble, fac1, fac2, fac3;
  double ax, ay, az;

  if(ThisTask == 0)
    {
      printf("\nNow producing ICs based on 2nd-order LPT\n\n");
      fflush(stdout);
    }

  a = All.TimeBegin;

  hubble = hubble_function(a);

  fac1 = 1.0 / (a * a * hubble * F1_Omega(a));	/* this factor converts the Zeldovich peculiar velocity
						   (expressed as  a^2*dX/dt  to comoving displacement */
  fac2 = header.lpt_scalingfactor;

  fac3 = fac2 * a * a * hubble * F2_Omega(a);

  if(ThisTask == 0)
    printf("fac1=%g  fac2=%g  fac3=%g\n", fac1, fac2, fac3);

  for(i = 0; i < NumPart; i++)
    {
      for(j = 0; j < 3; j++)
	P[i].Pos[j] += fac1 * P[i].Vel[j];	/* Zeldovich displacement */

#ifdef PMGRID
      for(j = 0; j < 3; j++)
	P[i].Pos[j] += fac2 * (P[i].GravPM[j] + P[i].g.GravAccel[j]);	/* second order lpt displacement */

      for(j = 0; j < 3; j++)
	P[i].Vel[j] += fac3 * (P[i].GravPM[j] + P[i].g.GravAccel[j]);	/* second order lpt velocity correction */
#else
      for(j = 0; j < 3; j++)
	P[i].Pos[j] += fac2 * (P[i].g.GravAccel[j]);	/* second order lpt displacement */

      for(j = 0; j < 3; j++)
	P[i].Vel[j] += fac3 * (P[i].g.GravAccel[j]);	/* second order lpt velocity correction */
#endif
    }

  /* now set the masses correctly */

  for(i = 0; i < NumPart; i++)
    {
      P[i].Mass = P[i].OldAcc;

      if(All.MassTable[P[i].Type] != 0)
	P[i].Mass = All.MassTable[P[i].Type];
    }

  if(All.ComovingIntegrationOn)
    if(All.PeriodicBoundariesOn == 1)
      check_omega();		/* check again whether we have plausible mass density */

  /* recompute long range force */

  All.DoDynamicUpdate = 1;
  domain_Decomposition();	/* redo domain decomposition because particles may have shifted */

  CPU_Step[CPU_MISC] += measure_time();

#ifdef PMGRID
  long_range_force();
#endif

  CPU_Step[CPU_MESH] += measure_time();

  gravity_tree();

  for(i = 0; i < NumPart; i++)
    {
#ifdef PMGRID
      ax = (P[i].g.GravAccel[0] + P[i].GravPM[0]) / All.G;
      ay = (P[i].g.GravAccel[1] + P[i].GravPM[1]) / All.G;
      az = (P[i].g.GravAccel[2] + P[i].GravPM[2]) / All.G;
#else
      ax = P[i].g.GravAccel[0] / All.G;
      ay = P[i].g.GravAccel[1] / All.G;
      az = P[i].g.GravAccel[2] / All.G;
#endif
      P[i].OldAcc = sqrt(ax * ax + ay * ay + az * az);
    }

  if(All.TypeOfOpeningCriterion == 1)
    {
      All.ErrTolTheta = 0;	/* This will switch to the relative opening criterion for the following force computations */
      gravity_tree();
    }

}


#include <stdlib.h>
#include <limits.h>
#include <stdio.h>
#include <errno.h>
#include <time.h>
#include <sys/resource.h>
#include <string.h>

#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>

double drand() {
    return (double) rand() / RAND_MAX;
}

void ptime(struct rusage *ru0, struct rusage *ru1) {

    double utime = 0, stime = 0, ttime = 0;

    utime = (double) ru1->ru_utime.tv_sec
            + 1.e-6 * (double) ru1->ru_utime.tv_usec
            - ru0->ru_utime.tv_sec
            - 1.e-6 * (double) ru0->ru_utime.tv_usec;
    stime = (double) ru1->ru_stime.tv_sec
            + 1.e-6 * (double) ru1->ru_stime.tv_usec
            - ru0->ru_stime.tv_sec
            - 1.e-6 * (double) ru0->ru_stime.tv_usec;
    ttime = stime + utime;

    printf("%3f\n", ttime);
}

int main(int argc, char *argv[]) {

    if (argc < 2) {
        errno = EINVAL;
        perror("");
        return errno;
    }
    int n = strtol(argv[1], NULL, 10);
    if (0 != errno) {
        perror("");
        return errno;
    }

    srand(time(NULL));

    int els = n * n;
    double *A_data = (double *) malloc(els * sizeof(double));
    for (int i = 0; i < els; i++) {
        A_data[i] = drand();
    }
    double *b_data = (double *) malloc(n * sizeof(double));
    for (int i = 0; i < n; i++) {
        b_data[i] = drand();
    }

    gsl_matrix_view A
            = gsl_matrix_view_array(A_data, n, n);
    gsl_matrix *A_copy = gsl_matrix_alloc(n, n);
    gsl_matrix_memcpy(A_copy, &A.matrix);
    fprintf(stderr, "A = [\n");
    gsl_matrix_fprintf(stderr, &A.matrix, "%g");
    fprintf(stderr, "]\n");

    gsl_vector_view b
            = gsl_vector_view_array(b_data, n);
    fprintf(stderr, "b = [\n");
    gsl_vector_fprintf(stderr, &b.vector, "%g");
    fprintf(stderr, "]\n");

    gsl_vector *x = gsl_vector_alloc(n);

    struct rusage t0, t1, t2;
    int s;

    gsl_permutation *p = gsl_permutation_alloc(n);

    getrusage(RUSAGE_SELF, &t0);
    gsl_linalg_LU_decomp(&A.matrix, p, &s);
    getrusage(RUSAGE_SELF, &t1);
    gsl_linalg_LU_solve(&A.matrix, p, &b.vector, x);
    getrusage(RUSAGE_SELF, &t2);

    fprintf(stderr, "x = [\n");
    gsl_vector_fprintf(stderr, x, "%g");
    fprintf(stderr, "]\n");

    fprintf(stderr, "%s \n", "decomposition time:");
    ptime(&t0, &t1);
    fprintf(stderr, "%s \n", "solve time:");
    ptime(&t1, &t2);
    fprintf(stderr, "%s \n", "together time:");
    ptime(&t0, &t2);

    gsl_vector *y = gsl_vector_alloc(n);
    gsl_blas_dgemv(CblasNoTrans, 1.0, A_copy, x, 0, y);
    fprintf(stderr, "y = [\n");
    gsl_vector_fprintf(stderr, y, "%g");
    fprintf(stderr, "]\n");

    gsl_permutation_free(p);
    gsl_vector_free(x);
    return EXIT_SUCCESS;
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gbpLib.h>
#include <gbpMath.h>
#include <gbpCosmo_core.h>
#include <gbpCosmo_NFW_etc.h>
#include <gsl/gsl_sf_expint.h>

double rho_NFW(double r, double M_vir, double z, int mode, cosmo_info **cosmo) {
    double c_vir;
    double R_vir;
    double g_c;
    double rho_o;
    double x;
    set_NFW_params(M_vir, z, mode, cosmo, &c_vir, &R_vir);
    g_c   = 1. / (log(1. + c_vir) - c_vir / (1. + c_vir));
    rho_o = M_vir * g_c / (FOUR_PI * pow(R_vir / c_vir, 3.));
    x     = r * c_vir / R_vir;
    return (rho_o / (x * pow(1. + x, 2.)));
}


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

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

#include "tests.h"

/* These are the test functions from table 4.1 of the QUADPACK book */

/* f1(x) = x^alpha * log(1/x) */
/* integ(f1,x,0,1) = 1/(alpha + 1)^2 */

double f1 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(x,alpha) * log(1/x) ;
}

/* f2(x) = 4^-alpha / ((x-pi/4)^2 + 16^-alpha) */
/* integ(f2,x,0,1) = arctan((4-pi)4^(alpha-1)) + arctan(pi 4^(alpha-1)) */

double f2 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(4.0,-alpha) / (pow((x-M_PI/4.0),2.0) + pow(16.0,-alpha)) ;
}

/* f3(x) = cos(2^alpha * sin(x)) */
/* integ(f3,x,0,pi) = pi J_0(2^alpha) */

double f3 (double x, void * params) {
  double alpha = *(double *) params ;
  return cos(pow(2.0,alpha) * sin(x)) ;
}

/* Functions 4, 5 and 6 are duplicates of functions  1, 2 and 3 */
/* ....                                                         */

/* f7(x) = |x - 1/3|^alpha */
/* integ(f7,x,0,1) = ((2/3)^(alpha+1) + (1/3)^(alpha+1))/(alpha + 1) */

double f7 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(fabs(x - (1.0/3.0)),alpha) ;
}

/* f8(x) = |x - pi/4|^alpha */
/* integ(f8,x,0,1) =
   ((1 - pi/4)^(alpha+1) + (pi/4)^(alpha+1))/(alpha + 1) */

double f8 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(fabs(x - (M_PI/4.0)),alpha) ;
}

/* f9(x) = sqrt(1 - x^2) / (x + 1 + 2^-alpha) */
/* integ(f9,x,-1,1) = pi/sqrt((1+2^-alpha)^2-1) */

double f9 (double x, void * params) {
  double alpha = *(double *) params ;
  return 1 / ((x + 1 + pow(2.0,-alpha)) * sqrt(1-x*x)) ;
}

/* f10(x) = sin(x)^(alpha - 1) */
/* integ(f10,x,0,pi/2) = 2^(alpha-2) ((Gamma(alpha/2))^2)/Gamma(alpha) */

double f10 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(sin(x), alpha-1) ;
}

/* f11(x) = log(1/x)^(alpha - 1) */
/* integ(f11,x,0,1) = Gamma(alpha) */

double f11 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(log(1/x), alpha-1) ;
}

/* f12(x) = exp(20*(x-1)) * sin(2^alpha * x) */
/* integ(f12,x,0,1) =
   (20 sin(2^alpha) - 2^alpha cos(2^alpha) + 2^alpha exp(-20))
   /(400 + 4^alpha) */

double f12 (double x, void * params) {
  double alpha = *(double *) params ;
  return exp(20*(x-1)) * sin(pow(2.0,alpha) * x) ;
}

/* f13(x) = cos(2^alpha * x)/sqrt(x(1 - x)) */
/* integ(f13,x,0,1) = pi cos(2^(alpha-1)) J_0(2^(alpha-1))  */

double f13 (double x, void * params) {
  double alpha = *(double *) params ;
  return cos(pow(2.0,alpha)*x)/sqrt(x*(1-x)) ;
}

double f14 (double x, void * params) {
  double alpha = *(double *) params ;
  return exp(-pow(2.0,-alpha)*x)*cos(x)/sqrt(x) ;
}

double f15 (double x, void * params) {
  double alpha = *(double *) params ;
  return x*x * exp(-pow(2.0,-alpha)*x) ;
}

double f16 (double x, void * params) {
  double alpha = *(double *) params ;
  if (x==0 && alpha == 1) return 1 ;  /* make the function continuous in x */
  if (x==0 && alpha > 1) return 0 ;   /* avoid problems with pow(0,1) */
  return pow(x,alpha-1)/pow((1+10*x),2.0) ;
}

double f17 (double x, void * params) {
  double alpha = *(double *) params ;
  return pow(2.0,-alpha)/(((x-1)*(x-1)+pow(4.0,-alpha))*(x-2)) ;
}

/* f454(x) = x^3 log|(x^2-1)(x^2-2)| */
/* integ(f454,x,0,inf) = 61 log(2) + (77/4) log(7) - 27 */

double f454 (double x, void * params) {
  double x2 = x * x;
  double x3 = x * x2;
  params = 0 ;
  return x3 * log(fabs((x2 - 1.0) * (x2 - 2.0))) ;
}

/* f455(x) = log(x)/(1+100*x^2) */
/* integ(f455,x,0,inf) = -log(10)/20 */

double f455 (double x, void * params) {
  params = 0 ;
  return log(x) / (1.0 + 100.0 * x * x) ;
}

/* f456(x) = log(x) */
/* integ(f456*sin(10 pi x),x,0,1) = -(gamma + log(10pi) - Ci(10pi))/(10pi) */

double f456 (double x, void * params) {
  params = 0 ;
  if (x == 0.0)
    {
      return 0;
    }
  return log(x) ;
}

/* f457(x) = 1/sqrt(x) */
/* integ(f457*cos(pi x / 2),x,0,+inf) = 1 */

double f457 (double x, void * params) {
  params = 0 ;
  if (x == 0.0)
    {
      return 0;
    }
  return 1/sqrt(x) ;
}

/* f458(x) = 1/(1 + log(x)^2)^2 */
/* integ(log(x) f458(x),x,0,1) = (Ci(1) sin(1) + (pi/2 - Si(1)) cos(1))/pi
                               = -0.1892752 */

double f458 (double x, void * params) {
  params = 0 ;

  if (x == 0.0)
    {
      return 0;
    }
  else
    {
      double u = log(x);
      double v = 1 + u * u;

      return 1.0 / (v * v) ;
    }
}

/* f459(x) = 1/(5 x^3 + 6) */
/* integ(f459/(x-0),x,-1,5) = log(125/631)/18 */

double f459 (double x, void * params) {
  params = 0 ;
  return 1.0 / (5.0 * x * x * x + 6.0) ;
}

/* myfn1(x) = exp(-x - x^2) */
/* integ(myfn1,x,-inf,inf) = sqrt(pi) exp(-1/4) */

double myfn1 (double x, void * params) {
  params = 0;
  return exp(-x - x*x) ;
}

/* myfn2(x) = exp(alpha*x) */
/* integ(myfn2,x,-inf,b) = exp(alpha*b)/alpha */

double myfn2 (double x, void * params) {
  double alpha = *(double *) params ;
  return exp(alpha*x) ;
}


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

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

int
main(void)
{
  const size_t N = 1000;                                 /* length of time series */
  const double sigma[] = { 1.0, 5.0, 1.0, 3.0, 5.0 };    /* variances */
  const size_t N_sigma[] = { 200, 450, 600, 850, 1000 }; /* samples where variance changes */
  const size_t K = 41;                                   /* window size */
  gsl_vector *x = gsl_vector_alloc(N);
  gsl_vector *xmedian = gsl_vector_alloc(N);
  gsl_vector *xmad = gsl_vector_alloc(N);
  gsl_vector *xiqr = gsl_vector_alloc(N);
  gsl_vector *xSn = gsl_vector_alloc(N);
  gsl_vector *xQn = gsl_vector_alloc(N);
  gsl_vector *xsd = gsl_vector_alloc(N);
  gsl_rng *r = gsl_rng_alloc(gsl_rng_default);
  gsl_movstat_workspace * w = gsl_movstat_alloc(K);
  size_t idx = 0;
  size_t i;

  for (i = 0; i < N; ++i)
    {
      double gi = gsl_ran_gaussian(r, sigma[idx]);
      double u = gsl_rng_uniform(r);
      double outlier = (u < 0.01) ? 15.0*GSL_SIGN(gi) : 0.0;
      double xi = gi + outlier;

      gsl_vector_set(x, i, xi);

      if (i == N_sigma[idx] - 1)
        ++idx;
    }

  /* compute moving statistics */
  gsl_movstat_mad(GSL_MOVSTAT_END_TRUNCATE, x, xmedian, xmad, w);
  gsl_movstat_qqr(GSL_MOVSTAT_END_TRUNCATE, x, 0.25, xiqr, w);
  gsl_movstat_Sn(GSL_MOVSTAT_END_TRUNCATE, x, xSn, w);
  gsl_movstat_Qn(GSL_MOVSTAT_END_TRUNCATE, x, xQn, w);
  gsl_movstat_sd(GSL_MOVSTAT_END_TRUNCATE, x, xsd, w);

  /* scale IQR by factor to approximate standard deviation */
  gsl_vector_scale(xiqr, 0.7413);

  /* print results */
  idx = 0;
  for (i = 0; i < N; ++i)
    {
      printf("%zu %f %f %f %f %f %f %f\n",
             i,
             gsl_vector_get(x, i),
             sigma[idx],
             gsl_vector_get(xmad, i),
             gsl_vector_get(xiqr, i),
             gsl_vector_get(xSn, i),
             gsl_vector_get(xQn, i),
             gsl_vector_get(xsd, i));

      if (i == N_sigma[idx] - 1)
        ++idx;
    }

  gsl_vector_free(x);
  gsl_vector_free(xmedian);
  gsl_vector_free(xmad);
  gsl_vector_free(xiqr);
  gsl_vector_free(xSn);
  gsl_vector_free(xQn);
  gsl_vector_free(xsd);
  gsl_rng_free(r);
  gsl_movstat_free(w);

  return 0;
}


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

// #include <stdlib.h>
// #include <time.h>

double boxcar_overlap(double rA, double radiiA, double rB, double radiiB)
{

    double F;
    F = pow(rB - rA, 2) / pow(radiiA + radiiB, 2);

    return F;

}

size_t gen_pts_rsa_1d(double *x,
    size_t npoints, double radius, int step_limit,
    unsigned long randSeed)
{

    // Setup GSL random number generator
    const gsl_rng_type * T;
    gsl_rng * r;
    T = gsl_rng_default;
    r = gsl_rng_alloc (T);

    // Set the seed
    // srand ( time(NULL) );
    // unsigned long randSeed = rand();
    gsl_rng_set(r, randSeed);

    // Set the initial position
    double xn = gsl_rng_uniform (r) * (1 - 2 * radius) + radius;
    x[0] = xn;

    size_t valid_pts;
    double F;
    int k, flag, step;

    step = 0;
    valid_pts = 1;

    while ((valid_pts < npoints) & (step < step_limit))
    {

        xn = gsl_rng_uniform (r) * (1 - 2 * radius) + radius;

        flag = 1;
        for (k = 0; k < valid_pts; k++)
        {

            F = boxcar_overlap(xn, radius, x[k], radius);
            if (F < 1.0)
            {

                flag = 0;
                break;

            }
        }
        if (flag == 1)
        {

           x[valid_pts] = xn;
           valid_pts += 1;

        }

        step += 1;

    }

    gsl_rng_free (r);

    return valid_pts;

}

unsigned int metro_md_1d(double *x,
    double radius, size_t npoints, unsigned int step_limit,
    unsigned long randSeed)
{

    /* Setup GSL random number generator */
    const gsl_rng_type * T;
    gsl_rng * r;
    T = gsl_rng_default;
    r = gsl_rng_alloc (T);

    /* Set the seed */
    // srand ( time(NULL) );
    // unsigned long randSeed = rand();
    gsl_rng_set(r, randSeed);

    double diameter = 2 * radius;

    double dx, xn, F;
    unsigned int step, i, k, flag, success_steps;

    step = 0;
    success_steps = 0;
    while (step < step_limit)
    {

        i = step % npoints;

        /* Generate new position */
        while (1)
        {

            dx = diameter * (gsl_rng_uniform (r) - 0.5);
            xn = x[i] + dx;

            if (((xn > radius) & (xn < 1 - radius)))
            {
               break;
            }

        }

        /* Determine if new position overlaps with other positions */
        flag = 1;
        for (k = 0; k < npoints; k++)
        {

            F = boxcar_overlap(xn, radius, x[k], radius);
            if ((F < 1.0) & (i != k))
            {
                flag = 0;
                break;
            }

        }

        if (flag == 1)
        {

            x[i] = xn;

            success_steps = success_steps + 1;

        }

        step = step + 1;

    }

    gsl_rng_free (r);

    return success_steps;

}

unsigned int metro_pd_1d(double *x,
    double *radius, size_t npoints, int step_limit,
    unsigned long randSeed)
{

    /* Setup GSL random number generator */
    const gsl_rng_type * T;
    gsl_rng * r;
    T = gsl_rng_default;
    r = gsl_rng_alloc (T);

    /* Set the seed */
    // srand ( time(NULL) );
    // unsigned long randSeed = rand();
    gsl_rng_set(r, randSeed);

    double dx, xn, diameter, F;
    unsigned int step, i, k, flag, success_steps;

    step = 0;
    success_steps = 0;
    while (step < step_limit)
    {

        i = step % npoints;

        /* Generate new position */
        while (1)
        {

            diameter = 2 * radius[i];

            dx = diameter * (gsl_rng_uniform (r) - 0.5);
            xn = x[i] + dx;

            if (((xn > radius[i]) & (xn < 1 - radius[i])) )
            {
               break;
            }

        }

        /* Determine if new position overlaps with other positions */
        flag = 1;
        for (k = 0; k < npoints; k++)
        {

            F = boxcar_overlap(xn, radius[i], x[k], radius[k]);
            if ((F < 1.0) & (i != k))
            {
                flag = 0;
                break;
            }

        }

        if (flag == 1)
        {

            x[i] = xn;

            success_steps += 1;

        }

        step = step + 1;

    }

    gsl_rng_free (r);

    return success_steps;

}


#include <stdio.h>
#include <stdlib.h>
#include <omp.h>
#include <sys/time.h>
#include <gsl/gsl_cblas.h>

#define N 5000;

void mm_bruteforce_ijk(double *a, double *b, double *c, int I, int K, int J) {
    for(int i = 0; i < I; i++) {
        for(int j = 0; j < J; j++) {
            for(int k = 0; k < K; k++) {
                c[i * J + j] += a[i * K + k] * b[k * J + j];
            }
        }
    }
}

void mm_bruteforce_ikj(double *a, double *b, double *c, int I, int K, int J) {
    for(int i = 0; i < I; i++) {
        for(int k = 0; k < K; k++) {
            double dv = a[i * K + k];
            for(int j = 0; j < J; j++) {
                c[i * J + j] += dv * b[k * J + j];
            }
        }
    }
}

void mm_omp(double *a, double *b, double *c, int I, int K, int J) {
    #pragma omp parallel for
    for(int i = 0; i < I; i++) {
        for(int k = 0; k < K; k++) {
            register double dv = a[i * K + k];
            for(int j = 0; j < J; j++) {
                c[i * J + j] += dv * b[k * J + j];
            }
        }
    }
}

void mm_cblas_dgemm(double *a, double *b, double *c, int p, int q, int r) {
    int l = p;
    int m = q;
    int n = r;

    int lda = m;
    int ldb = n;
    int ldc = n;

    double alpha = 1.0;
    double beta = 0.0;

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
            l, n, m, alpha, a, lda, b, ldb, beta, c, ldc);
}

void init_arange(double *mat, int a, int b) {
    for(int i = 0; i < (a*b); i++) {
        mat[i] = i + 1;
    }
}

void init_value(double *mat, int a, int b, double value) {
    for(int i = 0; i < (a*b); i++) {
        mat[i] = value;
    }
}

void init_zero(double *mat, int a, int b) {
    init_value(mat, a, b, 0);
}

void init_one(double *mat, int a, int b) {
    init_value(mat, a, b, 1);
}

void timer_start(struct timeval *pstv) {
    gettimeofday(pstv, NULL);
}

void timer_end(struct timeval *petv) {
    gettimeofday(petv, NULL);
}

void timer_print(struct timeval *pstv, struct timeval *petv) {
    time_t sec;
    suseconds_t usec;
    sec = petv->tv_sec - pstv->tv_sec;
    usec = petv->tv_usec - pstv->tv_usec;
    if(usec < 0) {
        sec--;
        usec += 1000000;
    }
    printf("elapsed time : %ld.%ld\n", sec, usec);
}

typedef void (*fptr_mm)(double *a, double *b, double *c, int I, int K, int J);

void check_etime_mm(double *a, double *b, double *c, int I, int K, int J, fptr_mm mm) {
    struct timeval stv;
    struct timeval etv;
    init_zero(c, I, J);
    timer_start(&stv);
    mm(a, b, c, I, K, J);
    timer_end(&etv);
    timer_print(&stv, &etv);
}

int main(int argc, char *argv[]) {
    int I, K, J;
    I = K = J = N;

    double *a = (double*)malloc(sizeof(double) * I * K);
    double *b = (double*)malloc(sizeof(double) * K * J);
    double *c = (double*)malloc(sizeof(double) * I * J);

    init_arange(a, I, K);
    init_arange(b, K, J);

    check_etime_mm(a, b, c, I, K, J, mm_bruteforce_ijk);
    check_etime_mm(a, b, c, I, K, J, mm_bruteforce_ikj);
    check_etime_mm(a, b, c, I, K, J, mm_omp);
    check_etime_mm(a, b, c, I, K, J, mm_cblas_dgemm);

    return 0;
}


#include <stdio.h>
#include <cblas.h>

#define M 2
#define N 2
#define K 3
#define X 4
#define Y 5

void print_mat(const char *name, int r, int c, float *m)
{
    printf("%s =\n", name);
    for (int i = 0; i < r; i++) {
        for (int j = 0; j < c; j++) {
            printf("%.2lf ", m[i * c + j]);
        }
        printf("\n");
    }
}

int main()
{
    float A[M * K] = {
        1, 2, 3,
        4, 5, 6,
    };
    float B[K * N] = {
        0.1, 0.2,
        0.3, 0.4,
        0.5, 0.6,
    };
    float C[X * Y] = { 0 };

    // M x K, K x N -> M x N (single precision, 's'gemm)
    // Save A x B in C starting from (1, 1)
    cblas_sgemm(
        CblasRowMajor, CblasNoTrans, CblasNoTrans,
        M, N, K,
        1,
        A, K,
        B, N,
        0,
        C + Y + 1, Y
    );

    print_mat("A", M, K, A);
    print_mat("B", K, N, B);
    print_mat("C", X, Y, C);

    return 0;
}


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

#include <config.h>
#include <gsl/gsl_integration.h>

/* Gauss quadrature weights and kronrod quadrature abscissae and
   weights as evaluated with 80 decimal digit arithmetic by
   L. W. Fullerton, Bell Labs, Nov. 1981. */

static const double xgk[11] =   /* abscissae of the 21-point kronrod rule */
{
  0.995657163025808080735527280689003,
  0.973906528517171720077964012084452,
  0.930157491355708226001207180059508,
  0.865063366688984510732096688423493,
  0.780817726586416897063717578345042,
  0.679409568299024406234327365114874,
  0.562757134668604683339000099272694,
  0.433395394129247190799265943165784,
  0.294392862701460198131126603103866,
  0.148874338981631210884826001129720,
  0.000000000000000000000000000000000
};

/* xgk[1], xgk[3], ... abscissae of the 10-point gauss rule.
   xgk[0], xgk[2], ... abscissae to optimally extend the 10-point gauss rule */

static const double wg[5] =     /* weights of the 10-point gauss rule */
{
  0.066671344308688137593568809893332,
  0.149451349150580593145776339657697,
  0.219086362515982043995534934228163,
  0.269266719309996355091226921569469,
  0.295524224714752870173892994651338
};

static const double wgk[11] =   /* weights of the 21-point kronrod rule */
{
  0.011694638867371874278064396062192,
  0.032558162307964727478818972459390,
  0.054755896574351996031381300244580,
  0.075039674810919952767043140916190,
  0.093125454583697605535065465083366,
  0.109387158802297641899210590325805,
  0.123491976262065851077958109831074,
  0.134709217311473325928054001771707,
  0.142775938577060080797094273138717,
  0.147739104901338491374841515972068,
  0.149445554002916905664936468389821
};

void
gsl_integration_qk21 (const gsl_function * f, double a, double b,
                      double *result, double *abserr,
                      double *resabs, double *resasc)
{
  double fv1[11], fv2[11];
  gsl_integration_qk (11, xgk, wg, wgk, fv1, fv2, f, a, b, result, abserr, resabs, resasc);
}


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

/* Author:  G. Jungman */

#ifndef __GSL_SF_BESSEL_H__
#define __GSL_SF_BESSEL_H__

#include <stdlib.h>
#include <gsl/gsl_mode.h>
#include <gsl/gsl_precision.h>
#include <gsl/gsl_sf_result.h>
#include <gsl/gsl_types.h>

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

__BEGIN_DECLS

/* Regular Bessel Function J_0(x)
 *
 * exceptions: none
 */
GSL_EXPORT int gsl_sf_bessel_J0_e(const double x,  gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_J0(const double x);

/* Regular Bessel Function J_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_J1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_J1(const double x);

/* Regular Bessel Function J_n(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Jn_e(int n, double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Jn(const int n, const double x);

/* Regular Bessel Function J_n(x),  nmin <= n <= nmax
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Jn_array(int nmin, int nmax, double x, double * result_array);

/* Irregular Bessel function Y_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Y0_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Y0(const double x);

/* Irregular Bessel function Y_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Y1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Y1(const double x);

/* Irregular Bessel function Y_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Yn_e(int n,const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Yn(const int n,const double x);

/* Irregular Bessel function Y_n(x), nmin <= n <= nmax
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Yn_array(const int nmin, const int nmax, const double x, double * result_array);

/* Regular modified Bessel function I_0(x)
 *
 * exceptions: GSL_EOVRFLW
 */
GSL_EXPORT int gsl_sf_bessel_I0_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_I0(const double x);

/* Regular modified Bessel function I_1(x)
 *
 * exceptions: GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_I1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_I1(const double x);

/* Regular modified Bessel function I_n(x)
 *
 * exceptions: GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_In_e(const int n, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_In(const int n, const double x);

/* Regular modified Bessel function  I_n(x) for n=nmin,...,nmax
 *
 * nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_In_array(const int nmin, const int nmax, const double x, double * result_array);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_0(x)
 *
 * exceptions: none
 */
GSL_EXPORT int gsl_sf_bessel_I0_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_I0_scaled(const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_I1_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_I1_scaled(const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_n(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_In_scaled_e(int n, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_In_scaled(const int n, const double x);

/* Scaled regular modified Bessel function
 *  exp(-|x|) I_n(x)  for n=nmin,...,nmax
 *
 * nmin >=0, nmax >= nmin
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_In_scaled_array(const int nmin, const int nmax, const double x, double * result_array);

/* Irregular modified Bessel function K_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_K0_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_K0(const double x);

/* Irregular modified Bessel function K_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_K1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_K1(const double x);

/* Irregular modified Bessel function K_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Kn_e(const int n, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Kn(const int n, const double x);

/* Irregular modified Bessel function  K_n(x)  for n=nmin,...,nmax
 *
 * x > 0.0, nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EOVRFLW, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Kn_array(const int nmin, const int nmax, const double x, double * result_array);

/* Scaled irregular modified Bessel function
 *  exp(x) K_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM
 */
GSL_EXPORT int gsl_sf_bessel_K0_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_K0_scaled(const double x);

/* Scaled irregular modified Bessel function
 *  exp(x) K_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_K1_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_K1_scaled(const double x);

/* Scaled irregular modified Bessel function
 *  exp(x) K_n(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Kn_scaled_e(int n, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Kn_scaled(const int n, const double x);

/* Scaled irregular modified Bessel function  exp(x) K_n(x)  for n=nmin,...,nmax
 *
 * x > 0.0, nmin >=0, nmax >= nmin
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Kn_scaled_array(const int nmin, const int nmax, const double x, double * result_array);

/* Regular spherical Bessel function j_0(x) = sin(x)/x
 *
 * exceptions: none
 */
GSL_EXPORT int gsl_sf_bessel_j0_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_j0(const double x);

/* Regular spherical Bessel function j_1(x) = (sin(x)/x - cos(x))/x
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_j1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_j1(const double x);

/* Regular spherical Bessel function j_2(x) = ((3/x^2 - 1)sin(x) - 3cos(x)/x)/x
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_j2_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_j2(const double x);

/* Regular spherical Bessel function j_l(x)
 *
 * l >= 0, x >= 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_jl_e(const int l, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_jl(const int l, const double x);

/* Regular spherical Bessel function j_l(x) for l=0,1,...,lmax
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_jl_array(const int lmax, const double x, double * result_array);

/* Regular spherical Bessel function j_l(x) for l=0,1,...,lmax
 * Uses Steed's method.
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_jl_steed_array(const int lmax, const double x, double * jl_x_array);

/* Irregular spherical Bessel function y_0(x)
 *
 * exceptions: none
 */
GSL_EXPORT int gsl_sf_bessel_y0_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_y0(const double x);

/* Irregular spherical Bessel function y_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_y1_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_y1(const double x);

/* Irregular spherical Bessel function y_2(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_y2_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_y2(const double x);

/* Irregular spherical Bessel function y_l(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_yl_e(int l, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_yl(const int l, const double x);

/* Irregular spherical Bessel function y_l(x) for l=0,1,...,lmax
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_yl_array(const int lmax, const double x, double * result_array);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_0(x)
 *
 * exceptions: none
 */
GSL_EXPORT int gsl_sf_bessel_i0_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_i0_scaled(const double x);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_1(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_i1_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_i1_scaled(const double x);

/* Regular scaled modified spherical Bessel function
 *
 * Exp[-|x|] i_2(x)
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_i2_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_i2_scaled(const double x);

/* Regular scaled modified spherical Bessel functions
 *
 * Exp[-|x|] i_l(x)
 *
 * i_l(x) = Sqrt[Pi/(2x)] BesselI[l+1/2,x]
 *
 * l >= 0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_il_scaled_e(const int l, double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_il_scaled(const int l, const double x);

/* Regular scaled modified spherical Bessel functions
 *
 * Exp[-|x|] i_l(x)
 * for l=0,1,...,lmax
 *
 * exceptions: GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_il_scaled_array(const int lmax, const double x, double * result_array);

/* Irregular scaled modified spherical Bessel function
 * Exp[x] k_0(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_k0_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_k0_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_1(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW, GSL_EOVRFLW
 */
GSL_EXPORT int gsl_sf_bessel_k1_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_k1_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_2(x)
 *
 * x > 0.0
 * exceptions: GSL_EDOM, GSL_EUNDRFLW, GSL_EOVRFLW
 */
GSL_EXPORT int gsl_sf_bessel_k2_scaled_e(const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_k2_scaled(const double x);

/* Irregular modified spherical Bessel function
 * Exp[x] k_l[x]
 *
 * k_l(x) = Sqrt[Pi/(2x)] BesselK[l+1/2,x]
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_kl_scaled_e(int l, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_kl_scaled(const int l, const double x);

/* Irregular scaled modified spherical Bessel function
 * Exp[x] k_l(x)
 *
 * for l=0,1,...,lmax
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_kl_scaled_array(const int lmax, const double x, double * result_array);

/* Regular cylindrical Bessel function J_nu(x)
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Jnu_e(const double nu, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Jnu(const double nu, const double x);

/* Irregular cylindrical Bessel function Y_nu(x)
 *
 * exceptions:
 */
GSL_EXPORT int gsl_sf_bessel_Ynu_e(double nu, double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Ynu(const double nu, const double x);

/* Regular cylindrical Bessel function J_nu(x)
 * evaluated at a series of x values. The array
 * contains the x values. They are assumed to be
 * strictly ordered and positive. The array is
 * over-written with the values of J_nu(x_i).
 *
 * exceptions: GSL_EDOM, GSL_EINVAL
 */
GSL_EXPORT int gsl_sf_bessel_sequence_Jnu_e(double nu, gsl_mode_t mode, size_t size, double * v);

/* Scaled modified cylindrical Bessel functions
 *
 * Exp[-|x|] BesselI[nu, x]
 * x >= 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
GSL_EXPORT int gsl_sf_bessel_Inu_scaled_e(double nu, double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Inu_scaled(double nu, double x);

/* Modified cylindrical Bessel functions
 *
 * BesselI[nu, x]
 * x >= 0, nu >= 0
 *
 * exceptions: GSL_EDOM, GSL_EOVRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Inu_e(double nu, double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Inu(double nu, double x);

/* Scaled modified cylindrical Bessel functions
 *
 * Exp[+|x|] BesselK[nu, x]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
GSL_EXPORT int gsl_sf_bessel_Knu_scaled_e(const double nu, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Knu_scaled(const double nu, const double x);

/* Modified cylindrical Bessel functions
 *
 * BesselK[nu, x]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM, GSL_EUNDRFLW
 */
GSL_EXPORT int gsl_sf_bessel_Knu_e(const double nu, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_Knu(const double nu, const double x);

/* Logarithm of modified cylindrical Bessel functions.
 *
 * Log[BesselK[nu, x]]
 * x > 0, nu >= 0
 *
 * exceptions: GSL_EDOM
 */
GSL_EXPORT int gsl_sf_bessel_lnKnu_e(const double nu, const double x, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_lnKnu(const double nu, const double x);

/* s'th positive zero of the Bessel function J_0(x).
 *
 * exceptions:
 */
GSL_EXPORT int gsl_sf_bessel_zero_J0_e(unsigned int s, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_zero_J0(unsigned int s);

/* s'th positive zero of the Bessel function J_1(x).
 *
 * exceptions:
 */
GSL_EXPORT int gsl_sf_bessel_zero_J1_e(unsigned int s, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_zero_J1(unsigned int s);

/* s'th positive zero of the Bessel function J_nu(x).
 *
 * exceptions:
 */
GSL_EXPORT int gsl_sf_bessel_zero_Jnu_e(double nu, unsigned int s, gsl_sf_result * result);
GSL_EXPORT double gsl_sf_bessel_zero_Jnu(double nu, unsigned int s);

__END_DECLS

#endif /* __GSL_SF_BESSEL_H__ */


/*gcc poisson.c /usr/lib/libgsl.a /usr/lib/libm.a -o poisson.exe */

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

int
main (int argc, char *argv[])
{
  if(argc < 2){
    printf("print probability of obtaining N from poisson distribution\n");
    printf("usage:  poisson.exe mean N\n");
    return 1;
  }

  const gsl_rng_type * T;
  gsl_rng * r;

  int billion = 1000000000;
  int i, n = billion;

  double mean = atof(argv[1]);
  unsigned int found = atoi(argv[2]);

  double prob = gsl_ran_poisson_pdf(found,mean);
  printf("probability %f of getting %d from mean %f\n",prob,found,mean);

  double totalprob = 0.0;
  for(i=0; i<found; i++){
    totalprob += gsl_ran_poisson_pdf(i,mean);
  }
  printf("probability %f of getting < %d from mean %f\n",
	 totalprob,found,mean);
  printf("probability %f of getting >= %d from mean %f\n",
	 1.0-totalprob,found,mean);

  /*
  gsl_rng_env_setup();

  T = gsl_rng_default;
  r = gsl_rng_alloc (T);

  for (i = 0; i < n; i++)
    {
      double u = gsl_rng_uniform (r);
      if(i > billion-5) printf("%.5f\n", u);
    }

  gsl_rng_free (r);
  */
  return 0;
}