/**
 * \author Sylvain Marsat, University of Maryland - NASA GSFC
 *
 * \brief C header for the computation of the Fourier-domain overlaps, likelihoods.
 *
 *
 */

#ifndef _LIKELIHOOD_H
#define _LIKELIHOOD_H

#define _XOPEN_SOURCE 500

#ifdef __GNUC__
#define UNUSED __attribute__ ((unused))
#else
#define UNUSED
#endif

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <complex.h>
#include <time.h>
#include <unistd.h>
#include <getopt.h>
#include <stdbool.h>
#include <string.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_bspline.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_min.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_complex.h>

#include "constants.h"
#include "struct.h"
#include "waveform.h"
#include "wip.h"

#if defined(__cplusplus)
extern "C" {
#elif 0
} /* so that editors will match preceding brace */
#endif

/****** Prototypes: utilities *******/

/* Function to evaluate a Noise function  */
void EvaluateNoise(
  gsl_vector* noisevalues,                         /* Output: vector of the noise values */
  gsl_vector* freq,                                /* Input: vector of frequencies on which to evaluate */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                     /* Lower bound of the frequency window for the detector */
  double fHigh);                                   /* Upper bound of the frequency window for the detector */

/* Function building a frequency vector with logarithmic sampling */
void SetLogFrequencies(
  gsl_vector* freqvector,    /* Output pointer to gsl_vector, already allocated */
  const double fmin,         /* Lower bound of the frequency interval */
  const double fmax,         /* Upper bound of the frequency interval */
  const int nbpts);          /* Number of points */
/* Function building a frequency vector with linear sampling */
void SetLinearFrequencies(
  gsl_vector* freqvector,    /* Output pointer to gsl_vector, already allocated */
  const double fmin,         /* Lower bound of the frequency interval */
  const double fmax,         /* Upper bound of the frequency interval */
  const int nbpts);          /* Number of points */

/* Function determining logarithmically spaced frequencies from a waveform given as a list of modes, a minimal frequency and a number of points */
void ListmodesSetFrequencies(
  struct tagListmodesCAmpPhaseFrequencySeries *list,     /* Waveform, list of modes in amplitude/phase form */
  double fLow,                                           /* Additional lower frequency limit */
  double fHigh,                                          /* Additional upper frequency limit */
  int nbpts,                                             /* Number of frequency samples */
  int tagsampling,                                       /* Tag for linear (0) or logarithmic (1) sampling */
  gsl_vector* freqvector);                               /* Output: vector of frequencies, already allocated with nbpts */

/****** Prototypes: overlaps and likelihood computation *******/

/***************************** Functions for overlaps using linear integration ******************************/

/* Function computing the overlap (h1|h2) between two given modes, for a given noise function - uses simple trapeze integration on logarithmically sampled frequencies  */
double FDSinglemodeLogLinearOverlap(
  struct tagCAmpPhaseFrequencySeries *freqseries1, /* First mode h1, in amplitude/phase form */
  struct tagCAmpPhaseFrequencySeries *freqseries2, /* Second mode h2, in amplitude/phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                     /* Lower bound of the frequency window for the detector */
  double fHigh);                                   /* Upper bound of the frequency window for the detector */

