/*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;
}


/*This program evaluates the differential equations for a photon's geodesic in a FRW perturbed spacetime in SPHERICAL coordinates and restricted to photon RADIAL MOTION only.*/

/*This program solves the particular case for flat FRW perturbed spacetime with metric: $g_{ab} = {[g]}_{ab} + h_{ab}$. Where ${[g]}_{ab}$ corresponds to the flat FRW metric and $h_{ab}$ corresponds to the perturbation in the conformal Newtonian gauge. A Plummer potential or a Hernquist potential with adequate parameters can be used to simulate the perturbation.
The equations are written in the form $\frac{d(x or p)^{\alpha}}{d\lambda}=f(x^{\alpha},p^{\alpha})$ and the indice $\alpha$ runs from 0 to 1 since the motion is only radial.
Where $p^{\alpha}={\dot{x}}^{\alpha}$.
The coordinates for the photon's geodesics are then: (ct,r) = (x0,x1).*/

#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <gsl/gsl_errno.h>          //GSL error management module
#include <gsl/gsl_spline.h>         //GSL interpolation module

/* PHYSICAL CONSTANTS AND PARAMETERS */
#define A 10.0     //Distance parameter of the perturbations
#define G 43007.01     //Gravitational constant
#define M 15000.0     //Mass of the perturbation
#define C 299792.458  //Speed of light
#define GAMMA 0.8    //Parameter for halo mass evolution

/* PROGRAM PARAMETERS */
#define NLINES 100000 //Number of lines in geodesic_solution.dat file
#define NSTEPS 600000000 //Number of steps for solving geodesics
#define NLINESFRW 10000 //Number of lines in frw.dat file
#define DLAMBDA 0.01   //Geodesics parameter step

typedef long double mydbl;

/*Interpolation of function inside *spline object evaluated at an abscisa 'x'.
Argument *spline is a pointer to a spline object which stores the type of interpolation to be made. x is the independent variable where the function is evaluated. *acc is a pointer to a lookup object for interpolations.*/
double interpolator(gsl_spline *spline, double x, gsl_interp_accel *acc)
{
  double a = gsl_spline_eval(spline, x, acc);  //Interpolates data to abcisa x using method in spline and acceleration object acc
  return a;  //Return value of interpolated function at x
}

/*Mass evolution. Function providing the mass at a given z. Mass at present time is obtained at z=0.*/
mydbl mass(mydbl a)
{
  mydbl z = 1.0/a - 1.0;
  return M*expl(-GAMMA*z);
}

/*Plummer model. Provided two variables pointers, this function stores the potential and the derivative of the potential for the Plummer model in these variables at a given radius.*/
void plummer_model(mydbl a, mydbl adot, mydbl r, mydbl *potential, mydbl *der_potential_radial, mydbl *der_potential_temporal)
{
  *potential = -G*mass(a)/(sqrtl(A*A + r*r));
  *der_potential_radial = G*mass(a)*r/(powl(A*A+r*r, 1.5));
  *der_potential_temporal = *potential*GAMMA*adot/(a*a);
}

/*Hernquist model. Provided two variables pointers, this function stores the potential and the derivative of the potential for the Hernquist model in these variables at a given radius.*/
void hernquist_model(mydbl a, mydbl adot, mydbl r, mydbl *potential, mydbl *der_potential_radial, mydbl *der_potential_temporal)
{
  double rsign = copysign(1.0,(double)(1.0*r));
  mydbl absr = fabsl(r);
  if(absr > 2000.0)
    {
      *potential = 0.0;
      *der_potential_radial = 0.0;
      *der_potential_temporal = 0.0;
    }
  else if(rsign == -1.0)
    {
      *potential = -G*mass(a)/(A + absr);
      *der_potential_radial = -G*mass(a)/powl(absr+A,2.0);
      *der_potential_temporal = *potential*GAMMA*adot/(a*a);
    }
  else if(rsign == 1.0)
    {
      *potential = -G*mass(a)/(A + absr);
      *der_potential_radial = G*mass(a)/powl(absr+A,2.0);
      *der_potential_temporal = *potential*GAMMA*adot/(a*a);
    }
}

/*Function of the 0th momentum component differential equation for the geodesics.
${p0}^{dot} = f0(x^{\alpha},p^{\alpha})$.*/
mydbl geodesic_equation_0(gsl_spline *spline1, gsl_interp_accel *acc1, gsl_spline *spline2, gsl_interp_accel *acc2, mydbl p0, mydbl pr, mydbl x0, mydbl r, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  double t = (double)(1.0*x0/C);
  mydbl a = (mydbl) 1.0*interpolator(spline1, t, acc1);
  mydbl adot = (mydbl) 1.0*interpolator(spline2, t, acc2);
  mydbl potential, der_potential_radial, der_potential_temporal;
  (*model)(a, adot, r, &potential, &der_potential_radial, &der_potential_temporal);
  mydbl f = -2.0*p0*(der_potential_temporal*p0/C + der_potential_radial*pr)/(C*C + 2.0*potential) + der_potential_temporal*(p0*p0 + a*a*pr*pr)/(C*C*C) - (1.0 - 2.0*potential/(C*C))*(a*adot)*(pr*pr)/(C + 2.0*potential/C);
  return f;
}

/*Function of the 1th (radial) momentum component differential equation for the geodesics.
${p1}^{dot} = f1(x^{\alpha},p^{\alpha})$.*/
mydbl geodesic_equation_r(gsl_spline *spline1, gsl_interp_accel *acc1, gsl_spline *spline2, gsl_interp_accel *acc2, mydbl p0, mydbl pr, mydbl x0, mydbl r, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  double t = (double)(1.0*x0/C);
  mydbl a = (mydbl) 1.0*interpolator(spline1, t, acc1);
  mydbl adot = (mydbl) 1.0*interpolator(spline2, t, acc2);
  mydbl potential, der_potential_radial, der_potential_temporal;
  (*model)(a, adot, r, &potential, &der_potential_radial, &der_potential_temporal);
  mydbl f = - (der_potential_radial*p0*p0)/(a*a*(C*C - 2.0*potential)) - (2.0*adot*p0*pr)/(C*a) + der_potential_radial*(pr*pr)/(C*C - 2.0*potential) + 2.0*der_potential_temporal*p0*pr/(a*a*C*(C*C - 2.0*potential));
  return f;
}

/*Function for solving the geodesics differential equations using 4th order Runge-Kutta method.
Arguments are pointer so variables in that memory addresses are changed every time this function is called.*/
void runge_kutta_4(gsl_spline *spline1, gsl_interp_accel *acc1, gsl_spline *spline2, gsl_interp_accel *acc2, mydbl *x0, mydbl *x1, mydbl *p0, mydbl *p1, mydbl *lambda, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  /*Increment in the variables of the differential equation we want to solve*/
  mydbl dx0, dx1, dp0, dp1;

  /*dxi = (k1,j + 2*k2,j + 2*k3,j + k4,j)/6. In this sections the ki,j are declared with i=1,2,3,4.*/
  mydbl k1x0, k1x1, k1p0, k1p1;
  mydbl k2x0, k2x1, k2p0, k2p1;
  mydbl k3x0, k3x1, k3p0, k3p1;
  mydbl k4x0, k4x1, k4p0, k4p1;

  /*This section calculates the k1 quantities*/
  k1x0 = *p0*DLAMBDA; k1x1 = *p1*DLAMBDA;
  k1p0 = DLAMBDA*geodesic_equation_0(spline1, acc1, spline2, acc2, *p0, *p1, *x0, *x1, (*model));
  k1p1 = DLAMBDA*geodesic_equation_r(spline1, acc1, spline2, acc2, *p0, *p1, *x0, *x1, (*model));

  /*This section calculates the k2 quantities*/
  k2x0 = DLAMBDA*(*p0 + 0.5*k1p0); k2x1 = DLAMBDA*(*p1 + 0.5*k1p1);
  k2p0 = DLAMBDA*geodesic_equation_0(spline1, acc1, spline2, acc2, *p0 + 0.5*k1p0, *p1 + 0.5*k1p1, *x0 + 0.5*k1x0, *x1 + 0.5*k1x1, (*model));
  k2p1 = DLAMBDA*geodesic_equation_r(spline1, acc1, spline2, acc2, *p0 + 0.5*k1p0, *p1 + 0.5*k1p1, *x0 + 0.5*k1x0, *x1 + 0.5*k1x1, (*model));

  /*This section calculates the k3 quantities*/
  k3x0 = DLAMBDA*(*p0 + 0.5*k2p0); k3x1 = DLAMBDA*(*p1 + 0.5*k2p1);
  k3p0 = DLAMBDA*geodesic_equation_0(spline1, acc1, spline2, acc2, *p0 + 0.5*k2p0, *p1 + 0.5*k2p1, *x0 + 0.5*k2x0, *x1 + 0.5*k2x1, (*model));
  k3p1 = DLAMBDA*geodesic_equation_r(spline1, acc1, spline2, acc2, *p0 + 0.5*k2p0, *p1 + 0.5*k2p1, *x0 + 0.5*k2x0, *x1 + 0.5*k2x1, (*model));

  /*This section calculates the k4 quantities*/
  k4x0 = DLAMBDA*(*p0 + k3p0); k4x1 = DLAMBDA*(*p1 + k3p1);
  k4p0 = DLAMBDA*geodesic_equation_0(spline1, acc1, spline2, acc2, *p0 + k3p0, *p1 + k3p1, *x0 + k3x0, *x1 + k3x1, (*model));
  k4p1 = DLAMBDA*geodesic_equation_r(spline1, acc1, spline2, acc2, *p0 + k3p0, *p1 + k3p1, *x0 + k3x0, *x1 + k3x1, (*model));

  /*Calculation of the increments*/
  dx0 = (k1x0 + 2.0*k2x0 + 2.0*k3x0 + k4x0)/6.0;
  dx1 = (k1x1 + 2.0*k2x1 + 2.0*k3x1 + k4x1)/6.0;
  dp0 = (k1p0 + 2.0*k2p0 + 2.0*k3p0 + k4p0)/6.0;
  dp1 = (k1p1 + 2.0*k2p1 + 2.0*k3p1 + k4p1)/6.0;

  /*New values of the variables of the differential equation. Since we are using pointers, when called the routine the value of variable change.*/
  *x0 = *x0 + dx0; *x1 = *x1 + dx1;
  *p0 = *p0 + dp0; *p1 = *p1 + dp1;

  /*Increment of parameter of geodesics*/
  *lambda = *lambda + DLAMBDA;
}

/*To set the initial value of pr, it must hold $g_{\mu\nu}p^{\mu}p^{\nu} = 0$.
This factor multiplies p0 to guarantee that p1 fulfill the null geodesic condition.*/
mydbl condition_factor(mydbl r, double a, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  mydbl potential, der_potential_radial, der_potential_temporal;
  (*model)((mydbl)(1.0*a), 0.0, r, &potential, &der_potential_radial, &der_potential_temporal);
  return (mydbl)(1.0/a)*sqrtl((C*C + 2.0*potential)/(C*C - 2.0*potential));
}

/*$cp^{0}$ multiplied by this factor allows to obtain the energy for a local inertial observer in this spacetime.*/
mydbl energy_factor(mydbl r, double a, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  mydbl potential, der_potential_radial, der_potential_temporal;
  (*model)((mydbl)(1.0*a), 0.0, r, &potential, &der_potential_radial, &der_potential_temporal);
  mydbl g = sqrtl(1.0 + 2.0*potential/(C*C));
  return g;
}

/*Violation of null geodesics condition $g_{\mu\nu}p^{\mu}p^{\nu} = 0$.*/
mydbl violation(mydbl r, mydbl p0, mydbl pr, double a, void (*model)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *))
{
  mydbl potential, der_potential_radial, der_potential_temporal;
  (*model)((mydbl)(1.0*a), 0.0, r, &potential, &der_potential_radial, &der_potential_temporal);
  mydbl f = -(1.0+2.0*potential/(C*C))*p0*p0 + (mydbl)(1.0*a*a)*(1.0-2.0*potential/(C*C))*pr*pr;
  return f;
}

