/*
    learn.c
*/
#include <stdio.h>
#include <stdlib.h>
#include <stdbool.h>
#include <math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_multifit.h>
#include "learn.h"
#include "feature.h"
#include "imatrix.h"
#include "dmatrix.h"
#include "util.h"
#include "likelihood.h"
#include "hyper.h"

void mvslda_learn(document *data, double **resp, double *alpha, double beta, double nu2, double sigma2,
    int nclass, int nlex, int dlenmax, int nresp, int maxiter, double **phi, double **theta, double **eta,
    int **n_mz, int **n_zw, FILE *likp, FILE *hyperp, unsigned long int random_seed){
    document *dp;
    int ndocs;
    int *n_m;
    int *n_z;
    int ***topics;
    int word_index;
    int word_num;
    double sum_alpha;
    double *left;
    double *center;
    double *log_right;
    double *p_z;
    double *log_p_z;
    double *cum_sum_p_z;
    double log_Z, sum_p_r, sum_empirical_z;
    double temp_prediction;
    double lik;
    double **temp_phi;
    double **temp_theta;
    double **empirical_z;
    int z;
    int it;
    int m, w, t, i, j, k;
    const gsl_rng_type *T;
    gsl_rng *r;

    gsl_rng_env_setup();
    T = gsl_rng_default;
    r = gsl_rng_alloc(T);

    // count data length
    for(dp = data, ndocs = 0;(dp->len) != -1;dp++, ndocs++)
        ;

    // initialize buffers
    if((n_m = calloc(ndocs,sizeof(int))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate n_m.\n");
        return;
    }
    if((n_z = calloc(nclass,sizeof(int))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate n_z.\n");
        return;
    }
    if((left = calloc(nclass,sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate left.\n");
        return;
    }
    if((center = calloc(nclass,sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate center.\n");
        return;
    }
    if((log_right = calloc(nclass,sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate log_cright.\n");
        return;
    }
    if((p_z = calloc(nclass,sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate p_z.\n");
        return;
    }
    if((log_p_z = calloc(nclass,sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate log_p_z.\n");
        return;
    }
    if((cum_sum_p_z = calloc((nclass+1),sizeof(double))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate cum_sum_p_z.\n");
        return;
    }
    if((topics = calloc(ndocs,sizeof(int **))) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate topics.\n");
        return;
    }
    if((empirical_z = dmatrix(ndocs, nclass)) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate empirical_z.\n");
        return;
    }
    if((temp_phi = dmatrix(nlex, nclass)) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate temp_phi.\n");
        exit(1);
    }
    if((temp_theta = dmatrix(ndocs, nclass)) == NULL){
        fprintf(stderr,"mvslda_learn:: cannot allocate temp_theta.\n");
        exit(1);
    }

    printf("Number of documents          = %d\n",ndocs);
    printf("Number of unique words       = %d\n",nlex);
    printf("Number of latent classes     = %d\n",nclass);
    printf("Number of responses          = %d\n",nresp);
    printf("Number of iteration          = %d\n",maxiter);

    // choose an arbitrary topic as first topic for word
    gsl_rng_set(r, random_seed);
    for(dp = data, m = 0;(dp->len) != -1;dp++, m++){
        if((topics[m] = calloc((dp->len), sizeof(int *))) == NULL){
            fprintf(stderr,"mvslda_learn:: cannot allocate topics[m].\n");
            return;
        }
        for(w = 0;w < (dp->len);w++){
            if((topics[m][w] = calloc((dp->cnt[w]), sizeof(int))) == NULL){
                fprintf(stderr,"mvslda_learn:: cannot allocate topics[m][w].\n");
                return;
            }
            word_index = dp->id[w];
            word_num = dp->cnt[w];
            for(i = 0;i < word_num;i++){
                z = (int)gsl_rng_uniform_int(r, nclass);
                n_mz[m][z] += 1;
                n_m[m] += 1;
                n_zw[z][word_index] += 1;
                n_z[z] += 1;
                topics[m][w][i] = z;
            }
        }
    }
    // initialize eta ([nclass, nresp])
    for(k = 0;k < nclass;k++)
        for(t = 0;t < nresp;t++)
            eta[k][t] = 0.0;

    // learning main
    for(it = 0;it < maxiter;it++){
        printf("iteration %2d/%3d..\n", it + 1, maxiter);
        fflush(stdout);
        sum_alpha = 0.0;
        for(k = 0;k < nclass;k++)
            sum_alpha += alpha[k];
        for (dp = data, m = 0; (dp->len) != -1; dp++, m++){
            // for words
            for(w = 0;w < (dp->len);w++){
                word_index = dp->id[w];
                word_num = dp->cnt[w];
                for(i = 0;i < word_num;i++){
                    z = topics[m][w][i];
                    n_mz[m][z] -= 1;
                    n_m[m] -= 1;
                    n_zw[z][word_index] -= 1;
                    n_z[z] -= 1;

                    // compute conditional distribution log_p_z
                    // log_p_z left ... theta term
                    for(k = 0;k < nclass;k++){
                        left[k] = (double)n_mz[m][k] + alpha[k];
                        left[k] /= ((double)n_m[m] + sum_alpha);
                    }
                    // log_p_z center ... phi term
                    for(k = 0;k < nclass;k++){
                        center[k] = (double)n_zw[k][word_index] + beta;
                        center[k] /= ((double)n_z[k] + (double)nlex * beta);
                    }
                    // temporal log_p_z (left and center)
                    for(k = 0; k < nclass;k++){
                        log_p_z[k] = log(left[k]) + log(center[k]);
                    }
                    // p_z right ... eta term
                    sum_empirical_z = 0.0;
                    for(k = 0; k < nclass;k++){
                        empirical_z[m][k] = (double)n_mz[m][k];
                        sum_empirical_z += (double)n_mz[m][k];
                    }
                    for(k = 0; k < nclass;k++){
                        empirical_z[m][k] = empirical_z[m][k] / sum_empirical_z;
                    }
                    for(t = 0; t < nresp; t++){
                        temp_prediction = 0.0;
                        for(k = 0;k < nclass;k++){
                            temp_prediction += eta[k][t] * empirical_z[m][k]; // dot(eta, z_d)
                        }
                        for(k = 0;k < nclass;k++){
                            log_right[k] = 1.0;
                            log_right[k] *= 1.0 / (2 * sigma2);
                            log_right[k] *= (eta[k][t] / (double)n_m[m]);
                            log_right[k] *= (2 * (resp[m][t] - temp_prediction) - (eta[k][t] / (double)n_m[m]));
                            log_p_z[k] += log_right[k];
                        }
                    }
                    // conditional distribution log_p_z
                    // log_Z = logsumexp(logP_k1 + logP_k2 + ... logP_kK)
                    log_Z = logsumexp(log_p_z, nclass);
                    for(k = 0;k < nclass;k++){
                        p_z[k] = exp(log_p_z[k] - log_Z); // normalize to obtain probabilities
                    }
                    // random sampling from p_z
                    z = sampling_multinomial(r, p_z, cum_sum_p_z, nclass);
                    // update buffers
                    n_mz[m][z] += 1;
                    n_m[m] += 1;
                    n_zw[z][word_index] += 1;
                    n_z[z] += 1;
                    topics[m][w][i] = z;
                }
            }
        }

        // for eta update
        //least squares for dot(Z, eta) = resp
        for(m = 0; m < ndocs; m++){
            sum_empirical_z = 0.0;
            for(k = 0; k < nclass;k++){
                empirical_z[m][k] = (double)n_mz[m][k];
                sum_empirical_z += (double)n_mz[m][k];
            }
            for(k = 0; k < nclass;k++){
                empirical_z[m][k] = empirical_z[m][k] / sum_empirical_z;
            }
        }
        for(t = 0; t < nresp; t++){
            double chisq;
            gsl_matrix *Z, *cov;
            gsl_vector *y, *c;
            gsl_multifit_linear_workspace * work = gsl_multifit_linear_alloc (ndocs, nclass);
            Z = gsl_matrix_alloc(ndocs, nclass);
            cov = gsl_matrix_alloc(nclass, nclass);
            y = gsl_vector_alloc(ndocs);
            c = gsl_vector_alloc(nclass);
            for(m = 0;m < ndocs;m++){
                gsl_vector_set(y, m, resp[m][t]);
                for(k = 0;k < nclass;k++){
                    gsl_matrix_set(Z, m, k, empirical_z[m][k]);
                }
            }
            gsl_multifit_linear(Z, y, c, cov, &chisq, work);
            for(k = 0;k < nclass;k++){
                eta[k][t] = gsl_vector_get(c, k);
            }
            gsl_multifit_linear_free(work);
            gsl_matrix_free(Z);
            gsl_matrix_free(cov);
            gsl_vector_free(y);
            gsl_vector_free(c);
        }

        // update hyperparameters.
        update_alpha(alpha, n_m, n_mz, ndocs, nclass);
        beta = update_beta(beta, n_z, n_zw, nclass, nlex);

        // compute likelihood.
        lik = loglikelihood(n_mz, n_zw, n_m, nclass, nlex, ndocs, nresp, resp, alpha, beta, eta, empirical_z, nu2, sigma2);
        printf("\tlikelihood ... %.8f\n",lik);
        printf("\talpha = \n\t");
        for(k = 0;k < nclass;k++)
            printf("%.8f ",alpha[k]);
        printf("\n\tbeta ... %.2f\n",beta);
        fprintf(likp,"%.8f\n",lik);
        for(k = 0;k < nclass;k++)
            fprintf(hyperp,"%.8f,",alpha[k]);
        fprintf(hyperp,"%.8f\n",beta);
    }

    // compute matrix phi ([nlex, nclass] matrix)
    for(w = 0;w < nlex;w++)
        for(k = 0;k < nclass;k++)
            temp_phi[w][k] = (double)n_zw[k][w] + beta;
    normalize_matrix_col(phi, temp_phi, nlex, nclass);

    // compute matrix theta ([ndocs, nclass])
    for(m = 0;m < ndocs;m++)
        for(k = 0;k < nclass;k++)
            temp_theta[m][k] = (double)n_mz[m][k] + alpha[k];
    normalize_matrix_row(theta, temp_theta, ndocs, nclass);

    free(n_m);
    free(n_z);
    free(left);
    free(center);
    free(log_right);
    free(p_z);
    free(log_p_z);
    free(cum_sum_p_z);

    for(dp = data, m = 0;(dp->len) != -1;dp++, m++){
        for(w = 0;w < (dp->len);w++){
            free(topics[m][w]);
        }
        free(topics[m]);
    }
    free(topics);
    free_dmatrix(temp_phi, nlex);
    free_dmatrix(temp_theta, ndocs);
    free_dmatrix(empirical_z, ndocs);

    return;
}

int sampling_multinomial(gsl_rng *r, double *p, double *cum_sum_p, int len_p){
    int k, z;
    double sampling;

    cum_sum_p[0] = 0.0;
    for(k = 0;k < len_p;k++){
        cum_sum_p[k+1] = cum_sum_p[k] + p[k];
    }
    sampling = gsl_rng_uniform(r);
    for(k = 0;k < len_p;k++){
        if((sampling >= cum_sum_p[k]) && (sampling < cum_sum_p[k+1])){
            z = k;
            break;
        }
    }
    return z;
}


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

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_exp.h"
#include "gsl_sf_log.h"
#include "gsl_sf_pow_int.h"
#include "gsl_sf_psi.h"
#include "gsl_sf_gamma.h"

#include "error.h"

static const double bern[21] = {
   0.0   /* no element 0 */,
  +0.833333333333333333333333333333333e-01,
  -0.138888888888888888888888888888888e-02,
  +0.330687830687830687830687830687830e-04,
  -0.826719576719576719576719576719576e-06,
  +0.208767569878680989792100903212014e-07,
  -0.528419013868749318484768220217955e-09,
  +0.133825365306846788328269809751291e-10,
  -0.338968029632258286683019539124944e-12,
  +0.858606205627784456413590545042562e-14,
  -0.217486869855806187304151642386591e-15,
  +0.550900282836022951520265260890225e-17,
  -0.139544646858125233407076862640635e-18,
  +0.353470703962946747169322997780379e-20,
  -0.895351742703754685040261131811274e-22,
  +0.226795245233768306031095073886816e-23,
  -0.574472439520264523834847971943400e-24,
  +0.145517247561486490186626486727132e-26,
  -0.368599494066531017818178247990866e-28,
  +0.933673425709504467203255515278562e-30,
  -0.236502241570062993455963519636983e-31
};

/* ((a)_x - 1)/x in the "small x" region where
 * cancellation must be controlled.
 *
 * Based on SLATEC DPOCH1().
 */
/*
C When ABS(X) is so small that substantial cancellation will occur if
C the straightforward formula is used, we use an expansion due
C to Fields and discussed by Y. L. Luke, The Special Functions and Their
C Approximations, Vol. 1, Academic Press, 1969, page 34.
C
C The ratio POCH(A,X) = GAMMA(A+X)/GAMMA(A) is written by Luke as
C        (A+(X-1)/2)**X * polynomial in (A+(X-1)/2)**(-2) .
C In order to maintain significance in POCH1, we write for positive a
C        (A+(X-1)/2)**X = EXP(X*LOG(A+(X-1)/2)) = EXP(Q)
C                       = 1.0 + Q*EXPREL(Q) .
C Likewise the polynomial is written
C        POLY = 1.0 + X*POLY1(A,X) .
C Thus,
C        POCH1(A,X) = (POCH(A,X) - 1) / X
C                   = EXPREL(Q)*(Q/X + Q*POLY1(A,X)) + POLY1(A,X)
C
*/
static
int
pochrel_smallx(const double a, const double x, gsl_sf_result * result)
{
  /*
   SQTBIG = 1.0D0/SQRT(24.0D0*D1MACH(1))
   ALNEPS = LOG(D1MACH(3))
   */
  const double SQTBIG = 1.0/(2.0*M_SQRT2*M_SQRT3*GSL_SQRT_DBL_MIN);
  const double ALNEPS = GSL_LOG_DBL_EPSILON - M_LN2;

  if(x == 0.0) {
    return gsl_sf_psi_e(a, result);
  }
  else {
    const double bp   = (  (a < -0.5) ? 1.0-a-x : a );
    const int	 incr = ( (bp < 10.0) ? 11.0-bp : 0 );
    const double b    = bp + incr;
    double dpoch1;
    gsl_sf_result dexprl;
    int stat_dexprl;
    int i;

    double var    = b + 0.5*(x-1.0);
    double alnvar = log(var);
    double q = x*alnvar;

    double poly1 = 0.0;

    if(var < SQTBIG) {
      const int nterms = (int)(-0.5*ALNEPS/alnvar + 1.0);
      const double var2 = (1.0/var)/var;
      const double rho  = 0.5 * (x + 1.0);
      double term = var2;
      double gbern[24];
      int k, j;

      gbern[1] = 1.0;
      gbern[2] = -rho/12.0;
      poly1 = gbern[2] * term;

      if(nterms > 20) {
        /* NTERMS IS TOO BIG, MAYBE D1MACH(3) IS BAD */
        /* nterms = 20; */
	result->val = 0.0;
	result->err = 0.0;
	GSL_ERROR ("error", GSL_ESANITY);
      }

      for(k=2; k<=nterms; k++) {
        double gbk = 0.0;
        for(j=1; j<=k; j++) {
          gbk += bern[k-j+1]*gbern[j];
        }
        gbern[k+1] = -rho*gbk/k;

        term  *= (2*k-2-x)*(2*k-1-x)*var2;
        poly1 += gbern[k+1]*term;
      }
    }

    stat_dexprl = gsl_sf_expm1_e(q, &dexprl);
    if(stat_dexprl != GSL_SUCCESS) {
      result->val = 0.0;
      result->err = 0.0;
      return stat_dexprl;
    }
    dexprl.val = dexprl.val/q;
    poly1 *= (x - 1.0);
    dpoch1 = dexprl.val * (alnvar + q * poly1) + poly1;

    for(i=incr-1; i >= 0; i--) {
      /*
       C WE HAVE DPOCH1(B,X), BUT BP IS SMALL, SO WE USE BACKWARDS RECURSION
       C TO OBTAIN DPOCH1(BP,X).
       */
      double binv = 1.0/(bp+i);
      dpoch1 = (dpoch1 - binv) / (1.0 + x*binv);
    }

    if(bp == a) {
      result->val = dpoch1;
      result->err = 2.0 * GSL_DBL_EPSILON * (fabs(incr) + 1.0) * fabs(result->val);
      return GSL_SUCCESS;
    }
    else {
      /*
       C WE HAVE DPOCH1(BP,X), BUT A IS LT -0.5.  WE THEREFORE USE A
       C REFLECTION FORMULA TO OBTAIN DPOCH1(A,X).
       */
      double sinpxx = sin(M_PI*x)/x;
      double sinpx2 = sin(0.5*M_PI*x);
      double t1 = sinpxx/tan(M_PI*b);
      double t2 = 2.0*sinpx2*(sinpx2/x);
      double trig  = t1 - t2;
      result->val  = dpoch1 * (1.0 + x*trig) + trig;
      result->err  = (fabs(dpoch1*x) + 1.0) * GSL_DBL_EPSILON * (fabs(t1) + fabs(t2));
      result->err += 2.0 * GSL_DBL_EPSILON * (fabs(incr) + 1.0) * fabs(result->val);
      return GSL_SUCCESS;
    }
  }
}

/* Assumes a>0 and a+x>0.
 */
static
int
lnpoch_pos(const double a, const double x, gsl_sf_result * result)
{
  double absx = fabs(x);

  if(absx > 0.1*a || absx*log(GSL_MAX_DBL(a,2.0)) > 0.1) {
    if(a < GSL_SF_GAMMA_XMAX && a+x < GSL_SF_GAMMA_XMAX) {
      /* If we can do it by calculating the gamma functions
       * directly, then that will be more accurate than
       * doing the subtraction of the logs.
       */
      gsl_sf_result g1;
      gsl_sf_result g2;
      gsl_sf_gammainv_e(a,   &g1);
      gsl_sf_gammainv_e(a+x, &g2);
      result->val  = -log(g2.val/g1.val);
      result->err  = g1.err/fabs(g1.val) + g2.err/fabs(g2.val);
      result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
      return GSL_SUCCESS;
    }
    else {
      /* Otherwise we must do the subtraction.
       */
      gsl_sf_result lg1;
      gsl_sf_result lg2;
      int stat_1 = gsl_sf_lngamma_e(a,   &lg1);
      int stat_2 = gsl_sf_lngamma_e(a+x, &lg2);
      result->val  = lg2.val - lg1.val;
      result->err  = lg2.err + lg1.err;
      result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
      return GSL_ERROR_SELECT_2(stat_1, stat_2);
    }
  }
  else if(absx < 0.1*a && a > 15.0) {
    /* Be careful about the implied subtraction.
     * Note that both a+x and and a must be
     * large here since a is not small
     * and x is not relatively large.
     * So we calculate using Stirling for Log[Gamma(z)].
     *
     *   Log[Gamma(a+x)/Gamma(a)] = x(Log[a]-1) + (x+a-1/2)Log[1+x/a]
     *                              + (1/(1+eps)   - 1) / (12 a)
     *                              - (1/(1+eps)^3 - 1) / (360 a^3)
     *                              + (1/(1+eps)^5 - 1) / (1260 a^5)
     *                              - (1/(1+eps)^7 - 1) / (1680 a^7)
     *                              + ...
     */
    const double eps = x/a;
    const double den = 1.0 + eps;
    const double d3 = den*den*den;
    const double d5 = d3*den*den;
    const double d7 = d5*den*den;
    const double c1 = -eps/den;
    const double c3 = -eps*(3.0+eps*(3.0+eps))/d3;
    const double c5 = -eps*(5.0+eps*(10.0+eps*(10.0+eps*(5.0+eps))))/d5;
    const double c7 = -eps*(7.0+eps*(21.0+eps*(35.0+eps*(35.0+eps*(21.0+eps*(7.0+eps))))))/d7;
    const double p8 = gsl_sf_pow_int(1.0+eps,8);
    const double c8 = 1.0/p8             - 1.0;  /* these need not   */
    const double c9 = 1.0/(p8*(1.0+eps)) - 1.0;  /* be very accurate */
    const double a4 = a*a*a*a;
    const double a6 = a4*a*a;
    const double ser_1 = c1 + c3/(30.0*a*a) + c5/(105.0*a4) + c7/(140.0*a6);
    const double ser_2 = c8/(99.0*a6*a*a) - 691.0/360360.0 * c9/(a6*a4);
    const double ser = (ser_1 + ser_2)/ (12.0*a);

    double term1 = x * log(a/M_E);
    double term2;
    gsl_sf_result ln_1peps;
    gsl_sf_log_1plusx_e(eps, &ln_1peps);  /* log(1 + x/a) */
    term2 = (x + a - 0.5) * ln_1peps.val;

    result->val  = term1 + term2 + ser;
    result->err  = GSL_DBL_EPSILON*fabs(term1);
    result->err += fabs((x + a - 0.5)*ln_1peps.err);
    result->err += fabs(ln_1peps.val) * GSL_DBL_EPSILON * (fabs(x) + fabs(a) + 0.5);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    gsl_sf_result poch_rel;
    int stat_p = pochrel_smallx(a, x, &poch_rel);
    double eps = x*poch_rel.val;
    int stat_e = gsl_sf_log_1plusx_e(eps, result);
    result->err  = 2.0 * fabs(x * poch_rel.err / (1.0 + eps));
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_ERROR_SELECT_2(stat_e, stat_p);
  }
}

/*-*-*-*-*-*-*-*-*-*-*-* Functions with Error Codes *-*-*-*-*-*-*-*-*-*-*-*/

int
gsl_sf_lnpoch_e(const double a, const double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(a <= 0.0 || a+x <= 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x == 0.0) {
    result->val = 1.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else {
    return lnpoch_pos(a, x, result);
  }
}

int
gsl_sf_lnpoch_sgn_e(const double a, const double x,
                       gsl_sf_result * result, double * sgn)
{
  if(a == 0.0 || a+x == 0.0) {
    *sgn = 0.0;
    DOMAIN_ERROR(result);
  }
  else if(x == 0.0) {
    *sgn = 1.0;
    result->val = 1.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else if(a > 0.0 && a+x > 0.0) {
    *sgn = 1.0;
    return lnpoch_pos(a, x, result);
  }
  else if(a < 0.0 && a+x < 0.0) {
    /* Reduce to positive case using reflection.
     */
    double sin_1 = sin(M_PI * (1.0 - a));
    double sin_2 = sin(M_PI * (1.0 - a - x));
    if(sin_1 == 0.0 || sin_2 == 0.0) {
      *sgn = 0.0;
      DOMAIN_ERROR(result);
    }
    else {
      gsl_sf_result lnp_pos;
      int stat_pp   = lnpoch_pos(1.0-a, -x, &lnp_pos);
      double lnterm = log(fabs(sin_1/sin_2));
      result->val  = lnterm - lnp_pos.val;
      result->err  = lnp_pos.err;
      result->err += 2.0 * GSL_DBL_EPSILON * (fabs(1.0-a) + fabs(1.0-a-x)) * fabs(lnterm);
      result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
      *sgn = GSL_SIGN(sin_1*sin_2);
      return stat_pp;
    }
  }
  else {
    /* Evaluate gamma ratio directly.
     */
    gsl_sf_result lg_apn;
    gsl_sf_result lg_a;
    double s_apn, s_a;
    int stat_apn = gsl_sf_lngamma_sgn_e(a+x, &lg_apn, &s_apn);
    int stat_a   = gsl_sf_lngamma_sgn_e(a,   &lg_a,   &s_a);
    if(stat_apn == GSL_SUCCESS && stat_a == GSL_SUCCESS) {
      result->val  = lg_apn.val - lg_a.val;
      result->err  = lg_apn.err + lg_a.err;
      result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
      *sgn = s_a * s_apn;
      return GSL_SUCCESS;
    }
    else if(stat_apn == GSL_EDOM || stat_a == GSL_EDOM){
      *sgn = 0.0;
      DOMAIN_ERROR(result);
    }
    else {
      result->val = 0.0;
      result->err = 0.0;
      *sgn = 0.0;
      return GSL_FAILURE;
    }
  }
}

int
gsl_sf_poch_e(const double a, const double x, gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(x == 0.0) {
    result->val = 1.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else {
    gsl_sf_result lnpoch;
    double sgn;
    int stat_lnpoch = gsl_sf_lnpoch_sgn_e(a, x, &lnpoch, &sgn);
    int stat_exp    = gsl_sf_exp_err_e(lnpoch.val, lnpoch.err, result);
    result->val *= sgn;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_ERROR_SELECT_2(stat_exp, stat_lnpoch);
  }
}

int
gsl_sf_pochrel_e(const double a, const double x, gsl_sf_result * result)
{
  const double absx = fabs(x);
  const double absa = fabs(a);

  /* CHECK_POINTER(result) */

  if(absx > 0.1*absa || absx*log(GSL_MAX(absa,2.0)) > 0.1) {
    gsl_sf_result lnpoch;
    double sgn;
    int stat_poch = gsl_sf_lnpoch_sgn_e(a, x, &lnpoch, &sgn);
    if(lnpoch.val > GSL_LOG_DBL_MAX) {
      OVERFLOW_ERROR(result);
    }
    else {
      const double el = exp(lnpoch.val);
      result->val  = (sgn*el - 1.0)/x;
      result->err  = fabs(result->val) * (lnpoch.err + 2.0 * GSL_DBL_EPSILON);
      result->err += 2.0 * GSL_DBL_EPSILON * (fabs(sgn*el) + 1.0) / fabs(x);
      return stat_poch;
    }
  }
  else {
    return pochrel_smallx(a, x, result);
  }
}

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

#include "eval.h"

double gsl_sf_lnpoch(const double a, const double x)
{
  EVAL_RESULT(gsl_sf_lnpoch_e(a, x, &result));
}

double gsl_sf_poch(const double a, const double x)
{
  EVAL_RESULT(gsl_sf_poch_e(a, x, &result));
}

double gsl_sf_pochrel(const double a, const double x)
{
  EVAL_RESULT(gsl_sf_pochrel_e(a, x, &result));
}


/* ===============================================================================*/
/*   Version 1.0.             Cullan Howlett                                      */
/*   Copyright (c) 2017       International Centre for Radio Astronomy Research,  */
/*   The MIT License (MIT)    University of Western Australia                     */
/*                                                                                */
/* Permission is hereby granted, free of charge, to any person obtaining a copy   */
/* of this software and associated documentation files (the "Software"), to deal  */
/* in the Software without restriction, including without limitation the rights   */
/* to use, copy, modify, merge, publish, distribute, sublicense, and/or sell      */
/* copies of the Software, and to permit persons to whom the Software is          */
/* furnished to do so, subject to the following conditions:                       */
/*                                                                                */
/* The above copyright notice and this permission notice shall be included in     */
/* all copies or substantial portions of the Software.                            */
/*                                                                                */
/* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR     */
/* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,       */
/* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE    */
/* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER         */
/* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,  */
/* OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN      */
/* THE SOFTWARE.                                                                  */
/* ===============================================================================*/

#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_integration.h>

// Fisher matrix calculation for surveys with velocity and density field measurements.
// ASSUMPTIONS:
//  -  Uncorrelated shot-noise between the density and velocity fields
//  -  I use the trapezium rule to integrate over r. There will be some error due to this, but this makes the most sense as
//     we are binning the number density anyway, and it makes hella difference in the speed of the code.
//  -  The redshift dependence of the non-linear matter and velocity divergence power spectra is captured using linear interpolation.
//  -  The PV error scales as a fixed pecentage of H0*r.
//  -  Flat LCDM cosmology (but not necessarily GR as gammaval can be changed).
//  -  The damping of the velocity and density fields due to non-linear RSD is redshift independent

// The parameters necessary for the calculation
static int nparams = 4;           // The number of free parameters (we can use any of beta, fsigma8, r_g, sigma_g, sigma_u)
static int Data[4] = {0,1,3,4};   // A vector of flags for the parameters we are interested in (0=beta, 1=fsigma8, 2=r_g, 3=sigma_g, 4=sigma_u). MAKE SURE THE LENGTH OF THIS VECTOR, NPARAMS AND THE ENTRIES AGREE/MAKE SENSE, OR YOU MIGHT GET NONSENSE RESULTS!!
static int nziter = 1;            // Now many bins in redshift between zmin and zmax we are considering
static double zmin = 0.0;         // The minimum redshift to consider (You must have power spectra that are within this range or GSL spline will error out)
static double zmax = 0.1;         // The maximum redshift to consider (You must have power spectra that are within this range or GSL spline will error out)
static double Om = 0.3121;        // The matter density at z=0
static double c = 299792.458;     // The speed of light in km/s
static double gammaval = 0.55;    // The value of gammaval to use in the forecasts (where f(z) = Om(z)^gammaval)
static double r_g = 1.0;          // The cross correlation coefficient between the velocity and density fields
static double beta0 = 0.393;      // The value of beta (at z=0, we'll modify this by the redshift dependent value of bias and f as required)
static double sigma80 = 0.8150;   // The value of sigma8 at z=0
static double sigma_u = 13.00;    // The value of the velocity damping parameter in Mpc/h. I use the values from Jun Koda's paper
static double sigma_g = 4.24;     // The value of the density damping parameter in Mpc/h. I use the values from Jun Koda's paper
static double kmax = 0.2;         // The maximum k to evaluate for dd, dv and vv correlations (Typical values are 0.1 - 0.2, on smaller scales the models are likely to break down).
static double survey_area[3] = {0.0, 0.0, 1.745};   // We need to know the survey area for each survey and the overlap area between the surveys (redshift survey only first, then PV survey only, then overlap.
                                                    // For fully overlapping we would have {0, 0, size_overlap}. For redshift larger than PV, we would have {size_red-size_overlap, 0, size_overlap}). Units are pi steradians, such that full sky is 4.0, half sky is 2.0 etc.
static double error_rand = 300.0;    // The observational error due to random non-linear velocities (I normally use 300km/s as in Jun Koda's paper)
static double error_dist = 0.05;     // The percentage error on the distance indicator (Typically 0.05 - 0.10 for SNe IA, 0.2 or more for Tully-Fisher or Fundamental Plane)
static double verbosity = 0;         // How much output to give: 0 = only percentage errors on fsigma8, 1 = other useful info and nuisance parameters, 2 = full fisher and covariance matrices

// The number of redshifts and the redshifts themselves of the input matter and velocity divergence power spectra.
// These numbers are multiplied by 100, converted to ints and written in the form _z0p%02d which is then appended to the filename Pvel_file. See routine read_power.
static double nzin = 11;
static double zin[11] = {0.00, 0.05, 0.10, 0.15, 0.20, 0.25, 0.30, 0.35, 0.40, 0.45, 0.50};
char * Pvel_file = "./example_files/example_pk";                                                  // The file containing the velocity divergence power spectrum. Don't include .dat as we'll append the redshifts on read in

// The files containing the number density of the surveys. First is the PV survey, then the redshift survey. These files MUST have the same binning and redshift range,
// so that the sum over redshift bins works (would be fine if we used splines), i.e., if one survey is shallower then that file must contain rows with n(z)=0.
// I also typically save nbar x 10^6 in the input file to make sure I don't lose precision when outputting small nbar values to files. This is corrected when the nbar file
// is read in, so see the read_nz() routine!
char * nbar_file[300] = {"./example_files/example_nbar_vel.dat",
                         "./example_files/example_nbar_red.dat"};

// Other global parameters and arrays
int NK, * NRED;
double pkkmin;         // The minimum kmin to integrate over, based on the input power spectrum file
double pkkmax;         // The maximum k in the input power spectrum. The maximum k to integrate over is the smallest of this or kmax
double * zarray;
double * rarray;
double * deltararray;
double * growtharray;
double ** nbararray;
double * karray, * deltakarray;
double ** pmmarray, ** pmtarray, ** pttarray;
gsl_spline * growth_spline, * r_spline;
gsl_interp_accel * growth_acc, * r_acc;

// Prototypes
double zeff_integrand(double mu, void * pin);
double mu_integrand(double mu, void * pin);
double ezinv(double x, void *p);
double rz(double red);
double growthfunc(double x, void *p);
double growthz(double red);
void read_nz();
void read_power();

// Calculates the fished matrix for a velocity survey.
int main(int argc, char **argv) {

    FILE * fout;
    int i, j;

    // Read in the velocity divergence power spectrum output from the COPTER code (Carlson 2009)
    read_power();

    // Read in the number densities of the surveys
    read_nz();

    // Run some checks
    if (!((survey_area[0] > 0.0) || (survey_area[2] > 0.0))) {
        for (i=0; i<nparams; i++) {
            if (Data[i] == 2) {
                printf("ERROR: r_g is a free parameter, but there is no information in the density field (Fisher matrix will be singular)\n");
                exit(0);
            }
            if (Data[i] == 3) {
                printf("ERROR: sigma_g is a free parameter, but there is no information in the density field (Fisher matrix will be singular)\n");
                exit(0);
            }
        }
    }
    if (!((survey_area[1] > 0.0) || (survey_area[2] > 0.0))) {
        for (i=0; i<nparams; i++) {
            if (Data[i] == 4) {
                printf("ERROR: sigma_u is a free parameter, but there is no information in the velocity field (Fisher matrix will be singular)\n");
                exit(0);
            }
        }
    }
    if ((sizeof(Data)/sizeof(*Data)) != nparams) {
        printf("ERROR: Size of Data vector for parameters of interest must be equal to nparams\n");
        exit(0);
    }

    // Calculate the Fisher matrices for all bins.
    gsl_matrix * Fisher_Tot = gsl_matrix_alloc(nparams, nparams);
    for (i=0; i<nparams; i++) {
        for (j=0; j<nparams; j++) gsl_matrix_set(Fisher_Tot, i, j, 0.0);
    }

    printf("Evaluating the Fisher Matrix for %d bins between [z_min = %lf, z_max = %lf]\n", nziter, zmin, zmax);

    if (verbosity == 0) printf("#     zmin         zmax         zeff      fsigma8(z_eff)   percentage error(z_eff)\n");

    int ziter;
    for (ziter = 0; ziter<nziter; ziter++) {

        double zbinwidth = (zmax-zmin)/(nziter);
        double zmin_iter = ziter*zbinwidth + zmin;
        double zmax_iter = (ziter+1.0)*zbinwidth + zmin;

        double rzmax = gsl_spline_eval(r_spline, zmax_iter, r_acc);
        double kmin = M_PI/rzmax;

        if (verbosity > 0) printf("Evaluating the Fisher Matrix for [k_min = %lf, k_max = %lf] and [z_min = %lf, z_max = %lf]\n", kmin, kmax, zmin_iter, zmax_iter);

        // Calculate the effective redshift (which I base on the sum of the S/N for the density and velocity fields)
        int numk;
        double k_sum1 = 0.0, k_sum2 = 0.0;
        for (numk=0; numk<NK; numk++) {

            double k = karray[numk]+0.5*deltakarray[numk];
            double deltak = deltakarray[numk];
            if (k < kmin) continue;
            if (k > kmax) continue;

            double result, error;
            double params[4] = {numk, k, zmin_iter, zmax_iter};

            size_t nevals = 1000;
            gsl_function F;
            F.function = &zeff_integrand;
            F.params = &params;
            gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);

            gsl_integration_qags(&F, 0.0, 1.0, 0, 5e-3, nevals, w, &result, &error);
            gsl_integration_workspace_free(w);

            k_sum1 += k*k*deltak*result;
            k_sum2 += k*k*deltak;

        }
        double z_eff = k_sum1/k_sum2;
        if (verbosity > 0) printf("Effective redshift z_eff = %lf\n", z_eff);

        double growth_eff = gsl_spline_eval(growth_spline, z_eff, growth_acc);

        // Calculate the fisher matrix, integrating over k, then mu, then r (r is last as it means we are effectively integrating over effective volume).
        // As the input spectra are tabulated we'll just use the trapezium rule to integrate over k
        gsl_matrix * Fisher = gsl_matrix_alloc(nparams, nparams);
        for (i=0; i<nparams; i++) {
            for (j=i; j<nparams; j++) {

                double k_sum = 0.0;
                for (numk=0; numk<NK; numk++) {

                    double k = karray[numk]+0.5*deltakarray[numk];
                    double deltak = deltakarray[numk];
                    if (k < kmin) continue;
                    if (k > kmax) continue;

                    double result, error;
                    double params[6] = {numk, k, Data[i], Data[j], zmin_iter, zmax_iter};

                    size_t nevals = 1000;
                    gsl_function F;
                    F.function = &mu_integrand;
                    F.params = &params;
                    gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);

                    gsl_integration_qags(&F, 0.0, 1.0, 0, 5e-3, nevals, w, &result, &error);
                    gsl_integration_workspace_free(w);

                    k_sum += k*k*deltak*result;

                }
                //printf("%d, %d, %lf\n", i, j, k_sum/(4.0*M_PI));
                gsl_matrix_set(Fisher, i, j, k_sum/(4.0*M_PI));
                gsl_matrix_set(Fisher, j, i, k_sum/(4.0*M_PI));

            }
        }

        for (i=0; i<nparams; i++) {
            for (j=0; j<nparams; j++) {
                double val = gsl_matrix_get(Fisher_Tot, i, j) + gsl_matrix_get(Fisher, i, j);
                gsl_matrix_set(Fisher_Tot, i, j, val);
            }
        }

        if (verbosity == 2) {
            printf("Fisher Matrix\n======================\n");
            for (i=0; i<nparams; i++) {
                printf("[");
                for (j=0; j<nparams; j++) printf("%15.6lf,\t", gsl_matrix_get(Fisher, i, j));
                printf("],\n");
            }
        }

        // Now invert the Fisher matrix
        int s;
        gsl_permutation * p;
        gsl_matrix * Covariance = gsl_matrix_alloc(nparams, nparams);
        p = gsl_permutation_alloc(nparams);
        gsl_linalg_LU_decomp(Fisher, p, &s);
        gsl_linalg_LU_invert(Fisher, p, Covariance);
        gsl_permutation_free(p);

        double sigma8 = sigma80 * growth_eff;
        double Omz = Om*ezinv(z_eff,NULL)*ezinv(z_eff,NULL)*(1.0+z_eff)*(1.0+z_eff)*(1.0+z_eff);
        double f = pow(Omz, gammaval);
        double beta = f*beta0*growth_eff/pow(Om,0.55);

        if (verbosity == 0) {
            for (i=0; i<nparams; i++) {
                if (Data[i] == 1) printf("%12.6lf  %12.6lf  %12.6lf  %12.6lf  %12.6lf\n", zmin_iter, zmax_iter, z_eff, f*sigma8, 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/(f*sigma8));
            }
        }

        if (verbosity > 0) {
            for (i=0; i<nparams; i++) {
                if (Data[i] == 0) {
                    printf("beta = %12.6lf +/- %12.6lf\n", beta, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on beta\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/beta);
                }
                if (Data[i] == 1) {
                    printf("fsigma8 = %12.6lf +/- %12.6lf\n", f*sigma8, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on fsigma8\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/(f*sigma8));
                }
                if (Data[i] == 2) {
                    printf("r_g = %12.6lf +/- %12.6lf\n", r_g, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on r_g\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/r_g);
                }
                if (Data[i] == 3) {
                    printf("sigma_g = %12.6lf +/- %12.6lf\n", sigma_g, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on sigma_g\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/sigma_g);
                }
                if (Data[i] == 4) {
                    printf("sigma_u = %12.6lf +/- %12.6lf\n", sigma_u, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on sigma_u\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/sigma_u);
                }
            }
        }

        if (verbosity == 2) {
            printf("Covariance Matrix\n======================\n");
            for (i=0; i<nparams; i++) {
                printf("[");
                for (j=0; j<nparams; j++) printf("%15.6lf,\t", gsl_matrix_get(Covariance, i, j));
                printf("],\n");
            }
        }

        gsl_matrix_free(Fisher);
        gsl_matrix_free(Covariance);
    }

    // Now the full Fisher matrix over all redshifts if we had more than 1 redshift bin
    if (nziter > 1) {
        double rzmax = gsl_spline_eval(r_spline, zmax, r_acc);
        double kmin = M_PI/rzmax;

        if (verbosity > 0) printf("Finally, evaluating the Fisher Matrix for [k_min = %lf, k_max = %lf] and [z_min = %lf, z_max = %lf]\n", kmin, kmax, zmin, zmax);

        // Calculate the effective redshift
        int numk;
        double k_sum1 = 0.0, k_sum2 = 0.0;
        for (numk=0; numk<NK; numk++) {

            double k = karray[numk]+0.5*deltakarray[numk];
            double deltak = deltakarray[numk];
            if (k < kmin) continue;
            if (k > kmax) continue;

            double result, error;
            double params[4] = {numk, k, zmin, zmax};

            size_t nevals = 1000;
            gsl_function F;
            F.function = &zeff_integrand;
            F.params = &params;
            gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);

            gsl_integration_qags(&F, 0.0, 1.0, 0, 5e-3, nevals, w, &result, &error);
            gsl_integration_workspace_free(w);

            k_sum1 += k*k*deltak*result;
            k_sum2 += k*k*deltak;

        }
        double z_eff = k_sum1/k_sum2;
        if (verbosity > 0) printf("Effective redshift z_eff = %lf\n", z_eff);

        double growth_eff = gsl_spline_eval(growth_spline, z_eff, growth_acc);

        if (verbosity == 2) {
            printf("Fisher Matrix\n======================\n");
            for (i=0; i<nparams; i++) {
                printf("[");
                for (j=0; j<nparams; j++) printf("%15.6lf,\t", gsl_matrix_get(Fisher_Tot, i, j));
                printf("],\n");
            }
        }

        // Now invert the Fisher matrix
        int s;
        gsl_permutation * p;
        gsl_matrix * Covariance = gsl_matrix_alloc(nparams, nparams);
        p = gsl_permutation_alloc(nparams);
        gsl_linalg_LU_decomp(Fisher_Tot, p, &s);
        gsl_linalg_LU_invert(Fisher_Tot, p, Covariance);
        gsl_permutation_free(p);

        double sigma8 = sigma80 * growth_eff;
        double Omz = Om*ezinv(z_eff,NULL)*ezinv(z_eff,NULL)*(1.0+z_eff)*(1.0+z_eff)*(1.0+z_eff);
        double f = pow(Omz, gammaval);
        double beta = f*beta0*growth_eff/pow(Om,0.55);

        if (verbosity == 0) {
            printf("# Full redshift range:\n");
            for (i=0; i<nparams; i++) {
                if (Data[i] == 1) printf("%12.6lf  %12.6lf  %12.6lf  %12.6lf  %12.6lf\n", zmin, zmax, z_eff, f*sigma8, 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/(f*sigma8));
            }
        }

        if (verbosity > 0) {
            for (i=0; i<nparams; i++) {
                if (Data[i] == 0) {
                    printf("beta = %12.6lf +/- %12.6lf\n", beta, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on beta\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/beta);
                }
                if (Data[i] == 1) {
                    printf("fsigma8 = %12.6lf +/- %12.6lf\n", f*sigma8, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on fsigma8\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/(f*sigma8));
                }
                if (Data[i] == 2) {
                    printf("r_g = %12.6lf +/- %12.6lf\n", r_g, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on r_g\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/r_g);
                }
                if (Data[i] == 3) {
                    printf("sigma_g = %12.6lf +/- %12.6lf\n", sigma_g, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on sigma_g\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/sigma_g);
                }
                if (Data[i] == 4) {
                    printf("sigma_u = %12.6lf +/- %12.6lf\n", sigma_u, sqrt(gsl_matrix_get(Covariance, i, i)));
                    printf("%4.2lf percent error on sigma_u\n", 100.0*sqrt(gsl_matrix_get(Covariance, i, i))/sigma_u);
                }
            }
        }

        if (verbosity == 2) {
            printf("Covariance Matrix\n======================\n");
            for (i=0; i<nparams; i++) {
                printf("[");
                for (j=0; j<nparams; j++) printf("%15.6lf,\t", gsl_matrix_get(Covariance, i, j));
                printf("],\n");
            }
        }
    }

    gsl_matrix_free(Fisher_Tot);
    gsl_spline_free(growth_spline);
    gsl_interp_accel_free(growth_acc);

    return 0;
}

// The integrand to calculate the effective redshift. I'm not actually sure how this is done in the case of
// density and velocity field measurements, but it seems logical to base it on the sum of the integral of the density spectra and the velocity power spectra
// weighted by their effective signal to noise. In this way the effective redshift is calculated in the same way as a redshift survey, but there is some dependence
// on the S/N in the velocity power spectrum too. In any case, the S/N of the density field measurement is always much higher (because there are
// no errors and the number density is higher) and so this dominates the effective redshift calculation.
double zeff_integrand(double mu, void * pin) {

    int i, j, m, q, u, surv;
    double * p = (double *)pin;

    int numk = (int)p[0];
    double k = p[1];
    double zminval = p[2];
    double zmaxval = p[3];
    gsl_interp_accel * Pmm_acc, * Pmt_acc, * Ptt_acc;
    gsl_spline * Pmm_spline, * Pmt_spline, * Ptt_spline;
    if (nzin > 1) {
        double * Pmm_array = (double *)malloc(nzin*sizeof(double));
        double * Pmt_array = (double *)malloc(nzin*sizeof(double));
        double * Ptt_array = (double *)malloc(nzin*sizeof(double));
        for (j=0; j<nzin; j++) {
            Pmm_array[j] = pmmarray[j][numk];
            Pmt_array[j] = pmtarray[j][numk];
            Ptt_array[j] = pttarray[j][numk];
        }
        Pmm_acc    = gsl_interp_accel_alloc();
        Pmm_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
        gsl_spline_init(Pmm_spline, zin, Pmm_array, nzin);
        free(Pmm_array);

        Pmt_acc    = gsl_interp_accel_alloc();
        Pmt_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
        gsl_spline_init(Pmt_spline, zin, Pmt_array, nzin);
        free(Pmt_array);

        Ptt_acc    = gsl_interp_accel_alloc();
        Ptt_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
        gsl_spline_init(Ptt_spline, zin, Ptt_array, nzin);
        free(Ptt_array);
    }

    double dendamp = sqrt(1.0/(1.0+0.5*(k*k*mu*mu*sigma_g*sigma_g)));     // This is unitless
    double veldamp = sin(k*sigma_u)/(k*sigma_u);                          // This is unitless

    double dVeff = 0.0, zdVeff = 0.0;
    for (i=0; i<NRED[0]; i++) {

        double zval = zarray[i];
        if (zval < zminval) continue;
        if (zval > zmaxval) break;

        double r_sum = 0.0;
        double r = rarray[i];
        double deltar = deltararray[i];

        double dd_prefac=0.0, vv_prefac=0.0;
        double P_gg=0.0, P_uu=0.0;

        double sigma8 = sigma80 * growtharray[i];

        // First lets calculate the relevant power spectra. Interpolate the power spectra linearly in redshift
        double Pmm, Pmt, Ptt;
        Pmm = gsl_spline_eval(Pmm_spline, zval, Pmm_acc);
        Pmt = gsl_spline_eval(Pmt_spline, zval, Pmm_acc);
        Ptt = gsl_spline_eval(Ptt_spline, zval, Pmm_acc);

        double Omz = Om*ezinv(zval,NULL)*ezinv(zval,NULL)*(1.0+zval)*(1.0+zval)*(1.0+zval);
        double f = pow(Omz, gammaval);
        double beta = f*beta0*growtharray[i]/pow(Om,0.55);

        vv_prefac  = 1.0e2*f*mu*veldamp/k;
        dd_prefac = (1.0/(beta*beta) + 2.0*r_g*mu*mu/beta + mu*mu*mu*mu)*f*f*dendamp*dendamp;
        P_gg = dd_prefac*Pmm;
        P_uu = vv_prefac*vv_prefac*Ptt;

        // We need to do the overlapping and non-overlapping parts of the redshifts and PV surveys separately
        for (surv=0; surv<3; surv++) {
            double surv_sum = 0.0;
            if (survey_area[surv] > 0.0) {
                double error_obs, error_noise, n_g = 0.0, n_u = 0.0;

                // Set the nbar for each section.
                if (surv == 0) {
                    n_g = nbararray[1][i];
                } else if (surv == 1) {
                    error_obs = 100.0*error_dist*r;                              // Percentage error * distance * H0 in km/s (factor of 100.0 comes from hubble parameter)
                    error_noise = error_rand*error_rand + error_obs*error_obs;   // Error_noise is in km^{2}s^{-2}
                    n_u = nbararray[0][i]/error_noise;
                } else {
                    error_obs = 100.0*error_dist*r;                              // Percentage error * distance * H0 in km/s (factor of 100.0 comes from hubble parameter)
                    error_noise = error_rand*error_rand + error_obs*error_obs;   // Error_noise is in km^{2}s^{-2}
                    n_u = nbararray[0][i]/error_noise;
                    n_g = nbararray[1][i];
                }

                double value1 = n_g/(1.0 + n_g*P_gg);
                double value2 = n_u/(1.0 + n_u*P_uu);
                surv_sum += value1*value1 + value2*value2;

                surv_sum *= survey_area[surv];
                r_sum += surv_sum;
            }
        }

        dVeff += r*r*deltar*r_sum;
        zdVeff += zval*r*r*deltar*r_sum;

    }

    gsl_spline_free(Pmm_spline);
    gsl_spline_free(Pmt_spline);
    gsl_spline_free(Ptt_spline);
    gsl_interp_accel_free(Pmm_acc);
    gsl_interp_accel_free(Pmt_acc);
    gsl_interp_accel_free(Ptt_acc);

    return zdVeff/dVeff;

}

// The integrand for the integral over mu in the Fisher matrix calculation.
// For each mu we need to create a 4x4 matrix of the relevant power spectra derivatives and the inverse of the power spectrum matrix.
// Because there are some regions where the number density goes to zero we have to work directly with the inverse as it is difficult to invert numerically
// but if we deal with the inverse only then we can just set the relevant parts to zero when the number density is zero.
double mu_integrand(double mu, void * pin) {

    int i, j, m, q, u, surv;
    double * p = (double *)pin;
    double result, error;

    int numk = (int)p[0];
    double k = p[1];
    double zminval = p[4];
    double zmaxval = p[5];
    gsl_interp_accel * Pmm_acc, * Pmt_acc, * Ptt_acc;
    gsl_spline * Pmm_spline, * Pmt_spline, * Ptt_spline;
    double * Pmm_array = (double *)malloc(nzin*sizeof(double));
    double * Pmt_array = (double *)malloc(nzin*sizeof(double));
    double * Ptt_array = (double *)malloc(nzin*sizeof(double));
    for (j=0; j<nzin; j++) {
        Pmm_array[j] = pmmarray[j][numk];
        Pmt_array[j] = pmtarray[j][numk];
        Ptt_array[j] = pttarray[j][numk];
    }
    Pmm_acc    = gsl_interp_accel_alloc();
    Pmm_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
    gsl_spline_init(Pmm_spline, zin, Pmm_array, nzin);
    free(Pmm_array);

    Pmt_acc    = gsl_interp_accel_alloc();
    Pmt_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
    gsl_spline_init(Pmt_spline, zin, Pmt_array, nzin);
    free(Pmt_array);

    Ptt_acc    = gsl_interp_accel_alloc();
    Ptt_spline = gsl_spline_alloc(gsl_interp_cspline, nzin);
    gsl_spline_init(Ptt_spline, zin, Ptt_array, nzin);
    free(Ptt_array);

    double dendamp = sqrt(1.0/(1.0+0.5*(k*k*mu*mu*sigma_g*sigma_g)));     // This is unitless
    double veldamp = sin(k*sigma_u)/(k*sigma_u);                          // This is unitless

    double result_sum = 0.0;
    for (i=0; i<NRED[0]; i++) {

        double zval = zarray[i];
        double r_sum = 0.0;
        double r = rarray[i];
        double deltar = deltararray[i];

        if (zval < zminval) continue;
        if (zval > zmaxval) break;

        double dd_prefac=0.0, dv_prefac=0.0, vv_prefac=0.0;
        double P_gg=0.0, P_ug=0.0, P_uu=0.0;

        double sigma8 = sigma80 * growtharray[i];

        // First lets calculate the relevant power spectra. Interpolate the power spectra linearly in redshift
        double Pmm, Pmt, Ptt;
        Pmm = gsl_spline_eval(Pmm_spline, zval, Pmm_acc);
        Pmt = gsl_spline_eval(Pmt_spline, zval, Pmm_acc);
        Ptt = gsl_spline_eval(Ptt_spline, zval, Pmm_acc);

        double Omz = Om*ezinv(zval,NULL)*ezinv(zval,NULL)*(1.0+zval)*(1.0+zval)*(1.0+zval);
        double f = pow(Omz, gammaval);
        double beta = f*beta0*growtharray[i]/pow(Om,0.55);

        vv_prefac  = 1.0e2*f*mu*veldamp/k;
        dd_prefac = (1.0/(beta*beta) + 2.0*r_g*mu*mu/beta + mu*mu*mu*mu)*f*f*dendamp*dendamp;
        dv_prefac = (r_g/beta + mu*mu)*f*dendamp;
        P_gg = dd_prefac*Pmm;
        P_ug = vv_prefac*dv_prefac*Pmt;
        P_uu = vv_prefac*vv_prefac*Ptt;

        // And now the derivatives. Need to create a matrix of derivatives for each of the two parameters of interest
        gsl_matrix * dPdt1 = gsl_matrix_calloc(2, 2);
        gsl_matrix * dPdt2 = gsl_matrix_calloc(2, 2);
        double value;
        switch((int)p[2]) {
            // Differential w.r.t betaA
            case 0:
                value = -2.0*(1.0/beta + r_g*mu*mu)*f*f*dendamp*dendamp*Pmm/(beta*beta);
                gsl_matrix_set(dPdt1, 0, 0, value);
                value = -(vv_prefac*f*r_g*dendamp*Pmt)/(beta*beta);
                gsl_matrix_set(dPdt1, 0, 1, value);
                gsl_matrix_set(dPdt1, 1, 0, value);
                break;
            // Differential w.r.t fsigma8
            case 1:
                value = 2.0*(f/(beta*beta) + 2.0*f*r_g*mu*mu/beta + f*mu*mu*mu*mu)*dendamp*dendamp*Pmm/sigma8;
                gsl_matrix_set(dPdt1, 0, 0, value);
                value = 2.0*vv_prefac*(r_g/beta + mu*mu)*dendamp*Pmt/sigma8;
                gsl_matrix_set(dPdt1, 0, 1, value);
                gsl_matrix_set(dPdt1, 1, 0, value);
                value = (2.0*P_uu)/(f*sigma8);
                gsl_matrix_set(dPdt1, 1, 1, value);
                break;
            // Differential w.r.t r_g
            case 2:
                value = 2.0*(1.0/beta)*mu*mu*f*f*dendamp*dendamp*Pmm;
                gsl_matrix_set(dPdt1, 0, 0, value);
                value = vv_prefac*(1.0/beta)*f*dendamp*Pmt;
                gsl_matrix_set(dPdt1, 0, 1, value);
                gsl_matrix_set(dPdt1, 1, 0, value);
                break;
            // Differential w.r.t sigma_g
            case 3:
                value = -k*k*mu*mu*dendamp*dendamp*sigma_g*P_gg;
                gsl_matrix_set(dPdt1, 0, 0, value);
                value = -0.5*k*k*mu*mu*dendamp*dendamp*sigma_g*P_ug;
                gsl_matrix_set(dPdt1, 0, 1, value);
                gsl_matrix_set(dPdt1, 1, 0, value);
                break;
            // Differential w.r.t sigma_u
            case 4:
                value = P_ug*(k*cos(k*sigma_u)/sin(k*sigma_u) - 1.0/sigma_u);
                gsl_matrix_set(dPdt1, 0, 1, value);
                gsl_matrix_set(dPdt1, 1, 0, value);
                value = 2.0*P_uu*(k*cos(k*sigma_u)/sin(k*sigma_u) - 1.0/sigma_u);
                gsl_matrix_set(dPdt1, 1, 1, value);
                break;
            default:
                break;
        }
        switch((int)p[3]) {
            // Differential w.r.t betaA
            case 0:
                value = -2.0*(1.0/beta + r_g*mu*mu)*f*f*dendamp*dendamp*Pmm/(beta*beta);
                gsl_matrix_set(dPdt2, 0, 0, value);
                value = -(vv_prefac*f*r_g*dendamp*Pmt)/(beta*beta);
                gsl_matrix_set(dPdt2, 0, 1, value);
                gsl_matrix_set(dPdt2, 1, 0, value);
                break;
            // Differential w.r.t fsigma8
            case 1:
                value = 2.0*(f/(beta*beta) + 2.0*f*r_g*mu*mu/beta + f*mu*mu*mu*mu)*dendamp*dendamp*Pmm/sigma8;
                gsl_matrix_set(dPdt2, 0, 0, value);
                value = 2.0*vv_prefac*(r_g/beta + mu*mu)*dendamp*Pmt/sigma8;
                gsl_matrix_set(dPdt2, 0, 1, value);
                gsl_matrix_set(dPdt2, 1, 0, value);
                value = (2.0*P_uu)/(f*sigma8);
                gsl_matrix_set(dPdt2, 1, 1, value);
                break;
            // Differential w.r.t r_g
            case 2:
                value = 2.0*(1.0/beta)*mu*mu*f*f*dendamp*dendamp*Pmm;
                gsl_matrix_set(dPdt2, 0, 0, value);
                value = vv_prefac*(1.0/beta)*f*dendamp*Pmt;
                gsl_matrix_set(dPdt2, 0, 1, value);
                gsl_matrix_set(dPdt2, 1, 0, value);
                break;
            // Differential w.r.t sigma_g
            case 3:
                value = -k*k*mu*mu*dendamp*dendamp*sigma_g*P_gg;
                gsl_matrix_set(dPdt2, 0, 0, value);
                value = -0.5*k*k*mu*mu*dendamp*dendamp*sigma_g*P_ug;
                gsl_matrix_set(dPdt2, 0, 1, value);
                gsl_matrix_set(dPdt2, 1, 0, value);
                break;
            // Differential w.r.t sigma_u
            case 4:
                value = P_ug*(k*cos(k*sigma_u)/sin(k*sigma_u) - 1.0/sigma_u);
                gsl_matrix_set(dPdt2, 0, 1, value);
                gsl_matrix_set(dPdt2, 1, 0, value);
                value = 2.0*P_uu*(k*cos(k*sigma_u)/sin(k*sigma_u) - 1.0/sigma_u);
                gsl_matrix_set(dPdt2, 1, 1, value);
                break;
            default:
                break;
        }

        // We need to do the overlapping and non-overlapping parts of the surveys separately
        for (surv=0; surv<3; surv++) {
            double surv_sum = 0.0;
            if (survey_area[surv] > 0.0) {
                double error_obs, error_noise, n_g = 0.0, n_u = 0.0;

                // Set the nbar for each section.
                if (surv == 0) {
                    n_g = nbararray[1][i];
                } else if (surv == 1) {
                    error_obs = 100.0*error_dist*r;                              // Percentage error * distance * H0 in km/s (factor of 100.0 comes from hubble parameter)
                    error_noise = error_rand*error_rand + error_obs*error_obs;   // Error_noise is in km^{2}s^{-2}
                    n_u = nbararray[0][i]/error_noise;
                } else {
                    error_obs = 100.0*error_dist*r;                              // Percentage error * distance * H0 in km/s (factor of 100.0 comes from hubble parameter)
                    error_noise = error_rand*error_rand + error_obs*error_obs;   // Error_noise is in km^{2}s^{-2}
                    n_u = nbararray[0][i]/error_noise;
                    n_g = nbararray[1][i];
                }

                //printf("%lf, %lf, %lf\n", r, n_g, 1.0e6*n_u);

                if (!((n_u > 0.0) || (n_g > 0.0))) continue;

                // First we need the determinant.
                double det = 1.0 + n_u*n_g*(P_gg*P_uu - P_ug*P_ug) + n_u*P_uu + n_g*P_gg;

                // Now the inverse matrix.
                gsl_matrix * iP = gsl_matrix_calloc(2, 2);
                value = n_u*n_g*P_uu + n_g;
                gsl_matrix_set(iP, 0, 0, value);
                value = n_g*n_u*P_gg + n_u;
                gsl_matrix_set(iP, 1, 1, value);
                value = - n_g*n_u*P_ug;
                gsl_matrix_set(iP, 0, 1, value);
                gsl_matrix_set(iP, 1, 0, value);

                // Finally we need to compute the Fisher integrand by summing over the inverse and differential matrices
                for (j=0; j<2; j++) {
                    for (m=0; m<2; m++) {
                        for (u=0; u<2; u++) {
                            for (q=0; q<2; q++) {
                                value = gsl_matrix_get(dPdt1, j, q)*gsl_matrix_get(iP, q, u)*gsl_matrix_get(dPdt2, u, m)*gsl_matrix_get(iP, m, j);
                                surv_sum += value;
                            }
                        }
                    }
                }
                surv_sum /= det*det;
                surv_sum *= survey_area[surv];
                r_sum += surv_sum;
                gsl_matrix_free(iP);
                //printf("%d, %lf, %lf, %lf, %lf\n", surv, k, mu, r, r_sum);

            }
        }
        //printf("%lf, %lf, %lf, %lf\n", k, mu, r, r_sum);

        result_sum += r*r*deltar*r_sum;

        gsl_matrix_free(dPdt1);
        gsl_matrix_free(dPdt2);
    }

    gsl_spline_free(Pmm_spline);
    gsl_spline_free(Pmt_spline);
    gsl_spline_free(Ptt_spline);
    gsl_interp_accel_free(Pmm_acc);
    gsl_interp_accel_free(Pmt_acc);
    gsl_interp_accel_free(Ptt_acc);

    return result_sum;
}

// Routine to read in the number density as a function of redshift. We need a file containing the left-most edge of each redshift bin and teh number density in that bin.
// From this we create arrays to store the bin centre, the bin width, the comoving distance and growth factor at the bin centre and the number density.
// The last bin width and bin centre is constructed from the last row of the input and the value of zmax at the top of the code.
// ITS VERY IMPORTANT THAT THE NUMBER OF ROWS AND THE REDSHIFTS OF BOTH THE DENSITY AND PV NUMBER DENSITIES MATCH AS THE INTEGRATION OVER Z IS DONE USING THE TRAPEZIUM RULE.
// ALSO MAKE NOTE OF THE FACTOR OF 1.0e-6 ON LINE 827. THIS IS BECAUSE I TYPICALLY SAVE THE VALUE OF NBAR x 10^6 IN THE INPUT FILES< SO THAT I DON'T LOSE PRECISION
// WHEN SMALL VALUES OF THE NUMBER DENSITY ARE WRITTEN TO A FILE!
void read_nz() {

    FILE * fp;
    char buf[500];
    int i, nsamp;

    NRED = (int *)calloc(2, sizeof(int));
    nbararray = (double **)calloc(2, sizeof(double*));
    double * zinarray;

    for (nsamp = 0; nsamp < 2; nsamp++) {

        if(!(fp = fopen(nbar_file[nsamp], "r"))) {
            printf("\nERROR: Can't open nbar file '%s'.\n\n", nbar_file[nsamp]);
            exit(0);
        }

        NRED[nsamp] = 0;
        while(fgets(buf,500,fp)) {
            if(strncmp(buf,"#",1)!=0) {
                double tz, tnbar;
                if(sscanf(buf, "%lf %lf\n", &tz, &tnbar) != 2) {printf("nbar read error\n"); exit(0);};
                if (tz > zmax) break;
                NRED[nsamp]++;
            }
        }
        fclose(fp);

        if (nsamp == 0) zinarray = (double *)calloc(NRED[nsamp], sizeof(double));
        nbararray[nsamp] = (double *)calloc(NRED[nsamp], sizeof(double));

        NRED[nsamp] = 0;
        fp = fopen(nbar_file[nsamp], "r");
        while(fgets(buf,500,fp)) {
            if(strncmp(buf,"#",1)!=0) {
                double tz, tnbar;
                if(sscanf(buf, "%lf %lf\n", &tz, &tnbar) != 2) {printf("nbar read error\n"); exit(0);};
                if (tz > zmax) break;
                if (nsamp == 0) zinarray[NRED[nsamp]] = tz;
                nbararray[nsamp][NRED[nsamp]] = 1.0e-6*tnbar;
                NRED[nsamp]++;
            }
        }
        fclose(fp);
    }

    if (NRED[1] != NRED[0]) {
        printf("ERROR: The number of redshift bins for each sample must match\n");
        exit(0);
    }

    zarray = (double *)calloc(NRED[0], sizeof(double));
    rarray = (double *)calloc(NRED[0], sizeof(double));
    deltararray = (double *)calloc(NRED[0], sizeof(double));
    growtharray = (double *)calloc(NRED[0], sizeof(double));

    for (i=0; i<NRED[0]-1; i++) {
        zarray[i] = (zinarray[i+1]+zinarray[i])/2.0;
        rarray[i] = rz(zarray[i]);
        deltararray[i] = rz(zinarray[i+1]) - rz(zinarray[i]);
        growtharray[i] = growthz(zarray[i])/growthz(0.0);
        //printf("%12.6lf %12.6lf %12.6lf %12.6lf %12.6lf %12.6lf\n", zarray[i], rarray[i], deltararray[i], growtharray[i], nbararray[0][i], nbararray[1][i]);
    }
    zarray[NRED[0]-1] = (zmax+zinarray[NRED[0]-1])/2.0;
    rarray[NRED[0]-1] = rz(zarray[NRED[0]-1]);
    deltararray[NRED[0]-1] = rz(zmax) - rz(zinarray[NRED[0]-1]);
    growtharray[NRED[0]-1] = growthz(zarray[NRED[0]-1])/growthz(0.0);
    //printf("%12.6lf %12.6lf %12.6lf %12.6lf %12.6lf %12.6lf\n", zarray[NRED[0]-1], rarray[NRED[0]-1], deltararray[NRED[0]-1], growtharray[NRED[0]-1], nbararray[0][NRED[0]-1], nbararray[1][NRED[0]-1]);

    growth_acc    = gsl_interp_accel_alloc();
    growth_spline = gsl_spline_alloc(gsl_interp_cspline, NRED[0]);
    gsl_spline_init(growth_spline, zarray, growtharray, NRED[0]);

    free(zinarray);

    // Also create a simple redshift-distance spline
    int nbins = 400;
    double REDMIN = 0.0;
    double REDMAX = 2.0;
    double redbinwidth = (REDMAX-REDMIN)/(double)(nbins-1);
    double RMIN = rz(REDMIN);
    double RMAX = rz(REDMAX);
    double * ztemp = (double *)malloc(nbins*sizeof(double));
    double * rtemp = (double *)malloc(nbins*sizeof(double));
    for (i=0;i<nbins;i++) {
        ztemp[i] = i*redbinwidth+REDMIN;
        rtemp[i] = rz(ztemp[i]);
    }
    r_acc = gsl_interp_accel_alloc();
    r_spline = gsl_spline_alloc(gsl_interp_cspline, nbins);
    gsl_spline_init(r_spline, ztemp, rtemp, nbins);

    free(ztemp);
    free(rtemp);

    return;
}

// Routine to read in the velocity power spectrum.
void read_power() {

    FILE * fp;
    char buf[500];
    int i, j;

    pmmarray = (double**)malloc(nzin*sizeof(double*));
    pmtarray = (double**)malloc(nzin*sizeof(double*));
    pttarray = (double**)malloc(nzin*sizeof(double*));

    for (i = 0; i<nzin; i++) {

        char Pvel_file_in[500];
        sprintf(Pvel_file_in, "%s_z0p%02d.dat", Pvel_file, (int)(100.0*zin[i]));

        if(!(fp = fopen(Pvel_file_in, "r"))) {
            printf("\nERROR: Can't open power file '%s'.\n\n", Pvel_file_in);
            exit(0);
        }

        NK = 0;
        while(fgets(buf,500,fp)) {
            if(strncmp(buf,"#",1)!=0) {
                double tk, pkdelta, pkdeltavel, pkvel;
                if(sscanf(buf, "%lf %lf %lf %lf\n", &tk, &pkdelta, &pkdeltavel, &pkvel) != 4) {printf("Pvel read error\n"); exit(0);};
                NK++;
            }
        }
        fclose(fp);

        if (i == 0) {
            karray = (double *)calloc(NK, sizeof(double));
            deltakarray = (double *)calloc(NK-1, sizeof(double));
        }
        pmmarray[i] = (double *)calloc(NK, sizeof(double));
        pmtarray[i] = (double *)calloc(NK, sizeof(double));
        pttarray[i] = (double *)calloc(NK, sizeof(double));

        NK = 0;
        fp = fopen(Pvel_file_in, "r");
        while(fgets(buf,500,fp)) {
            if(strncmp(buf,"#",1)!=0) {
                double tk, pkdelta, pkdeltavel, pkvel;
                if(sscanf(buf, "%lf %lf %lf %lf\n", &tk, &pkdelta, &pkdeltavel, &pkvel) != 4) {printf("Pvel read error\n"); exit(0);};
                if (i == 0) karray[NK] = tk;
                pttarray[i][NK] = pkvel;
                pmmarray[i][NK] = pkdelta;
                pmtarray[i][NK] = pkdeltavel;
                NK++;
            }
        }
        fclose(fp);
    }

    for (i=0; i<NK-1; i++) deltakarray[i] = karray[i+1]-karray[i];

    pkkmin = karray[0];
    pkkmax = karray[NK-1];

    if (pkkmax < kmax) {
        printf("ERROR: The maximum k in the input power spectra id less than k_max\n");
        exit(0);
    }

    return;
}

// Integrand for the comoving distance
double ezinv(double x, void *p) {
  return 1.0/sqrt(Om*(1.0+x)*(1.0+x)*(1.0+x)+(1.0-Om));
}

// Calculates the comoving distance from the redshift
double rz(double red) {
  double result, error;
  gsl_function F;
  gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);
  F.function = &ezinv;
  gsl_integration_qags(&F, 0.0, red, 0, 1e-7, 1000, w, &result, &error);
  gsl_integration_workspace_free(w);
  return c*result/100.0;
}

// The integrand for the normalised growth factor
double growthfunc(double x, void *p) {
    double red = 1.0/x - 1.0;
    double Omz = Om*ezinv(red,NULL)*ezinv(red,NULL)/(x*x*x);
    double f = pow(Omz, gammaval);
    return f/x;
}

// Calculates the normalised growth factor as a function of redshift given a value of gammaval
double growthz(double red) {
  double result, error;
  gsl_function F;
  gsl_integration_workspace * w = gsl_integration_workspace_alloc(1000);
  F.function = &growthfunc;
  double a = 1.0/(1.0+red);
  gsl_integration_qags(&F, a, 1.0, 0, 1e-7, 1000, w, &result, &error);
  gsl_integration_workspace_free(w);
  return exp(-result);
}


#pragma once

/***************************************************
 *************** Auto-Generated File ***************
 ***************************************************/

#include <cstring>
#include <string>

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

#include "../../Utils/BinarySearch.h"

enum UnitType {
	NONE,
	DISTANCE,
	TIME,
	TIMESQUARED,
	SPEED,
	ACCELERATION,
	AREA,
	VOLUME,
	MASS,
	FORCE,
	MASSDISTANCE,
	MASSPERTIMESQUARED,
	ENERGY,
	MASSAREA
};

constexpr const int numUnits = 161;
constexpr const char* unitNames[numUnits] = {
	"acre", "astronomical_unit", "attogram", "attometer", "attometerscubed",
	"attometerssquared", "attosecond", "barn", "btu", "calorie", "canadian_gallon", "carat",
	"centimeter", "century", "cup", "decade", "decameter", "decimeter", "dyne",
	"electron_volt", "erg", "exagram", "exameter", "exameterscubed", "exameterssquared",
	"exasecond", "fathom", "femtogram", "femtometer", "femtometerscubed",
	"femtometerssquared", "femtosecond", "fluid_ounce", "foot", "gigagram", "gigameter",
	"gigameterscubed", "gigameterssquared", "gigasecond", "gram", "gram_force", "grammeter",
	"grammeterspersecondsquared", "grammeterssquared", "grammeterssquaredpersecondsquared",
	"grampersecondsquared", "grav_accel", "hectare", "hectometer", "hour", "inch", "joule",
	"kilogram", "kilometer", "kilometers_per_hour", "kilometerscubed", "kilometerssquared",
	"kilopound_force", "kilosecond", "knot", "light_year", "liter", "mass_electron",
	"mass_muon", "mass_neutron", "mass_proton", "megagram", "megameter", "megameterscubed",
	"megameterssquared", "megasecond", "meter", "meterscubed", "meterspersecond",
	"meterspersecondsquared", "meterssquared", "metric_ton", "microgram", "microliter",
	"micrometer", "micrometerscubed", "micrometerssquared", "microsecond", "mil", "mile",
	"miles_per_hour", "millenium", "milligram", "milliliter", "millimeter",
	"millimeterscubed", "millimeterssquared", "millisecond", "minute", "month", "nanogram",
	"nanometer", "nanometerscubed", "nanometerssquared", "nanosecond", "nautical_mile",
	"newton", "newton_meter", "ounce_mass", "petagram", "petameter", "petameterscubed",
	"petameterssquared", "petasecond", "picogram", "picometer", "picometerscubed",
	"picometerssquared", "picosecond", "pint", "pound_force", "pound_mass", "poundal",
	"quart", "rydberg", "second", "secondsquared", "solar_mass", "speed_of_light",
	"tablespoon", "teaspoon", "teragram", "terameter", "terameterscubed",
	"terameterssquared", "terasecond", "therm", "ton", "troy_ounce", "uk_gallon", "uk_ton",
	"unified_atomic_mass", "us_gallon", "week", "yard", "year", "yoctogram", "yoctometer",
	"yoctometerscubed", "yoctometerssquared", "yoctosecond", "yottagram", "yottameter",
	"yottameterscubed", "yottameterssquared", "yottasecond", "zeptogram", "zeptometer",
	"zeptometerscubed", "zeptometerssquared", "zeptosecond", "zettagram", "zettameter",
	"zettameterscubed", "zettameterssquared", "zettasecond"
};
constexpr const int unitIndices[numUnits] = {
	52, 0, 53, 54, 56, 55, 57, 58, 59, 61, 2, 1, 63, 62, 64, 66, 65, 67, 3, 4, 68, 5, 6, 8,
	7, 9, 76, 69, 71, 73, 72, 74, 70, 75, 11, 12, 14, 13, 15, 77, 83, 78, 79, 80, 81, 82,
	10, 85, 86, 84, 87, 16, 88, 90, 94, 92, 91, 89, 95, 93, 98, 17, 102, 103, 104, 105, 19,
	20, 22, 21, 23, 99, 107, 100, 101, 106, 118, 142, 143, 144, 146, 145, 147, 110, 109,
	116, 112, 108, 111, 113, 115, 114, 117, 18, 119, 120, 121, 123, 122, 125, 124, 24, 25,
	126, 26, 27, 29, 28, 30, 128, 129, 131, 130, 132, 133, 97, 96, 127, 134, 31, 135, 136,
	32, 60, 138, 141, 33, 34, 36, 35, 37, 139, 137, 140, 39, 40, 38, 41, 148, 149, 154, 150,
	151, 153, 152, 155, 42, 43, 45, 44, 46, 156, 157, 159, 158, 160, 47, 48, 50, 49, 51
};
constexpr const char * unitAbbreviations[numUnits] = {
	"AU", "CD", "CG", "Dy", "EV", "Eg", "Em", "Em^2", "Em^3", "Es", "G", "Gg", "Gm", "Gm^2",
	"Gm^3", "Gs", "J", "L", "M", "Mg", "Mm", "Mm^2", "Mm^3", "Ms", "N", "Nm", "Pg", "Pm",
	"Pm^2", "Pm^3", "Ps", "Ry", "SM", "Tg", "Tm", "Tm^2", "Tm^3", "Ts", "UAM", "UKG", "UKT",
	"USG", "Yg", "Ym", "Ym^2", "Ym^3", "Ys", "Zg", "Zm", "Zm^2", "Zm^3", "Zs", "ac", "ag",
	"am", "am^2", "am^3", "as", "bn", "btu", "c", "cal", "cen", "cm", "cp", "dcm", "dec",
	"dm", "erg", "fg", "floz", "fm", "fm^2", "fm^3", "fs", "ft", "fth", "g", "g*m",
	"g*m/s^2", "g*m^2", "g*m^2/s^2", "g/s^2", "gF", "h", "hec", "hm", "in", "kg", "klbF",
	"km", "km^2", "km^3", "knt", "kph", "ks", "lb", "lbF", "ly", "m", "m/s", "m/s^2", "mE",
	"mMu", "mNt", "mPt", "m^2", "m^3", "mg", "mi", "mil", "ml", "mln", "mm", "mm^2", "mm^3",
	"mph", "ms", "mt", "mth", "ng", "nm", "nm^2", "nm^3", "nmi", "ns", "oz", "pdl", "pg",
	"pm", "pm^2", "pm^3", "ps", "pt", "qt", "s", "s^2", "t", "tbsp", "thm", "toz", "tsp",
	"ug", "ul", "um", "um^2", "um^3", "us", "wk", "yd", "yg", "ym", "ym^2", "ym^3", "yr",
	"ys", "zg", "zm", "zm^2", "zm^3", "zs"
};
constexpr const UnitType unitTypes[numUnits] = {
	DISTANCE, MASS, VOLUME, FORCE, ENERGY, MASS, DISTANCE, AREA, VOLUME, TIME, ACCELERATION,
	MASS, DISTANCE, AREA, VOLUME, TIME, ENERGY, VOLUME, TIME, MASS, DISTANCE, AREA, VOLUME,
	TIME, FORCE, ENERGY, MASS, DISTANCE, AREA, VOLUME, TIME, ENERGY, MASS, MASS, DISTANCE,
	AREA, VOLUME, TIME, MASS, VOLUME, MASS, VOLUME, MASS, DISTANCE, AREA, VOLUME, TIME,
	MASS, DISTANCE, AREA, VOLUME, TIME, AREA, MASS, DISTANCE, AREA, VOLUME, TIME, AREA,
	ENERGY, SPEED, ENERGY, TIME, DISTANCE, VOLUME, DISTANCE, TIME, DISTANCE, ENERGY, MASS,
	VOLUME, DISTANCE, AREA, VOLUME, TIME, DISTANCE, DISTANCE, MASS, MASSDISTANCE, FORCE,
	MASSAREA, ENERGY, MASSPERTIMESQUARED, FORCE, TIME, AREA, DISTANCE, DISTANCE, MASS,
	FORCE, DISTANCE, AREA, VOLUME, SPEED, SPEED, TIME, MASS, FORCE, DISTANCE, DISTANCE,
	SPEED, ACCELERATION, MASS, MASS, MASS, MASS, AREA, VOLUME, MASS, DISTANCE, DISTANCE,
	VOLUME, TIME, DISTANCE, AREA, VOLUME, SPEED, TIME, MASS, TIME, MASS, DISTANCE, AREA,
	VOLUME, DISTANCE, TIME, MASS, FORCE, MASS, DISTANCE, AREA, VOLUME, TIME, VOLUME, VOLUME,
	TIME, TIMESQUARED, MASS, VOLUME, ENERGY, MASS, VOLUME, MASS, VOLUME, DISTANCE, AREA,
	VOLUME, TIME, TIME, DISTANCE, MASS, DISTANCE, AREA, VOLUME, TIME, TIME, MASS, DISTANCE,
	AREA, VOLUME, TIME
};
constexpr const double unitConversions[numUnits] = {
	GSL_CONST_MKSA_ASTRONOMICAL_UNIT, GSL_CONST_MKSA_CARAT*1000.0,
	GSL_CONST_MKSA_CANADIAN_GALLON, GSL_CONST_MKSA_DYNE*1000.0,
	GSL_CONST_MKSA_ELECTRON_VOLT*1000.0, GSL_CONST_NUM_EXA, GSL_CONST_NUM_EXA,
	GSL_CONST_NUM_EXA, GSL_CONST_NUM_EXA, GSL_CONST_NUM_EXA, GSL_CONST_MKSA_GRAV_ACCEL,
	GSL_CONST_NUM_GIGA, GSL_CONST_NUM_GIGA, GSL_CONST_NUM_GIGA, GSL_CONST_NUM_GIGA,
	GSL_CONST_NUM_GIGA, GSL_CONST_MKSA_JOULE*1000.0, GSL_CONST_MKSA_LITER,
	GSL_CONST_MKSA_MINUTE, GSL_CONST_NUM_MEGA, GSL_CONST_NUM_MEGA, GSL_CONST_NUM_MEGA,
	GSL_CONST_NUM_MEGA, GSL_CONST_NUM_MEGA, GSL_CONST_MKSA_NEWTON*1000.0, 1000,
	GSL_CONST_NUM_PETA, GSL_CONST_NUM_PETA, GSL_CONST_NUM_PETA, GSL_CONST_NUM_PETA,
	GSL_CONST_NUM_PETA, GSL_CONST_MKSA_RYDBERG*1000.0, GSL_CONST_MKSA_SOLAR_MASS*1000.0,
	GSL_CONST_NUM_TERA, GSL_CONST_NUM_TERA, GSL_CONST_NUM_TERA, GSL_CONST_NUM_TERA,
	GSL_CONST_NUM_TERA, GSL_CONST_MKSA_UNIFIED_ATOMIC_MASS*1000.0, GSL_CONST_MKSA_UK_GALLON,
	GSL_CONST_MKSA_UK_TON*1000.0, GSL_CONST_MKSA_US_GALLON, GSL_CONST_NUM_YOTTA,
	GSL_CONST_NUM_YOTTA, GSL_CONST_NUM_YOTTA, GSL_CONST_NUM_YOTTA, GSL_CONST_NUM_YOTTA,
	GSL_CONST_NUM_ZETTA, GSL_CONST_NUM_ZETTA, GSL_CONST_NUM_ZETTA, GSL_CONST_NUM_ZETTA,
	GSL_CONST_NUM_ZETTA, GSL_CONST_MKSA_ACRE, GSL_CONST_NUM_ATTO, GSL_CONST_NUM_ATTO,
	GSL_CONST_NUM_ATTO, GSL_CONST_NUM_ATTO, GSL_CONST_NUM_ATTO, GSL_CONST_MKSA_BARN,
	GSL_CONST_MKSA_BTU*1000.0, GSL_CONST_MKSA_SPEED_OF_LIGHT, GSL_CONST_MKSA_CALORIE*1000.0,
	3153600000, 1e-2, GSL_CONST_MKSA_CUP, 1e1, 315360000, 1e-1, GSL_CONST_MKSA_ERG*1000.0,
	GSL_CONST_NUM_FEMTO, GSL_CONST_MKSA_FLUID_OUNCE, GSL_CONST_NUM_FEMTO,
	GSL_CONST_NUM_FEMTO, GSL_CONST_NUM_FEMTO, GSL_CONST_NUM_FEMTO, GSL_CONST_MKSA_FOOT,
	GSL_CONST_MKSA_FATHOM, 1, 1, 1, 1, 1, 1, GSL_CONST_MKSA_GRAM_FORCE*1000.0,
	GSL_CONST_MKSA_HOUR, GSL_CONST_MKSA_HECTARE, 1e2, GSL_CONST_MKSA_INCH,
	GSL_CONST_NUM_KILO, GSL_CONST_MKSA_KILOPOUND_FORCE*1000.0, GSL_CONST_NUM_KILO,
	GSL_CONST_NUM_KILO, GSL_CONST_NUM_KILO, GSL_CONST_MKSA_KNOT,
	GSL_CONST_MKSA_KILOMETERS_PER_HOUR, GSL_CONST_NUM_KILO,
	GSL_CONST_MKSA_POUND_MASS*1000.0, GSL_CONST_MKSA_POUND_FORCE*1000.0,
	GSL_CONST_MKSA_LIGHT_YEAR, 1, 1, 1, GSL_CONST_MKSA_MASS_ELECTRON*1000.0,
	GSL_CONST_MKSA_MASS_MUON*1000.0, GSL_CONST_MKSA_MASS_NEUTRON*1000.0,
	GSL_CONST_MKSA_MASS_PROTON*1000.0, 1, 1, GSL_CONST_NUM_MILLI, GSL_CONST_MKSA_MILE,
	GSL_CONST_MKSA_MIL, 1e-6, 31536000000, GSL_CONST_NUM_MILLI, GSL_CONST_NUM_MILLI,
	GSL_CONST_NUM_MILLI, GSL_CONST_MKSA_MILES_PER_HOUR, GSL_CONST_NUM_MILLI,
	GSL_CONST_MKSA_METRIC_TON*1000.0, 2628288, GSL_CONST_NUM_NANO, GSL_CONST_NUM_NANO,
	GSL_CONST_NUM_NANO, GSL_CONST_NUM_NANO, GSL_CONST_MKSA_NAUTICAL_MILE,
	GSL_CONST_NUM_NANO, GSL_CONST_MKSA_OUNCE_MASS*1000.0, GSL_CONST_MKSA_POUNDAL*1000.0,
	GSL_CONST_NUM_PICO, GSL_CONST_NUM_PICO, GSL_CONST_NUM_PICO, GSL_CONST_NUM_PICO,
	GSL_CONST_NUM_PICO, GSL_CONST_MKSA_PINT, GSL_CONST_MKSA_QUART, 1, 1,
	GSL_CONST_MKSA_TON*1000.0, GSL_CONST_MKSA_TABLESPOON, GSL_CONST_MKSA_THERM*1000.0,
	GSL_CONST_MKSA_TROY_OUNCE*1000.0, GSL_CONST_MKSA_TEASPOON, GSL_CONST_NUM_MICRO, 1e-9,
	GSL_CONST_NUM_MICRO, GSL_CONST_NUM_MICRO, GSL_CONST_NUM_MICRO, GSL_CONST_NUM_MICRO,
	GSL_CONST_MKSA_WEEK, GSL_CONST_MKSA_YARD, GSL_CONST_NUM_YOCTO, GSL_CONST_NUM_YOCTO,
	GSL_CONST_NUM_YOCTO, GSL_CONST_NUM_YOCTO, 31536000, GSL_CONST_NUM_YOCTO,
	GSL_CONST_NUM_ZEPTO, GSL_CONST_NUM_ZEPTO, GSL_CONST_NUM_ZEPTO, GSL_CONST_NUM_ZEPTO,
	GSL_CONST_NUM_ZEPTO
};

/*
Returns index of the unit in the unitNames array.

Uses binary search under the hood to search for the index.

Parameters
----------
name: The name of the unit

Returns
-------
The index or -1 if the provided name is not a unit.
*/
CONSTEXPR_BINARY_SEARCH(getUnitIndex, unitNames, numUnits)

CONSTEXPR_BINARY_SEARCH(getAbbrIndex, unitAbbreviations, numUnits)

constexpr UnitType getUnitType(const char* name){
    int index = getUnitIndex(name);
    if (index != -1){
		return NONE;
	}
	return unitTypes[index];
}
inline UnitType getUnitType(const std::string& name){
    int index = getUnitIndex(name.c_str());
    if (index != -1){
		return NONE;
	}
	return unitTypes[index];
}
inline UnitType getUnitType(int index){
    if (index < 0 || index >= numUnits){
		return NONE;
	}
	return unitTypes[index];
}

constexpr double getUnitConversion(const char* name){
    int index = getUnitIndex(name);
    if (index != -1){
		return NONE;
	}
	return unitConversions[index];
}
inline double getUnitConversion(const std::string& name){
    int index = getUnitIndex(name.c_str());
    if (index != -1){
		return NONE;
	}
	return unitConversions[index];
}
inline double getUnitConversion(int index){
    if (index < 0 || index >= numUnits){
		return NONE;
	}
	return unitConversions[index];
}


/**
 *
 * @file core_scasum.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @generated c Tue Jan  7 11:44:46 2014
 *
 **/
#include <cblas.h>
#include <math.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex32_t
 *
 *  CORE_scasum - Computes the sums of the absolute values of elements in a same
 *  row or column.
 *  This function is an auxiliary function to norm computations.
 *
 *******************************************************************************
 *
 * @param[in] storev
 *          Specifies whether the sums are made per column or row.
 *          = PlasmaColumnwise: Computes the sum on each column
 *          = PlasmaRowwise:    Computes the sum on each row
 *
 * @param[in] uplo
 *          Specifies whether the matrix A is upper triangular or lower triangular or general
 *          = PlasmaUpperLower: All matrix A is referenced;
 *          = PlasmaUpper: Upper triangle of A is referenced;
 *          = PlasmaLower: Lower triangle of A is referenced.
 *
 * @param[in] M
 *          M specifies the number of rows of the matrix A. M >= 0.
 *
 * @param[in] N
 *          N specifies the number of columns of the matrix A. N >= 0.
 *
 * @param[in] A
 *          A is a M-by-N matrix.
 *
 * @param[in] lda
 *          The leading dimension of the array A. lda >= max(1,M).
 *
 * @param[out] work
 *          Array of dimension M if storev = PlasmaRowwise; N otherwise.
 *          On exit, contains the sums of the absolute values per column or row.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_scasum = PCORE_scasum
#define CORE_scasum PCORE_scasum
#endif
void CORE_scasum(PLASMA_enum storev, PLASMA_enum uplo, int M, int N,
                 const PLASMA_Complex32_t *A, int lda, float *work)
{
    const PLASMA_Complex32_t *tmpA;
    float *tmpW, sum, abs;
    int i,j;

    switch (uplo) {
    case PlasmaUpper:
        for (j = 0; j < N; j++) {
            tmpA = A+(j*lda);
            sum = 0.0;
            for (i = 0; i < j; i++) {
                abs      = cabsf(*tmpA);
                sum     += abs;
                work[i] += abs;
                tmpA++;
            }
            work[j] += sum + cabsf(*tmpA);
        }
        break;
    case PlasmaLower:
        for (j = 0; j < N; j++) {
            tmpA = A+(j*lda)+j;

            sum = 0.0;
            work[j] += cabsf(*tmpA);

            tmpA++;
            for (i = j+1; i < M; i++) {
                abs      = cabsf(*tmpA);
                sum     += abs;
                work[i] += abs;
                tmpA++;
            }
            work[j] += sum;
        }
        break;
    case PlasmaUpperLower:
    default:
        if (storev == PlasmaColumnwise) {
            for (j = 0; j < N; j++) {
                /* work[j] += cblas_scasum(M, &(A[j*lda]), 1); */
                tmpA = A+(j*lda);
                for (i = 0; i < M; i++) {
                    work[j] +=  cabsf(*tmpA);
                    tmpA++;
                }
            }
        }
        else {
            for (j = 0; j < N; j++) {
                tmpA = A+(j*lda);
                tmpW = work;
                for (i = 0; i < M; i++) {
                    /* work[i] += cabsf( A[j*lda+i] );*/
                    *tmpW += cabsf( *tmpA );
                    tmpA++; tmpW++;
                }
            }
        }
    }
}


#include "stdlib.h"
#include "stdio.h"
#include "/home/lillian/work/install_fpdebug/valgrind-3.7.0/fpdebug/fpdebug.h"
#include <gsl/gsl_statistics.h>
int main(int argc, const char * argv[]) {
unsigned long int hexdouble;
int a;
a = atoi(argv[1]);
int argv_cnt = 2;
double b[5];
for(int i = 0; i < a; i++) {
sscanf(argv[argv_cnt++], "%lX", &hexdouble);
b[i] = *(double*)(&hexdouble);
}
unsigned long c = 1;
double d[5];
for(int i = 0; i < a; i++) {
sscanf(argv[argv_cnt++], "%lX", &hexdouble);
d[i] = *(double*)(&hexdouble);
}
unsigned long e = 1;
double g;
sscanf(argv[argv_cnt++], "%lX", &hexdouble);
g = *(double*)(&hexdouble);
double h;
sscanf(argv[argv_cnt++], "%lX", &hexdouble);
h = *(double*)(&hexdouble);
double result = gsl_stats_wkurtosis_m_sd(b, c, d, e, a, g, h);
//printf("%.15f\n", result);
VALGRIND_PRINT_VALUES("result", 1, &result);
return 0;
}


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

#ifndef MATLEN
#define MATLEN 128
#endif

#ifndef QUIET
#define PRINT( exp ) exp
#else
#define PRINT( exp )
#endif

int main( ) {
  int EventSet = PAPI_NULL;
  long long values[ 4 ], s, e;
  int retval;
  double *a, *b, *c;

  /* INICIALIZAÇÃO */

  PRINT( printf( "Inicializando Matriz: %dx%d\n", MATLEN, MATLEN ) );

  a = ( double* ) malloc( MATLEN * MATLEN * sizeof( double ) );
  b = ( double* ) malloc( MATLEN * MATLEN * sizeof( double ) );
  c = ( double* ) malloc( MATLEN * MATLEN * sizeof( double ) );

  /*
   * CONFIGURAÇÃO DO PAPI
   * Init PAPI library
   */
  retval = PAPI_library_init( PAPI_VER_CURRENT );
  if( retval != PAPI_VER_CURRENT ) {
    printf( "Erro em PAPI_library_init : retval = %d\n", retval );
    exit( 1 );
  }
  if( ( retval = PAPI_create_eventset( &EventSet ) ) != PAPI_OK ) {
    printf( "Erro em PAPI_create_eventset : retval = %d\n", retval );
    exit( 1 );
  }
  if( PAPI_add_event( EventSet, PAPI_L2_DCM ) != PAPI_OK ) {
    printf( "Erro em PAPI_L2_DCM\n" );
    exit( 1 );
  }
  if( PAPI_add_event( EventSet, PAPI_DP_OPS ) != PAPI_OK ) {
    printf( "Erro em PAPI_DP_OPS\n" );
    exit( 1 );
  }
  if( PAPI_add_event( EventSet, PAPI_TOT_CYC ) != PAPI_OK ) {
    printf( "Erro em PAPI_TOT_CYC\n" );
    exit( 1 );
  }
  if( PAPI_add_event( EventSet, PAPI_TOT_INS ) != PAPI_OK ) {
    printf( "Erro em PAPI_TOT_INS\n" );
    exit( 1 );
  }
  if( ( retval = PAPI_start( EventSet ) ) != PAPI_OK ) {
    printf( "Erro em PAPI_start" );
    exit( 1 );
  }
  s = PAPI_get_real_usec( );
  /* FUNÇÃO A SER AVALIADA */

  cblas_dgemm( CblasRowMajor, CblasNoTrans, CblasNoTrans,
               MATLEN, MATLEN, MATLEN, 1.0, a, MATLEN,
               b, MATLEN, 0.0, c, MATLEN );

  /* FIM DA FUNÇÃO A SER AVALIADA */
  e = PAPI_get_real_usec( );
  if( ( retval = PAPI_read( EventSet, &values[ 0 ] ) ) != PAPI_OK ) {
    printf( "Erro em PAPI_read" );
    exit( 1 );
  }
  if( ( retval = PAPI_stop( EventSet, NULL ) ) != PAPI_OK ) {
    printf( "Erro em PAPI_stop" );
    exit( 1 );
  }
  double cpi = ( double ) values[ 2 ] / ( double ) values[ 3 ];
  double icp = ( double ) values[ 3 ] / ( double ) values[ 2 ];
  double mflops = ( double ) values[ 1 ];
  // double mflops = ( double ) 2 * MATLEN * MATLEN * MATLEN;
  mflops = ( mflops / ( ( double ) ( e - s ) ) );
  /* EXIBINDO INFORMAÇÕES */
  PRINT(
    printf( "PAPI_L2_DCM = %lld\n", values[ 0 ] );
    printf( "PAPI_DP_OPS = %lld\n", values[ 1 ] );

    /* CPI */
    printf( "PAPI_TOT_CYC = %lld\n", values[ 2 ] );
    printf( "PAPI_TOT_INS = %lld\n", values[ 3 ] );
    printf( "CPI: %.2f\n", cpi );
    printf( "ICP: %.2f\n", icp );

    printf( "Wallclock time: %lld ms\n", e - s );
    printf( "MFLOPS: %g\n", mflops );
    printf( "Fim\n" );
    );
  /*       MAT BLk Time  DCM   MFLOPS CPI */
  printf( "%d, %lld, %lld, %.2f, %.2f\n", MATLEN, e - s, values[ 0 ], mflops, cpi );
  free( a );
  free( b );
  free( c );
  return( 0 );
}