/* Function computing the overlap (h1|h2) between two waveforms given as lists of mode contributions (factos sYlm already included), for a given noise function - uses simple trapeze integration on logarithmically sampled frequencies - generates the frequency series in Re/Im form by summing the mode contributions first, then computes the overlap */
double FDListmodesLogLinearOverlap(
  struct tagListmodesCAmpPhaseFrequencySeries *list1,    /* First waveform, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *list2,    /* First waveform, list of modes in amplitude/phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                           /* Lower bound of the frequency window for the detector */
  double fHigh,                                          /* Upper bound of the frequency window for the detector */
  double fstartobs1,                                     /* Starting frequency for the 22 mode of wf 1 - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobs2);                                    /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */

/* Function computing the overlap (h1|h2) between h1 given in Re/Im form and h2 given as a list of mode contributions (factos sYlm already included), for a given vector of noise values - uses simple trapeze integration - generates the frequency series of h2 in Re/Im form by summing the mode contributions first, then computes the overlap */
double FDOverlapReImvsListmodesCAmpPhase(
  struct tagReImFrequencySeries *freqseries1,            /* First waveform, in Re/Im form */
  struct tagListmodesCAmpPhaseFrequencySeries *list2,    /* Second waveform, list of modes in amplitude/phase form */
  gsl_vector* noisevalues,                               /* Vector for the noise values on the freq of h1 */
  double fLow,                                           /* Minimal frequency - set to 0 to ignore */
  double fHigh,                                          /* Maximal frequency - set to 0 to ignore */
  double fstartobs2);                                    /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */

/* Function computing the overlap (h1|h2) between two waveforms given as Re/Im frequency series (common freq values), for a given vector of noise values - uses simple trapeze integration */
double FDOverlapReImvsReIm(
  struct tagReImFrequencySeries *h1,  /* First waveform, frequency series in Re/Im form */
  struct tagReImFrequencySeries *h2,  /* Second waveform, frequency series in Re/Im form */
  gsl_vector* noisevalues);           /* Vector for the noise values on common freq of the freqseries */

/***************************** Functions for overlaps using amplitude/phase (wip) ******************************/

/* Function computing the overlap (h1|h2) between two given modes in amplitude/phase form, for a given noise function - uses the amplitude/phase representation (wip) */
double FDSinglemodeWIPOverlap(
  struct tagCAmpPhaseFrequencySeries *freqseries1, /* First mode h1, in amplitude/phase form */
  struct tagCAmpPhaseFrequencySeries *freqseries2, /* Second mode h2, in amplitude/phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                     /* Lower bound of the frequency window for the detector */
  double fHigh);                                   /* Upper bound of the frequency window for the detector */

/* Function computing the overlap (h1|h2) between two waveforms given as list of modes, for a given noise function - no cross-products between modes are taken into account - two additional parameters for the starting 22-mode frequencies (then properly scaled for the other modes) for a limited duration of the observations */
double FDListmodesWIPOverlap(
  struct tagListmodesCAmpPhaseFrequencySeries *listh1, /* First waveform, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *listh2, /* Second waveform, list of modes in amplitude/phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                         /* Lower bound of the frequency window for the detector */
  double fHigh,                                        /* Upper bound of the frequency window for the detector */
  double fstartobs1,                                   /* Starting frequency for the 22 mode of wf 1 - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobs2);                                  /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */

/************** Functions for overlap/likelihood allowing to switch between wip and loglinear integration *****************/

/* Wrapping of FDListmodesWIPOverlap or FDListmodesLogLinearOverlap according to tagint */
double FDListmodesOverlap(
  struct tagListmodesCAmpPhaseFrequencySeries *listh1, /* First mode h1, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *listh2, /* Second mode h2, list of modes in amplitude/phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                         /* Lower bound of the frequency window for the detector */
  double fHigh,                                        /* Upper bound of the frequency window for the detector */
  double fstartobs1,                                   /* Starting frequency for the 22 mode of wf 1 - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobs2,                                   /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */
  int tagint);                                         /* Tag choosing the integrator: 0 for wip, 1 for log linear integration */

/* Function computing the log likelihood (h|s) - 1/2 (h|h) - 1/2 (s|s), with s the signal, h the template, and where we keep the constant term (s|s) - passed to the function as a parameter - all the cross-products between modes are taken into account - two additionals parameters for the starting 22-mode frequencies (then properly scaled for the other modes) for a limited duration of the observations */
double FDLogLikelihood(
  struct tagListmodesCAmpPhaseFrequencySeries *lists,  /* Input: list of modes for the signal s, in Frequency-domain amplitude and phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *listh,  /* Input: list of modes for the template, in Frequency-domain amplitude and phase form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                         /* Lower bound of the frequency window for the detector */
  double fHigh,                                        /* Upper bound of the frequency window for the detector */
  double ss,                                           /* Inner product (s|s), constant to be computed elsewhere and passed as an argument */
  double hh,                                           /* Inner product (h|h), constant to be computed elsewhere and passed as an argument */
  double fstartobss,                                   /* Starting frequency for the 22 mode of s - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobsh,                                   /* Starting frequency for the 22 mode of h - as determined from a limited duration of the observation - set to 0 to ignore */
  int tagint);                                         /* Tag choosing the integrator: 0 for wip, 1 for log linear integration */

/************** Functions for overlap/likelihood specific to loglinear integration *****************/

/* Function computing the log likelihood -1/2(h-s|h-s), with s the signal, h the template (both given as frequency series in Re/Im form) - h, s assumed to be given on the same set of frequencies - same for the vector of noise values - fstartobs for s, h has already been taken into account */
double FDLogLikelihoodReIm(
  struct tagReImFrequencySeries *s,    /* First waveform (injection), frequency series in Re/Im form */
  struct tagReImFrequencySeries *h,    /* Second waveform (template), frequency series in Re/Im form */
  gsl_vector* noisevalues);            /* Vector for the noise values on common freq of the freqseries */

/***************************** Functions for overlaps using amplitude/phase (Fresnel) ******************************/

void ComputeIntegrandValues(
  CAmpPhaseFrequencySeries** integrand,     /* Output: values of the integrand on common frequencies (initialized in the function) */
  CAmpPhaseFrequencySeries* freqseries1,    /* Input: frequency series for wf 1 */
  CAmpPhaseSpline* splines2,                /* Input: splines in matrix form for wf 2 */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                              /* Lower bound of the frequency - 0 to ignore */
  double fHigh);                            /* Upper bound of the frequency - 0 to ignore */
/* Function computing the integrand values, combining the three channels A, E and T */
int ComputeIntegrandValues3Chan(
  CAmpPhaseFrequencySeries** integrand,     /* Output: values of the integrand on common frequencies (initialized in the function) */
  CAmpPhaseFrequencySeries* freqseries1chan1,    /* Input: frequency series for wf 1, channel 1 */
  CAmpPhaseFrequencySeries* freqseries1chan2,    /* Input: frequency series for wf 1, channel 2 */
  CAmpPhaseFrequencySeries* freqseries1chan3,    /* Input: frequency series for wf 1, channel 3 */
  CAmpPhaseSpline* splines2chan1,                /* Input: splines in matrix form for wf 2, channel 1 */
  CAmpPhaseSpline* splines2chan2,                /* Input: splines in matrix form for wf 2, channel 2 */
  CAmpPhaseSpline* splines2chan3,                /* Input: splines in matrix form for wf 2, channel 3 */
  ObjectFunction * Snoise1,                         /* Noise function */
  ObjectFunction * Snoise2,                         /* Noise function */
  ObjectFunction * Snoise3,                         /* Noise function */
  double fLow,                              /* Lower bound of the frequency - 0 to ignore */
  double fHigh);                            /* Upper bound of the frequency - 0 to ignore */

/* Function computing the overlap (h1|h2) between two given modes in amplitude/phase form, one being already interpolated, for a given noise function - uses the amplitude/phase representation (Fresnel) */
double FDSinglemodeFresnelOverlap(
  struct tagCAmpPhaseFrequencySeries *freqseries1, /* First mode h1, in amplitude/phase form */
  struct tagCAmpPhaseSpline *splines2,             /* Second mode h2, already interpolated in matrix form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                     /* Lower bound of the frequency window for the detector */
  double fHigh);                                   /* Upper bound of the frequency window for the detector */
/* Function computing the overlap (h1|h2) between two given modes in amplitude/phase form for each channel A, E, T, one being already interpolated, for a given noise function - uses the amplitude/phase representation (Fresnel) */
double FDSinglemodeFresnelOverlap3Chan(
  struct tagCAmpPhaseFrequencySeries *freqseries1chan1, /* First mode h1 for channel 1, in amplitude/phase form */
  struct tagCAmpPhaseFrequencySeries *freqseries1chan2, /* First mode h1 for channel 2, in amplitude/phase form */
  struct tagCAmpPhaseFrequencySeries *freqseries1chan3, /* First mode h1 for channel 3, in amplitude/phase form */
  struct tagCAmpPhaseSpline *splines2chan1,             /* Second mode h2 for channel 1, already interpolated in matrix form */
  struct tagCAmpPhaseSpline *splines2chan2,             /* Second mode h2 for channel 2, already interpolated in matrix form */
  struct tagCAmpPhaseSpline *splines2chan3,             /* Second mode h2 for channel 3, already interpolated in matrix form */
  ObjectFunction * Snoise1,                         /* Noise function */
  ObjectFunction * Snoise2,                         /* Noise function */
  ObjectFunction * Snoise3,                         /* Noise function */
  double fLow,                                      /* Lower bound of the frequency window for the detector */
  double fHigh);                                    /* Upper bound of the frequency window for the detector */

/* Function computing the overlap (h1|h2) between two waveforms given as list of modes, one being already interpolated, for a given noise function - two additional parameters for the starting 22-mode frequencies (then properly scaled for the other modes) for a limited duration of the observations */
double FDListmodesFresnelOverlap(
  struct tagListmodesCAmpPhaseFrequencySeries *listh1, /* First waveform, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseSpline *listsplines2,    /* Second waveform, list of modes already interpolated in matrix form */
  ObjectFunction * Snoise,                         /* Noise function */
  double fLow,                                         /* Lower bound of the frequency window for the detector */
  double fHigh,                                        /* Upper bound of the frequency window for the detector */
  double fstartobs1,                                   /* Starting frequency for the 22 mode of wf 1 - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobs2);                                  /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */
/* Function computing the overlap (h1|h2) between two waveforms given as list of modes for each non-correlated channel 1,2,3, one being already interpolated, for a given noise function - two additional parameters for the starting 22-mode frequencies (then properly scaled for the other modes) for a limited duration of the observations */
double FDListmodesFresnelOverlap3Chan(
  struct tagListmodesCAmpPhaseFrequencySeries *listh1chan1, /* First waveform channel channel 1, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *listh1chan2, /* First waveform channel channel 2, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseFrequencySeries *listh1chan3, /* First waveform channel channel 3, list of modes in amplitude/phase form */
  struct tagListmodesCAmpPhaseSpline *listsplines2chan1,    /* Second waveform channel channel 1, list of modes already interpolated in matrix form */
  struct tagListmodesCAmpPhaseSpline *listsplines2chan2,    /* Second waveform channel channel 2, list of modes already interpolated in matrix form */
  struct tagListmodesCAmpPhaseSpline *listsplines2chan3,    /* Second waveform channel channel 3, list of modes already interpolated in matrix form */
  ObjectFunction * Snoise1,                         /* Noise function */
  ObjectFunction * Snoise2,                         /* Noise function */
  ObjectFunction * Snoise3,                         /* Noise function */
  double fLow,                                          /* Lower bound of the frequency window for the detector */
  double fHigh,                                         /* Upper bound of the frequency window for the detector */
  double fstartobs1,                                    /* Starting frequency for the 22 mode of wf 1 - as determined from a limited duration of the observation - set to 0 to ignore */
  double fstartobs2);                                    /* Starting frequency for the 22 mode of wf 2 - as determined from a limited duration of the observation - set to 0 to ignore */

#if 0
{ /* so that editors will match succeeding brace */
#elif defined(__cplusplus)
}
#endif

#endif /* _LIKELIHOOD_H */


#include <cerrno>
#include <cstdio>
#include <cstdlib>
#include <sys/stat.h>
#include <cmath>
#include <vector>
#include <iostream>
#include <fstream>
#include <sstream>
#include <string>
#include <time.h>

#include <gsl/gsl_odeiv2.h>
#include <gsl/gsl_math.h>
#include <math.h>       /* pow */
#include <gsl/gsl_sf.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_spline.h>

/* Conversion constants */
// megaparsec to km
const double mptkm = 3.086e19;
// kg to Gev
const double kgtgev = 5.62e26;
// Gev to kg
const double gevtkg = 1.78e-27;
//// 1/seconds to GeV
const double dstgev = 6.58e-25;
// Gev to 1/seconds
const double gevtds = 1.52e24;
// Kelvin to 1/s
const double keltds = 8.62e-14;
// Solar mass in kg
const double msol = 1.989e30;
// 1/m to GeV
const double dmtgev = 1.98e-16;
// Kelvin to Gev
const double keltgev = 8.62e-14;

/* LCDM constants and yield from Planck 2018 1807.06209 */
// Hubble constant in inverse seconds
const double h0 = 67.32/mptkm;
// Cold dark matter fraction from Planck 2018
const double oc = 0.265;
// Baryonic matter fraction from Planck 2018
const double ob = 0.0494;
// Total matter fraction from Planck 2018
const double om = oc+ob;
// Radiation fraction from Planck 2018 + massless neutrinos
const double orad = 9.2367e-5;//0.00006;
// Yield of B-L = n_B-L/ entropy density
const double yield = 1e-10;
// Hooks value for yield 1404.0113
const double yieldhook = 9e-11;

/* Scale factors */
const double ai = 1e-30; // starting factor ~ end of inflation
const double arad = 0.000264; // dm-rad equality
const double acmb = 9e-4; // CMB
const double alam = 0.5; // DM - Lambda equality

/* Mass constants */
// Planck mass in kg
const double mplanck = 2.176e-8;
// log10 of planck mass (in kg)
const double lgmp = -7.66234;
// log10 of maximum mass used in integrations in kg
const double lgmax =36.;
// horizon mass in kg at time of radiation-matter equality --- 2001.04371
const double meq = 2.8e17;
// Horizon mass when shortest wavelength reenters horizon - choice
const double ms = 1e-7;
// log of 5 times ms
const double lgmf = -6.301;
// proton mass in kg
const double protonm = 1.672621e-27;

/* Decay constants */
// Sum of degrees of freedom of standard model -- see 1404.0113 or our draft
const double gstar = 106.75;

// sum of qi^2 gi
const double sumq2g = 13.;

// 3 x gstar / (30720 pi) * Mplanck^4 in kg^4
const double cc = 7.4397e-34;

// 3 x gstar / (30720 pi) * Mplanck^4 in kg^3/s
const double decfac = 6.35e17; // = cc*gevtds/gevtkg

/* Newton's G in m^3 /kg / s^2 */
const double gnewton = 6.67e-11;

/* Speeed of light in m/s */
const double sofl = 2.99792e8;

// conversion factor from dM to dlog10[M]
const double intf = 2.30259;

/* All parameters should be given in SI base units - conversions are handled in the functions*/

// structure to hold relevant parameters
struct myparam_type2{
	double lambda; // coupling constant
 	double lgn0;  // log10 of final total number density of bh in 1/m^3
	double peakm; // log10  of mass spectrum peak  in kg
	double Trh; // reheating Temperature in Kelvin
	double trh; // time of reheatting in s
	double aval; // scale factor
	bool rem; // remnants or not
	gsl_spline *spline;
	gsl_interp_accel *acc;
	bool mono; // monochromatic spectrum (true) or broad (false)
} ;

// Reduced structure for epoch/approximate calculations
struct myparam_type{
	double peakm; // mass spectrum peak
	double trh; // time of reheating
	double aval; // scale factor
	bool rem; // remnants or not
};

// structure for creating a(t) object
typedef struct arrays{
  int count;
  double xx[1002];
  double yy[1002]; } *arrays_T;


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

#include <gsl/gsl_integration.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_sf_bessel.h>

#include "ccl.h"
#include "ccl_f2d.h"
#include "ccl_emu17.h"
#include "ccl_emu17_params.h"

// helper functions for BBKS and EH98
static double bbks_power(ccl_parameters *params, void *p, double k) {
  return ccl_bbks_power(params, k);
}

static double eh_power(ccl_parameters *params, void *p, double k) {
  return ccl_eh_power(params, (eh_struct*)p, k);
}

/*------ ROUTINE: ccl_cosmology_compute_power_analytic -----
INPUT: cosmology
TASK: provide spline for an analytic power spectrum with baryonic correction
*/

static ccl_f2d_t *ccl_compute_linpower_analytic(ccl_cosmology* cosmo, void* par,
                                                double (*pk)(ccl_parameters* params,
                                                             void* p, double k),
                                                int* status) {
  ccl_f2d_t *psp_out = NULL;
  double sigma8,log_sigma8;
  //These are the limits of the splining range
  double kmin = cosmo->spline_params.K_MIN;
  double kmax = cosmo->spline_params.K_MAX;
  //Compute nk from number of decades and N_K = # k per decade
  double ndecades = log10(kmax) - log10(kmin);
  int nk = (int)ceil(ndecades*cosmo->spline_params.N_K);
  // Compute na using predefined spline spacing
  double amin = cosmo->spline_params.A_SPLINE_MINLOG_PK;
  double amax = cosmo->spline_params.A_SPLINE_MAX;
  int na = cosmo->spline_params.A_SPLINE_NA_PK+cosmo->spline_params.A_SPLINE_NLOG_PK-1;

  // Exit if sigma8 wasn't specified
  if (isnan(cosmo->params.sigma8)) {
    *status = CCL_ERROR_INCONSISTENT;
    ccl_cosmology_set_status_message(cosmo,
             "ccl_power.c: ccl_compute_linpower_analytic(): "
             "sigma8 not set, required for analytic power spectra\n");
    return NULL;
  }

  // The x array is initially k, but will later
  // be overwritten with log(k)
  double *x=NULL, *y=NULL, *z=NULL, *y2d=NULL;
  x=ccl_log_spacing(kmin, kmax, nk);
  if(x==NULL) {
    *status = CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo,
             "ccl_power.c: ccl_compute_linpower_analytic(): "
             "memory allocation\n");
  }
  if(*status==0) {
    y=malloc(sizeof(double)*nk);
    if(y==NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
               "ccl_power.c: ccl_compute_linpower_analytic(): "
               "memory allocation\n");
    }
  }
  if(*status==0) {
    z=ccl_linlog_spacing(amin, cosmo->spline_params.A_SPLINE_MIN_PK,
       amax, cosmo->spline_params.A_SPLINE_NLOG_PK,
       cosmo->spline_params.A_SPLINE_NA_PK);
    if(z==NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
               "ccl_power.c: ccl_compute_linpower_analytic(): "
               "memory allocation\n");
    }
  }

  if(*status==0) {
    y2d = malloc(nk * na * sizeof(double));
    if(y2d==NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
               "ccl_power.c: ccl_compute_linpower_analytic(): "
               "memory allocation\n");
    }
  }

  if(*status==0) {
    // Calculate P(k) on k grid. After this loop, x will contain log(k) and y
    // will contain log(pk) [which has not yet been normalized]
    // After this loop x will contain log(k)
    for (int i=0; i<nk; i++) {
      y[i] = log((*pk)(&cosmo->params, par, x[i]));
      x[i] = log(x[i]);
    }
  }

  if(*status==0) {
    for (int j = 0; j < na; j++) {
      double gfac = ccl_growth_factor(cosmo,z[j], status);
      double g2 = 2.*log(gfac);
      for (int i=0; i<nk; i++) {
        y2d[j*nk+i] = y[i]+g2;
      }
    }
  }

  if(*status==0) {
    psp_out=ccl_f2d_t_new(na,z,nk,x,y2d,NULL,NULL,0,
                          1,2,ccl_f2d_cclgrowth,1,0,2,
                          ccl_f2d_3,status);
  }
  if(*status==0) {
    sigma8 = ccl_sigma8(cosmo, psp_out, status);
  }

  if(*status==0) {
    // Calculate normalization factor using computed value of sigma8, then
    // recompute P(k, a) using this normalization
    log_sigma8 = 2*(log(cosmo->params.sigma8) - log(sigma8));
    for(int j=0;j<na*nk;j++)
      y2d[j] += log_sigma8;
  }

  if(*status==0) {
    // Free the previous P(k,a) spline, and allocate a new one to store the
    // properly-normalized P(k,a)
    ccl_f2d_t_free(psp_out);
    psp_out = ccl_f2d_t_new(na,z,nk,x,y2d,NULL,NULL,0,
                            1,2,ccl_f2d_cclgrowth,1,0,2,
                            ccl_f2d_3,status);
  }

  free(x);
  free(y);
  free(z);
  free(y2d);
  return psp_out;
}