int main(void)
{
  /***READ SCALE FACTOR DATA AND PREPARE OBJECTS FOR INTERPOLATION ***/
  int i;            //For array manipulation

  /*Pointer to scale_factor.data file*/
  FILE *frw;
  frw = fopen("../scale_factor.dat","r");

  /*Variables and arrays to read the data*/
  double cosmictime[NLINESFRW], conftime, scale_factor[NLINESFRW], der_scale_factor[NLINESFRW];

  /*Reading the data*/
  for(i=0; i<NLINESFRW; i++)
    {
      fscanf(frw,"%lf %lf %lf %lf", &cosmictime[i], &conftime, &scale_factor[i], &der_scale_factor[i]);
    }

  /*Free space in memory*/
  fclose(frw);

  /*** Initializes objects for interpolation. 1 is for interpolation of scale factor, 2 is for interpolation of derivative of scale factor ***/

  /*Allocate space in memory*/
  gsl_interp_accel *acc1 = gsl_interp_accel_alloc();  //Acceleration type object (for index lookup)
  gsl_interp_accel *acc2 = gsl_interp_accel_alloc();
  gsl_spline *spline1 = gsl_spline_alloc(gsl_interp_cspline, NLINESFRW);  //Spline type object (define interpolation type and space in memory, works for both)
  gsl_spline *spline2 = gsl_spline_alloc(gsl_interp_cspline, NLINESFRW);

  /*Initializes objects for interpolation*/
  gsl_spline_init(spline1, cosmictime, scale_factor, NLINESFRW);  //Initializes spline object for data cosmictime, scale_factor of size NLINES
  gsl_spline_init(spline2, cosmictime, der_scale_factor, NLINESFRW);  //Initializes spline object for data cosmictime, der_scale_factor of size NLINES

  /************************************************************************************/

  /***SOLVES GEODESIC EQUATIONS FOR PERTURBED FRW UNIVERSE WITH A GIVEN POTENTIAL MODEL ***/

  /*Choose model to use for solving geodesics*/
  void (*model_in_use)(mydbl, mydbl, mydbl, mydbl *, mydbl *, mydbl *);
  model_in_use = hernquist_model;

  /*Initial conditions*/
  mydbl ti = 9.0 ,x0, r = -3000.0, p0 = 1.0e-3, pr, lambda = 0.0, energy1, energy, v, difft, difference, pfrw, isw;
  double difftfrw, aem, aobs;
  x0 = C*ti;
  aem = interpolator(spline1, (double)(1.0*ti), acc1);
  pr = condition_factor(r, aem, model_in_use)*p0;
  energy1 = C*energy_factor(r, aem, model_in_use)*p0;
  v = violation(r, p0, pr, aem, model_in_use);
  difft = (energy1 - energy1)/energy1;
  difftfrw = (aem/aem) - 1.0;
  difference = difft - (mydbl)(1.0*difftfrw);
  pfrw = ((mydbl)(1.0*aem)*1.0e-03/((mydbl)(1.0*aem)));
  isw = p0/pfrw - 1.0;

  /*Pointer to file where solution of differential equation will be saved.*/
  FILE *geodesic;
  geodesic = fopen("geodesic_solution.dat","w");

  /*Write line of initial values in file*/
  fprintf(geodesic, "%16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8e %16.8Le %16.8Le\n", lambda, x0, r, p0, pr, energy1, v, difft, difftfrw, difference, isw);

  long long int ii;

  /*Solution of the differential equation*/
  for(ii=0; ii< NSTEPS; ii++)
    {
      runge_kutta_4(spline1, acc1, spline2, acc2, &x0, &r, &p0, &pr, &lambda, model_in_use);
      if((ii%(NSTEPS/NLINES)) == 0)
	{
	  ti = x0/C;
	  aobs = interpolator(spline1, (double)(1.0*ti), acc1);
	  energy = C*energy_factor(r, aobs, model_in_use)*p0;
	  v = violation(r, p0, pr, aobs, model_in_use);
	  difft = (energy - energy1)/energy1;
	  difftfrw = (aem/aobs) - 1.0;
	  difference = difft - (mydbl)(1.0*difftfrw);
	  pfrw = (mydbl)(1.0*aem)*1.0e-03/((mydbl)(1.0*aobs));
	  isw = p0/pfrw - 1.0;
	  fprintf(geodesic, "%16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8Le %16.8e %16.8Le %16.8Le\n", lambda, x0, r, p0, pr, energy, v, difft, difftfrw, difference, isw);
	}
    }

  /************************************************************************************/

  /*** Releasing all used space in memory ***/
  fclose(geodesic); //Close file storing the results
  gsl_spline_free(spline1);  //Free memory of spline object
  gsl_spline_free(spline2);
  gsl_interp_accel_free(acc1);  //Free memory of accel object
  gsl_interp_accel_free(acc2);
}


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "parmt_utils.h"
#ifdef PARMT_USE_INTEL
#include <mkl_lapacke.h>
#include <mkl_cblas.h>
#else
#include <lapacke.h>
#include <cblas.h>
#endif
#include "iscl/array/array.h"
#include "iscl/memory/memory.h"
#include "iscl/random/random.h"
#include "iscl/signal/convolve.h"

int parmt_utils_getEffectiveRank(const double relError,
                                 const struct parmtNoiseBasis_struct basis)
{
    double frac;
    int i, rank;
    rank = 1;
    for (i=1; i<basis.nvals; i++)
    {
        // Modification of Demmel 3.9.3 to deal with sqrt(eig)
        if (100.0*pow(basis.sqrtEvals[i], 2)/pow(basis.sqrtEvals[0], 2) < relError)
        {
            rank = i;
            break;
        }
    }
    return rank;
}

int parmt_utils_makeKLNoise(const int rank,
                            const int npts,
                            const struct parmtNoiseBasis_struct basis,
                            double *__restrict__ xn)
{
    double *r, xscal;
    int ir, ierr, ldz, rankUse;
    if (rank < 1 || npts < 1 || basis.npts != npts || xn == NULL)
    {
        if (rank < 1){fprintf(stderr, "%s: rank is too small\n", __func__);}
        if (npts < 1){fprintf(stderr, "%s: no points\n", __func__);}
        if (basis.npts != npts)
        {
            fprintf(stderr, "%s: npts != basis.npts\n", __func__);
        }
        if (xn == NULL){fprintf(stderr, "%s: error x is NULL\n", __func__);}
        return -1;
    }
    rankUse = MAX(1, MIN(basis.nvals, rank));
    ldz = basis.lde;
    r = random_rand64f(rankUse, &ierr);
    array_zeros64f_work(npts, xn);
    for (ir=0; ir<rank; ir++)
    {
        xscal = r[ir]*basis.sqrtEvals[ir];
printf("%f %f\n", r[ir], basis.sqrtEvals[ir]);
        cblas_daxpy(npts, xscal, &basis.evects[ir*ldz], 1, xn, 1);
    }
    memory_free64f(&r);
    return 0;
}
//============================================================================//
/*!
 * @brief Releases memory on the noise basis struture
 *
 * @param[out] basis   on exit all memory has been released and all variables
 *                     set to NULL or 0.
 *
 * @author Ben Baker
 *
 * @copyright ISTI distributed under Apache 2
 *
 */
int parmt_utils_freeNoiseBasis(struct parmtNoiseBasis_struct *basis)
{
    memory_free64f(&basis->sqrtEvals);
    memory_free64f(&basis->evects);
    memset(basis, 0, sizeof(struct parmtNoiseBasis_struct));
    return 0;
}
//============================================================================//
/*!
 * @brief Computes the eigenvectors and eigenvalues of the noise
 *        autocorrelation matrix which will be further used in the
 *        Karhunen-Loeve expansion.
 *
 * @param[in] npts     number of data points
 * @param[in] data     noise signal from which to compute noise basis.
 *
 * @param[out] basis   on successful exit contains the eigendecomposition
 *                     of the autocorrelation noise matrix for use in the KL
 *                     expansion.
 *
 * @result 0 indicates success
 *
 * @author Ben Baker
 *
 * @copyright ISTI distributed under Apache 2
 *
 */
int parmt_utils_getNoiseBasis64f(const int npts,
                                 const double *__restrict__ data,
                                 struct parmtNoiseBasis_struct *basis)
{
    double *C, *CtC, *s, xnorm;
    int i, ierr, j, ldc, ldctc, m, n, nrows;
    const enum corrMatrixType_enum type = CORRMTX_AUTOCORRELATION;
    //------------------------------------------------------------------------//
    //
    // error checking
    ierr = 0;
    memset(basis, 0, sizeof(struct parmtNoiseBasis_struct));
    if (npts < 1 || data == NULL)
    {
        if (npts < 1)
        {
            fprintf(stderr, "%s: No points in noise signal\n", __func__);
        }
        if (data == NULL)
        {
            fprintf(stderr, "%s; Noise signal is NULL\n", __func__);
        }
        return -1;
    }
    C = NULL;
    CtC = NULL;
    // Normalize the noise energy in the noise signal
    xnorm = cblas_dnrm2(npts, data, 1);
    if (fabs(xnorm) < 1.e-15)
    {
        fprintf(stderr, "%s: Error division by zero\n", __func__);
        return -1;
    }
    xnorm = 1.0/xnorm;
    s = array_copy64f(npts, data, &ierr);
    cblas_dscal(npts, xnorm, s, 1);
    // Figure out the size of the noise correlation matrix
    n = npts;
    m = npts - 1;
    ldc = n;
    if (type == CORRMTX_AUTOCORRELATION)
    {
        nrows = n + m;
        C = memory_calloc64f(ldc*nrows);
    }
    else
    {
        fprintf(stderr, "%s: Invalid correlation matrix type\n", __func__);
        return -1;
    }
    ldctc = n;
    CtC = memory_calloc64f(n*n);
    // Compute the correlation matrix and C'C
    ierr = convolve_corrmtx64f_work(npts, s,
                                    m, ldc, C,
                                    type, true, ldctc, CtC);
    if (ierr != 0)
    {
        fprintf(stderr, "%s: Failed to compute correlation matrix\n", __func__);
        goto ERROR;
    }
    ierr = parmt_utils_getNoiseBasisFromCtC64f(npts, ldctc, CtC, basis);
    if (ierr != 0)
    {
        fprintf(stderr, "%s: Failed to compute noise basis\n", __func__);
    }
ERROR:;
    memory_free64f(&C);
    memory_free64f(&CtC);
    return ierr;
}

int parmt_utils_getNoiseBasisFromCtC64f(const int npts, const int ldctc,
                                        const double *__restrict__ CtC,
                                        struct parmtNoiseBasis_struct *basis)
{
    double *CtCw, *w;
    int ierr, i, info, j;
    ierr = 0;
    memset(basis, 0, sizeof(struct parmtNoiseBasis_struct));
    CtCw = memory_calloc64f(npts*ldctc);
    for (i=0; i<npts; i++)
    {
        cblas_dcopy(npts, &CtC[i*ldctc], 1, &CtCw[i*ldctc], 1);
    }
    // Compute the eigendecompsition of the symmetric matrix
    w = memory_calloc64f(npts);
    info = LAPACKE_dsyev(LAPACK_ROW_MAJOR, 'V', 'U', npts, CtCw, ldctc, w);
    if (info != 0)
    {
        ierr = 1;
        if (info > 0)
        {
            fprintf(stderr, "%s: Failure to converge on %d'th element\n",
                    __func__, info);
        }
        else
        {
            fprintf(stderr, "%s: %d'th parameter is invalid\n", __func__, info);
        }
        goto ERROR;
    }
    // Set the basis
    basis->lde = npts;
    basis->nvals = npts;
    basis->npts = npts;
    basis->sqrtEvals = memory_calloc64f(basis->nvals);
    basis->evects = memory_calloc64f(basis->lde*basis->nvals);
    // Put into descending order
    for (i=0; i<npts; i++)
    {
        basis->sqrtEvals[i] = sqrt(w[npts-1-i]);
    }
    // Copy corresponding eigenvectors in descending order
    for (j=0; j<npts; j++)
    {
        for (i=0; i<npts; i++)
        {
            basis->evects[j*basis->lde+i] = CtCw[i*ldctc+(npts-1-j)];
        }
    }
ERROR:;
    memory_free64f(&w);
    memory_free64f(&CtCw);
    return ierr;
}


#ifndef _CSPLINE_H_
#define _CSPLINE_H_

#include <iostream>
#include <sstream>
#include <vector>
#include <cmath>
#include <vector_types.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_linalg.h>

template <typename T> class cspline{
    std::vector<T> y;
    std::vector<T> t;
    std::vector<T> h;
    std::vector<T> z;
    int N;

    void h_calc();
    void b_calc(std::vector<T> &b);
    void v_calc(std::vector<T> &v);
    void u_calc(std::vector<T> &u, std::vector<T> &b);
    void z_calc(std::vector<T> &v, std::vector<T> &u);

    public:
        cspline();

        cspline(std::vector<T> &x, std::vector<T> &fx);

        void initialize(std::vector<T> &x, std::vector<T> &fx);

        void set_pointer_for_device(std::vector<float4> &spline);

        void set_pointer_for_device(std::vector<double4> &spline);

        T evaluate(T x);

};

template<typename T> void cspline<T>::h_calc() {
    for (int i = 0; i < cspline<T>::N - 1; ++i)
        cspline<T>::h.push_back(t[i + 1] - t[i]);
}

template<typename T> void cspline<T>::b_calc(std::vector<T> &b) {
    for (int i = 0; i < cspline<T>::N - 1; ++i)
        b[i] = (cspline<T>::y[i + 1] - cspline<T>::y[i])/h[i];
}

template<typename T> void cspline<T>::v_calc(std::vector<T> &v) {
    for (int i = 1; i < cspline<T>::N - 1; ++i)
        v[i - 1] = 2.0*(cspline<T>::h[i - 1] + cspline<T>::h[i]);
}

template<typename T> void cspline<T>::u_calc(std::vector<T> &u, std::vector<T> &b) {
    for (int i = 1; i < cspline<T>::N - 1; ++i)
        u[i - 1] = 6.0*(b[i] - b[i - 1]);
}

template<typename T> void cspline<T>::z_calc(std::vector<T> &v, std::vector<T> &u) {
    gsl_matrix *A = gsl_matrix_alloc(cspline<T>::N - 2, cspline<T>::N - 2);
    gsl_vector *Z = gsl_vector_alloc(cspline<T>::N - 2);
    gsl_vector *U = gsl_vector_alloc(cspline<T>::N - 2);

    for (int i = 1; i < cspline<T>::N - 1; ++i) {
        gsl_vector_set(U, i - 1, u[i - 1]);
        for (int j = 1; j < cspline<T>::N - 1; ++j) {
            if (i == j) gsl_matrix_set(A, i - 1, j - 1, v[i - 1]);
            else if (j == i + 1) gsl_matrix_set(A, i - 1, j - 1, cspline<T>::h[i]);
            else if (j == i - 1) gsl_matrix_set(A, i - 1, j - 1, cspline<T>::h[j]);
            else gsl_matrix_set(A, i - 1, j - 1, 0.0);
        }
    }

    int s;
    gsl_permutation *p = gsl_permutation_alloc(cspline<T>::N - 2);
    gsl_linalg_LU_decomp(A, p, &s);
    gsl_linalg_LU_solve(A, p, U, Z);

    for (int i = 0; i < cspline<T>::N; ++i) {
        if (i == 0 || i == cspline<T>::N - 1) cspline<T>::z.push_back(0.0);
        else cspline<T>::z.push_back(gsl_vector_get(Z, i - 1));
    }

    gsl_vector_free(Z);
    gsl_vector_free(U);
    gsl_matrix_free(A);
    gsl_permutation_free(p);
}

template<typename T> cspline<T>::cspline() {
    cspline<T>::N = 1;
}

template<typename T> cspline<T>::cspline(std::vector<T> &x, std::vector<T> &fx) {
    cspline<T>::N = fx.size();

    for (int i = 0; i < cspline<T>::N; ++i) {
        cspline<T>::t.push_back(x[i]);
        cspline<T>::y.push_back(fx[i]);
    }

    std::vector<T> b(cspline<T>::N - 1);
    std::vector<T> v(cspline<T>::N - 2);
    std::vector<T> u(cspline<T>::N - 2);

    cspline<T>::h_calc();
    cspline<T>::b_calc(b);
    cspline<T>::v_calc(v);
    cspline<T>::u_calc(u, b);
    cspline<T>::z_calc(v, u);
}

template<typename T> void cspline<T>::initialize(std::vector<T> &x, std::vector<T> &fx) {
    cspline<T>::N = fx.size();

    for (int i = 0; i < cspline<T>::N; ++i) {
        cspline<T>::t.push_back(x[i]);
        cspline<T>::y.push_back(fx[i]);
    }

    std::vector<T> b(cspline<T>::N - 1);
    std::vector<T> v(cspline<T>::N - 2);
    std::vector<T> u(cspline<T>::N - 2);

    cspline<T>::h_calc();
    cspline<T>::b_calc(b);
    cspline<T>::v_calc(v);
    cspline<T>::u_calc(u, b);
    cspline<T>::z_calc(v, u);
}

template<typename T> void cspline<T>::set_pointer_for_device(std::vector<float4> &spline) {
    for (int i = 0; i < cspline<T>::N; ++i) {
        float4 temp = {cspline<T>::t[i], cspline<T>::y[i], cspline<T>::z[i], cspline<T>::h[i]};
        spline.push_back(temp);
    }
}

template<typename T> void cspline<T>::set_pointer_for_device(std::vector<double4> &spline) {
    for (int i = 0; i < cspline<T>::N; ++i) {
        double4 temp = {cspline<T>::t[i], cspline<T>::y[i], cspline<T>::z[i], cspline<T>::h[i]};
        spline.push_back(temp);
    }
}

template<typename T> T cspline<T>::evaluate(T x) {
    if (x < cspline<T>::t[0] || x > cspline<T>::t[cspline<T>::N - 1]) {
        std::stringstream message;
        message << "The requested x value is outside of the allowed range." << std::endl;
        throw std::runtime_error(message.str());
    }

    int i = 0;
    while (cspline<T>::t[i] < x) ++i;
    i--;

    T val = (cspline<T>::z[i + 1]*(x - cspline<T>::t[i])*(x - cspline<T>::t[i])*(x - cspline<T>::t[i]))/(6.0*cspline<T>::h[i])
             + (cspline<T>::z[i]*(cspline<T>::t[i + 1] - x)*(cspline<T>::t[i + 1] - x)*(cspline<T>::t[i + 1] - x))/(6.0*cspline<T>::h[i])
             + (cspline<T>::y[i + 1]/cspline<T>::h[i] - (cspline<T>::z[i + 1]*cspline<T>::h[i])/6.0)*(x - cspline<T>::t[i])
             + (cspline<T>::y[i]/cspline<T>::h[i] - (cspline<T>::h[i]*cspline<T>::z[i])/6.0)*(cspline<T>::t[i + 1] - x);

    return val;
}

#endif


/*
 * Tema 2 ASC
 * 2019 Spring
 * Catalin Olaru / Vlad Spoiala
 */
#include <cblas.h>

#include "utils.h"
/*
 * Add your BLAS implementation here
 */
double* my_solver(int N, double *A, double *B) {
	double *first_multiplication = malloc(N * N * sizeof(double));
	double *second_multiplication = malloc(N * N * sizeof(double));
	double *final_result = malloc(N * N * sizeof(double));
	double alpha = 1.0;
	double beta = 0.0;
	double *identity_matrix = malloc(N * N * sizeof(double));
	int i, j;

/* Compute identity matrix so we can use it later on. */
	for (i = 0; i < N; ++i)
		for (j = 0; j < N; ++j)
			identity_matrix[i * N + j] = j == i ? 1.0 : 0.0;

/* Compute Transpose(A) * B in first_multiplication. */
	cblas_dgemm(CblasRowMajor,
				CblasTrans,
				CblasNoTrans,
				N,
				N,
				N,
				alpha,
				A,
				N,
				B,
				N,
				beta,
				first_multiplication,
				N);
/* Compute Transpose(B) * A in second_multiplication. */
	cblas_dgemm(CblasRowMajor,
				CblasTrans,
				CblasNoTrans,
				N,
				N,
				N,
				alpha,
				B,
				N,
				A,
				N,
				beta,
				second_multiplication,
				N);
/* Add the previous 2 results in second multiplication. */
	cblas_dgemm(CblasRowMajor,
				CblasNoTrans,
				CblasNoTrans,
				N,
				N,
				N,
				alpha,
				first_multiplication,
				N,
				identity_matrix,
				N,
				alpha,
				second_multiplication,
				N);

/* Apply zerotr(second_multiplication) as everything involving
 * CblasLower or CblasUpper didn't work for some reason. :(
 */
	for (i = 0; i < N; ++i)
		for (j = 0; j < i; ++j)
			second_multiplication[i * N + j] = 0;

/* Multiply second_multiplication by itself so we get the
 * result in final_result. */
	cblas_dgemm(CblasRowMajor,
				CblasNoTrans,
				CblasNoTrans,
				N,
				N,
				N,
				alpha,
				second_multiplication,
				N,
				second_multiplication,
				N,
				beta,
				final_result,
				N);

/* Free everything aside from the return value. */
	free(first_multiplication);
	free(second_multiplication);
	free(identity_matrix);

	return final_result;
}


/*
 * harvest.c -- compute solutions of harvest equation
 *
 * (c) 2016 Prof Dr Andreas Mueller,  Hochschule Rapperswil
 */
#include <stdlib.h>
#include <stdio.h>
#define __USE_XOPEN
#include <math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_odeiv2.h>

typedef struct param_s {
	double	a;
	double	h;
} param_t;

param_t	p0 = { .a = 5, .h = 0.8 };

int	f(double x, const double y[], double f[], void *params) {
	param_t	*p = (param_t *)params;
	f[0] = p->a * y[0] * (1 - y[0]) - p->h * (1 + sin(2 * M_PI * x));
	return GSL_SUCCESS;
}

int	singlecurve(FILE *out, const char *name, double x0, double y0,
		int direction) {
	printf("%s: %f\n", name, y0);
	gsl_odeiv2_system	system = { f, NULL, 1, &p0 };
	gsl_odeiv2_driver	*driver
		= gsl_odeiv2_driver_alloc_y_new(&system, gsl_odeiv2_step_rk8pd,
			1e-6 * direction, 1e-6, 0.0);
	fprintf(out, "path %s;\n", name);
	double	x = x0;
	double	y[1] = { y0 };
	fprintf(out, "%s = (%.3f,%.3f)", name, x, y[0]);
	for (int i = 1; i < 500; i++) {
		double	xnext = x + 0.01 * direction;
		int	status = gsl_odeiv2_driver_apply(driver, &x, xnext, y);
		if (status != GSL_SUCCESS) {
			fprintf(stderr, "error: rc = %d\n", status);
			fprintf(out, ";\n");
			return -1;
		}
		if (fabs(y[0]) > 100) {
			goto end;
		}
		fprintf(out, "\n    --(%.3f,%.3f)", x, y[0]);
	}
end:
	fprintf(out, ";\n");
	gsl_odeiv2_driver_free(driver);
	return 1;
}

int	centercurve(FILE *out, const char *name, double y0) {
	printf("%s: %f\n", name, y0);
	gsl_odeiv2_system	system = { f, NULL, 1, &p0 };
	gsl_odeiv2_driver	*driver
		= gsl_odeiv2_driver_alloc_y_new(&system, gsl_odeiv2_step_rk8pd,
			-1e-6, 1e-6, 0.0);
	fprintf(out, "path %s;\n", name);
	double	x = 2.5;
	double	y[1] = { y0 };
	// integrate backwards to the initial value
	gsl_odeiv2_driver_apply(driver, &x, 0, y);
	gsl_odeiv2_driver_free(driver);
	driver = gsl_odeiv2_driver_alloc_y_new(&system, gsl_odeiv2_step_rk8pd,
			1e-6, 1e-6, 0.0);
	if (fabs(y[0]) > 100) {
		goto end;
	}
	fprintf(out, "%s = (%.3f,%.3f)", name, x, y[0]);
	for (int i = 1; i < 501; i++) {
		double	xnext = x + 0.01;
		int	status = gsl_odeiv2_driver_apply(driver, &x, xnext, y);
		if (status != GSL_SUCCESS) {
			fprintf(stderr, "error: rc = %d\n", status);
			fprintf(out, ";\n");
			return -1;
		}
		if (fabs(y[0]) > 100) {
			goto end;
		}
		fprintf(out, "\n    --(%.3f,%.3f)", x, y[0]);
	}
end:
	fprintf(out, ";\n");
	gsl_odeiv2_driver_free(driver);
	return 1;
}

int	limitcurve(FILE *out, const char *name, int direction) {
	gsl_odeiv2_system	system = { f, NULL, 1, &p0 };
	gsl_odeiv2_driver	*driver
		= gsl_odeiv2_driver_alloc_y_new(&system, gsl_odeiv2_step_rk8pd,
			direction * 1e-6, 1e-6, 0.0);
	double	x = 0;
	double	y[1] = { 0.5 };
	double	xnext = 1000 * direction;
	int	status = gsl_odeiv2_driver_apply(driver, &x, xnext, y);
	printf("integration from %f to %f: %f (%d)\n", x, xnext, y[0], status);
	gsl_odeiv2_driver_free(driver);
	// now use this as the initial value
	return singlecurve(out, name, 2.5 * (1 - direction), y[0], direction);
}

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

	FILE	*out = fopen("harvest.mp", "w");
	char	suffix = 'a';
	char	curvename[10];
	for (int i = 0; i < 5; i++) {
		snprintf(curvename, sizeof(curvename), "path%c", suffix++);
		double	y0 = 0.7 + 0.2 * i;
		singlecurve(out, curvename, 0, y0, 1);
	}
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 0, 0.318, 1);
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 0, 0.315, 1);
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 0, 0.300, 1);
	for (int i = 0; i < 5; i++) {
		snprintf(curvename, sizeof(curvename), "path%c", suffix++);
		double	y0 = 0.3 - 0.2 * i;
		singlecurve(out, curvename, 5, y0, -1);
	}
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 5, 0.892, -1);
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 5, 0.895, -1);
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	singlecurve(out, curvename, 5, 0.91, -1);
	for (int i = -3; i <= 3; i++) {
		snprintf(curvename, sizeof(curvename), "path%c", suffix++);
		double	y0 = 0.395 + 0.0945 * i;
		centercurve(out, curvename, y0);
	}

	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	limitcurve(out, curvename, -1);
	snprintf(curvename, sizeof(curvename), "path%c", suffix++);
	limitcurve(out, curvename, 1);

	fclose(out);

	return EXIT_SUCCESS;
}