ccl_f2d_t *ccl_compute_linpower_bbks(ccl_cosmology *cosmo, int *status)
{
  ccl_f2d_t *psp=ccl_compute_linpower_analytic(cosmo, NULL, bbks_power, status);
  return psp;
}

ccl_f2d_t *ccl_compute_linpower_eh(ccl_cosmology *cosmo, int wiggled, int *status)
{
  ccl_f2d_t *psp = NULL;
  eh_struct *eh = NULL;
  eh = ccl_eh_struct_new(&(cosmo->params),wiggled);
  if (eh != NULL) {
    psp=ccl_compute_linpower_analytic(cosmo, eh,
                                      eh_power,
                                      status);
  }
  else
    *status = CCL_ERROR_MEMORY;
  free(eh);
  return psp;
}

/*------ ROUTINE: ccl_compute_power_emu -----
INPUT: cosmology
TASK: provide spline for the emulated power spectrum from Cosmic EMU
*/

ccl_f2d_t *ccl_compute_power_emu(ccl_cosmology * cosmo, int * status)
{
  double Omeganuh2_eq;
  ccl_f2d_t *psp_out=NULL;

  // Check ranges to see if the cosmology is valid
  if(*status==0) {
    if((cosmo->params.h<0.55) || (cosmo->params.h>0.85)){
      *status=CCL_ERROR_INCONSISTENT;
      ccl_cosmology_set_status_message(cosmo,
               "ccl_power.c: ccl_compute_power_emu(): "
               "h is outside allowed range\n");
    }
  }

  if(*status==0) {
   // Check if the cosmology has been set up with equal neutrino masses for the emulator
    // If not, check if the user has forced redistribution of masses and if so do this.
    if(cosmo->params.N_nu_mass>0) {
      if (cosmo->config.emulator_neutrinos_method == ccl_emu_strict){
        if (cosmo->params.N_nu_mass==3){
          if (cosmo->params.m_nu[0] != cosmo->params.m_nu[1] ||
              cosmo->params.m_nu[0] != cosmo->params.m_nu[2] ||
              cosmo->params.m_nu[1] != cosmo->params.m_nu[2]){
            *status = CCL_ERROR_INCONSISTENT;
            ccl_cosmology_set_status_message(cosmo,
                                             "ccl_power.c: ccl_compute_power_emu(): "
                                             "In the default configuration, you must pass a list of 3 "
                                             "equal neutrino masses or pass a sum and set "
                                             "m_nu_type = 'equal'. If you wish to over-ride this, "
                                             "set config->emulator_neutrinos_method = "
                                             "'ccl_emu_equalize'. This will force the neutrinos to "
                                             "be of equal mass but will result in "
                                             "internal inconsistencies.\n");
          }
        }else if (cosmo->params.N_nu_mass!=3){
          *status = CCL_ERROR_INCONSISTENT;
          ccl_cosmology_set_status_message(cosmo,
                                           "ccl_power.c: ccl_compute_power_emu(): "
                                           "In the default configuration, you must pass a list of 3 "
                                           "equal neutrino masses or pass a sum and set "
                                           "m_nu_type = 'equal'. If you wish to over-ride this, "
                                           "set config->emulator_neutrinos_method = "
                                           "'ccl_emu_equalize'. This will force the neutrinos to "
                                           "be of equal mass but will result in "
                                           "internal inconsistencies.\n");
        }
      }else if (cosmo->config.emulator_neutrinos_method == ccl_emu_equalize){
        // Reset the masses to equal
        double mnu_eq[3] = {cosmo->params.sum_nu_masses / 3.,
                            cosmo->params.sum_nu_masses / 3.,
                            cosmo->params.sum_nu_masses / 3.};
        Omeganuh2_eq = ccl_Omeganuh2(1.0, 3, mnu_eq, cosmo->params.T_CMB, status);
      }
    } else {
      if(fabs(cosmo->params.N_nu_rel - 3.04)>1.e-6){
        *status=CCL_ERROR_INCONSISTENT;
        ccl_cosmology_set_status_message(cosmo,
                                         "ccl_power.c: ccl_compute_power_emu(): "
                                         "Set Neff = 3.04 for cosmic emulator predictions in "
                                         "absence of massive neutrinos.\n");
      }
    }
  }

  if(*status==0) {
    double w0wacomb = -cosmo->params.w0 - cosmo->params.wa;
    if(w0wacomb<8.1e-3){ //0.3^4
      *status=CCL_ERROR_INCONSISTENT;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "w0 and wa do not satisfy the emulator bound\n");
    }
  }

  if(*status==0) {
    if(cosmo->params.Omega_nu_mass*cosmo->params.h*cosmo->params.h>0.01){
      *status=CCL_ERROR_INCONSISTENT;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "Omega_nu does not satisfy the emulator bound\n");
    }
  }

  if(*status==0) {
    // Check to see if sigma8 was defined
    if(isnan(cosmo->params.sigma8)){
      *status=CCL_ERROR_INCONSISTENT;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "sigma8 is not defined; specify sigma8 instead of A_s\n");
    }
  }

  int na=cosmo->spline_params.A_SPLINE_NA_PK;
  double *lpk_1a=NULL,*lk=NULL,*aemu=NULL,*lpk_nl=NULL;
  if (*status == 0) {
    //Now start the NL computation with the emulator
    //These are the limits of the splining range
    aemu = ccl_linear_spacing(A_MIN_EMU,cosmo->spline_params.A_SPLINE_MAX, na);
    if(aemu==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "memory allocation error\n");
    }
  }
  if (*status == 0) {
    lk=malloc(NK_EMU*sizeof(double));
    if(lk==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "memory allocation error\n");
    }
  }
  if (*status == 0) {
    //The emulator only computes power spectra at fixed nodes in k,
    //given by the global variable "mode"
    for (int i=0; i<NK_EMU; i++)
      lk[i] = log(mode[i]);
  }
  if (*status == 0) {
    lpk_nl = malloc(NK_EMU * na * sizeof(double));
    if(lpk_nl==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "memory allocation error\n");
    }
  }
  if (*status == 0) {
    lpk_1a=malloc(NK_EMU*sizeof(double));
    if(lpk_1a==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
                                       "ccl_power.c: ccl_compute_power_emu(): "
                                       "memory allocation error\n");
    }
  }

  if (*status == 0) {
    double emu_par[9];
    //For each redshift:
    for (int j = 0; j < na; j++){
      //Turn cosmology into emu_par:
      if ((cosmo->params.N_nu_mass>0) &&
          (cosmo->config.emulator_neutrinos_method == ccl_emu_equalize)){
          emu_par[0] = (cosmo->params.Omega_c+cosmo->params.Omega_b)*cosmo->params.h*cosmo->params.h + Omeganuh2_eq;
      }else{
          emu_par[0] = (cosmo->params.Omega_c+cosmo->params.Omega_b+cosmo->params.Omega_nu_mass)*cosmo->params.h*cosmo->params.h;
      }
      emu_par[1] = cosmo->params.Omega_b*cosmo->params.h*cosmo->params.h;
      emu_par[2] = cosmo->params.sigma8;
      emu_par[3] = cosmo->params.h;
      emu_par[4] = cosmo->params.n_s;
      emu_par[5] = cosmo->params.w0;
      emu_par[6] = cosmo->params.wa;
      if ((cosmo->params.N_nu_mass>0) &&
          (cosmo->config.emulator_neutrinos_method == ccl_emu_equalize)){
        emu_par[7] = Omeganuh2_eq;
      }else{
        emu_par[7] = cosmo->params.Omega_nu_mass*cosmo->params.h*cosmo->params.h;
      }
      emu_par[8] = 1./aemu[j]-1;
      //Need to have this here because otherwise overwritten by emu in each loop

      //Call emulator at this redshift
      ccl_pkemu(emu_par,NK_EMU,lpk_1a, status, cosmo);
      if (*status) {
        *status=CCL_ERROR_MEMORY;
        ccl_cosmology_set_status_message(cosmo,
                                         "ccl_power.c: ccl_compute_power_emu(): "
                                         "memory allocation error\n");
        break;
      }
      for (int i=0; i<NK_EMU; i++)
        lpk_nl[j*NK_EMU+i] = log(lpk_1a[i]);
    }
  }

  if(*status==0) {
    psp_out=ccl_f2d_t_new(na,aemu,NK_EMU,lk,lpk_nl,NULL,NULL,0,
                          1,2,ccl_f2d_no_extrapol,
                          1,0,2,ccl_f2d_3,status);
  }

  free(lpk_1a);
  free(lk);
  free(aemu);
  free(lpk_nl);
  return psp_out;
}

ccl_f2d_t *ccl_apply_halofit(ccl_cosmology* cosmo, ccl_f2d_t *plin, int *status)
{
  ccl_f2d_t *psp_out=NULL;
  size_t nk, na;
  double *x, *z, *y2d=NULL;

  //Halofit structure
  halofit_struct *hf=NULL;
  hf = ccl_halofit_struct_new(cosmo, plin, status);

  if(*status == 0) {
    //Find lk array
    if(plin->fk != NULL) {
      nk = plin->fk->size;
      x = plin->fk->x;
    }
    else {
      nk = plin->fka->interp_object.xsize;
      x = plin->fka->xarr;
    }

    //Find a array
    if(plin->fa != NULL) {
      na = plin->fa->size;
      z = plin->fa->x;
    }
    else {
      na = plin->fka->interp_object.ysize;
      z = plin->fka->yarr;
    }

    //Allocate pka array
    y2d = malloc(nk * na * sizeof(double));
    if (y2d == NULL) {
      *status = CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo,
        "ccl_power.c: ccl_apply_halofit(): memory allocation\n");
    }
  }

  if (*status == 0) {
    // Calculate P(k) on a, k grid. After this loop, x will contain log(k) and y
    // will contain log(pk) [which has not yet been normalized]
    for (int j = 0; j<na; j++) {
      for (int i=0; i<nk; i++) {
        if (*status == 0) {
          double pk = ccl_halofit_power(cosmo, plin, x[i], z[j], hf, status);
          y2d[j*nk + i] = log(pk);
        }
      }
    }
  }

  if(*status == 0)
    psp_out = ccl_f2d_t_new(na, z, nk, x, y2d, NULL, NULL, 0,
                            1, 2, ccl_f2d_cclgrowth, 1,
                            0, 2, ccl_f2d_3, status);

  free(y2d);
  ccl_halofit_struct_free(hf);
  return psp_out;
}

void ccl_rescale_linpower(ccl_cosmology* cosmo, ccl_f2d_t *psp,
                          int rescale_mg, int rescale_norm,
                          int *status)
{
  if(rescale_mg || rescale_norm)
    ccl_rescale_musigma_s8(cosmo, psp, rescale_mg, status);
}

// Params for sigma(R) integrand
typedef struct {
  ccl_cosmology *cosmo;
  double R;
  double a;
  ccl_f2d_t *psp;
  int* status;
} SigmaR_pars;

typedef struct {
  ccl_cosmology *cosmo;
  double R;
  double a;
  ccl_f2d_t *psp;
  int* status;
} SigmaV_pars;

// Params for k_NL integrand
typedef struct {
  ccl_cosmology *cosmo;
  double a;
  ccl_f2d_t *psp;
  int* status;
} KNL_pars;

/* --------- ROUTINE: w_tophat ---------
INPUT: kR, ususally a wavenumber multiplied by a smoothing radius
TASK: Output W(x)=[sin(x)-x*cos(x)]*(3/x)^3
*/
static double w_tophat_2d(double kR) {
  double w;
  double kR2 = kR*kR;

  // This is the Maclaurin expansion of W(x)=2 J1(x)/x to O(x^10), with x=kR.
  // Necessary numerically because at low x W(x) relies on the fine cancellation of two terms
  if(kR<0.1) {
    w= 1. + kR2*(-1.0/8.0 + kR2*(1.0/192.0 +
      kR2*(-1.0/9216.0 + kR2*(1.0/737280.0 +
      kR2* (-1.0/88473600.0)))));
  }
  else
    w = 2 * gsl_sf_bessel_J1(kR) / kR;
  return w;
}

// Integrand for sigmaB integral (used for the SSC covariance calculation)
static double sigma2B_integrand(double lk,void *params) {
  SigmaR_pars *par=(SigmaR_pars *)params;

  double k=pow(10.,lk);
  double pk=ccl_f2d_t_eval(par->psp, lk * M_LN10, par->a,
                           par->cosmo, par->status);
  double kR=k*par->R;
  double w = w_tophat_2d(kR);

  return pk*k*k*w*w;
}

/* --------- ROUTINE: ccl_sigmaB ---------
INPUT: cosmology, comoving smoothing radius, scale factor
TASK: compute sigmaB, the variance in the projected *linear* density field
smoothed with a 2D tophat filter of comoving size R
*/
double ccl_sigma2B(ccl_cosmology *cosmo,double R,double a,ccl_f2d_t *psp, int *status)
{
  SigmaR_pars par;
  par.status = status;

  par.cosmo=cosmo;
  par.R=R;
  par.a=a;
  par.psp=psp;

  gsl_integration_cquad_workspace *workspace =  NULL;
  gsl_function F;
  F.function=&sigma2B_integrand;
  F.params=∥
  double sigma_B;

  workspace = gsl_integration_cquad_workspace_alloc(cosmo->gsl_params.N_ITERATION);
  if (workspace == NULL) {
    *status = CCL_ERROR_MEMORY;
  }
  if (*status == 0) {
    int gslstatus = gsl_integration_cquad(&F,
                                          log10(cosmo->spline_params.K_MIN),
                                          log10(cosmo->spline_params.K_MAX),
                                          0.0, cosmo->gsl_params.INTEGRATION_SIGMAR_EPSREL,
                                          workspace,&sigma_B,NULL,NULL);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_power.c: ccl_sigma2B():");
      *status |= gslstatus;
    }
  }
  gsl_integration_cquad_workspace_free(workspace);

  return sigma_B*M_LN10/(2*M_PI);
}

void ccl_sigma2Bs(ccl_cosmology *cosmo,int na, double *a, double *R,
                  double *sigma2B_out, ccl_f2d_t *psp, int *status) {
#pragma omp parallel default(none)                      \
  shared(cosmo, na, a, R, psp, sigma2B_out, status)
  {
    int ia;
    int local_status=*status;

    #pragma omp for
    for(ia=0; ia<na; ia++) {
      if(local_status==0)
        sigma2B_out[ia]=ccl_sigma2B(cosmo,R[ia],a[ia],psp,&local_status);
    } //end omp for
    if(local_status) {
      #pragma omp atomic write
      *status=local_status;
    }
  } //end omp parallel

  if(*status) {
    ccl_cosmology_set_status_message(cosmo,
             "ccl_power.c: ccl_sigma2Bs(): "
             "integration error\n");
  }
}

/* --------- ROUTINE: w_tophat ---------
INPUT: kR, ususally a wavenumber multiplied by a smoothing radius
TASK: Output W(x)=[sin(x)-x*cos(x)]*(3/x)^3
*/
static double w_tophat(double kR) {
  double w;
  double kR2 = kR*kR;

  // This is the Maclaurin expansion of W(x)=[sin(x)-xcos(x)]*3/x**3 to O(x^10), with x=kR.
  // Necessary numerically because at low x W(x) relies on the fine cancellation of two terms
  if(kR<0.1) {
    w= 1. + kR2*(-1.0/10.0 + kR2*(1.0/280.0 +
      kR2*(-1.0/15120.0 + kR2*(1.0/1330560.0 +
      kR2* (-1.0/172972800.0)))));
  }
  else
    w = 3.*(sin(kR) - kR*cos(kR))/(kR2*kR);
  return w;
}

// Integrand for sigmaR integral
static double sigmaR_integrand(double lk,void *params) {
  SigmaR_pars *par=(SigmaR_pars *)params;

  double k=pow(10.,lk);
  double pk=ccl_f2d_t_eval(par->psp, lk * M_LN10, par->a,
                           par->cosmo, par->status);
  double kR=k*par->R;
  double w = w_tophat(kR);

  return pk*k*k*k*w*w;
}

// Integrand for sigmaV integral
static double sigmaV_integrand(double lk,void *params) {
  SigmaV_pars *par=(SigmaV_pars *)params;

  double k=pow(10.,lk);
  double pk=ccl_f2d_t_eval(par->psp, lk * M_LN10, par->a,
                           par->cosmo, par->status);
  double kR=k*par->R;
  double w = w_tophat(kR);

  return pk*k*w*w/3.0;
}