#include <stdio.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sum.h>

#define N 20

int
main (void)
{
  double t[N];
  double sum_accel, err;
  double sum = 0;
  int n;

  gsl_sum_levin_u_workspace * w
    = gsl_sum_levin_u_alloc (N);

  const double zeta_2 = M_PI * M_PI / 6.0;

  /* terms for zeta(2) = \sum_{n=1}^{\infty} 1/n^2 */

  for (n = 0; n < N; n++)
    {
      double np1 = n + 1.0;
      t[n] = 1.0 / (np1 * np1);
      sum += t[n];
    }

  gsl_sum_levin_u_accel (t, N, w, &sum_accel, &err);

  printf ("term-by-term sum = % .16f using %d terms\n",
          sum, N);

  printf ("term-by-term sum = % .16f using %zu terms\n",
          w->sum_plain, w->terms_used);

  printf ("exact value      = % .16f\n", zeta_2);
  printf ("accelerated sum  = % .16f using %zu terms\n",
          sum_accel, w->terms_used);

  printf ("estimated error  = % .16f\n", err);
  printf ("actual error     = % .16f\n",
          sum_accel - zeta_2);

  gsl_sum_levin_u_free (w);
  return 0;
}


/* specfunc/mathieu_angfunc.c
 *
 * Copyright (C) 2002 Lowell Johnson
 *
 * 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., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* Author:  L. Johnson */

#include <config.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_mathieu.h>

int gsl_sf_mathieu_ce_e(int order, double qq, double zz, gsl_sf_result *result)
{
  int even_odd, ii, status;
  double coeff[GSL_SF_MATHIEU_COEFF], norm, fn, factor;
  gsl_sf_result aa;

  norm = 0.0;
  even_odd = 0;
  if (order % 2 != 0)
      even_odd = 1;

  /* Handle the trivial case where q = 0. */
  if (qq == 0.0)
  {
      norm = 1.0;
      if (order == 0)
          norm = sqrt(2.0);

      fn = cos(order*zz)/norm;

      result->val = fn;
      result->err = 2.0*GSL_DBL_EPSILON;
      factor = fabs(fn);
      if (factor > 1.0)
          result->err *= factor;

      return GSL_SUCCESS;
  }

  /* Use symmetry characteristics of the functions to handle cases with
     negative order. */
  if (order < 0)
      order *= -1;

  /* Compute the characteristic value. */
  status = gsl_sf_mathieu_a_e(order, qq, &aa);
  if (status != GSL_SUCCESS)
  {
      return status;
  }

  /* Compute the series coefficients. */
  status = gsl_sf_mathieu_a_coeff(order, qq, aa.val, coeff);
  if (status != GSL_SUCCESS)
  {
      return status;
  }

  if (even_odd == 0)
  {
      fn = 0.0;
      norm = coeff[0]*coeff[0];
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          fn += coeff[ii]*cos(2.0*ii*zz);
          norm += coeff[ii]*coeff[ii];
      }
  }
  else
  {
      fn = 0.0;
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          fn += coeff[ii]*cos((2.0*ii + 1.0)*zz);
          norm += coeff[ii]*coeff[ii];
      }
  }

  norm = sqrt(norm);
  fn /= norm;

  result->val = fn;
  result->err = 2.0*GSL_DBL_EPSILON;
  factor = fabs(fn);
  if (factor > 1.0)
      result->err *= factor;

  return GSL_SUCCESS;
}

int gsl_sf_mathieu_se_e(int order, double qq, double zz, gsl_sf_result *result)
{
  int even_odd, ii, status;
  double coeff[GSL_SF_MATHIEU_COEFF], norm, fn, factor;
  gsl_sf_result aa;

  norm = 0.0;
  even_odd = 0;
  if (order % 2 != 0)
      even_odd = 1;

  /* Handle the trivial cases where order = 0 and/or q = 0. */
  if (order == 0)
  {
      result->val = 0.0;
      result->err = 0.0;
      return GSL_SUCCESS;
  }

  if (qq == 0.0)
  {
      norm = 1.0;
      fn = sin(order*zz);

      result->val = fn;
      result->err = 2.0*GSL_DBL_EPSILON;
      factor = fabs(fn);
      if (factor > 1.0)
          result->err *= factor;

      return GSL_SUCCESS;
  }

  /* Use symmetry characteristics of the functions to handle cases with
     negative order. */
  if (order < 0)
      order *= -1;

  /* Compute the characteristic value. */
  status = gsl_sf_mathieu_b_e(order, qq, &aa);
  if (status != GSL_SUCCESS)
  {
      return status;
  }

  /* Compute the series coefficients. */
  status = gsl_sf_mathieu_b_coeff(order, qq, aa.val, coeff);
  if (status != GSL_SUCCESS)
  {
      return status;
  }

  if (even_odd == 0)
  {
      fn = 0.0;
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          norm += coeff[ii]*coeff[ii];
          fn += coeff[ii]*sin(2.0*(ii + 1)*zz);
      }
  }
  else
  {
      fn = 0.0;
      for (ii=0; ii<GSL_SF_MATHIEU_COEFF; ii++)
      {
          norm += coeff[ii]*coeff[ii];
          fn += coeff[ii]*sin((2.0*ii + 1)*zz);
      }
  }
  norm = sqrt(norm);
  fn /= norm;

  result->val = fn;
  result->err = 2.0*GSL_DBL_EPSILON;
  factor = fabs(fn);
  if (factor > 1.0)
      result->err *= factor;

  return GSL_SUCCESS;
}

int gsl_sf_mathieu_ce_array(int nmin, int nmax, double qq, double zz,
                            gsl_sf_mathieu_workspace *work,
                            double result_array[])
{
  int even_odd, order, ii, jj, status;
  double coeff[GSL_SF_MATHIEU_COEFF], *aa = work->aa, norm;

  /* Initialize the result array to zeroes. */
  for (ii=0; ii<nmax-nmin+1; ii++)
      result_array[ii] = 0.0;

  /* Ensure that the workspace is large enough to accomodate. */
  if (work->size < (unsigned int)nmax)
  {
      GSL_ERROR("Work space not large enough", GSL_EINVAL);
  }

  if (nmin < 0 || nmax < nmin)
  {
      GSL_ERROR("domain error", GSL_EDOM);
  }

  /* Compute all of the eigenvalues up to nmax. */
  gsl_sf_mathieu_a_array(0, nmax, qq, work, aa);

  for (ii=0, order=nmin; order<=nmax; ii++, order++)
  {
      norm = 0.0;
      even_odd = 0;
      if (order % 2 != 0)
          even_odd = 1;

      /* Handle the trivial case where q = 0. */
      if (qq == 0.0)
      {
          norm = 1.0;
          if (order == 0)
              norm = sqrt(2.0);

          result_array[ii] = cos(order*zz)/norm;

          continue;
      }

      /* Compute the series coefficients. */
      status = gsl_sf_mathieu_a_coeff(order, qq, aa[order], coeff);
      if (status != GSL_SUCCESS)
          return status;

      if (even_odd == 0)
      {
          norm = coeff[0]*coeff[0];
          for (jj=0; jj<GSL_SF_MATHIEU_COEFF; jj++)
          {
              result_array[ii] += coeff[jj]*cos(2.0*jj*zz);
              norm += coeff[jj]*coeff[jj];
          }
      }
      else
      {
          for (jj=0; jj<GSL_SF_MATHIEU_COEFF; jj++)
          {
              result_array[ii] += coeff[jj]*cos((2.0*jj + 1.0)*zz);
              norm += coeff[jj]*coeff[jj];
          }
      }

      norm = sqrt(norm);
      result_array[ii] /= norm;
  }

  return GSL_SUCCESS;
}

int gsl_sf_mathieu_se_array(int nmin, int nmax, double qq, double zz,
                            gsl_sf_mathieu_workspace *work,
                            double result_array[])
{
  int even_odd, order, ii, jj, status;
  double coeff[GSL_SF_MATHIEU_COEFF], *bb = work->bb, norm;

  /* Initialize the result array to zeroes. */
  for (ii=0; ii<nmax-nmin+1; ii++)
      result_array[ii] = 0.0;

  /* Ensure that the workspace is large enough to accomodate. */
  if (work->size < (unsigned int)nmax)
  {
      GSL_ERROR("Work space not large enough", GSL_EINVAL);
  }

  if (nmin < 0 || nmax < nmin)
  {
      GSL_ERROR("domain error", GSL_EDOM);
  }

  /* Compute all of the eigenvalues up to nmax. */
  gsl_sf_mathieu_b_array(0, nmax, qq, work, bb);

  for (ii=0, order=nmin; order<=nmax; ii++, order++)
  {
      norm = 0.0;
      even_odd = 0;
      if (order % 2 != 0)
          even_odd = 1;

      /* Handle the trivial cases where order = 0 and/or q = 0. */
      if (order == 0)
      {
          norm = 1.0;
          result_array[ii] = 0.0;
          continue;
      }

      if (qq == 0.0)
      {
          norm = 1.0;
          result_array[ii] = sin(order*zz);

          continue;
      }

      /* Compute the series coefficients. */
      status = gsl_sf_mathieu_b_coeff(order, qq, bb[order], coeff);
      if (status != GSL_SUCCESS)
      {
          return status;
      }

      if (even_odd == 0)
      {
          for (jj=0; jj<GSL_SF_MATHIEU_COEFF; jj++)
          {
              result_array[ii] += coeff[jj]*sin(2.0*(jj + 1)*zz);
              norm += coeff[jj]*coeff[jj];
          }
      }
      else
      {
          for (jj=0; jj<GSL_SF_MATHIEU_COEFF; jj++)
          {
              result_array[ii] += coeff[jj]*sin((2.0*jj + 1.0)*zz);
              norm += coeff[jj]*coeff[jj];
          }
      }

      norm = sqrt(norm);
      result_array[ii] /= norm;
  }

  return GSL_SUCCESS;
}

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

#include "eval.h"

double gsl_sf_mathieu_ce(int order, double qq, double zz)
{
	EVAL_RESULT(gsl_sf_mathieu_ce_e(order, qq, zz, &result));
}

double gsl_sf_mathieu_se(int order, double qq, double zz)
{
	EVAL_RESULT(gsl_sf_mathieu_se_e(order, qq, zz, &result));
}


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

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

/* The Rayleigh distribution has the form

   p(x) dx = (x / sigma^2) exp(-x^2/(2 sigma^2)) dx

   for x = 0 ... +infty */

double
gsl_ran_rayleigh (const gsl_rng * r, const double sigma)
{
  double u = gsl_rng_uniform_pos (r);

  return sigma * sqrt(-2.0 * log (u));
}

double
gsl_ran_rayleigh_pdf (const double x, const double sigma)
{
  if (x < 0)
    {
      return 0 ;
    }
  else
    {
      double u = x / sigma ;
      double p = (u / sigma) * exp(-u * u / 2.0) ;

      return p;
    }
}

/* The Rayleigh tail distribution has the form

   p(x) dx = (x / sigma^2) exp((a^2 - x^2)/(2 sigma^2)) dx

   for x = a ... +infty */

double
gsl_ran_rayleigh_tail (const gsl_rng * r, const double a, const double sigma)
{
  double u = gsl_rng_uniform_pos (r);

  return sqrt(a * a - 2.0 * sigma * sigma * log (u));
}

double
gsl_ran_rayleigh_tail_pdf (const double x, const double a, const double sigma)
{
  if (x < a)
    {
      return 0 ;
    }
  else
    {
      double u = x / sigma ;
      double v = a / sigma ;

      double p = (u / sigma) * exp((v + u) * (v - u) / 2.0) ;

      return p;
    }
}


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