/* --------- ROUTINE: ccl_sigmaR ---------
INPUT: cosmology, comoving smoothing radius, scale factor
TASK: compute sigmaR, the variance in the *linear* density field
smoothed with a tophat filter of comoving size R
*/
double ccl_sigmaR(ccl_cosmology *cosmo,double R,double a,ccl_f2d_t *psp, int *status) {

  SigmaR_pars par;
  par.status = status;

  par.cosmo=cosmo;
  par.R=R;
  par.a=a;
  par.psp=psp;

  gsl_integration_cquad_workspace *workspace =  NULL;
  gsl_function F;
  F.function=&sigmaR_integrand;
  F.params=∥
  double sigma_R;

  workspace = gsl_integration_cquad_workspace_alloc(cosmo->gsl_params.N_ITERATION);
  if (workspace == NULL) {
    *status = CCL_ERROR_MEMORY;
  }
  if (*status == 0) {
    int gslstatus = gsl_integration_cquad(&F,
                                          log10(cosmo->spline_params.K_MIN),
                                          log10(cosmo->spline_params.K_MAX),
                                          0.0, cosmo->gsl_params.INTEGRATION_SIGMAR_EPSREL,
                                          workspace,&sigma_R,NULL,NULL);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_power.c: ccl_sigmaR():");
      *status |= gslstatus;
    }
  }
  gsl_integration_cquad_workspace_free(workspace);

  return sqrt(sigma_R*M_LN10/(2*M_PI*M_PI));
}

/* --------- ROUTINE: ccl_sigmaV ---------
INPUT: cosmology, comoving smoothing radius, scale factor
TASK: compute sigmaV, the variance in the *linear* displacement field
smoothed with a tophat filter of comoving size R
The linear displacement field is the gradient of the linear density field
*/
double ccl_sigmaV(ccl_cosmology *cosmo,double R,double a,ccl_f2d_t *psp, int *status) {

  SigmaV_pars par;
  par.status = status;

  par.cosmo=cosmo;
  par.R=R;
  par.a=a;
  par.psp=psp;

  gsl_integration_cquad_workspace *workspace = NULL;
  gsl_function F;
  F.function=&sigmaV_integrand;
  F.params=∥
  double sigma_V;

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

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

  if (*status == 0) {
    int gslstatus = gsl_integration_cquad(&F,
                                          log10(cosmo->spline_params.K_MIN),
                                          log10(cosmo->spline_params.K_MAX),
                                          0.0, cosmo->gsl_params.INTEGRATION_SIGMAR_EPSREL,
                                          workspace,&sigma_V,NULL,NULL);

    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_power.c: ccl_sigmaV():");
      *status |= gslstatus;
    }
  }

  gsl_integration_cquad_workspace_free(workspace);

  return sqrt(sigma_V*M_LN10/(2*M_PI*M_PI));
}

/* --------- ROUTINE: ccl_sigma8 ---------
INPUT: cosmology
TASK: compute sigma8, the variance in the *linear* density field at a=1
smoothed with a tophat filter of comoving size 8 Mpc/h
*/

double ccl_sigma8(ccl_cosmology *cosmo, ccl_f2d_t *psp, int *status) {
  return ccl_sigmaR(cosmo, 8/cosmo->params.h, 1., psp, status);
}

// Integrand for kNL integral
static double kNL_integrand(double k,void *params) {
  KNL_pars *par=(KNL_pars *)params;

  double pk=ccl_f2d_t_eval(par->psp, log(k), par->a,
                           par->cosmo, par->status);

  return pk;
}

/* --------- ROUTINE: ccl_kNL ---------
INPUT: cosmology, scale factor
TASK: compute kNL, the scale for the non-linear cut
*/
double ccl_kNL(ccl_cosmology *cosmo,double a,ccl_f2d_t *psp, int *status) {

  KNL_pars par;
  par.status = status;
  par.a = a;
  par.psp=psp;

  par.cosmo=cosmo;
  gsl_integration_cquad_workspace *workspace =  NULL;
  gsl_function F;
  F.function=&kNL_integrand;
  F.params=∥
  double PL_integral;

  workspace = gsl_integration_cquad_workspace_alloc(cosmo->gsl_params.N_ITERATION);
  if (workspace == NULL) {
    *status = CCL_ERROR_MEMORY;
  }
  if (*status == 0) {
    int gslstatus = gsl_integration_cquad(&F, cosmo->spline_params.K_MIN, cosmo->spline_params.K_MAX,
                                          0.0, cosmo->gsl_params.INTEGRATION_KNL_EPSREL,
                                          workspace,&PL_integral,NULL,NULL);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_power.c: ccl_kNL():");
      *status |= gslstatus;
    }
  }
  gsl_integration_cquad_workspace_free(workspace);
  double sigma_eta = sqrt(PL_integral/(6*M_PI*M_PI));
  return pow(sigma_eta, -1);
}


#include <stdio.h>
#include <math.h>
#include "wf.h"
#include "alphas.h"
#include "glasma.h"
#include <gsl/gsl_integration.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>

//workspace and global variables for integration
static double abserr = 1.e-200;
static double relerr = 1.e-20;

double phiKernel(double x, void *params);

static double result,error;
static size_t neval;
static gsl_function phiIntKernel;

double d2Nglasma0(double pT, double qT, double phipq, double yp, double yq, double rts)
{
    static struct glasma_params params;
    params.pT = pT;
    params.qT = qT;
    params.yp = yp;
    params.yq = yq;
    params.rts = rts;
    params.phipq = phipq;
    phiIntKernel.function = &phiKernel;
    (params.Kernel).function = &doubleKernel;

    phiIntKernel.params = &params;
    gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr,\
            &result, &error, &neval);

    double norm = (Nc*Nc)/gsl_pow_3(Nc*Nc-1.)/(4.*pow(M_PI,10.))/gsl_pow_2(pT*
        qT)*alpha(pT)*alpha(qT);

    return norm*result;
}

double d2Nglasma1(double pT, double yp, double yq, double rts)
{
    double sinres, cosres;
    static struct glasma_params params;
    params.pT = pT;
    params.yp = yp;
    params.yq = yq;
    params.rts = rts;

    phiIntKernel.function = &phiKernel;
    (params.Kernel).function = &cosKernel;
    phiIntKernel.params = &params;
    gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr, &cosres, &error, &neval);

    (params.Kernel).function = &sinKernel;
    phiIntKernel.params = &params;
    gsl_integration_qng(&phiIntKernel, -M_PI, M_PI, abserr, relerr, &sinres, &error, &neval);

    double norm =  (Nc*Nc)/gsl_pow_3(Nc*Nc-1.)/(4.*pow(M_PI,10.))/gsl_pow_2(pT*pT)*alpha(pT)*alpha(pT) ;

    return norm*(cosres*cosres + sinres*sinres);
}

double doubleKernel(double x, void *p)
{
   struct glasma_params params = *(struct glasma_params *)p;

   double rts = params.rts;
   double pT, qT, yp, yq;
   double x1p, x2p, x1q, x2q, x1max, x2max;

   double phi = params.phi;
   double phipq = params.phipq;
   double kT =  x;

   pT = params.pT;
   qT = params.qT;
   yp = params.yp;
   yq = params.yq;

   x1p = pT/rts*exp(+yp);
   x2p = pT/rts*exp(-yp);
   x1q = qT/rts*exp(+yq);
   x2q = qT/rts*exp(-yq);

   x1max = gsl_max(x1p,x1q);
   x2max = gsl_max(x2p,x2q);

   double qTmkT = sqrt( qT*qT + kT*kT - 2.0*qT*kT*cos(phipq-phi) );
   double qTpkT = sqrt( qT*qT + kT*kT + 2.0*qT*kT*cos(phipq-phi) );
   double pTmkT = sqrt( pT*pT + kT*kT - 2.0*pT*kT*cos(phi) );
   double pTpkT = sqrt( pT*pT + kT*kT + 2.0*pT*kT*cos(phi) );

   double pTmkTmqT = sqrt( pT*pT + kT*kT + qT*qT \
                          -2.0*pT*qT*cos(phipq) \
                          -2.0*pT*kT*cos(phi) \
                          +2.0*qT*kT*cos(phipq-phi)\
                        );

   double pTmkTpqT = sqrt( pT*pT + kT*kT + qT*qT \
                          +2.0*pT*qT*cos(phipq) \
                          -2.0*pT*kT*cos(phi) \
                          -2.0*qT*kT*cos(phipq-phi)\
                        );

   //diagram A & E
   //this factor of 0.5 is from
   //symmetrizing wrt pTmkT
   double AE = 0.5*kT*pow(wf(1,x1max,kT),2.0)\
          *( wf(2,x2p,pTmkT) + wf(2,x2p,pTpkT) )\
          *( wf(2,x2q,qTmkT) + wf(2,x2q,qTpkT) );

   //diagram B & F
   double BF = 0.5*kT*pow(wf(2,x2max,kT),2.0)\
          *( wf(1,x1p,pTmkT) + wf(1,x1p,pTpkT) )\
          *( wf(1,x1q,qTmkT) + wf(1,x1q,qTpkT) );

   double T1D, T2D, T1H, T2H, denD, denH;
   T1D = ( kT*pT*cos(phi)-kT*kT )\
        *( pT*pT - pT*qT*cos(phipq) - pT*kT*cos(phi) - pow(pTmkTmqT,2.0) ) \
        - (pT*kT*sin(phi))*(pT*qT*sin(phipq) + pT*kT*sin(phi) );

   T1H = ( kT*pT*cos(phi)-kT*kT )\
        *( pT*pT + pT*qT*cos(phipq) - pT*kT*cos(phi) - pow(pTmkTpqT,2.0) ) \
        - (pT*kT*sin(phi))*(-pT*qT*sin(phipq) + pT*kT*sin(phi) );

   T2D = ( kT*qT*cos(phipq-phi)+kT*kT )\
        *( -qT*qT + pT*qT*cos(phipq) - qT*kT*cos(phipq-phi) + pow(pTmkTmqT,2.0) ) \
        + (qT*kT*sin(phipq-phi))*(pT*qT*sin(phipq) - qT*kT*sin(phipq-phi) );

   T2H = ( -kT*qT*cos(phipq-phi)+kT*kT )\
        *( -qT*qT - pT*qT*cos(phipq) + qT*kT*cos(phipq-phi) + pow(pTmkTpqT,2.0) ) \
        + (qT*kT*sin(phipq-phi))*(pT*qT*sin(phipq) - qT*kT*sin(phipq-phi) );

   denD = pow(kT*pTmkTmqT*pTmkT*qTpkT,2.0);

   denH = pow(kT*pTmkTpqT*pTmkT*qTmkT,2.0);

   //this factor of 0.5 is from the different f^4\delta^4 structure
   double D = 0.5*kT*T1D*T2D/denD\
               *wf(1,x1max,kT)*wf(1,x1max,pTmkTmqT)*wf(2,x2max,pTmkT)*wf(2,x2max,qTpkT);

   double H = 0.5*kT*T1H*T2H/denH\
               *wf(1,x1max,kT)*wf(1,x1max,pTmkTpqT)*wf(2,x2max,pTmkT)*wf(2,x2max,qTmkT);

   return (AE + BF + D + H);
}

double cosKernel(double x, void *p)
{
   struct glasma_params params = *(struct glasma_params *)p;

   double rts = params.rts;
   double pT, yp, yq;
   double x1p, x2p, x1q, x2q, x1max, x2max;

   double phi = params.phi;
   double kT =  x;

   pT = params.pT;
   yp = params.yp;
   yq = params.yq;

   x1p = pT/rts*exp(+yp);
   x2p = pT/rts*exp(-yp);
   x1q = pT/rts*exp(+yq);
   x2q = pT/rts*exp(-yq);

   x1max = gsl_max(x1p,x1q);
   x2max = gsl_max(x2p,x2q);

   double pTmkT = sqrt( pT*pT + kT*kT - 2.0*pT*kT*cos(phi) );

   double num = pow( kT*pT*cos(phi)-kT*kT, 2.0);
   double den  = pow(kT*pTmkT,2.);

   return kT*wf(1,x1p,kT)*wf(2,x2p,pTmkT)*num/den;
}

double sinKernel(double x, void *p)
{
   struct glasma_params params = *(struct glasma_params *)p;

   double rts = params.rts;
   double pT, yp, yq;
   double x1p, x2p, x1q, x2q, x1max, x2max;

   double phi = params.phi;
   double kT =  x;

   pT = params.pT;
   yp = params.yp;
   yq = params.yq;

   x1p = pT/rts*exp(+yp);
   x2p = pT/rts*exp(-yp);
   x1q = pT/rts*exp(+yq);
   x2q = pT/rts*exp(-yq);

   x1max = gsl_max(x1p,x1q);
   x2max = gsl_max(x2p,x2q);

   double pTmkT = sqrt( pT*pT + kT*kT - 2.0*pT*kT*cos(phi) );

   double num = pow( kT*pT*sin(phi), 2.0);
   double den = pow( kT*pTmkT ,2.0);

   return kT*wf(1,x1max,kT)*wf(2,x2max,pTmkT)*num/den;
}

//does phi integration over d^2k_\perp
double phiKernel(double x, void *p)
{
   struct glasma_params params = *(struct glasma_params *)p;
   double result, error;
   params.phi = x;

   gsl_function F = params.Kernel;
   F.params = &params;

   gsl_integration_qng(&F, kT_min, 2.0*kT_max, abserr, relerr,\
           &result, &error, &neval);

return result;
}

void TabulateGlasma(FILE *out, double rts)
{
   //returns dN/d^2p_T d^2q_T dy_p dy_q / (S_\perp) [GeV^-2]
   //this is the delta function contribution
   //of the glasma graphs

   double yp, yq, rtpT;
   //double yrange = 6.0;
   double dy = 0.25;
   double yrange = dy;

   for (yp = -yrange; yp <= yrange; yp += dy)
   for (yq = -yrange; yq <= yrange; yq += dy)
   for (rtpT = .1; rtpT <= 5.11; rtpT += .2){
   fprintf(out,"%10.2f\t%10.2f\t%10.2f\t%10.5e\n", yp, yq, rtpT,\
   d2Nglasma1(pow(rtpT,2.),yp,yq,rts) );
   }
   fclose(out);

return;
}


#ifndef __GSL_HELPER_H__
#define __GSL_HELPER_H__

#if defined _WIN32 || defined _WIN64
 #include <crtdbg.h>
 #define _gsl_asserte(expr,msg) _ASSERT_EXPR(expr,_CRT_WIDE(msg))
#else
 #include <assert.h>
 #define _gsl_asserte(expr,msg) assert(expr)
#endif
#define _gsl_assert(expr) _gsl_asserte(expr, #expr)

extern "C"
{
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector_double.h>
#include <gsl/gsl_matrix_double.h>
}
#include <limits>
#include <memory>
#include <functional>
#include <iostream>

namespace gsl
{

struct Precondition
{
	template<typename E, typename Condition>
	void check(Condition cond) {
		if (!cond) throw E();
	}

	template<typename E, typename Condition, typename... ConditionList>
	void check(Condition cond, ConditionList... conds) {
		if (!cond) throw E();
		else check<E>(conds...);
	}

	template<typename E, typename Condition, typename... ConditionList>
	void operator () (Condition cond, ConditionList... conds) {
		return check<E>(cond, conds...);
	}

	const char* file;
	int line;

	Precondition(const char* file, int line)
		: file(file), line(line) {}
};
#define precondition Precondition(__FILE__, __LINE__).operator()

struct out_of_range: public std::exception {};
struct bad_pointer: public std::exception {};
struct bad_size: public std::exception {};
struct zero_devide: public std::exception {};

/**
 * base_vector
 * объектно-ориентированная оболочка для gsl_vector*
 */
class base_const_vector
{
protected:
	base_const_vector() = default;
	base_const_vector(base_const_vector&&) = default;
	base_const_vector(const base_const_vector&) = default;

public:
	double at(size_t i) const throw(std::exception) {
		precondition<out_of_range>(i >= 0);
		precondition<out_of_range>(i < ptr()->size);
		return gsl_vector_get(ptr(), i);
	}

	double operator [] (size_t i) const throw (std::exception) {
		return at(i);
	}

	const double* data() const {
		return ptr()->data;
	}

	size_t size() const {
		return ptr()->size;
	}

	virtual ~base_const_vector() {}
	virtual const gsl_vector* ptr() const = 0;
};

class base_vector: public base_const_vector
{
protected:
	base_vector() = default;
	base_vector(base_vector&&) = default;
	base_vector(const base_vector&) = default;

public:
	double& at(size_t i) throw(std::exception) {
		precondition<out_of_range>(i >= 0);
		precondition<out_of_range>(i < ptr()->size);
		return *gsl_vector_ptr(ptr(), i);
	}

	double& operator [] (size_t i) throw (std::exception) {
		return at(i);
	}

	double* data() {
		return ptr()->data;
	}

	void set_zero() {
		gsl_vector_set_zero(ptr());
	}

	void set_all(double value) {
		gsl_vector_set_all(ptr(), value);
	}

	virtual ~base_vector() {}
	virtual gsl_vector* ptr() = 0;
};

class vector: public base_vector
{
public:
	vector(vector&&) = default;

	explicit vector(size_t n)
	{
		precondition<bad_size>(n > 0);
		myvec = gsl_vector_calloc(n);
		precondition<bad_pointer>(myvec);
	}

	vector(size_t n, double value)
	{
		precondition<bad_size>(n > 0);
		myvec = gsl_vector_alloc(n);
		gsl_vector_set_all(myvec, value);
		precondition<bad_pointer>(myvec);
	}

    vector(const double* array, size_t n)
	{
    	precondition<bad_pointer>(array);
    	precondition<bad_size>(n > 0);
		gsl_vector_const_view view = gsl_vector_const_view_array(array, n);
		myvec = gsl_vector_alloc(n);
		gsl_vector_memcpy(myvec, &view.vector);
		precondition<bad_pointer>(myvec);
	}

	explicit vector(const gsl_vector* vec)
	{
		precondition<bad_pointer>(vec);
		myvec = gsl_vector_alloc(vec->size);
		gsl_vector_memcpy(myvec, vec);
		precondition<bad_pointer>(myvec);
	}

	explicit vector(const gsl_vector_view& view)
	{
		myvec = gsl_vector_alloc(view.vector.size);
		gsl_vector_memcpy(myvec, &view.vector);
		precondition<bad_pointer>(myvec);
	}

	explicit vector(const gsl_vector_const_view& view)
	{
		myvec = gsl_vector_alloc(view.vector.size);
		gsl_vector_memcpy(myvec, &view.vector);
		precondition<bad_pointer>(myvec);
	}

	vector(const base_const_vector& other)
		: vector(other.ptr()) {}

	vector(const vector& other)
		: vector(other.myvec) {}

	~vector() {
		gsl_vector_free(myvec);
	}

	vector& operator = (const vector& other) {
		if( this != &other ) {
			precondition<bad_pointer>(other.myvec);
			precondition<bad_size>(myvec->size == other.myvec->size);
			gsl_vector_memcpy(myvec, other.myvec);
		}
		return *this;
	}

	gsl_vector* ptr() override {
		return myvec;
	}

	const gsl_vector* ptr() const override {
		return myvec;
	}

private:
	gsl_vector* myvec;
};

template<class V>
struct view_traits;

template<>
struct view_traits<gsl_vector_view> {

	using value_t = double;
	using vector_t = gsl_vector;
	using view_t = gsl_vector_view;

	inline static view_t view_array(value_t* arr, size_t n) {
		return gsl_vector_view_array(arr, n);
	}

	inline static view_t view_array_with_stride(value_t* arr, size_t n, size_t stride) {
		return gsl_vector_view_array_with_stride(arr, n, stride);
	}

	inline static view_t subvector(vector_t* v, size_t i, size_t n) {
		return gsl_vector_subvector(v, i, n);
	}

	inline static view_t subvector_with_stride(vector_t* v, size_t i, size_t stride, size_t n) {
		return gsl_vector_subvector_with_stride(v, i, stride, n);
	}
};

template<>
struct view_traits<gsl_vector_const_view> {

	using value_t = const double;
	using vector_t = const gsl_vector;
	using view_t = gsl_vector_const_view;

	inline static view_t view_array(value_t* arr, size_t n) {
		return gsl_vector_const_view_array(arr, n);
	}

	inline static view_t view_array_with_stride(value_t* arr, size_t n, size_t stride) {
		return gsl_vector_const_view_array_with_stride(arr, n, stride);
	}

	inline static view_t subvector(vector_t* v, size_t i, size_t n) {
		return gsl_vector_const_subvector(v, i, n);
	}