void mgsl_linalg_complex_LU_det(gsl_matrix_complex *LU, int signum, gsl_complex *res)
{
  gsl_complex ret = gsl_linalg_complex_LU_det(LU, signum);
  *res = ret;
}

void mgsl_linalg_complex_LU_sgndet(gsl_matrix_complex *LU, int signum, gsl_complex *res)
{
  gsl_complex ret = gsl_linalg_complex_LU_sgndet(LU, signum);
  *res = ret;
}

void mgsl_linalg_complex_householder_transform(gsl_vector_complex *w, gsl_complex *res)
{
  gsl_complex ret = gsl_linalg_complex_householder_transform(w);
  *res = ret;
}

int mgsl_linalg_complex_householder_hm(gsl_complex *tau, gsl_vector_complex *v, gsl_matrix_complex *A)
{
  return gsl_linalg_complex_householder_hm(*tau, v, A);
}

int mgsl_linalg_complex_householder_mh(gsl_complex *tau, gsl_vector_complex *v, gsl_matrix_complex *A)
{
  return gsl_linalg_complex_householder_mh(*tau, v, A);
}

int mgsl_linalg_complex_householder_hv(gsl_complex *tau, gsl_vector_complex *v, gsl_vector_complex *w)
{
  return gsl_linalg_complex_householder_hv(*tau, v, w);
}


#ifndef DETERMINISTIC_NETWORK_SIR_H
#define DETERMINISTIC_NETWORK_SIR_H

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

using namespace std;

class Deterministic_Network_SIR_Sim : public DiffEq_Sim {

    private:
        const double r;
        const double mu;
        const vector<double> deg_dist;

    public:
        Deterministic_Network_SIR_Sim() : r(0.0), mu(0.0) { nbins=4;}
        Deterministic_Network_SIR_Sim(double r_param, double mu_param, vector<double> deg_dist_param):
            r(r_param),
            mu(mu_param),
            deg_dist(deg_dist_param) {
                nbins=4;
            }
        ~Deterministic_Network_SIR_Sim() {};

        void initialize( double theta, double pS, double pI, double I) {
            y = new double[nbins];
            y[0] = theta;
            y[1] = pS;
            y[2] = pI;
            y[3] = I;
        }

        double current_susceptible() { return g( y[0] ); }
        double current_infectious() { return y[3]; }
        double current_recovered() { return 1.0 - current_susceptible() - current_infectious(); }

        double g( double theta) {
            double val = 0;
            for (unsigned int i = 0; i<deg_dist.size(); i++) {
                val += deg_dist[i] * pow(theta,i);
            }
            return val;
        }

        double dg( double theta) {
            double val = 0;
            for (unsigned int i = 1; i<deg_dist.size(); i++) {
                val += (i) * deg_dist[i] * pow(theta,i-1);
            }
            return val;
        }

        double ddg( double theta) {
            double val = 0;
            for (unsigned int i = 2; i<deg_dist.size(); i++) {
                val += (i) * (i-1) *deg_dist[i] * pow(theta,i-2);
            }
            return val;
        }

        void derivative(double const y[], double dydt[]) {
            const double theta = y[0];
            const double pS = y[1];
            const double pI = y[2];
            const double I = y[3];

            dydt[0] = -r * pI * theta;                                                  // dtheta.dt
            dydt[1] = r *  pS * pI * (1 - theta * ddg(theta)/dg(theta));                // dpS.dt
            dydt[2] = r *  pI * pS * theta * ddg(theta)/dg(theta) - pI*(1-pI)*r- pI*mu; // dpI.dt

            dydt[3] = r * pI * theta * dg(theta) - mu*I;
        }

};

#endif


#include <math.h>
#include <stdlib.h>
#include <gsl/gsl_siman.h>

/* set up parameters for this simulated annealing run */

/* how many points do we try before stepping */
#define N_TRIES 200

/* how many iterations for each T? */
#define ITERS_FIXED_T 10

/* max step size in random walk */
#define STEP_SIZE 10

/* Boltzmann constant */
#define K 1.0

/* initial temperature */
#define T_INITIAL 0.002

/* damping factor for temperature */
#define MU_T 1.005
#define T_MIN 2.0e-6

gsl_siman_params_t params
  = {N_TRIES, ITERS_FIXED_T, STEP_SIZE,
     K, T_INITIAL, MU_T, T_MIN};

/* now some functions to test in one dimension */
double E1(void *xp)
{
  double x = * ((double *) xp);

  return exp(-pow((x-1.0),2.0))*sin(8*x);
}

double M1(void *xp, void *yp)
{
  double x = *((double *) xp);
  double y = *((double *) yp);

  return fabs(x - y);
}

void S1(const gsl_rng * r, void *xp, double step_size)
{
  double old_x = *((double *) xp);
  double new_x;

  double u = gsl_rng_uniform(r);
  new_x = u*2*step_size - step_size + old_x;

  memcpy(xp, &new_x, sizeof(new_x));
}

void P1(void *xp)
{
  printf("%12g", *((double *) xp));
}

int
main(int argc, char *argv[])
{
  gsl_rng_type * T;
  gsl_rng * r;

  double x_initial = 15.5;

  gsl_rng_env_setup();

  T = gsl_rng_default;
  r = gsl_rng_alloc(T);

  gsl_siman_solve(r, &x_initial, E1, S1, M1, P1,
                  NULL, NULL, NULL,
                  sizeof(double), params);
  return 0;
}


/*
  NAME:
     logsum
  PURPOSE:
     calculate the log of the sum of numbers which are given as logs using as much of the dynamic range as possible
  CALLING SEQUENCE:
     logsum(gsl_matrix * q, int row, bool isrow,bool partial, int partial_indx[3])
  INPUT:
     q            - matrix of which we will sum a row/column
     row          - row/column number
     isrow        - are we summing a row or a column
  OUTPUT:
     log of the sum
  REVISION HISTORY:
     2008-09-21 - Written Bovy
*/
#include <stdbool.h>
#include <math.h>
#include <float.h>
#include <gsl/gsl_matrix.h>
#include <proj_gauss_mixtures.h>

double logsum(gsl_matrix * q, int row, bool isrow){
  double logxmin = log(DBL_MIN);
  double logxmax = log(DBL_MAX);
  int l = (isrow) ? q->size2 : q->size1;

  /* First find the maximum and mininum */
  double max, min;
  minmax(q,row,isrow,&min,&max);//,allfixed);

  min *= -1.;
  min += logxmin;
  max *= -1.;
  max += logxmax - log(l);
  (min >  max) ? (max=max) : (max=min);
  double loglike=0.0;
  int dd;
  if (isrow)
    for (dd = 0; dd != q->size2; ++dd)
	loglike += exp(gsl_matrix_get(q,row,dd)+max);
  else
    for (dd = 0; dd != q->size1; ++dd)
	loglike += exp(gsl_matrix_get(q,dd,row)+max);

  return log(loglike)-max;
}


/* linalg/svd.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2004, 2007 Gerard Jungman, 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 <string.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>

#include <gsl/gsl_linalg.h>

#include "givens.c"
#include "svdstep.c"

/* Factorise a general M x N matrix A into,
 *
 *   A = U D V^T
 *
 * where U is a column-orthogonal M x N matrix (U^T U = I),
 * D is a diagonal N x N matrix,
 * and V is an N x N orthogonal matrix (V^T V = V V^T = I)
 *
 * U is stored in the original matrix A, which has the same size
 *
 * V is stored as a separate matrix (not V^T). You must take the
 * transpose to form the product above.
 *
 * The diagonal matrix D is stored in the vector S,  D_ii = S_i
 */