	inline static view_t subvector_with_stride(vector_t* v, size_t i, size_t stride, size_t n) {
		return gsl_vector_const_subvector_with_stride(v, i, stride, n);
	}
};

template<class View>
class base_view_t
{
protected:
	typedef view_traits<View> traits;
	typedef typename traits::value_t value_t;
	typedef typename traits::vector_t vector_t;
	typedef typename traits::view_t view_t;

	view_t make_view(vector_t* v, size_t i, size_t stride, size_t n) {
		precondition<bad_pointer>(v);
		precondition<out_of_range>(i >= 0 && i < v->size);
		precondition<out_of_range>(i + stride * (n - 1) < v->size);
		precondition<bad_size>(n > 0 && n <= v->size - i);

		return traits::subvector_with_stride(v, i, stride, n);
	}

public:
	base_view_t(const base_view_t& other)
		: view(other.view) {}

	base_view_t(const view_t& _view)
		: view(_view) {}

	base_view_t(vector_t* v)
		: view( make_view(v, 0, 1, v->size) ) {}

	base_view_t(vector_t* vector, size_t i, size_t n)
		: view( make_view(vector, i, 1, n) ) {}

	base_view_t(vector_t* vector, size_t i, size_t stride, size_t n)
		: view( make_view(vector, i, stride, n) ) {}

protected:
	view_t view;
};

class vector_const_view: public base_const_vector, public base_view_t<gsl_vector_const_view>
{
public:
	using base_view_t<gsl_vector_const_view>::base_view_t;

	vector_const_view(const base_const_vector& v)
		: base_view_t(v.ptr()) {}

	vector_const_view(const base_const_vector& v, size_t i, size_t n)
		: base_view_t(v.ptr(), i, n) {}

	vector_const_view(const base_const_vector& v, size_t i, size_t stride, size_t n)
		: base_view_t(v.ptr(), i, stride, n) {}

	const gsl_vector* ptr() const override {
		return &view.vector;
	}
};

class vector_view: public base_vector, public base_view_t<gsl_vector_view>
{
public:
	using base_view_t<gsl_vector_view>::base_view_t;

	vector_view(base_vector& v)
		: base_view_t(v.ptr()) {}

	vector_view(base_vector& v, size_t i, size_t n)
		: base_view_t(v.ptr(), i, n) {}

	vector_view(base_vector& v, size_t i, size_t stride, size_t n)
		: base_view_t(v.ptr(), i, stride, n) {}

	vector_view& operator = (const vector_view& other) {
		if (this != &other)
			view = other.view;
		return *this;
	}

	const gsl_vector* ptr() const override {
		return &view.vector;
	}

	gsl_vector* ptr() override {
		return &view.vector;
	}
};

inline std::ostream& operator << (std::ostream& output, const base_const_vector& v) {
	output << '{';
	for( size_t i=0; i<v.size(); ++i ) {
		if( i > 0 ) output << ", ";
		output << v[i];
	}
	output << '}';
	return output;
}

}//namespace gsl

#endif //__GSL_HELPER_H__


#ifndef DISTREADER_H_
#define DISTREADER_H_

#include <ctime>
#include <string>
#include <iostream>
#include <sstream>
#include <cmath>

//#define WINDOWS_32_Q
#define NOGSL

#include <ctime>
#include <string>

#ifdef WINDOWS_32_Q
#include <windows.h>
#define NOGSL
#endif

#ifndef NOGSL
#include <gsl/gsl_cdf.h>
#endif
// convert from integer to string
std::string itos(int j)
{
	std::stringstream s;
	s << j;
	return s.str();
}

// convert double to string (doesn't work though...)
std::string dtos(double j)
{
    std::stringstream s;
    s << j;

    return s.str();
}

unsigned get_nanoseconds()
{
#ifndef WINDOWS_32_Q

	timespec ts;

	if (0!=clock_gettime(CLOCK_REALTIME,&ts))
	{
		throw "error in getting the real time stamp in nanosecs, quitting!";
	}

	return(ts.tv_nsec);

#endif

#ifdef WINDOWS_32_Q
	SYSTEMTIME SystemTime;

	GetSystemTime(&SystemTime);

	return(SystemTime.wMilliseconds);
#endif
}

std::string create_filename(std::string filename)
{
	time_t timep = time(NULL);

	tm *timestruct = localtime(&timep);

	filename.append("_");
	filename.append(itos(timestruct->tm_mday));
	filename.append("_");
	filename.append(itos(timestruct->tm_mon + 1));
	filename.append("_");
	filename.append(itos(timestruct->tm_year + 1900));
	filename.append("_");

	size_t hour = timestruct->tm_hour;

	if (hour < 10)
		filename.append("0");

	filename.append(itos(hour));

	size_t minutes = timestruct->tm_min;

	if (minutes < 10)
		filename.append("0");

	filename.append(itos(minutes));

	size_t seconds = timestruct->tm_sec;

	if (seconds < 10)
		filename.append("0");

	filename.append(itos(seconds));

	filename.append("_");

	// now we are going to insert microsecs
	// to obtain unique filename
	filename.append(itos(get_nanoseconds()));

	return(filename);
}

int linear_search(const int list[], const int maxsize, int value)
{
    int index = 0;
    int position = -1;
    bool found = false;

    while (index < maxsize && !found)
    {
        if (list[index] == value)
        {
            found = true;
            position = index;
        }

        ++index;
    }

    return(position);
}

struct Stats
{
    double mean;
    double mean_ci;
    double sumsquares;
    double var;
    double sumthirds;
    double skew;
    double sumfourths;
    double kurt;
    double sample;
};

struct JointStats
{
    double cov;
    double sum12;
    double sample;
};

void stat_reset(Stats &results)
{
    results.mean = 0;
    results.mean_ci = 0;
    results.sumsquares = 0;
    results.var = 0;
    results.sumthirds = 0;
    results.skew = 0;
    results.sumfourths = 0;
    results.kurt = 0;
    results.sample = 0;
}

void stat_addval(Stats &results, const double traitvalue)
{
    results.mean += traitvalue;
    results.sumsquares += pow(traitvalue,2);
    results.sumthirds += pow(traitvalue,3);
    results.sumfourths += pow(traitvalue,4);
    ++results.sample;
}

void jstat_reset(JointStats &results)
{
    results.sum12 = 0;
    results.sample = 0;
}

void jstat_addval(JointStats &results, const double trait1, const double trait2)
{
    results.sum12+=trait1*trait2;
    ++results.sample;
}

void jstat_finalize(JointStats &results, const double mean1, const double mean2)
{
    results.cov = results.sum12 / results.sample - mean1 * mean2;
}

void stat_finalize(Stats &results)
{
    if (results.sample == 0)
    {
        results.mean = 0;
        results.var = 0;
        results.mean_ci = 0;
        results.skew = 0;
        results.kurt = 0;
    }
    else
    {
        results.mean /= results.sample;
        results.var = results.sumsquares == 0 ? 0 : results.sumsquares / results.sample - pow(results.mean,2);
#ifdef WINDOWS_32_Q
        results.mean_ci = 0;
#endif

#ifndef NOGSL
        results.mean_ci = gsl_cdf_tdist_Qinv(0.025,results.sample - 1) * results.var / sqrt(results.sample);
#endif
        results.skew = results.sumthirds / results.sample - 3 * results.mean * results.sumsquares / results.sample + 2 * pow(results.mean,3);
        results.kurt = (double) (results.sumfourths / results.sample - 4 * results.sumthirds / results.sample * results.mean + 6 * pow(results.mean,2) * results.sumsquares / results.sample - 3 * pow(results.mean,4));

    }
}

#endif


//This does CELL (~soma) stage of GRU (gated recurrent unit) model.
//This requires each neuron to have 3 input time series, X, Xr, Xz,
//where X is the usual input and Xr, Xz the inputs for the reset and update gates.
//X, Xr, Xz are the output of a separate linear IN stage (weights and baises).

//For dim=0, R[:,t] = sig{Xr[:,t] + Ur*Y[:,t-1]} \n";
//           Z[:,t] = sig{Xz[:,t] + Uz*Y[:,t-1]} \n";
//           H[:,t] = R[:,t].*Y[:,t-1] \n";
//           Y[:,t] = Z[:,t].*Y[:,t-1] + (1-Z[:,t]).*tanh{X[:,t] + U*H[:,t]} \n";
//with sizes X, Xr, Xz: N x T \n";
//           U, Ur, Uz: N x N \n";
//           Y        : N x T \n";
//
//For dim=1, R[t,:] = sig{Xr[t,:] + Y[t-1,:]*Ur} \n";
//           Z[t,:] = sig{Xz[t,:] + Y[t-1,:]*Uz} \n";
//           H[t,:] = R[t,:].*Y[t-1,:] \n";
//           Y[t,:] = Z[t,:].*Y[t-1,:] + (1-Z[t,:]).*tanh{X[t,:] + H[t,:]*U} \n";
//with sizes X, Xr, Xz: T x N \n";
//           U, Ur, Uz: N x N \n";
//           Y        : T x N \n";
//
//where sig is the logistic (sigmoid) nonlinearity = 1/(1+exp(-x)),
//R is the reset gate, Z is the update gate, H is an intermediate (hidden) vector,
//U, Ur, Uz are NxN matrices, and Y is the output.

//Note that, the neurons of a layer are independent only if U, Ur, Uz are diagonal matrices.
//This is only really a CELL (~soma) stage in that case.

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

#ifdef __cplusplus
namespace codee {
extern "C" {
#endif

int gru3_s (float *Y, const float *X, const float *Xr, const float *Xz, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);
int gru3_d (double *Y, const double *X, const double *Xr, const double *Xz, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);

int gru3_inplace_s (float *X, const float *Xr, const float *Xz, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);
int gru3_inplace_d (double *X, const double *Xr, const double *Xz, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);

int gru3_s (float *Y, const float *X, const float *Xr, const float *Xz, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const float o = 1.0f;
    size_t nT, tN;

    float *R, *Z, *H;
    if (!(R=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_s: problem with malloc. "); perror("malloc"); return 1; }

    if (N==1u)
    {
        //R[0] = 1.0f / (1.0f+expf(-Xr[0]));
        Z[0] = 1.0f / (1.0f+expf(-Xz[0]));
        Y[0] = (1.0f-Z[0]) * tanhf(X[0]);
        for (size_t t=1; t<T; ++t)
        {
            //R[0] = 1.0f / (1.0f+expf(-Xr[t]-Ur[0]*Y[t-1]));
            Z[0] = 1.0f / (1.0f+expf(-Xz[t]-Uz[0]*Y[t-1]));
            //H[0] = R[0] * Y[t-1];
            H[0] = Y[t-1] / (1.0f+expf(-Xr[t]-Ur[0]*Y[t-1]));
            Y[t] = Z[0]*Y[t-1] + (1.0f-Z[0])*tanhf(X[t]+U[0]*H[0]);
        }
    }
    else if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                //R[n] = 1.0f / (1.0f+expf(-Xr[n]));
                Z[n] = 1.0f / (1.0f+expf(-Xz[n]));
                Y[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_scopy((int)N,&Xr[tN],1,R,1); cblas_scopy((int)N,&Xz[tN],1,Z,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    //R[n] = 1.0f / (1.0f+expf(-R[n]));
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    //H[n] = R[n] * Y[tN-N+n];
                    H[n] = Y[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[tN],1,&Y[tN],1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0f-Z[n])*tanhf(Y[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                //R[n] = 1.0f / (1.0f+expf(-Xr[nT]));
                Z[n] = 1.0f / (1.0f+expf(-Xz[nT]));
                Y[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&Xr[t],(int)T,R,1); cblas_scopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    //R[n] = 1.0f / (1.0f+expf(-R[n]));
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    //H[n] = R[n] * Y[t-1+n*T];
                    H[n] = Y[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0f-Z[n])*tanhf(Y[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-Xz[nT]));
                Y[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&Xr[t],(int)T,R,1); cblas_scopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0f-Z[n])*tanhf(Y[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0f / (1.0f+expf(-Xz[n]));
                Y[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_scopy((int)N,&Xr[tN],1,R,1); cblas_scopy((int)N,&Xz[tN],1,Z,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[tN],1,&Y[tN],1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0f-Z[n])*tanhf(Y[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru3_s: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru3_d (double *Y, const double *X, const double *Xr, const double *Xz, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const double o = 1.0;
    size_t nT, tN;

    double *R, *Z, *H;
    if (!(R=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_d: problem with malloc. "); perror("malloc"); return 1; }

    if (N==1u)
    {
        Z[0] = 1.0 / (1.0+exp(-Xz[0]));
        Y[0] = (1.0-Z[0]) * tanh(X[0]);
        for (size_t t=1; t<T; ++t)
        {
            Z[0] = 1.0 / (1.0+exp(-Xz[t]-Uz[0]*Y[t-1]));
            H[0] = Y[t-1] / (1.0+exp(-Xr[t]-Ur[0]*Y[t-1]));
            Y[t] = Z[0]*Y[t-1] + (1.0-Z[0])*tanh(X[t]+U[0]*H[0]);
        }
    }
    else if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-Xz[n]));
                Y[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_dcopy((int)N,&Xr[tN],1,R,1); cblas_dcopy((int)N,&Xz[tN],1,Z,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[tN],1,&Y[tN],1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0-Z[n])*tanh(Y[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-Xz[nT]));
                Y[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&Xr[t],(int)T,R,1); cblas_dcopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0-Z[n])*tanh(Y[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-Xz[nT]));
                Y[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&Xr[t],(int)T,R,1); cblas_dcopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0-Z[n])*tanh(Y[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-Xz[n]));
                Y[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_dcopy((int)N,&Xr[tN],1,R,1); cblas_dcopy((int)N,&Xz[tN],1,Z,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[tN],1,&Y[tN],1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0-Z[n])*tanh(Y[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru3_d: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru3_inplace_s (float *X, const float *Xr, const float *Xz, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const float o = 1.0f;
    size_t nT, tN;

    float *R, *Z, *H;
    if (!(R=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_inplace_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_inplace_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru3_inplace_s: problem with malloc. "); perror("malloc"); return 1; }

    if (N==1u)
    {
        //R[0] = 1.0f / (1.0f+expf(-Xr[0]));
        Z[0] = 1.0f / (1.0f+expf(-Xz[0]));
        X[0] = (1.0f-Z[0]) * tanhf(X[0]);
        for (size_t t=1; t<T; ++t)
        {
            //R[0] = 1.0f / (1.0f+expf(-Xr[t]-Ur[0]*X[t-1]));
            Z[0] = 1.0f / (1.0f+expf(-Xz[t]-Uz[0]*X[t-1]));
            //H[0] = R[0] * X[t-1];
            H[0] = X[t-1] / (1.0f+expf(-Xr[t]-Ur[0]*X[t-1]));
            X[t] = Z[0]*X[t-1] + (1.0f-Z[0])*tanhf(X[t]+U[0]*H[0]);
        }
    }
    else if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                //R[n] = 1.0f / (1.0f+expf(-Xr[n]));
                Z[n] = 1.0f / (1.0f+expf(-Xz[n]));
                X[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_scopy((int)N,&Xr[tN],1,R,1); cblas_scopy((int)N,&Xz[tN],1,Z,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN-N],1,o,R,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    //R[n] = 1.0f / (1.0f+expf(-R[n]));
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    //H[n] = R[n] * X[tN-N+n];
                    H[n] = X[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN+n] = Z[n]*X[tN-N+n] + (1.0f-Z[n])*tanhf(X[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-Xz[nT]));
                X[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&Xr[t],(int)T,R,1); cblas_scopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0f-Z[n])*tanhf(X[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-Xz[nT]));
                X[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&Xr[t],(int)T,R,1); cblas_scopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0f-Z[n])*tanhf(X[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0f / (1.0f+expf(-Xz[n]));
                X[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_scopy((int)N,&Xr[tN],1,R,1); cblas_scopy((int)N,&Xz[tN],1,Z,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN-N],1,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN+n] = Z[n]*X[tN-N+n] + (1.0f-Z[n])*tanhf(X[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru3_inplace_s: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru3_inplace_d (double *X, const double *Xr, const double *Xz, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const double o = 1.0;
    size_t nT, tN;

    double *R, *Z, *H;
    if (!(R=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_inplace_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_inplace_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru3_inplace_d: problem with malloc. "); perror("malloc"); return 1; }

    if (N==1u)
    {
        Z[0] = 1.0 / (1.0+exp(-Xz[0]));
        X[0] = (1.0-Z[0]) * tanh(X[0]);
        for (size_t t=1; t<T; ++t)
        {
            Z[0] = 1.0 / (1.0+exp(-Xz[t]-Uz[0]*X[t-1]));
            H[0] = X[t-1] / (1.0+exp(-Xr[t]-Ur[0]*X[t-1]));
            X[t] = Z[0]*X[t-1] + (1.0-Z[0])*tanh(X[t]+U[0]*H[0]);
        }
    }
    else if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-Xz[n]));
                X[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_dcopy((int)N,&Xr[tN],1,R,1); cblas_dcopy((int)N,&Xz[tN],1,Z,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN-N],1,o,R,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN+n] = Z[n]*X[tN-N+n] + (1.0-Z[n])*tanh(X[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-Xz[nT]));
                X[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&Xr[t],(int)T,R,1); cblas_dcopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0-Z[n])*tanh(X[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-Xz[nT]));
                X[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&Xr[t],(int)T,R,1); cblas_dcopy((int)N,&Xz[t],(int)T,Z,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0-Z[n])*tanh(X[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-Xz[n]));
                X[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N;
                cblas_dcopy((int)N,&Xr[tN],1,R,1); cblas_dcopy((int)N,&Xz[tN],1,Z,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN-N],1,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN+n] = Z[n]*X[tN-N+n] + (1.0-Z[n])*tanh(X[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru3_inplace_d: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

#ifdef __cplusplus
}
}
#endif


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

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_multifit_nlin.h>
#include <gsl/gsl_multilarge_nlinear.h>

static double scaled_infnorm(const gsl_vector *x, const gsl_vector *g);

/*
gsl_multilarge_nlinear_test()
  Convergence tests for nonlinear least squares minimization

(1) |dx_i| <= xtol * (1 + |x_i|) for all i
(2) || g .* x ||_inf <= gtol ||f||^2
(3) ||f(x+dx) - f(x)|| <= ftol * max(||f(x)||, 1)

Inputs: xtol - tolerance for step size
        gtol - tolerance for gradient vector
        ftol - tolerance for residual vector
        info - (output)
               1 - stopped by small x step
               2 - stopped by small gradient
               3 - stopped by small residual vector change
        w    - workspace
*/

int
gsl_multilarge_nlinear_test (const double xtol, const double gtol,
                             const double ftol, int *info,
                             const gsl_multilarge_nlinear_workspace * w)
{
  int status;
  double gnorm, fnorm, phi;

  *info = 0;

  status = gsl_multifit_test_delta(w->dx, w->x, xtol*xtol, xtol);
  if (status == GSL_SUCCESS)
    {
      *info = 1;
      return GSL_SUCCESS;
    }

  /* compute gnorm = max_i( g_i * max(x_i, 1) ) */
  gnorm = scaled_infnorm(w->x, w->g);

  /* compute fnorm = ||f|| */
  fnorm = gsl_blas_dnrm2(w->f);
  phi = 0.5 * fnorm * fnorm;

#if 0
  fprintf(stderr, "gnorm = %.12e fnorm = %.12e gnorm/phi = %.12e\n", gnorm, fnorm, gnorm / phi);
#endif

  if (gnorm <= gtol * GSL_MAX(phi, 1.0))
    {
      *info = 2;
      return GSL_SUCCESS;
    }

#if 0
  if (dfnorm <= ftol * GSL_MAX(fnorm, 1.0))
    {
      *info = 3;
      return GSL_SUCCESS;
    }
#endif

  return GSL_CONTINUE;
}

static double
scaled_infnorm(const gsl_vector *x, const gsl_vector *g)
{
  const size_t n = x->size;
  size_t i;
  double norm = 0.0;

  for (i = 0; i < n; ++i)
    {
      double xi = GSL_MAX(gsl_vector_get(x, i), 1.0);
      double gi = gsl_vector_get(g, i);
      double tmp = fabs(xi * gi);

      if (tmp > norm)
        norm = tmp;
    }

  return norm;
}