int
gsl_linalg_SV_decomp (gsl_matrix * A, gsl_matrix * V, gsl_vector * S,
                      gsl_vector * work)
{
  size_t a, b, i, j, iter;

  const size_t M = A->size1;
  const size_t N = A->size2;
  const size_t K = GSL_MIN (M, N);

  if (M < N)
    {
      GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
    }
  else if (V->size1 != N)
    {
      GSL_ERROR ("square matrix V must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (V->size1 != V->size2)
    {
      GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
    }
  else if (S->size != N)
    {
      GSL_ERROR ("length of vector S must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (work->size != N)
    {
      GSL_ERROR ("length of workspace must match second dimension of matrix A",
                 GSL_EBADLEN);
    }

  /* Handle the case of N = 1 (SVD of a column vector) */

  if (N == 1)
    {
      gsl_vector_view column = gsl_matrix_column (A, 0);
      double norm = gsl_blas_dnrm2 (&column.vector);

      gsl_vector_set (S, 0, norm);
      gsl_matrix_set (V, 0, 0, 1.0);

      if (norm != 0.0)
        {
          gsl_blas_dscal (1.0/norm, &column.vector);
        }

      return GSL_SUCCESS;
    }

  {
    gsl_vector_view f = gsl_vector_subvector (work, 0, K - 1);

    /* bidiagonalize matrix A, unpack A into U S V */

    gsl_linalg_bidiag_decomp (A, S, &f.vector);
    gsl_linalg_bidiag_unpack2 (A, S, &f.vector, V);

    /* apply reduction steps to B=(S,Sd) */

    chop_small_elements (S, &f.vector);

    /* Progressively reduce the matrix until it is diagonal */

    b = N - 1;
    iter = 0;

    while (b > 0)
      {
        double fbm1 = gsl_vector_get (&f.vector, b - 1);

        if (fbm1 == 0.0 || gsl_isnan (fbm1))
          {
            b--;
            continue;
          }

        /* Find the largest unreduced block (a,b) starting from b
           and working backwards */

        a = b - 1;

        while (a > 0)
          {
            double fam1 = gsl_vector_get (&f.vector, a - 1);

            if (fam1 == 0.0 || gsl_isnan (fam1))
              {
                break;
              }

            a--;
          }

        iter++;

        if (iter > 100 * N)
          {
            GSL_ERROR("SVD decomposition failed to converge", GSL_EMAXITER);
          }

        {
          const size_t n_block = b - a + 1;
          gsl_vector_view S_block = gsl_vector_subvector (S, a, n_block);
          gsl_vector_view f_block = gsl_vector_subvector (&f.vector, a, n_block - 1);

          gsl_matrix_view U_block =
            gsl_matrix_submatrix (A, 0, a, A->size1, n_block);
          gsl_matrix_view V_block =
            gsl_matrix_submatrix (V, 0, a, V->size1, n_block);

          qrstep (&S_block.vector, &f_block.vector, &U_block.matrix, &V_block.matrix);

          /* remove any small off-diagonal elements */

          chop_small_elements (&S_block.vector, &f_block.vector);
        }
      }
  }
  /* Make singular values positive by reflections if necessary */

  for (j = 0; j < K; j++)
    {
      double Sj = gsl_vector_get (S, j);

      if (Sj < 0.0)
        {
          for (i = 0; i < N; i++)
            {
              double Vij = gsl_matrix_get (V, i, j);
              gsl_matrix_set (V, i, j, -Vij);
            }

          gsl_vector_set (S, j, -Sj);
        }
    }

  /* Sort singular values into decreasing order */

  for (i = 0; i < K; i++)
    {
      double S_max = gsl_vector_get (S, i);
      size_t i_max = i;

      for (j = i + 1; j < K; j++)
        {
          double Sj = gsl_vector_get (S, j);

          if (Sj > S_max)
            {
              S_max = Sj;
              i_max = j;
            }
        }

      if (i_max != i)
        {
          /* swap eigenvalues */
          gsl_vector_swap_elements (S, i, i_max);

          /* swap eigenvectors */
          gsl_matrix_swap_columns (A, i, i_max);
          gsl_matrix_swap_columns (V, i, i_max);
        }
    }

  return GSL_SUCCESS;
}

/* Modified algorithm which is better for M>>N */

int
gsl_linalg_SV_decomp_mod (gsl_matrix * A,
                          gsl_matrix * X,
                          gsl_matrix * V, gsl_vector * S, gsl_vector * work)
{
  size_t i, j;

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

  if (M < N)
    {
      GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
    }
  else if (V->size1 != N)
    {
      GSL_ERROR ("square matrix V must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (V->size1 != V->size2)
    {
      GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
    }
  else if (X->size1 != N)
    {
      GSL_ERROR ("square matrix X must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (X->size1 != X->size2)
    {
      GSL_ERROR ("matrix X must be square", GSL_ENOTSQR);
    }
  else if (S->size != N)
    {
      GSL_ERROR ("length of vector S must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (work->size != N)
    {
      GSL_ERROR ("length of workspace must match second dimension of matrix A",
                 GSL_EBADLEN);
    }

  if (N == 1)
    {
      gsl_vector_view column = gsl_matrix_column (A, 0);
      double norm = gsl_blas_dnrm2 (&column.vector);

      gsl_vector_set (S, 0, norm);
      gsl_matrix_set (V, 0, 0, 1.0);

      if (norm != 0.0)
        {
          gsl_blas_dscal (1.0/norm, &column.vector);
        }

      return GSL_SUCCESS;
    }

  /* Convert A into an upper triangular matrix R */

  for (i = 0; i < N; i++)
    {
      gsl_vector_view c = gsl_matrix_column (A, i);
      gsl_vector_view v = gsl_vector_subvector (&c.vector, i, M - i);
      double tau_i = gsl_linalg_householder_transform (&v.vector);

      /* Apply the transformation to the remaining columns */

      if (i + 1 < N)
        {
          gsl_matrix_view m =
            gsl_matrix_submatrix (A, i, i + 1, M - i, N - (i + 1));
          gsl_linalg_householder_hm (tau_i, &v.vector, &m.matrix);
        }

      gsl_vector_set (S, i, tau_i);
    }

  /* Copy the upper triangular part of A into X */

  for (i = 0; i < N; i++)
    {
      for (j = 0; j < i; j++)
        {
          gsl_matrix_set (X, i, j, 0.0);
        }

      {
        double Aii = gsl_matrix_get (A, i, i);
        gsl_matrix_set (X, i, i, Aii);
      }

      for (j = i + 1; j < N; j++)
        {
          double Aij = gsl_matrix_get (A, i, j);
          gsl_matrix_set (X, i, j, Aij);
        }
    }

  /* Convert A into an orthogonal matrix L */

  for (j = N; j-- > 0;)
    {
      /* Householder column transformation to accumulate L */
      double tj = gsl_vector_get (S, j);
      gsl_matrix_view m = gsl_matrix_submatrix (A, j, j, M - j, N - j);
      gsl_linalg_householder_hm1 (tj, &m.matrix);
    }

  /* unpack R into X V S */

  gsl_linalg_SV_decomp (X, V, S, work);

  /* Multiply L by X, to obtain U = L X, stored in U */

  {
    gsl_vector_view sum = gsl_vector_subvector (work, 0, N);

    for (i = 0; i < M; i++)
      {
        gsl_vector_view L_i = gsl_matrix_row (A, i);
        gsl_vector_set_zero (&sum.vector);

        for (j = 0; j < N; j++)
          {
            double Lij = gsl_vector_get (&L_i.vector, j);
            gsl_vector_view X_j = gsl_matrix_row (X, j);
            gsl_blas_daxpy (Lij, &X_j.vector, &sum.vector);
          }

        gsl_vector_memcpy (&L_i.vector, &sum.vector);
      }
  }

  return GSL_SUCCESS;
}

/*  Solves the system A x = b using the SVD factorization
 *
 *  A = U S V^T
 *
 *  to obtain x. For M x N systems it finds the solution in the least
 *  squares sense.
 */

int
gsl_linalg_SV_solve (const gsl_matrix * U,
                     const gsl_matrix * V,
                     const gsl_vector * S,
                     const gsl_vector * b, gsl_vector * x)
{
  if (U->size1 != b->size)
    {
      GSL_ERROR ("first dimension of matrix U must size of vector b",
                 GSL_EBADLEN);
    }
  else if (U->size2 != S->size)
    {
      GSL_ERROR ("length of vector S must match second dimension of matrix U",
                 GSL_EBADLEN);
    }
  else if (V->size1 != V->size2)
    {
      GSL_ERROR ("matrix V must be square", GSL_ENOTSQR);
    }
  else if (S->size != V->size1)
    {
      GSL_ERROR ("length of vector S must match size of matrix V",
                 GSL_EBADLEN);
    }
  else if (V->size2 != x->size)
    {
      GSL_ERROR ("size of matrix V must match size of vector x", GSL_EBADLEN);
    }
  else
    {
      const size_t N = U->size2;
      size_t i;

      gsl_vector *w = gsl_vector_calloc (N);

      gsl_blas_dgemv (CblasTrans, 1.0, U, b, 0.0, w);

      for (i = 0; i < N; i++)
        {
          double wi = gsl_vector_get (w, i);
          double alpha = gsl_vector_get (S, i);
          if (alpha != 0)
            alpha = 1.0 / alpha;
          gsl_vector_set (w, i, alpha * wi);
        }

      gsl_blas_dgemv (CblasNoTrans, 1.0, V, w, 0.0, x);

      gsl_vector_free (w);

      return GSL_SUCCESS;
    }
}

/* This is a the jacobi version */
/* Author:  G. Jungman */

/*
 * Algorithm due to J.C. Nash, Compact Numerical Methods for
 * Computers (New York: Wiley and Sons, 1979), chapter 3.
 * See also Algorithm 4.1 in
 * James Demmel, Kresimir Veselic, "Jacobi's Method is more
 * accurate than QR", Lapack Working Note 15 (LAWN15), October 1989.
 * Available from netlib.
 *
 * Based on code by Arthur Kosowsky, Rutgers University
 *                  kosowsky@physics.rutgers.edu
 *
 * Another relevant paper is, P.P.M. De Rijk, "A One-Sided Jacobi
 * Algorithm for computing the singular value decomposition on a
 * vector computer", SIAM Journal of Scientific and Statistical
 * Computing, Vol 10, No 2, pp 359-371, March 1989.
 *
 */

int
gsl_linalg_SV_decomp_jacobi (gsl_matrix * A, gsl_matrix * Q, gsl_vector * S)
{
  if (A->size1 < A->size2)
    {
      /* FIXME: only implemented  M>=N case so far */

      GSL_ERROR ("svd of MxN matrix, M<N, is not implemented", GSL_EUNIMPL);
    }
  else if (Q->size1 != A->size2)
    {
      GSL_ERROR ("square matrix Q must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else if (Q->size1 != Q->size2)
    {
      GSL_ERROR ("matrix Q must be square", GSL_ENOTSQR);
    }
  else if (S->size != A->size2)
    {
      GSL_ERROR ("length of vector S must match second dimension of matrix A",
                 GSL_EBADLEN);
    }
  else
    {
      const size_t M = A->size1;
      const size_t N = A->size2;
      size_t i, j, k;

      /* Initialize the rotation counter and the sweep counter. */
      int count = 1;
      int sweep = 0;
      int sweepmax = 5*N;

      double tolerance = 10 * M * GSL_DBL_EPSILON;

      /* Always do at least 12 sweeps. */
      sweepmax = GSL_MAX (sweepmax, 12);

      /* Set Q to the identity matrix. */
      gsl_matrix_set_identity (Q);

      /* Store the column error estimates in S, for use during the
         orthogonalization */

      for (j = 0; j < N; j++)
        {
          gsl_vector_view cj = gsl_matrix_column (A, j);
          double sj = gsl_blas_dnrm2 (&cj.vector);
          gsl_vector_set(S, j, GSL_DBL_EPSILON * sj);
        }

      /* Orthogonalize A by plane rotations. */

      while (count > 0 && sweep <= sweepmax)
        {
          /* Initialize rotation counter. */
          count = N * (N - 1) / 2;

          for (j = 0; j < N - 1; j++)
            {
              for (k = j + 1; k < N; k++)
                {
                  double a = 0.0;
                  double b = 0.0;
                  double p = 0.0;
                  double q = 0.0;
                  double cosine, sine;
                  double v;
                  double abserr_a, abserr_b;
                  int sorted, orthog, noisya, noisyb;

                  gsl_vector_view cj = gsl_matrix_column (A, j);
                  gsl_vector_view ck = gsl_matrix_column (A, k);

                  gsl_blas_ddot (&cj.vector, &ck.vector, &p);
                  p *= 2.0 ;  /* equation 9a:  p = 2 x.y */

                  a = gsl_blas_dnrm2 (&cj.vector);
                  b = gsl_blas_dnrm2 (&ck.vector);

                  q = a * a - b * b;
                  v = hypot(p, q);

                  /* test for columns j,k orthogonal, or dominant errors */

                  abserr_a = gsl_vector_get(S,j);
                  abserr_b = gsl_vector_get(S,k);

                  sorted = (GSL_COERCE_DBL(a) >= GSL_COERCE_DBL(b));
                  orthog = (fabs (p) <= tolerance * GSL_COERCE_DBL(a * b));
                  noisya = (a < abserr_a);
                  noisyb = (b < abserr_b);

                  if (sorted && (orthog || noisya || noisyb))
                    {
                      count--;
                      continue;
                    }

                  /* calculate rotation angles */
                  if (v == 0 || !sorted)
                    {
                      cosine = 0.0;
                      sine = 1.0;
                    }
                  else
                    {
                      cosine = sqrt((v + q) / (2.0 * v));
                      sine = p / (2.0 * v * cosine);
                    }

                  /* apply rotation to A */
                  for (i = 0; i < M; i++)
                    {
                      const double Aik = gsl_matrix_get (A, i, k);
                      const double Aij = gsl_matrix_get (A, i, j);
                      gsl_matrix_set (A, i, j, Aij * cosine + Aik * sine);
                      gsl_matrix_set (A, i, k, -Aij * sine + Aik * cosine);
                    }

                  gsl_vector_set(S, j, fabs(cosine) * abserr_a + fabs(sine) * abserr_b);
                  gsl_vector_set(S, k, fabs(sine) * abserr_a + fabs(cosine) * abserr_b);

                  /* apply rotation to Q */
                  for (i = 0; i < N; i++)
                    {
                      const double Qij = gsl_matrix_get (Q, i, j);
                      const double Qik = gsl_matrix_get (Q, i, k);
                      gsl_matrix_set (Q, i, j, Qij * cosine + Qik * sine);
                      gsl_matrix_set (Q, i, k, -Qij * sine + Qik * cosine);
                    }
                }
            }

          /* Sweep completed. */
          sweep++;
        }

      /*
       * Orthogonalization complete. Compute singular values.
       */

      {
        double prev_norm = -1.0;

        for (j = 0; j < N; j++)
          {
            gsl_vector_view column = gsl_matrix_column (A, j);
            double norm = gsl_blas_dnrm2 (&column.vector);

            /* Determine if singular value is zero, according to the
               criteria used in the main loop above (i.e. comparison
               with norm of previous column). */

            if (norm == 0.0 || prev_norm == 0.0
                || (j > 0 && norm <= tolerance * prev_norm))
              {
                gsl_vector_set (S, j, 0.0);     /* singular */
                gsl_vector_set_zero (&column.vector);   /* annihilate column */

                prev_norm = 0.0;
              }
            else
              {
                gsl_vector_set (S, j, norm);    /* non-singular */
                gsl_vector_scale (&column.vector, 1.0 / norm);  /* normalize column */

                prev_norm = norm;
              }
          }
      }

      if (count > 0)
        {
          /* reached sweep limit */
          GSL_ERROR ("Jacobi iterations did not reach desired tolerance",
                     GSL_ETOL);
        }

      return GSL_SUCCESS;
    }
}


#include <string.h>
#include <gbpLib.h>
#include <gbpMisc.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>

void invert_square_matrix(double *matrix_in, int size, double *inverse_out) {
    gsl_matrix *     matrix;
    gsl_matrix *     LU_decomp;
    gsl_matrix *     inverse;
    gsl_permutation *permutation;
    int              signum;
    gsl_matrix_view  m;
    double *         matrix_copy;
    int              i_x, i_y, i_M;

    // Allocate some RAM and set some pointers
    matrix_copy = (double *)SID_malloc(sizeof(double) * size * size);
    memcpy(matrix_copy, matrix_in, sizeof(double) * size * size);
    m           = gsl_matrix_view_array(matrix_copy, size, size);
    matrix      = &m.matrix;
    LU_decomp   = matrix;
    inverse     = gsl_matrix_alloc(size, size);
    permutation = gsl_permutation_alloc(size);

    // Perform LU decomposition.  Result ends-up in matrix,
    //   which is pointed to by LU_decomp
    gsl_linalg_LU_decomp(matrix, permutation, &signum);
    gsl_linalg_LU_invert(LU_decomp, permutation, inverse);

    // Copy result into the out-going array
    for(i_y = 0, i_M = 0; i_y < size; i_y++) {
        for(i_x = 0; i_x < size; i_x++, i_M++) {
            inverse_out[i_M] = gsl_matrix_get(inverse, i_x, i_y);
        }
    }

    // Test that the matrix*inverse=identity
    /*
    for(i_x=0;i_x<size;i_x++){
       for(i_y=0;i_y<size;i_y++,i_M++){
          double test;
          int j_M;
          test=0.;
          for(j_M=0;j_M<size;j_M++) test+=matrix_in[i_y*size+j_M]*inverse_out[j_M*size+i_x];
          fprintf(stderr,"%le ",test);
       }
       fprintf(stderr,"\n");
    }
    */

    // Free some RAM
    gsl_matrix_free(inverse);
    gsl_permutation_free(permutation);
    SID_free(SID_FARG matrix_copy);
}


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

// y' = 2y + x
// https://www.wolframalpha.com/input/?i=y%27+%3D+2y+%2B+x%2C+y%280%29+%3D+1%2C+y%281%29
// https://www.wolframalpha.com/input/?i=1%2F4+*+%285+*+e%5E2+-+3%29
// 미분 방정식을 푸는 방법
// 1. 미분 방정식의 표준형을 작성한다.
//    y' <<<--- 미분항의 계수를 1로 만들어야 표준형이됨
// 2. 표준형의 y항 계수식을 통해 적분 인자를 구한다.
// 3. 적분 인자를 양변에 곱한다.
//    2y' + y = 3 -> y' + y / 2 = 3 / 2
//    여기서 적분 인자는 1 / 2가 됨
//    좀 더 정확하게는 exp^integral(1/2) 형태가 됨
// 4. 양변에 대한 계산(적분)을 진행한다.
// 5. 양변을 exp^적분인자 로 나누어 y에 대해 정리한다.
int odefunc (double x, const double y[], double f[], void *params)
{
	// 계산하고자 하는 미분 방정식의 표준형식을 여기에 기록함
    f[0] = x+2*y[0];
    return GSL_SUCCESS;
}

int * jac;

int main(void)
{
	// 1계 미분 방정식
	// 만약 2계 미분 방정식이라면 dim = 2
    int dim = 1;
	// 미방을 풀기 위한 데이터 타입
    gsl_odeiv2_system sys = {odefunc, NULL, dim, NULL};

	// 드라이버는 미방을 쉽게 풀 수 있도록 시간에 따른 변화, 제어, 스텝에 대한 래퍼
	// gsl_odeiv2_step_rkf45는 룬게쿠타 4-5차를 의미함
	// Taylor(테일러) 혹은 Maculaurin(맥클로린) 급수
	// 테일러 급수를 활용해서 미분을 4번이상 하여
	// 오차를 최소화하는 방식을 룬게쿠타 4-5차라고 표현함

	// 다음 인자는 미분방정식의 시작지점
	// 절대적인 에러 바운드와 상대적인 에러 바운드
    gsl_odeiv2_driver * d = gsl_odeiv2_driver_alloc_y_new (&sys, gsl_odeiv2_step_rkf45, 1e-6, 1e-6, 0.0);
    int i;
    double x0 = 0.0,  xf = 10.0; /* start and end of integration interval */
    double x = x0;
    double y[1] = { 1.0  };  /* initial value */

	// 루프를 돌면서 각 케이스별 미분 방정식을 계산함
    for (i = 1; i <= xf; i++)
    {
		// 0 ~ 10 - x input
        double xi = x0 + i * (xf-x0) / xf;
		// 결국 이 코드를 다시 재해석하자면
		// x가 0일 경우, 1일 경우, ... , 10일 경우에 대해 각각을 해석한다고 보면 됩니다!
		// 앞서서 룬게쿠타 4-5차 방식으로 미분 방정식을 계산하도록
		// odefunc을 만들었고 이에 대한 설정값들로 xi를 넣고 이에 대한 y값을 계산한다.
        int status = gsl_odeiv2_driver_apply (d, &x, xi, y);

        if (status != GSL_SUCCESS)
        {
            printf ("error, return value=%d\n", status);
            break;
        }

        printf ("%.8e %.8e\n", x, y[0]);
		printf ("x = %lf, xi = %lf\n", x, xi);
    }

	// malloc 혹은 new 처럼 Heap에 메모리를 할당하기 때문에
	// free를 사용해서 메모리 해제를 해주셔야 메모리 누수를 방지할 수 있음
    gsl_odeiv2_driver_free (d);
    return 0;
}


#include <stdlib.h>
#include <stddef.h>
#include <stdio.h>
#include <math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_hyperg.h>
#include <gsl/gsl_errno.h>

void inc_gamma_error_msg(const char* fn_name, const char* reason, const char* file, int line, int gsl_errno) {
	fprintf(stderr, "Error in GSL %s\n", fn_name);
	fprintf(stderr, "GSL Error %i: %s.\n", gsl_errno, gsl_strerror(gsl_errno));
	fprintf(stderr, "%s in %s:%i.\n", reason, file, line);
}

void gamma_inc_lower_error_handler(const char* reason, const char* file, int line, int gsl_errno) {
	if (gsl_errno != GSL_EUNDRFLW) {
		inc_gamma_error_msg("gamma_inc_P while computing lower incomplete gamma ratio.", reason, file, line, gsl_errno);
		abort();
	}
}

void gamma_inc_upper_error_handler(const char* reason, const char* file, int line, int gsl_errno) {
	if (gsl_errno != GSL_EUNDRFLW) {
		inc_gamma_error_msg("gamma_inc while computing upper incomplete gamma ratio.", reason, file, line, gsl_errno);
		abort();
	}
}

#define INC_GAMMA_NO_UNDERFLOW(fn, handler) do { \
		gsl_error_handler_t* old_handler = gsl_set_error_handler(& handler ); \
		fn; \
		gsl_set_error_handler(old_handler); \
	} while (0)

void inc_gamma_check_value(long double val, const char* fn_name) {
	if (isnan(val) || !isfinite(val)) {
		fprintf(stderr, "Error while computing %s.\n", fn_name);
		if (isnan(val)) {
			fprintf(stderr, "NaN detected. ");
		} else {
			fprintf(stderr, "Infinity detected. ");
		}
		fprintf(stderr, "This is likely the result of an overflow.\n");
		abort();
	}
}

/*
	Computes the upper Gamma(x+y,a)/Gamma(x) for x = [1 ... x_max]
*/
void inc_gamma_upper_ratio_ary(int x_max, double y, double a, double* result) {

	// x = 1 case
	size_t idx = 0;
	int x = 1;
	long double ln_gamma_xp1 = 0;
	// With fn(x) = Gamma(x+y, a)/Gamma(x)
	long double fn_x;
	INC_GAMMA_NO_UNDERFLOW(fn_x = gsl_sf_gamma_inc(x+y, a), gamma_inc_upper_error_handler);
	result[idx] = fn_x;

	for (;x < x_max;) {
		ln_gamma_xp1 += logl((long double) x);
		// Using the recurrence relation Gamma(s+1,a) = s Gamma(s,a) + a^s exp(-a)
		// We have Gamma((x+1)+y)/Gamma(x+1) = (x+y) ( Gamma(x+y)/Gamma(x) )/x + a^(x+y) exp(-a)/Gamma(x+1)
		// -> fn(x+1) = (x+y) fn(x)/x + exp((x+y) ln a - a - ln Gamma(x+1))
		long double fn_xp1 = (x+y) * fn_x/x + expl((x+y)*logl(a) - a - ln_gamma_xp1);
		result[idx+1] = (double)fn_xp1;
		fn_x = fn_xp1;
		idx += 1;
		x += 1;
	}
	// Make use of the fact that NaNs and infinities will propagate to the last value computed.
	inc_gamma_check_value(result[x_max-1], "upper incomplete gamma ratio");
}

/*
	Computes the lower gamma(x+y,a)/Gamma(x) for x = [1 ... x_max]
*/
void inc_gamma_lower_ratio_ary(int x_max, double y, double a, double* result) {

	// x = x_max case
	size_t idx = x_max - 1;
	int x = x_max;
	long double ln_gamma_x = gsl_sf_lngamma(x);
	// With fn(x) = gamma(x+y, a)/Gamma(x)
	long double fn_x;
	//INC_GAMMA_NO_UNDERFLOW(fn_x = expl((x+y)*logl(a) - a - logl(x+y) - ln_gamma_x)*gsl_sf_hyperg_1F1(1, x+y+1, a), hyperg_error_handler);
	INC_GAMMA_NO_UNDERFLOW(fn_x = gsl_sf_gamma_inc_P(x+y,a) * expl(gsl_sf_lngamma(x+y) - ln_gamma_x), gamma_inc_lower_error_handler);
	result[idx] = fn_x;

	for (;x>1;) {
		x -= 1;
		idx -= 1;
		ln_gamma_x -= logl((long double) x);
		long double fn_xp1 = fn_x;
		// We have gamma(s,a) = (gamma(s+1, a) + a^s exp(-a))/s
		// So gamma(x+y,a)/Gamma(x) = ( x gamma((x+1)+y, a)/Gamma(x+1) + a^(x+y) exp(-a)/Gamma(x) ) / s
		// -> fn(x) = ( x fn(x+1) + exp( (x+y) ln a - a - ln Gamma(x)! ) ) / (x+y)
		fn_x = ( x*fn_xp1 + expl( (x+y)*logl(a) - a - ln_gamma_x ) ) / (x+y);
		result[idx] = (double)fn_x;
	}
	// Make use of the fact that NaNs and infinities will propagate to the last value computed.
	inc_gamma_check_value(result[0], "lower incomplete gamma ratio");
}


// @file im2col_conv.c
//
//  \date Created on: Sep 30, 2017
//  \author Gopalakrishna Hegde
//
//   Description:
//
//
//

#include <stdbool.h>
#include <cblas.h>
#include "common_types.h"

//From Berkeley Vision's Caffe
//Refer to Caffe's license : https://github.com/BVLC/caffe/blob/master/LICENSE
static inline bool is_a_ge_zero_and_a_lt_b(int a, int b) {
  return (unsigned int)a < (unsigned int)(b);
}

void Im2Col(const float *data_im, const int channels,
    const int height, const int width, const int kernel_h, const int kernel_w,
    const int pad_h, const int pad_w,
    const int stride_h, const int stride_w,
    float *data_col) {
  const int output_h = (height + 2 * pad_h -
    ((kernel_h - 1) + 1)) / stride_h + 1;
  const int output_w = (width + 2 * pad_w -
    ((kernel_w - 1) + 1)) / stride_w + 1;
  const int channel_size = height * width;
  for (int channel = channels; channel--; data_im += channel_size) {
    for (int kernel_row = 0; kernel_row < kernel_h; kernel_row++) {
      for (int kernel_col = 0; kernel_col < kernel_w; kernel_col++) {
        int input_row = -pad_h + kernel_row;
        for (int output_rows = output_h; output_rows; output_rows--) {
          if (!is_a_ge_zero_and_a_lt_b(input_row, height)) {
            for (int output_cols = output_w; output_cols; output_cols--) {
              *(data_col++) = 0;
            }
          } else {
            int input_col = -pad_w + kernel_col;
            for (int output_col = output_w; output_col; output_col--) {
              if (is_a_ge_zero_and_a_lt_b(input_col, width)) {
                *(data_col++) = data_im[input_row * width + input_col];
              } else {
                *(data_col++) = 0;
              }
              input_col += stride_w;
            }
          }
          input_row += stride_h;
        }
      }
    }
  }
}

void Im2ColConvLayer(const float *input, const float *weight,
    const float *bias, float *scratchpad, const TensorDim in_dim,
    const TensorDim out_dim, const int ker_size, const int group,
    const int pad, const int stride, const int bias_en, float *output) {

  int C = in_dim.c;
  int H = in_dim.h;
  int W = in_dim.w;
  int in_ch_per_group = C / group;
  int out_ch_per_group = out_dim.c / group;
  float alpha = 1;
  float beta = 0;

  for (int b = 0; b < in_dim.n; b++) {
    int in_offset = b * C * H * W;
    Im2Col(input + in_offset, C, H, W, ker_size, ker_size, pad, pad, stride,
           stride, scratchpad);
    for (int g = 0; g < group; g++) {
      int weight_offset = g * ker_size * ker_size * in_ch_per_group * out_ch_per_group;
      int data_offset = g * (ker_size * ker_size * in_ch_per_group) *
          (out_dim.h * out_dim.w);
      int out_offset = (b * out_dim.c + g * out_ch_per_group) *
          out_dim.h * out_dim.w;

      int m = out_ch_per_group;
      int k = in_ch_per_group * ker_size * ker_size;
      int n = out_dim.h * out_dim.w;
      cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                 m, n, k, alpha, weight + weight_offset,
                 k, scratchpad + data_offset, n, beta, output + out_offset, n);
    }
  }

}


/*
* -----------------------------------------------------------------
*  Binary Search Tree Library --- bst_lib.h
*  Version: 1.6180
*  Date: Feb 19, 2010
* -----------------------------------------------------------------
*  Programmer: Americo Barbosa da Cunha Junior
*              americo.cunhajr@gmail.com
* -----------------------------------------------------------------
*  Copyright (c) 2010 by Americo Barbosa da Cunha Junior
*
*  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.
*
*  A copy of the GNU General Public License is available in
*  LICENSE.txt or http://www.gnu.org/licenses/.
* -----------------------------------------------------------------
*  This is the header file for a library with
*  to operates a binary search tree.
* -----------------------------------------------------------------
*/

#ifndef __BST_LIB_H__
#define __BST_LIB_H__

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

#undef  RIGHT
#define RIGHT 1

#undef  LEFT
#define LEFT 0

/*
*------------------------------------------------------------
*   structure of binary search tree leaf
*
*   last update: Feb 2, 2009
*------------------------------------------------------------
*/

typedef struct leaf
{
    gsl_vector *phi;   /* composition */
    gsl_vector *Rphi;  /* reaction mapping */
    gsl_matrix *A;     /* mapping gradient matrix */
    gsl_matrix *L;     /* ellipsoid Cholesky matrix */
} bst_leaf;
/*------------------------------------------------------------*/

/*
*------------------------------------------------------------
*   structure of binary search tree node
*
*   last update: Feb 2, 2009
*------------------------------------------------------------
*/

typedef struct node
{
    gsl_vector *v;          /* cutting plane normal vector */
    double a;               /* scalar a */
    struct node *r_node;    /* right node */
    struct node *l_node;    /* left node */
    struct leaf *r_leaf;    /* right leaf */
    struct leaf *l_leaf;    /* left leaf */
} bst_node;
/*------------------------------------------------------------*/

/*
*------------------------------------------------------------
* function prototypes
*------------------------------------------------------------
*/

bst_leaf *bst_leaf_alloc();

bst_node* bst_node_alloc();

void bst_leaf_free(void **leaf_bl);

void bst_node_free(void **node_bl);

int bst_leaf_set(gsl_vector *phi,
                 gsl_vector *Rphi,
                 gsl_matrix *A,
                 gsl_matrix *L,
                 bst_leaf *leaf);

double bst_cutplane(gsl_vector *phi_l,
                    gsl_vector *phi_r,
                    gsl_vector *v);

int bst_node_set(bst_leaf *l_leaf,
                 bst_leaf *r_leaf,
                 bst_node *node);

int bst_node_add(int side,
                 bst_node *old_node,
                 bst_node *new_node);

int bst_search(bst_node *root,
               gsl_vector *phi,
               bst_node **end_node,
               bst_leaf **end_leaf);

int bst_height(bst_node *root);

#endif /* __BST_LIB_H__ */


//
//  gemv.h
//  Linear Algebra Template Library
//
//  Created by Rodney James on 12/12/11.
//  Copyright (c) 2011 University of Colorado Denver. All rights reserved.
//

#ifndef _gemv_h
#define _gemv_h

/// @file gemv.h Computes general matrix-vector products.

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

namespace LATL
{
   /// @brief Computes general real matrix-vector products.
   ///
   /// For a real matrix A and real scalars alpha, beta
   ///
   ///        y := alpha * op(A) * x + beta * y
   ///
   /// is computed, where op(A) = A or A'.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param trans Specifies whether the transpose of A is used or not:
   ///
   ///        if trans = 'N' or 'n' then op(A) = A
   ///        if trans = 'T' or 't' then op(A) = A'
   ///        if trans = 'C' or 'c' then op(A) = A'
   ///
   /// @param m The number of rows of the matrix A.  m>=0
   /// @param n The number of columns of the matrix A.  n>=0
   /// @param alpha Real scalar.
   /// @param A Pointer to real matrix m-by-n matrix A.
   /// @param ldA Column length of the matrix A.  ldA>=m.
   /// @param x Pointer to real vector x.
   /// @param incx Increment of the vector x.
   /// @param beta Real scalar.
   /// @param y Pointer to real vector y.
   /// @param incy Increment of the vector y.
   /// @ingroup BLAS

   template <typename real_t>
   int GEMV(char trans, int_t m, int_t n, real_t alpha, real_t *A, int_t ldA, real_t *x, int_t incx, real_t beta, real_t *y, int_t incy)
   {
      trans=std::toupper(trans);
      const real_t one(1.0);
      const real_t zero(0.0);
      int_t kx,ky,lenx,leny,i,ix,iy,j,jx,jy;
      real_t temp;

      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      lenx=(trans=='N')?n:m;
      leny=(trans=='N')?m:n;
      kx=(incx>0)?0:(1-lenx)*incx;
      ky=(incy>0)?0:(1-leny)*incy;

      if(beta==zero)
      {
         if(incy==1)
         {
            for(i=0;i<leny;i++)
               y[i]=zero;
         }
         else
         {
            iy=ky;
            for(i=0;i<leny;i++)
            {
               y[iy]=zero;
               iy+=incy;
            }

         }
      }
      else if(beta!=one)
      {
         if(incy==1)
         {
            for(i=0;i<leny;i++)
               y[i]*=beta;
         }
         else
         {
            iy=ky;
            for(i=0;i<leny;i++)
            {
               y[iy]*=beta;
               iy+=incy;
            }
         }
      }

      if(alpha!=zero)
      {
         if(trans=='N')
         {
            jx=kx;
            if(incy==1)
            {
               for(j=0;j<n;j++)
               {
                  temp=alpha*x[jx];
                  for(i=0;i<m;i++)
                     y[i]+=temp*A[i];
                  A+=ldA;
                  jx+=incx;
               }
            }
            else
            {
               for(j=0;j<n;j++)
               {
                  temp=alpha*x[jx];
                  iy=ky;
                  for(i=0;i<m;i++)
                  {
                     y[iy]+=temp*A[i];
                     iy+=incy;
                  }
                  A+=ldA;
                  jx+=incx;
               }
            }
         }
         else
         {
            jy=ky;
            if(incx==1)
            {
               for(j=0;j<n;j++)
               {
                  temp=zero;
                  for(i=0;i<m;i++)
                     temp+=A[i]*x[i];
                  y[jy]+=alpha*temp;
                  jy+=incy;
                  A+=ldA;
               }
            }
            else
            {
               for(j=0;j<n;j++)
               {
                  temp=zero;
                  ix=kx;
                  for(i=0;i<m;i++)
                  {
                     temp+=A[i]*x[ix];
                     ix+=incx;
                  }
                  y[jy]+=alpha*temp;
                  jy+=incy;
                  A+=ldA;
               }
            }
         }
      }
      return 0;
   }

   /// @brief Computes general complex matrix-vector products.
   ///
   /// For a complex matrix A and complex scalars alpha, beta
   ///
   ///        y := alpha * op(A) * x + beta * y
   ///
   /// is computed, where op(A) = A or A'.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param trans Specifies whether the transpose or conjugate transpose of A, or neither is used:
   ///
   ///        if trans = 'N' or 'n' then op(A) = A
   ///        if trans = 'T' or 't' then op(A) = A.'
   ///        if trans = 'C' or 'c' then op(A) = A'
   ///
   /// @param m The number of rows of the matrix A.  m>=0
   /// @param n The number of columns of the matrix A.  n>=0
   /// @param alpha Complex scalar.
   /// @param A Pointer to complex matrix m-by-n matrix A.
   /// @param ldA Column length of the matrix A.  ldA>=m.
   /// @param x Pointer to complex vector x.
   /// @param incx Increment of the vector x.
   /// @param beta Complex scalar.
   /// @param y Pointer to complex vector y.
   /// @param incy Increment of the vector y.
   /// @ingroup BLAS

   template <typename real_t>
   int GEMV(char trans, int_t m, int_t n, complex<real_t> alpha, complex<real_t> *A, int_t ldA, complex<real_t> *x, int_t incx, complex<real_t> beta, complex<real_t> *y, int_t incy)
   {
      trans=std::toupper(trans);
      using std::conj;
      const complex<real_t> one(1.0,0.0);
      const complex<real_t> zero(0.0,0.0);
      int_t kx,ky,lenx,leny,i,ix,iy,j,jx,jy;
      complex<real_t> temp;

      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      lenx=(trans=='N')?n:m;
      leny=(trans=='N')?m:n;
      kx=(incx>0)?0:(1-lenx)*incx;
      ky=(incy>0)?0:(1-leny)*incy;

      if(beta==zero)
      {
         if(incy==1)
         {
            for(i=0;i<leny;i++)
               y[i]=zero;
         }
         else
         {
            iy=ky;
            for(i=0;i<leny;i++)
            {
               y[iy]=zero;
               iy+=incy;
            }

         }
      }
      else if(beta!=one)
      {
         if(incy==1)
         {
            for(i=0;i<leny;i++)
               y[i]*=beta;
         }
         else
         {
            iy=ky;
            for(i=0;i<leny;i++)
            {
               y[iy]*=beta;
               iy+=incy;
            }
         }
      }

      if(alpha!=zero)
      {
         switch(trans)
         {
            case 'N':
               jx=kx;
               if(incy==1)
                  for(j=0;j<n;j++)
                  {
                     temp=alpha*x[jx];
                     for(i=0;i<m;i++)
                        y[i]+=temp*A[i];
                     A+=ldA;
                     jx+=incx;
                  }
               else
                  for(j=0;j<n;j++)
                  {
                     temp=alpha*x[jx];
                     iy=ky;
                     for(i=0;i<m;i++)
                     {
                        y[iy]+=temp*A[i];
                        iy+=incy;
                     }
                     A+=ldA;
                     jx+=incx;
                  }
               break;

            case 'T':
               jy=ky;
               if(incx==1)
                  for(j=0;j<n;j++)
                  {
                     temp=zero;
                     for(i=0;i<m;i++)
                        temp+=A[i]*x[i];
                     y[jy]+=alpha*temp;
                     jy+=incy;
                     A+=ldA;
                  }
               else
                  for(j=0;j<n;j++)
                  {
                     temp=zero;
                     ix=kx;
                     for(i=0;i<m;i++)
                     {
                        temp+=A[i]*x[ix];
                        ix+=incx;
                     }
                     y[jy]+=alpha*temp;
                     jy+=incy;
                     A+=ldA;
                  }

               break;

            case 'C':
               jy=ky;
               if(incx==1)
                  for(j=0;j<n;j++)
                  {
                     temp=zero;
                     for(i=0;i<m;i++)
                        temp+=conj(A[i])*x[i];
                     y[jy]+=alpha*temp;
                     jy+=incy;
                     A+=ldA;
                  }
               else
                  for(j=0;j<n;j++)
                  {
                     temp=zero;
                     ix=kx;
                     for(i=0;i<m;i++)
                     {
                        temp+=conj(A[i])*x[ix];
                        ix+=incx;
                     }
                     y[jy]+=alpha*temp;
                     jy+=incy;
                     A+=ldA;
                  }

               break;
         }
      }
      return 0;
   }

#ifdef __latl_cblas
#include <cblas.h>

   template <> int GEMV<float>(char trans, int_t m, int_t n, float alpha, float *A, int_t ldA, float *x, int_t incx, float beta, float *y, int_t incy)
   {
      trans=std::toupper(trans);
      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);

      cblas_sgemv(CblasColMajor,Trans,m,n,alpha,A,ldA,x,incx,beta,y,incy);

      return 0;
   }

   template <> int GEMV<double>(char trans, int_t m, int_t n, double alpha, double *A, int_t ldA, double *x, int_t incx, double beta, double *y, int_t incy)
   {
      trans=std::toupper(trans);
      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);

      cblas_dgemv(CblasColMajor,Trans,m,n,alpha,A,ldA,x,incx,beta,y,incy);

      return 0;
   }

   template <> int GEMV<float>(char trans, int_t m, int_t n, complex<float> alpha, complex<float> *A, int_t ldA, complex<float> *x, int_t incx, complex<float> beta, complex<float> *y, int_t incy)
   {
      trans=std::toupper(trans);
      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);

      cblas_cgemv(CblasColMajor,Trans,m,n,&alpha,A,ldA,x,incx,&beta,y,incy);

      return 0;
   }

   template <> int GEMV<double>(char trans, int_t m, int_t n, complex<double> alpha, complex<double> *A, int_t ldA, complex<double> *x, int_t incx, complex<double> beta, complex<double> *y, int_t incy)
   {
      trans=std::toupper(trans);
      if((trans!='N')&&(trans!='T')&&(trans!='C'))
         return -1;
      else if(m<0)
         return -2;
      else if(n<0)
         return -3;
      else if(ldA<m)
         return -6;
      else if(incx==0)
         return -8;
      else if(incy==0)
         return -11;
      else if((m==0)||(n==0))
         return 0;

      const CBLAS_TRANSPOSE Trans=(trans=='N')?CblasNoTrans:((trans=='T')?CblasTrans:CblasConjTrans);

      cblas_zgemv(CblasColMajor,Trans,m,n,&alpha,A,ldA,x,incx,&beta,y,incy);

      return 0;
   }
#endif
}
#endif