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

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

#include "ccl.h"

#ifdef HAVE_ANGPOW
#include "Angpow/angpow_ccl.h"
#endif

#define CCL_FRAC_RELEVANT 5E-4
//#define CCL_FRAC_RELEVANT 1E-3
//Gets the x-interval where the values of y are relevant
//(meaning, that the values of y for those x are at least above a fraction frac of its maximum)
static void get_support_interval(int n,double *x,double *y,double frac,
				 double *xmin_out,double *xmax_out)
{
  int ix;
  double ythr=-1000;

  //Initialize as the original edges in case we don't find an interval
  *xmin_out=x[0];
  *xmax_out=x[n-1];

  //Find threshold
  for(ix=0;ix<n;ix++) {
    if(y[ix]>ythr) ythr=y[ix];
  }
  ythr*=frac;

  //Find minimum
  for(ix=0;ix<n;ix++) {
    if(y[ix]>=ythr) {
      *xmin_out=x[ix];
      break;
    }
  }

  //Find maximum
  for(ix=n-1;ix>=0;ix--) {
    if(y[ix]>=ythr) {
      *xmax_out=x[ix];
      break;
    }
  }
}

//Wrapper around spline_eval with GSL function syntax
static double speval_bis(double x,void *params)
{
  return ccl_spline_eval(x,(SplPar *)params);
}

void ccl_cl_workspace_free(CCL_ClWorkspace *w)
{
  free(w->l_arr);
  free(w);
}

CCL_ClWorkspace *ccl_cl_workspace_new(int lmax,int l_limber,
				      double l_logstep,int l_linstep,int *status)
{
  int i_l,l0,increment;
  CCL_ClWorkspace *w=(CCL_ClWorkspace *)malloc(sizeof(CCL_ClWorkspace));
  if(w==NULL)
    *status=CCL_ERROR_MEMORY;

  if(*status==0) {
    //Set params
    w->lmax=lmax;
    w->l_limber=l_limber;
    w->l_logstep=l_logstep;
    w->l_linstep=l_linstep;

    //Compute number of multipoles
    i_l=0; l0=0;
    increment=CCL_MAX(((int)(l0*(w->l_logstep-1.))),1);
    while((l0 < w->lmax) && (increment < w->l_linstep)) {
      i_l++;
      l0+=increment;
      increment=CCL_MAX(((int)(l0*(w->l_logstep-1))),1);
    }
    increment=w->l_linstep;
    while(l0 < w->lmax) {
      i_l++;
      l0+=increment;
    }

    //Allocate array of multipoles
    w->n_ls=i_l+1;
    w->l_arr=(int *)malloc(w->n_ls*sizeof(int));
    if(w->l_arr==NULL)
      *status=CCL_ERROR_MEMORY;
  }

  if(*status==0) {
    //Redo the computation above and store values of ell
    i_l=0; l0=0;
    increment=CCL_MAX(((int)(l0*(w->l_logstep-1.))),1);
    while((l0 < w->lmax) && (increment < w->l_linstep)) {
      w->l_arr[i_l]=l0;
      i_l++;
      l0+=increment;
      increment=CCL_MAX(((int)(l0*(w->l_logstep-1))),1);
    }
    increment=w->l_linstep;
    while(l0 < w->lmax) {
      w->l_arr[i_l]=l0;
      i_l++;
      l0+=increment;
    }
    //Don't go further than lmaw
    w->l_arr[w->n_ls-1]=w->lmax;
  }

  return w;
}

CCL_ClWorkspace *ccl_cl_workspace_new_limber(int lmax,double l_logstep,int l_linstep,int *status)
{
  return ccl_cl_workspace_new(lmax,-1,l_logstep,l_linstep,status);
}

//Params for lensing kernel integrand
typedef struct {
  double chi;
  SplPar *spl_pz;
  ccl_cosmology *cosmo;
  int *status;
} IntLensPar;

//Integrand for lensing kernel
static double integrand_wl(double chip,void *params)
{
  IntLensPar *p=(IntLensPar *)params;
  double chi=p->chi;
  double a=ccl_scale_factor_of_chi(p->cosmo,chip, p->status);
  double z=1./a-1;
  double pz=ccl_spline_eval(z,p->spl_pz);
  double h=p->cosmo->params.h*ccl_h_over_h0(p->cosmo,a, p->status)/CLIGHT_HMPC;

  if(chi==0)
    return h*pz;
  else
    return h*pz*ccl_sinn(p->cosmo,chip-chi,p->status)/ccl_sinn(p->cosmo,chip,p->status);
}

//Integral to compute lensing window function
//chi     -> comoving distance
//cosmo   -> ccl_cosmology object
//spl_pz  -> normalized N(z) spline
//chi_max -> maximum comoving distance to which the integral is computed
//win     -> result is stored here
static int window_lensing(double chi,ccl_cosmology *cosmo,SplPar *spl_pz,double chi_max,double *win)
{
  int gslstatus =0, status =0;
  double result,eresult;
  IntLensPar ip;
  gsl_function F;
  gsl_integration_workspace *w=gsl_integration_workspace_alloc(ccl_gsl->N_ITERATION);

  ip.chi=chi;
  ip.cosmo=cosmo;
  ip.spl_pz=spl_pz;
  ip.status = &status;
  F.function=&integrand_wl;
  F.params=&ip;
  // This conputes the lensing kernel:
  //   w_L(chi) = Integral[ dN/dchi(chi') * f(chi'-chi)/f(chi') , chi < chi' < chi_horizon ]
  // Where f(chi) is the comoving angular distance (which is just chi for zero curvature).
  gslstatus=gsl_integration_qag(&F, chi, chi_max, 0,
                                ccl_gsl->INTEGRATION_EPSREL, ccl_gsl->N_ITERATION,
                                ccl_gsl->INTEGRATION_GAUSS_KRONROD_POINTS,
                                w, &result, &eresult);
  *win=result;
  gsl_integration_workspace_free(w);
  if(gslstatus!=GSL_SUCCESS || *ip.status) {
    ccl_raise_gsl_warning(gslstatus, "ccl_cls.c: window_lensing():");
    return 1;
  }
  //TODO: chi_max should be changed to chi_horizon
  //we should precompute this quantity and store it in cosmo by default

  return 0;
}

//Params for lensing kernel integrand
typedef struct {
  double chi;
  SplPar *spl_pz;
  SplPar *spl_sz;
  ccl_cosmology *cosmo;
  int *status;
} IntMagPar;

//Integrand for magnification kernel
static double integrand_mag(double chip,void *params)
{
  IntMagPar *p=(IntMagPar *)params;
  double chi=p->chi;
  double a=ccl_scale_factor_of_chi(p->cosmo,chip, p->status);
  double z=1./a-1;
  double pz=ccl_spline_eval(z,p->spl_pz);
  double sz=ccl_spline_eval(z,p->spl_sz);
  double h=p->cosmo->params.h*ccl_h_over_h0(p->cosmo,a, p->status)/CLIGHT_HMPC;

  if(chi==0)
    return h*pz*(1-2.5*sz);
  else
    return h*pz*(1-2.5*sz)*ccl_sinn(p->cosmo,chip-chi,p->status)/ccl_sinn(p->cosmo,chip,p->status);
}

//Integral to compute magnification window function
//chi     -> comoving distance
//cosmo   -> ccl_cosmology object
//spl_pz  -> normalized N(z) spline
//spl_pz  -> magnification bias s(z)
//chi_max -> maximum comoving distance to which the integral is computed
//win     -> result is stored here
static int window_magnification(double chi,ccl_cosmology *cosmo,SplPar *spl_pz,SplPar *spl_sz,
				double chi_max,double *win)
{
  int gslstatus =0, status =0;
  double result,eresult;
  IntMagPar ip;
  gsl_function F;
  gsl_integration_workspace *w=gsl_integration_workspace_alloc(ccl_gsl->N_ITERATION);

  ip.chi=chi;
  ip.cosmo=cosmo;
  ip.spl_pz=spl_pz;
  ip.spl_sz=spl_sz;
  ip.status = &status;
  F.function=&integrand_mag;
  F.params=&ip;
  // This conputes the magnification lensing kernel:
  //   w_M(chi) = Integral[ dN/dchi(chi') * (1-5/2 * s(chi)) * f(chi'-chi)/f(chi') , chi < chi' < chi_horizon ]
  // Where f(chi) is the comoving angular distance (which is just chi for zero curvature)
  // and s(chi) is the magnification bias parameter.
  gslstatus=gsl_integration_qag(&F, chi, chi_max, 0,
                                ccl_gsl->INTEGRATION_EPSREL, ccl_gsl->N_ITERATION,
                                ccl_gsl->INTEGRATION_GAUSS_KRONROD_POINTS,
                                w, &result, &eresult);
  *win=result;
  gsl_integration_workspace_free(w);
  if(gslstatus!=GSL_SUCCESS || *ip.status) {
    ccl_raise_gsl_warning(gslstatus, "ccl_cls.c: window_magnification():");
    return 1;
  }
  //TODO: chi_max should be changed to chi_horizon
  //we should precompute this quantity and store it in cosmo by default

  return 0;
}

static void clt_init_nz(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int nz_n,double *z_n,double *n,int *status)
{
  int gslstatus;
  gsl_function F;
  double nz_norm,nz_enorm;
  double *nz_normalized;

  //Find redshift range where the N(z) has support
  get_support_interval(nz_n,z_n,n,CCL_FRAC_RELEVANT,&(clt->zmin),&(clt->zmax));
  clt->chimax=ccl_comoving_radial_distance(cosmo,1./(1+clt->zmax),status);
  clt->chimin=ccl_comoving_radial_distance(cosmo,1./(1+clt->zmin),status);
  clt->spl_nz=ccl_spline_init(nz_n,z_n,n,0,0);
  if(clt->spl_nz==NULL) {
    *status=CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_nz(): error initializing spline for N(z)\n");
  }

  if(*status==0) {
    //Normalize n(z)
    nz_normalized=(double *)malloc(nz_n*sizeof(double));
    if(nz_normalized==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_nz(): memory allocation\n");
      return;
    }
  }

  if(*status==0) {
    gsl_integration_workspace *w=gsl_integration_workspace_alloc(ccl_gsl->N_ITERATION);
    F.function=&speval_bis;
    F.params=clt->spl_nz;
    //Here we're just integrating the N(z) to normalize it to unit probability.
    gslstatus=gsl_integration_qag(&F, z_n[0], z_n[nz_n-1], 0,
				  ccl_gsl->INTEGRATION_EPSREL, ccl_gsl->N_ITERATION,
				  ccl_gsl->INTEGRATION_GAUSS_KRONROD_POINTS,
				  w, &nz_norm, &nz_enorm);
    gsl_integration_workspace_free(w);
    if(gslstatus!=GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_cls.c: clt_init_nz():");
      *status=CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_nz(): integration error when normalizing N(z)\n");
    }
  }

  if(*status==0) {
    for(int ii=0;ii<nz_n;ii++)
      nz_normalized[ii]=n[ii]/nz_norm;
    ccl_spline_free(clt->spl_nz);
    clt->spl_nz=ccl_spline_init(nz_n,z_n,nz_normalized,0,0);
    if(clt->spl_nz==NULL) {
      *status=CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_nz(): error initializing normalized spline for N(z)\n");
    }
  }

  free(nz_normalized);
}

static void clt_init_bz(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int nz_b,double *z_b,double *b,int *status)
{
  //Initialize bias spline
  clt->spl_bz=ccl_spline_init(nz_b,z_b,b,b[0],b[nz_b-1]);
  if(clt->spl_bz==NULL) {
    *status=CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_bz(): error initializing spline for b(z)\n");
  }
}

static void clt_init_wM(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int nz_s,double *z_s,double *s,int *status)
{
  //Compute magnification kernel
  int nchi;
  double *x,*y;
  double dchi_here=5.;
  double zmax=clt->spl_nz->xf;
  double chimax=ccl_comoving_radial_distance(cosmo,1./(1+zmax),status);
  //TODO: The interval in chi (5. Mpc) should be made a macro

  //In this case we need to integrate all the way to z=0. Reset zmin and chimin
  clt->zmin=0;
  clt->chimin=0;
  clt->spl_sz=ccl_spline_init(nz_s,z_s,s,s[0],s[nz_s-1]);
  if(clt->spl_sz==NULL) {
    *status=CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo,
				     "ccl_cls.c: clt_init_wM(): error initializing spline for s(z)\n");
  }

  if(*status==0) {
    nchi=(int)(chimax/dchi_here)+1;
    x=ccl_linear_spacing(0.,chimax,nchi);
    dchi_here=chimax/nchi;
    if(x==NULL || (fabs(x[0]-0)>1E-5) || (fabs(x[nchi-1]-chimax)>1e-5)) {
      *status=CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(cosmo,
				       "ccl_cls.c: clt_init_wM(): Error creating linear spacing in chi\n");
    }
  }

  if(*status==0) {
    y=(double *)malloc(nchi*sizeof(double));
    if(y==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_wM(): memory allocation\n");
    }
  }

  if(*status==0) {
    int clstatus=0;
    for(int j=0;j<nchi;j++)
      clstatus|=window_magnification(x[j],cosmo,clt->spl_nz,clt->spl_sz,chimax,&(y[j]));
    if(clstatus) {
      *status=CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_wM(): error computing lensing window\n");
    }
  }

  if(*status==0) {
    clt->spl_wM=ccl_spline_init(nchi,x,y,y[0],0);
    if(clt->spl_wM==NULL) {
      *status=CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo,
				       "ccl_cls.c: clt_init_wM(): error initializing spline for lensing window\n");
    }
  }
  free(x); free(y);
}

//CCL_ClTracer initializer for number counts
static void clt_nc_init(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int has_rsd,int has_magnification,
			int nz_n,double *z_n,double *n,
			int nz_b,double *z_b,double *b,
			int nz_s,double *z_s,double *s,int *status)
{
  clt->has_rsd=has_rsd;
  clt->has_magnification=has_magnification;

  if ( ((cosmo->params.N_nu_mass)>0) && clt->has_rsd){
    *status=CCL_ERROR_NOT_IMPLEMENTED;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_cl_tracer_new(): Number counts tracers with RSD not yet implemented in cosmologies with massive neutrinos.");
    return;
  }

  clt_init_nz(clt,cosmo,nz_n,z_n,n,status);
  clt_init_bz(clt,cosmo,nz_b,z_b,b,status);
  if(clt->has_magnification)
    clt_init_wM(clt,cosmo,nz_s,z_s,s,status);
}

static void clt_init_wL(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int *status)
{
  //Compute weak lensing kernel
  int nchi;
  double *x,*y;
  double dchi_here=5.;
  double zmax=clt->spl_nz->xf;
  double chimax=ccl_comoving_radial_distance(cosmo,1./(1+zmax),status);
  //TODO: The interval in chi (5. Mpc) should be made a macro

  //In this case we need to integrate all the way to z=0. Reset zmin and chimin
  clt->zmin=0;
  clt->chimin=0;
  nchi=(int)(chimax/dchi_here)+1;
  x=ccl_linear_spacing(0.,chimax,nchi);
  dchi_here=chimax/nchi;
  if(x==NULL || (fabs(x[0]-0)>1E-5) || (fabs(x[nchi-1]-chimax)>1e-5)) {
    *status=CCL_ERROR_LINSPACE;
    ccl_cosmology_set_status_message(cosmo,
				     "ccl_cls.c: clt_init_wL(): Error creating linear spacing in chi\n");
  }

  if(*status==0) {
    y=(double *)malloc(nchi*sizeof(double));
    if(y==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_wL(): memory allocation\n");
    }
  }

  if(*status==0) {
    int clstatus=0;
    for(int j=0;j<nchi;j++)
      clstatus|=window_lensing(x[j],cosmo,clt->spl_nz,chimax,&(y[j]));
    if(clstatus) {
      *status=CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_wL(): error computing lensing window\n");
    }
  }

  if(*status==0) {
    clt->spl_wL=ccl_spline_init(nchi,x,y,y[0],0);
    if(clt->spl_wL==NULL) {
      *status=CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo,
				     "ccl_cls.c: clt_init_wL(): error initializing spline for lensing window\n");
    }
  }
  free(x); free(y);
}

static void clt_init_rf(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int nz_rf,double *z_rf,double *rf,int *status)
{
  //Initialize bias spline
  clt->spl_rf=ccl_spline_init(nz_rf,z_rf,rf,rf[0],rf[nz_rf-1]);
  if(clt->spl_rf==NULL) {
    *status=CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_rf(): error initializing spline for b(z)\n");
  }
}

static void clt_init_ba(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int nz_ba,double *z_ba,double *ba,int *status)
{
  //Initialize bias spline
  clt->spl_ba=ccl_spline_init(nz_ba,z_ba,ba,ba[0],ba[nz_ba-1]);
  if(clt->spl_ba==NULL) {
    *status=CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: clt_init_ba(): error initializing spline for b(z)\n");
  }
}

static void clt_wl_init(CCL_ClTracer *clt,ccl_cosmology *cosmo,
			int has_intrinsic_alignment,
			int nz_n,double *z_n,double *n,
			int nz_ba,double *z_ba,double *ba,
			int nz_rf,double *z_rf,double *rf,int *status)
{
  clt->has_intrinsic_alignment=has_intrinsic_alignment;

  clt_init_nz(clt,cosmo,nz_n,z_n,n,status);
  clt_init_wL(clt,cosmo,status);
  if(clt->has_intrinsic_alignment) {
    clt_init_rf(clt,cosmo,nz_rf,z_rf,rf,status);
    clt_init_ba(clt,cosmo,nz_ba,z_ba,ba,status);
  }
}

//CCL_ClTracer creator
//cosmo   -> ccl_cosmology object
//tracer_type -> type of tracer. Supported: ccl_number_counts_tracer, ccl_weak_lensing_tracer
//nz_n -> number of points for N(z)
//z_n  -> array of z-values for N(z)
//n    -> corresponding N(z)-values. Normalization is irrelevant
//        N(z) will be set to zero outside the range covered by z_n
//nz_b -> number of points for b(z)
//z_b  -> array of z-values for b(z)
//b    -> corresponding b(z)-values.
//        b(z) will be assumed constant outside the range covered by z_n
static CCL_ClTracer *cl_tracer(ccl_cosmology *cosmo,int tracer_type,
			       int has_rsd,int has_magnification,int has_intrinsic_alignment,
			       int nz_n,double *z_n,double *n,
			       int nz_b,double *z_b,double *b,
			       int nz_s,double *z_s,double *s,
			       int nz_ba,double *z_ba,double *ba,
			       int nz_rf,double *z_rf,double *rf,
			       double z_source, int * status)
{
  int clstatus=0;
  CCL_ClTracer *clt=(CCL_ClTracer *)malloc(sizeof(CCL_ClTracer));
  if(clt==NULL) {
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_cl_tracer(): memory allocation\n");
  }

  if(*status==0) {
    clt->tracer_type=tracer_type;

    double hub=cosmo->params.h*ccl_h_over_h0(cosmo,1.,status)/CLIGHT_HMPC;
    clt->prefac_lensing=1.5*hub*hub*cosmo->params.Omega_m;

    if(tracer_type==ccl_number_counts_tracer)
      clt_nc_init(clt,cosmo,has_rsd,has_magnification,
		  nz_n,z_n,n,nz_b,z_b,b,nz_s,z_s,s,status);
    else if(tracer_type==ccl_weak_lensing_tracer)
      clt_wl_init(clt,cosmo,has_intrinsic_alignment,
		  nz_n,z_n,n,nz_ba,z_ba,ba,nz_rf,z_rf,rf,status);
    else if(tracer_type==ccl_cmb_lensing_tracer) {
      clt->chi_source=ccl_comoving_radial_distance(cosmo,1./(1+z_source),status);
      clt->chimax=clt->chi_source;
      clt->chimin=0;
    }
    else {
      free(clt);
      *status=CCL_ERROR_INCONSISTENT;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_cl_tracer(): unknown tracer type\n");
      return NULL;
    }
  }

  if(*status) {
    free(clt);
    clt=NULL;
  }

  return clt;
}

//CCL_ClTracer constructor with error checking
//cosmo   -> ccl_cosmology object
//tracer_type -> type of tracer. Supported: ccl_number_counts_tracer, ccl_weak_lensing_tracer
//nz_n -> number of points for N(z)
//z_n  -> array of z-values for N(z)
//n    -> corresponding N(z)-values. Normalization is irrelevant
//        N(z) will be set to zero outside the range covered by z_n
//nz_b -> number of points for b(z)
//z_b  -> array of z-values for b(z)
//b    -> corresponding b(z)-values.
//        b(z) will be assumed constant outside the range covered by z_n
CCL_ClTracer *ccl_cl_tracer(ccl_cosmology *cosmo,int tracer_type,
				int has_rsd,int has_magnification,int has_intrinsic_alignment,
				int nz_n,double *z_n,double *n,
				int nz_b,double *z_b,double *b,
				int nz_s,double *z_s,double *s,
				int nz_ba,double *z_ba,double *ba,
				int nz_rf,double *z_rf,double *rf,
				double z_source, int * status)
{
  CCL_ClTracer *clt=cl_tracer(cosmo,tracer_type,has_rsd,has_magnification,has_intrinsic_alignment,
			      nz_n,z_n,n,nz_b,z_b,b,nz_s,z_s,s,
			      nz_ba,z_ba,ba,nz_rf,z_rf,rf,z_source,status);
  ccl_check_status(cosmo,status);
  return clt;
}

//CCL_ClTracer destructor
void ccl_cl_tracer_free(CCL_ClTracer *clt)
{
  if((clt->tracer_type==ccl_number_counts_tracer) || (clt->tracer_type==ccl_weak_lensing_tracer))
    ccl_spline_free(clt->spl_nz);

  if(clt->tracer_type==ccl_number_counts_tracer) {
    ccl_spline_free(clt->spl_bz);
    if(clt->has_magnification) {
      ccl_spline_free(clt->spl_sz);
      ccl_spline_free(clt->spl_wM);
    }
  }
  else if(clt->tracer_type==ccl_weak_lensing_tracer) {
    ccl_spline_free(clt->spl_wL);
    if(clt->has_intrinsic_alignment) {
      ccl_spline_free(clt->spl_ba);
      ccl_spline_free(clt->spl_rf);
    }
  }
  free(clt);
}

CCL_ClTracer *ccl_cl_tracer_cmblens(ccl_cosmology *cosmo,double z_source,int *status)
{
  return ccl_cl_tracer(cosmo,ccl_cmb_lensing_tracer,
			   0,0,0,
			   0,NULL,NULL,0,NULL,NULL,0,NULL,NULL,
			   0,NULL,NULL,0,NULL,NULL,z_source,status);
}

CCL_ClTracer *ccl_cl_tracer_number_counts(ccl_cosmology *cosmo,
					      int has_rsd,int has_magnification,
					      int nz_n,double *z_n,double *n,
					      int nz_b,double *z_b,double *b,
					      int nz_s,double *z_s,double *s, int * status)
{
  return ccl_cl_tracer(cosmo,ccl_number_counts_tracer,has_rsd,has_magnification,0,
			   nz_n,z_n,n,nz_b,z_b,b,nz_s,z_s,s,
			   -1,NULL,NULL,-1,NULL,NULL,0, status);
}

CCL_ClTracer *ccl_cl_tracer_number_counts_simple(ccl_cosmology *cosmo,
						     int nz_n,double *z_n,double *n,
						     int nz_b,double *z_b,double *b, int * status)
{
  return ccl_cl_tracer(cosmo,ccl_number_counts_tracer,0,0,0,
			   nz_n,z_n,n,nz_b,z_b,b,-1,NULL,NULL,
			   -1,NULL,NULL,-1,NULL,NULL,0, status);
}

CCL_ClTracer *ccl_cl_tracer_lensing(ccl_cosmology *cosmo,
					int has_alignment,
					int nz_n,double *z_n,double *n,
					int nz_ba,double *z_ba,double *ba,
					int nz_rf,double *z_rf,double *rf, int * status)
{
  return ccl_cl_tracer(cosmo,ccl_weak_lensing_tracer,0,0,has_alignment,
			   nz_n,z_n,n,-1,NULL,NULL,-1,NULL,NULL,
			   nz_ba,z_ba,ba,nz_rf,z_rf,rf,0, status);
}

CCL_ClTracer *ccl_cl_tracer_lensing_simple(ccl_cosmology *cosmo,
					       int nz_n,double *z_n,double *n, int * status)
{
  return ccl_cl_tracer(cosmo,ccl_weak_lensing_tracer,0,0,0,
			   nz_n,z_n,n,-1,NULL,NULL,-1,NULL,NULL,
			   -1,NULL,NULL,-1,NULL,NULL,0, status);
}

static double f_dens(double a,ccl_cosmology *cosmo,CCL_ClTracer *clt, int * status)
{
  double z=1./a-1;
  double pz=ccl_spline_eval(z,clt->spl_nz);
  double bz=ccl_spline_eval(z,clt->spl_bz);
  double h=cosmo->params.h*ccl_h_over_h0(cosmo,a,status)/CLIGHT_HMPC;

  return pz*bz*h;
}

static double f_rsd(double a,ccl_cosmology *cosmo,CCL_ClTracer *clt, int * status)
{
  double z=1./a-1;
  double pz=ccl_spline_eval(z,clt->spl_nz);
  double fg=ccl_growth_rate(cosmo,a,status);
  double h=cosmo->params.h*ccl_h_over_h0(cosmo,a,status)/CLIGHT_HMPC;

  return pz*fg*h;
}

static double f_mag(double a,double chi,ccl_cosmology *cosmo,CCL_ClTracer *clt, int * status)
{
  double wM=ccl_spline_eval(chi,clt->spl_wM);

  if(wM<=0)
    return 0;
  else
    return wM/(a*chi);
}

//Transfer function for number counts
//l -> angular multipole
//k -> wavenumber modulus
//cosmo -> ccl_cosmology object
//w -> CCL_ClWorskpace object
//clt -> CCL_ClTracer object (must be of the ccl_number_counts_tracer type)
static double transfer_nc(int l,double k,
			  ccl_cosmology *cosmo,CCL_ClWorkspace *w,CCL_ClTracer *clt, int * status)
{
  double ret=0;
  double x0=(l+0.5);
  double chi0=x0/k;
  if(chi0<=clt->chimax) {
    double a0=ccl_scale_factor_of_chi(cosmo,chi0,status);
    double f_all=f_dens(a0,cosmo,clt,status);
    if(clt->has_rsd) {
      double x1=(l+1.5);
      double chi1=x1/k;
      if(chi1<=clt->chimax) {
	double a1=ccl_scale_factor_of_chi(cosmo,chi1,status);
	double pk0=ccl_nonlin_matter_power(cosmo,k,a0,status);
	double pk1=ccl_nonlin_matter_power(cosmo,k,a1,status);
	double fg0=f_rsd(a0,cosmo,clt,status);
	double fg1=f_rsd(a1,cosmo,clt,status);
	f_all+=fg0*(1.-l*(l-1.)/(x0*x0))-fg1*2.*sqrt((l+0.5)*pk1/((l+1.5)*pk0))/x1;
      }
    }
    if(clt->has_magnification)
      f_all+=-2*clt->prefac_lensing*l*(l+1)*f_mag(a0,chi0,cosmo,clt,status)/(k*k);
    ret=f_all;
  }

  return ret;
}

static double f_lensing(double a,double chi,ccl_cosmology *cosmo,CCL_ClTracer *clt, int * status)
{
  double wL=ccl_spline_eval(chi,clt->spl_wL);

  if(wL<=0)
    return 0;
  else
    return clt->prefac_lensing*wL/(a*chi);
}

static double f_IA_NLA(double a,double chi,ccl_cosmology *cosmo,CCL_ClTracer *clt, int * status)
{
  if(chi<=1E-10)
    return 0;
  else {
    double a=ccl_scale_factor_of_chi(cosmo,chi, status);
    double z=1./a-1;
    double pz=ccl_spline_eval(z,clt->spl_nz);
    double ba=ccl_spline_eval(z,clt->spl_ba);
    double rf=ccl_spline_eval(z,clt->spl_rf);
    double h=cosmo->params.h*ccl_h_over_h0(cosmo,a,status)/CLIGHT_HMPC;

    return pz*ba*rf*h/(chi*chi);
  }
}

//Transfer function for shear
//l -> angular multipole
//k -> wavenumber modulus
//cosmo -> ccl_cosmology object
//w -> CCL_ClWorskpace object
//clt -> CCL_ClTracer object (must be of the ccl_weak_lensing_tracer type)
static double transfer_wl(int l,double k,
			  ccl_cosmology *cosmo,CCL_ClWorkspace *w,CCL_ClTracer *clt, int * status)
{
  double ret=0;
  double chi=(l+0.5)/k;
  if(chi<=clt->chimax) {
    double a=ccl_scale_factor_of_chi(cosmo,chi,status);
    double f_all=f_lensing(a,chi,cosmo,clt,status);
    if(clt->has_intrinsic_alignment)
      f_all+=f_IA_NLA(a,chi,cosmo,clt,status);

    ret=f_all;
  }

  return sqrt((l+2.)*(l+1.)*l*(l-1.))*ret/(k*k);
  //return (l+1.)*l*ret/(k*k);
}

static double transfer_cmblens(int l,double k,ccl_cosmology *cosmo,CCL_ClTracer *clt,int *status)
{
  double chi=(l+0.5)/k;
  if(chi>=clt->chi_source)
    return 0;

  if(chi<=clt->chimax) {
    double a=ccl_scale_factor_of_chi(cosmo,chi,status);
    double w=1-chi/clt->chi_source;
    return clt->prefac_lensing*l*(l+1.)*w/(a*chi*k*k);
  }
  return 0;
}

//Wrapper for transfer function
//l -> angular multipole
//k -> wavenumber modulus
//cosmo -> ccl_cosmology object
//clt -> CCL_ClTracer object
static double transfer_wrap(int il,double lk,ccl_cosmology *cosmo,
			    CCL_ClWorkspace *w,CCL_ClTracer *clt, int * status)
{
  double transfer_out=0;
  double k=pow(10.,lk);

  if(clt->tracer_type==ccl_number_counts_tracer)
    transfer_out=transfer_nc(w->l_arr[il],k,cosmo,w,clt,status);
  else if(clt->tracer_type==ccl_weak_lensing_tracer)
    transfer_out=transfer_wl(w->l_arr[il],k,cosmo,w,clt,status);
  else if(clt->tracer_type==ccl_cmb_lensing_tracer)
    transfer_out=transfer_cmblens(w->l_arr[il],k,cosmo,clt,status);
  else
    transfer_out=-1;
  return transfer_out;
}

//Params for power spectrum integrand
typedef struct {
  int il;
  ccl_cosmology *cosmo;
  CCL_ClWorkspace *w;
  CCL_ClTracer *clt1;
  CCL_ClTracer *clt2;
  int *status;
} IntClPar;

//Integrand for integral power spectrum
static double cl_integrand(double lk,void *params)
{
  double d1,d2;
  IntClPar *p=(IntClPar *)params;
  d1=transfer_wrap(p->il,lk,p->cosmo,p->w,p->clt1,p->status);
  if(d1==0)
    return 0;
  d2=transfer_wrap(p->il,lk,p->cosmo,p->w,p->clt2,p->status);
  if(d2==0)
    return 0;

  double k=pow(10.,lk);
  double chi=(p->w->l_arr[p->il]+0.5)/k;
  double a=ccl_scale_factor_of_chi(p->cosmo,chi,p->status);
  double pk=ccl_nonlin_matter_power(p->cosmo,k,a,p->status);

  return k*pk*d1*d2;
}

//Figure out k intervals where the Limber kernel has support
//clt1 -> tracer #1
//clt2 -> tracer #2
//l    -> angular multipole
//lkmin, lkmax -> log10 of the range of scales where the transfer functions have support
static void get_k_interval(ccl_cosmology *cosmo,CCL_ClWorkspace *w,
			   CCL_ClTracer *clt1,CCL_ClTracer *clt2,int l,
			   double *lkmin,double *lkmax)
{
  double chimin,chimax;
  int cut_low_1=0,cut_low_2=0;

  //Define a minimum distance only if no lensing is needed
  if((clt1->tracer_type==ccl_number_counts_tracer) && (clt1->has_magnification==0)) cut_low_1=1;
  if((clt2->tracer_type==ccl_number_counts_tracer) && (clt2->has_magnification==0)) cut_low_2=1;

  if(cut_low_1) {
    if(cut_low_2) {
      chimin=fmax(clt1->chimin,clt2->chimin);
      chimax=fmin(clt1->chimax,clt2->chimax);
    }
    else {
      chimin=clt1->chimin;
      chimax=clt1->chimax;
    }
  }
  else if(cut_low_2) {
    chimin=clt2->chimin;
    chimax=clt2->chimax;
  }
  else {
    chimin=0.5*(l+0.5)/ccl_splines->K_MAX;
    chimax=2*(l+0.5)/ccl_splines->K_MIN;
  }

  if(chimin<=0)
    chimin=0.5*(l+0.5)/ccl_splines->K_MAX;

  *lkmax=log10(fmin( ccl_splines->K_MAX  ,2  *(l+0.5)/chimin));
  *lkmin=log10(fmax( ccl_splines->K_MIN  ,0.5*(l+0.5)/chimax));
}

//Compute angular power spectrum between two bins
//cosmo -> ccl_cosmology object
//il -> index in angular multipole array
//clt1 -> tracer #1
//clt2 -> tracer #2
static double ccl_angular_cl_native(ccl_cosmology *cosmo,CCL_ClWorkspace *cw,int il,
				    CCL_ClTracer *clt1,CCL_ClTracer *clt2,int * status)
{
  int clastatus=0, gslstatus;
  IntClPar ipar;
  double result=0,eresult;
  double lkmin,lkmax;
  gsl_function F;
  gsl_integration_workspace *w=gsl_integration_workspace_alloc(ccl_gsl->N_ITERATION);

  ipar.il=il;
  ipar.cosmo=cosmo;
  ipar.w=cw;
  ipar.clt1=clt1;
  ipar.clt2=clt2;
  ipar.status = &clastatus;
  F.function=&cl_integrand;
  F.params=&ipar;
  get_k_interval(cosmo,cw,clt1,clt2,cw->l_arr[il],&lkmin,&lkmax);
  // This computes the angular power spectra in the Limber approximation between two quantities a and b:
  //  C_ell^ab = 2/(2*ell+1) * Integral[ Delta^a_ell(k) Delta^b_ell(k) * P(k) , k_min < k < k_max ]
  // Note that we use log10(k) as an integration variable, and the ell-dependent prefactor is included
  // at the end of this function.
  gslstatus=gsl_integration_qag(&F, lkmin, lkmax, 0,
                                ccl_gsl->INTEGRATION_LIMBER_EPSREL, ccl_gsl->N_ITERATION,
                                ccl_gsl->INTEGRATION_LIMBER_GAUSS_KRONROD_POINTS,
                                w, &result, &eresult);
  gsl_integration_workspace_free(w);

  // Test if a round-off error occured in the evaluation of the integral
  // If so, try another integration function, more robust but potentially slower
  if(gslstatus == GSL_EROUND) {
    ccl_raise_gsl_warning(gslstatus, "ccl_cls.c: ccl_angular_cl_native(): Default GSL integration failure, attempting backup method.");
    gsl_integration_cquad_workspace *w_cquad= gsl_integration_cquad_workspace_alloc (ccl_gsl->N_ITERATION);
    size_t nevals=0;
    gslstatus=gsl_integration_cquad(&F, lkmin, lkmax, 0,
				    ccl_gsl->INTEGRATION_LIMBER_EPSREL,
				    w_cquad, &result, &eresult, &nevals);
    gsl_integration_cquad_workspace_free(w_cquad);
  }
  if(gslstatus!=GSL_SUCCESS || *ipar.status) {
    ccl_raise_gsl_warning(gslstatus, "ccl_cls.c: ccl_angular_cl_native():");
    // If an error status was already set, don't overwrite it.
    if(*status == 0){
        *status=CCL_ERROR_INTEG;
        ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_angular_cl_native(): error integrating over k\n");
    }
    return -1;
  }
  ccl_check_status(cosmo,status);

  return result*M_LN10/(cw->l_arr[il]+0.5);
}

void ccl_angular_cls(ccl_cosmology *cosmo,CCL_ClWorkspace *w,
		     CCL_ClTracer *clt1,CCL_ClTracer *clt2,
		     int nl_out,int *l_out,double *cl_out,int *status)
{
  int ii,do_angpow;
  double *l_nodes,*cl_nodes;
  SplPar *spcl_nodes;

  //First check if ell range is within workspace
  for(ii=0;ii<nl_out;ii++) {
    if(l_out[ii]>w->lmax) {
      *status=CCL_ERROR_SPLINE_EV;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_angular_cls(); "
	     "requested l beyond range allowed by workspace\n");
      return;
    }
  }

  if(*status==0) {
    //Allocate array for power spectrum at interpolation nodes
    l_nodes=(double *)malloc(w->n_ls*sizeof(double));
    if(l_nodes==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_angular_cls(); memory allocation\n");
    }
  }

  if(*status==0) {
    cl_nodes=(double *)malloc(w->n_ls*sizeof(double));
    if(cl_nodes==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_cl_angular_cls(); memory allocation\n");
    }
  }

  if(*status==0) {
    for(ii=0;ii<w->n_ls;ii++)
      l_nodes[ii]=(double)(w->l_arr[ii]);

    do_angpow=0;
    //Now check if angpow is needed at all
    if(w->l_limber>0) {
      for(ii=0;ii<w->n_ls;ii++) {
	if(w->l_arr[ii]<=w->l_limber)
	  do_angpow=1;
      }
    }
#ifndef HAVE_ANGPOW
    do_angpow=0;
#endif //HAVE_ANGPOW

    //Resort to Limber if we have lensing (this will hopefully only be temporary)
    if(clt1->tracer_type==ccl_weak_lensing_tracer || clt2->tracer_type==ccl_weak_lensing_tracer ||
       clt1->has_magnification || clt2->has_magnification) {
      do_angpow=0;
    }

    //Use angpow if non-limber is needed
    if(do_angpow)
      ccl_angular_cls_angpow(cosmo,w,clt1,clt2,cl_nodes,status);
    ccl_check_status(cosmo,status);
  }

  if(*status==0) {
    //Compute limber nodes
    for(ii=0;ii<w->n_ls;ii++) {
      if((!do_angpow) || (w->l_arr[ii]>w->l_limber))
	cl_nodes[ii]=ccl_angular_cl_native(cosmo,w,ii,clt1,clt2,status);
    }

    //Interpolate into ells requested by user
    spcl_nodes=ccl_spline_init(w->n_ls,l_nodes,cl_nodes,0,0);
    if(spcl_nodes==NULL) {
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: ccl_cl_angular_cls(); memory allocation\n");
    }
  }

  if(*status==0) {
    for(ii=0;ii<nl_out;ii++)
      cl_out[ii]=ccl_spline_eval((double)(l_out[ii]),spcl_nodes);
  }

  //Cleanup
  ccl_spline_free(spcl_nodes);
  free(cl_nodes);
  free(l_nodes);
}

static int check_clt_fa_inconsistency(CCL_ClTracer *clt,int func_code)
{
  if(((func_code==ccl_trf_nz) && (clt->tracer_type==ccl_cmb_lensing_tracer)) || //lensing has no n(z)
     (((func_code==ccl_trf_bz) || (func_code==ccl_trf_sz) || (func_code==ccl_trf_wM)) &&
      (clt->tracer_type!=ccl_number_counts_tracer)) || //bias and magnification only for clustering
     (((func_code==ccl_trf_rf) || (func_code==ccl_trf_ba) || (func_code==ccl_trf_wL)) &&
      (clt->tracer_type!=ccl_weak_lensing_tracer))) //IAs only for weak lensing
    return 1;
  if((((func_code==ccl_trf_sz) || (func_code==ccl_trf_wM)) &&
      (clt->has_magnification==0)) || //correct combination, but no magnification
     (((func_code==ccl_trf_rf) || (func_code==ccl_trf_ba)) &&
      (clt->has_intrinsic_alignment==0))) //Correct combination, but no IAs
    return 1;
  return 0;
}

double ccl_get_tracer_fa(ccl_cosmology *cosmo,CCL_ClTracer *clt,double a,int func_code,int *status)
{
  SplPar *spl;

  if(check_clt_fa_inconsistency(clt,func_code)) {
    *status=CCL_ERROR_INCONSISTENT;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: inconsistent combination of tracer and internal function to be evaluated");
    return -1;
  }

  switch(func_code) {
  case ccl_trf_nz :
    spl=clt->spl_nz;
    break;
  case ccl_trf_bz :
    spl=clt->spl_bz;
    break;
  case ccl_trf_sz :
    spl=clt->spl_sz;
    break;
  case ccl_trf_rf :
    spl=clt->spl_rf;
    break;
  case ccl_trf_ba :
    spl=clt->spl_ba;
    break;
  case ccl_trf_wL :
    spl=clt->spl_wL;
    break;
  case ccl_trf_wM :
    spl=clt->spl_wM;
    break;
  }

  double x;
  if((func_code==ccl_trf_wL) || (func_code==ccl_trf_wM))
    x=ccl_comoving_radial_distance(cosmo,a,status); //x-variable is comoving distance for lensing kernels
  else
    x=1./a-1; //x-variable is redshift by default

  return ccl_spline_eval(x,spl);
}

int ccl_get_tracer_fas(ccl_cosmology *cosmo,CCL_ClTracer *clt,int na,double *a,double *fa,
		       int func_code,int *status)
{
  SplPar *spl;

  if(check_clt_fa_inconsistency(clt,func_code)) {
    *status=CCL_ERROR_INCONSISTENT;
    ccl_cosmology_set_status_message(cosmo, "ccl_cls.c: inconsistent combination of tracer and internal function to be evaluated");
    return -1;
  }

  switch(func_code) {
  case ccl_trf_nz :
    spl=clt->spl_nz;
    break;
  case ccl_trf_bz :
    spl=clt->spl_bz;
    break;
  case ccl_trf_sz :
    spl=clt->spl_sz;
    break;
  case ccl_trf_rf :
    spl=clt->spl_rf;
    break;
  case ccl_trf_ba :
    spl=clt->spl_ba;
    break;
  case ccl_trf_wL :
    spl=clt->spl_wL;
    break;
  case ccl_trf_wM :
    spl=clt->spl_wM;
    break;
  }

  int compchi = (func_code==ccl_trf_wL) || (func_code==ccl_trf_wM);

  int ia;
  for(ia=0;ia<na;ia++) {
    double x;
    if(compchi) //x-variable is comoving distance for lensing kernels
      x=ccl_comoving_radial_distance(cosmo,a[ia],status);
    else //x-variable is redshift by default
      x=1./a[ia]-1;
    fa[ia]=ccl_spline_eval(x,spl);
  }

  return 0;
}


#ifndef INFMCMC_H
#define INFMCMC_H

#include <complex.h>
#include <fftw3.h>
#include <gsl/gsl_rng.h>

//void sampleRMWH(CHAIN *C);
//void sampleIndependenceSampler(CHAIN *C);
//void updateMean(CHAIN *C);
//void updateVar(CHAIN *C);

struct _CHAIN {
  int nj, nk; // number of Fourier coefficients in x/y direction respectively
  int numKeptSamples;
  int sizeObsVector;
  int currentIter;
  int accepted;
  double _shortTimeAccProbAvg;
  double _bLow, _bHigh;

  double *currentPhysicalState, *avgPhysicalState, *varPhysicalState, *_M2;
  double *proposedPhysicalState;
  double logLHDCurrentState;
  double accProb, avgAccProb;
  double rwmhStepSize, alphaPrior, priorVar, priorStd;

  // -- potentially not used --
  double *currentStateObservations, *proposedStateObservations;
  double *data;
  double currentLSQFunctional;
  double currentStateL2Norm2;
  double obsStdDev;
  // --------------------------

  fftw_complex *currentSpectralState, *avgSpectralState;
  fftw_complex *priorDraw, *proposedSpectralState;

  fftw_plan _c2r;
  fftw_plan _r2c;

  gsl_rng *r;
};

typedef struct _CHAIN CHAIN;
typedef struct _CHAIN INFCHAIN;

void infmcmc_initChain(INFCHAIN *C, const int nj, const int nk);
void infmcmc_freeChain(INFCHAIN *C);
void infmcmc_resetChain(INFCHAIN *C);
void infmcmc_proposeRWMH(INFCHAIN *C);
void infmcmc_updateRWMH(INFCHAIN *C, double logLHDOfProposal);
void infmcmc_seedWithPriorDraw(INFCHAIN *C);
void infmcmc_writeChainInfo(const INFCHAIN *C, FILE *fp);
void infmcmc_writeVFChain(const INFCHAIN *U, const INFCHAIN *V, FILE *fp);
void infmcmc_writeChain(const INFCHAIN *C, FILE *fp);
void infmcmc_printChain(INFCHAIN *C);
void infmcmc_setRWMHStepSize(INFCHAIN *C, double beta);
void infmcmc_adaptRWMHStepSize(INFCHAIN *C, double inc);
void infmcmc_setPriorAlpha(INFCHAIN *C, double alpha);
void infmcmc_setPriorVar(INFCHAIN *C, double var);
double infmcmc_L2Current(INFCHAIN *C);
double infmcmc_L2Proposed(INFCHAIN *C);
double infmcmc_L2Prior(INFCHAIN *C);

void infmcmc_seedWithDivFreePriorDraw(INFCHAIN *C1, INFCHAIN *C2);
void infmcmc_proposeDivFreeRWMH(INFCHAIN *C1, INFCHAIN *C2);
void infmcmc_updateVectorFieldRWMH(INFCHAIN *C1, INFCHAIN *C2, double logLHDOfProposal);

void randomPriorDrawOLD(gsl_rng *r, double PRIOR_ALPHA, fftw_complex *randDrawCoeffs);

#endif


/*
 * File: spce_sect.h
 * External definitions for spce_sect.c
 *
 *
 */

#ifndef spce_sect_H
#define spce_sect_H

#include <math.h>
#include <gsl/gsl_roots.h>
#include "aXe_grism.h"
#include "spc_trace_functions.h"

/**
  @package spce_sect
*/

/**
    A structure to support old gsl 0.9 gsl_interval
*/
typedef struct
{
     double lower;
     double upper;
}
gsl_interval;

/**
  A structure describing the function that has a zero at the section point,
  including the measuring point and the slope of the line through it,
  the function describing the spectrum trace, functions related to
  gsl and a flag to initiate special handling of vertically oriented
  objects.

  @see fill_in_sectionfun
  @see free_sectionfun
*/
typedef struct
{
  int vertical;	     /* Special handling if orientation is close to vertical */
  double m;	     /* slope of line through x0, y0 that is to */
  double x0, y0;     /* intersect the trace */
  trace_func *func;  /* Parametrization of the trace */

     /* the GSL stuff has to be kept in here to avoid excessive re-allocing
        of the solver for each pixel */
  gsl_interval *interv;
  gsl_function *gslfun;
  gsl_root_fsolver *solver;
}
sectionfun;

/* public */

int fill_in_sectionfun (sectionfun * const sf, const double inclination,
			const beam * const b);
int find_section_point (sectionfun *sf, const double x, const double y,
			double *const res);
void free_sectionfun (sectionfun * const sf);
#endif


/////////////////
//example25.5.c
/////////////////
#include <stdio.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_odeiv.h>
#include <math.h>

typedef struct{
  double *a; //y=a[0]x[0]+a[1]x[1]+...a[ka]y[ka]+b[0]u[0]+b[1]u[1]+...+b[kb]u[kb]
  //  double *a; //y[t+1]=a[0]y[t]+a[1]y[t-1]+...a[ka]y[t-ka]+b[0]u[t]+b[1]u[t-1]+...+b[kb]u[t-kb]
  double *b;
  double *x;
  double *u;
  int k,kx,ku;
  double xmax;
  double umax;
  double y;
  int _dim;
  double *_y;
  double *_y_err;
  double *_dydt_in;
  double *_dydt_out;
  double _t;
} CRANE;

#define dim_crane 4
int cranefunc (double t, const double y[], double f[], void *params)
{
  CRANE *c = (CRANE *)params;
  f[0] = y[1];
  f[1] = (-(2*c->dr+c->C)*y[1] -c->ddX*cos(y[0]) -c->g*sin(y[0]))/c->r;
  f[2] = y[3];
  f[3] = (c->F+c->T*sin(y[0]))/c->M;
  return GSL_SUCCESS;
}
////////////////
#define square(x) ((x)*(x))
CRANE crane;
int initialize()
{
  crane.kx=3;
  crane.ku=1;
  crane.k=crane.kx+ku;
  double *a=(double*)malloc(sizeof(double)*ka);
  double *b=&a[kx];
  double *x=(double*)malloc(sizeof(double)*k+1);
  double *u=&x[kx];
  crane.umax=20.0;//check//  crane.Fmax=30;//check

#ifdef CRANESUB
  //  crane.Fmax=_crane_Fmax;//check//  crane.Fmax=30;//check
  //  crane.xmax=20.0;//check//  crane.Fmax=30;//check
  if(_AP_umax>0) AP_u_max=crane.umax=_AP_umax;
  else AP_u_max=crane.umax;

  AP_u_min=-AP_u_max;
  rr=AP_r=_AP_r;//10
  rr_kyoyou=_rr_kyoyou;
  C_MODE=11;
#else
  crane.h=0.01;
#endif
  crane._t=0;
  int i;for(i=0;i<crane._dim;i++) crane._dydt_in[i]=0;

  return(0);
}
#ifndef CRANESUB
char *fn="crane2io.dat";
FILE *fp;
#endif//#ifndef CRANESUB

double plant(double uu)
{
  //store previous x and u
  int i,kx_1=crane.kx-1;
  for(i=0;i<kx_1;i++) crane.x[i+1]=crane.x[i];
  int ku_1=crane.ku-1;
  for(i=0;i<ku_1;i++) crane.u[i+1]=crane.u[i];
  //store former output
  crane.x[0]=crane.y;

  //current input
  if(uu>crane.umax) crane.u[0]=crane.umax;
  else if(uu<-crane.umax) crane.u[0]=-crane.umax;
  // current output
  crane.y=0;
  for(i=0;i<crane.k;i++) crane.y+=crane.a[i]*crane.x[i];
  crane._t++;

#ifndef CRANESUB
  fprintf(fp,"%.7e %.7e %.7e %.7e", crane._t,crane.u[0],crane.x[0],crane.y);//crane.a,crane.da
  fprintf(fp,"\n");
#endif
  return(crane.x);
  //  return(crane.X);
}

#ifndef CRANESUB
int main()
{
  ////////////////////////////////////////////////////
  /// method 1                                     ///
  /// input ddX                                    ///
  /// output a,x,y,F                               ///
  ////////////////////////////////////////////////////
  //  double h = 0.001;//,hh=0.1; h = 0.0001;//,hh=0.1;
  double t0=5;     //stationary
  double t1=5.0+t0;//accelerate(speed up)
  double t2=2.0+t1;//free run
  double t3=5.0+t2;//decelerate(slow down)
  double t4=20+t3;   //free run
  initialize();
  int M=(t4/crane.h)+1;
  double *ddX=(double*)malloc(sizeof(double)*M);
  //  double *F  =(double*)malloc(sizeof(double)*M);
  double Vmax=1;//dX/dt=1[m/s]

  int n;
  double t;
  ////////////////////////////////////////////////////
  ///   set ddX                                    ///
  ////////////////////////////////////////////////////
  int n0 =t0/crane.h+0.5, n4=t4/crane.h+0.5;
  for(t=0;t<t4;t+=crane.h){
    n=t/crane.h;
    if(t<=t0) ddX[n]=0; //zero
    else if(t<=t1) ddX[n]=Vmax/(t1-t0); //accelerate
    else if(t<=t2) ddX[n]=0;            //free move
    else if(t<=t3) ddX[n]=-Vmax/(t3-t2);//decelerate
    else ddX[n]=0;                      //free move
  }
  ////////////////////////////////////////////////////
  ///   Solve by the Runge Kutta Method of GSL     ///
  ////////////////////////////////////////////////////
  fp=fopen(fn,"w");
  fprintf(fp,"#%.7e %d %d %.7e %.7e %.7e %.7e #h,n0,n4,M,n,r\n",crane.h,n0,n4,crane.M,crane.m,crane.r,crane.C);
  //  double dx0=0,dy0=0,da0=0;
  //  for(n=0;n<n4;){
  for(t=0;t<t4;t+=crane.h){
    n=t/crane.h;
    plant(ddX[n]);
  }
  fclose(fp);
  fprintf(stdout,"Results are stored in '%s'.\n",fn);

  gsl_odeiv_step_free (crane._s);
  return 0;
}

#ifndef CRANESUB
int main()
{
  ////////////////////////////////////////////////////
  /// method 1                                     ///
  /// input ddX                                    ///
  /// output a,x,y,F                               ///
  ////////////////////////////////////////////////////
  //  double h = 0.001;//,hh=0.1; h = 0.0001;//,hh=0.1;
  double t0=5;     //stationary
  double t1=5.0+t0;//accelerate(speed up)
  double t2=2.0+t1;//free run
  double t3=5.0+t2;//decelerate(slow down)
  double t4=20+t3;   //free run
  initialize();
  int M=(t4/crane.h)+1;
  double *ddX=(double*)malloc(sizeof(double)*M);
  //  double *F  =(double*)malloc(sizeof(double)*M);
  double Vmax=1;//dX/dt=1[m/s]

  int n;
  double t;
  ////////////////////////////////////////////////////
  ///   set ddX                                    ///
  ////////////////////////////////////////////////////
  int n0 =t0/crane.h+0.5, n4=t4/crane.h+0.5;
  for(t=0;t<t4;t+=crane.h){
    n=t/crane.h;
    if(t<=t0) ddX[n]=0; //zero
    else if(t<=t1) ddX[n]=Vmax/(t1-t0); //accelerate
    else if(t<=t2) ddX[n]=0;            //free move
    else if(t<=t3) ddX[n]=-Vmax/(t3-t2);//decelerate
    else ddX[n]=0;                      //free move
  }
  ////////////////////////////////////////////////////
  ///   Solve by the Runge Kutta Method of GSL     ///
  ////////////////////////////////////////////////////
  fp=fopen(fn,"w");
  fprintf(fp,"#%.7e %d %d %.7e %.7e %.7e %.7e #h,n0,n4,M,n,r\n",crane.h,n0,n4,crane.M,crane.m,crane.r,crane.C);
  //  double dx0=0,dy0=0,da0=0;
  //  for(n=0;n<n4;){
  for(t=0;t<t4;t+=crane.h){
    n=t/crane.h;
    plant(ddX[n]);
  }
  fclose(fp);
  fprintf(stdout,"Results are stored in '%s'.\n",fn);

  gsl_odeiv_step_free (crane._s);
  return 0;
}
#endif //#ifndef SUB


/* multifit/gcv.c
 *
 * Copyright (C) 2016 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.
 */

/*
 * References:
 *
 * [1] P. C. Hansen, "Discrete Inverse Problems: Insight and Algorithms,"
 * SIAM Press, 2010.
 */

#include <config.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_multifit.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_min.h>

typedef struct
{
  const gsl_vector * S;
  const gsl_vector * UTy;
  double delta0;
  size_t np;
  gsl_vector * workp;
} gcv_params;

static double gcv_func(double lambda, void * params);

/*
gsl_multifit_linear_gcv_init()
  Initialize Generalized Cross Validation parameters

Inputs: y         - right hand side vector
        reg_param - (output) regularization parameters
        UTy       - (output) U^T y
        delta0    - (output) delta0
        work      - workspace
*/

int
gsl_multifit_linear_gcv_init(const gsl_vector * y,
                             gsl_vector * reg_param,
                             gsl_vector * UTy,
                             double * delta0,
                             gsl_multifit_linear_workspace * work)
{
  const size_t n = y->size;

  if (n != work->n)
    {
      GSL_ERROR("y vector does not match workspace", GSL_EBADLEN);
    }
  else if (UTy->size != work->p)
    {
      GSL_ERROR ("UTy vector does not match workspace", GSL_EBADLEN);
    }
  else
    {
      const size_t p = work->p;

      gsl_matrix_view U = gsl_matrix_submatrix(work->A, 0, 0, n, p);
      gsl_vector_view S = gsl_vector_subvector(work->S, 0, p);

      const double smax = gsl_vector_get(&S.vector, 0);
      const double smin = gsl_vector_get(&S.vector, p - 1);

      double dr; /* residual error from projection */

      double normy = gsl_blas_dnrm2(y);
      double normUTy;

      /* compute projection UTy = U^T y */
      gsl_blas_dgemv (CblasTrans, 1.0, &U.matrix, y, 0.0, UTy);
      normUTy = gsl_blas_dnrm2(UTy);

      /* dr = ||y||^2 - ||U^T y||^2 */
      dr = (normy + normUTy) * (normy - normUTy);

      /* calculate regularization parameters */
      gsl_multifit_linear_lreg(smin, smax, reg_param);

      if (n > p && dr > 0.0)
        *delta0 = dr;
      else
        *delta0 = 0.0;

      return GSL_SUCCESS;
    }
}

/*
gsl_multifit_linear_gcv_curve()
  Calculate Generalized Cross Validation curve for a set
of regularization parameters

Inputs: reg_param - regularization parameters
        UTy       - U^T y vector, size p
        delta0    - delta0
        G         - (output) GCV curve values
        work      - workspace
*/

int
gsl_multifit_linear_gcv_curve(const gsl_vector * reg_param,
                              const gsl_vector * UTy,
                              const double delta0,
                              gsl_vector * G,
                              gsl_multifit_linear_workspace * work)
{
  const size_t n = work->n;
  const size_t p = work->p;
  const size_t N = reg_param->size; /* number of points on GCV curve */

  if (UTy->size != p)
    {
      GSL_ERROR("UTy vector does not match workspace", GSL_EBADLEN);
    }
  else if (G->size != N)
    {
      GSL_ERROR ("size of reg_param and G vectors do not match",
                 GSL_EBADLEN);
    }
  else
    {
      size_t i;

      gsl_vector_view S = gsl_vector_subvector(work->S, 0, p);
      gsl_vector_view workp = gsl_matrix_subcolumn(work->QSI, 0, 0, p);

      gcv_params params;

      params.S = &S.vector;
      params.UTy = UTy;
      params.delta0 = delta0;
      params.np = n - p;
      params.workp = &workp.vector;

      for (i = 0; i < N; ++i)
        {
          double lambdai = gsl_vector_get(reg_param, i);
          double Gi = gcv_func(lambdai, &params);

          gsl_vector_set(G, i, Gi);
        }

      return GSL_SUCCESS;
    }
}

/*
gsl_multifit_linear_gcv_min()
  Find regularization parameter which minimizes GCV curve

Inputs: reg_param - regularization parameters
        UTy       - U^T y vector, size p
        G         - GCV curve values
        delta0    - delta0
        lambda    - (output) optimal regularization parameter
        work      - workspace
*/

int
gsl_multifit_linear_gcv_min(const gsl_vector * reg_param,
                            const gsl_vector * UTy,
                            const gsl_vector * G,
                            const double delta0,
                            double * lambda,
                            gsl_multifit_linear_workspace * work)
{
  const size_t n = work->n;
  const size_t p = work->p;
  const size_t npts = reg_param->size; /* number of points on GCV curve */

  if (UTy->size != p)
    {
      GSL_ERROR("UTy vector does not match workspace", GSL_EBADLEN);
    }
  else if (G->size != npts)
    {
      GSL_ERROR ("size of reg_param and G vectors do not match",
                 GSL_EBADLEN);
    }
  else
    {
      int status;
      const size_t max_iter = 500;
      const double tol = 1.0e-4;
      gsl_vector_view S = gsl_vector_subvector(work->S, 0, p);
      gsl_vector_view workp = gsl_matrix_subcolumn(work->QSI, 0, 0, p);
      gcv_params params;
      int idxG = (int) gsl_vector_min_index(G);
      double a = gsl_vector_get(reg_param, GSL_MIN(idxG + 1, (int) npts - 1));
      double b = gsl_vector_get(reg_param, GSL_MAX(idxG - 1, 0));
      double m = gsl_vector_get(reg_param, idxG);
      size_t iter = 0;
      gsl_function F;

      /* XXX FIXME */
      gsl_min_fminimizer *min_workspace_p;

      if (idxG == 0 || idxG == ((int)npts - 1))
        {
          /* the minimum is an endpoint of the curve, no need to search */
          *lambda = m;
          return GSL_SUCCESS;
        }

      /* XXX FIXME */
      min_workspace_p = gsl_min_fminimizer_alloc(gsl_min_fminimizer_brent);

      params.S = &S.vector;
      params.UTy = UTy;
      params.delta0 = delta0;
      params.np = n - p;
      params.workp = &workp.vector;

      F.function = gcv_func;
      F.params = &params;

      gsl_min_fminimizer_set(min_workspace_p, &F, m, a, b);

      do
        {
          iter++;
          status = gsl_min_fminimizer_iterate(min_workspace_p);

          a = gsl_min_fminimizer_x_lower(min_workspace_p);
          b = gsl_min_fminimizer_x_upper(min_workspace_p);

          status = gsl_min_test_interval(a, b, 0.0, tol);
        }
      while (status == GSL_CONTINUE && iter < max_iter);

      if (status == GSL_SUCCESS)
        *lambda = gsl_min_fminimizer_minimum(min_workspace_p);
      else
        status = GSL_EMAXITER;

      gsl_min_fminimizer_free(min_workspace_p);

      return status;
    }
}

/*
gsl_multifit_linear_gcv_calc()
  Calculate GCV function G(lambda) for given lambda

Inputs: reg_param - regularization parameters
        UTy       - U^T y vector, size p
        delta0    - delta0
        G         - (output) GCV curve values
        work      - workspace
*/

double
gsl_multifit_linear_gcv_calc(const double lambda,
                             const gsl_vector * UTy,
                             const double delta0,
                             gsl_multifit_linear_workspace * work)
{
  const size_t n = work->n;
  const size_t p = work->p;

  if (UTy->size != p)
    {
      GSL_ERROR_VAL("UTy vector does not match workspace", GSL_EBADLEN, 0.0);
    }
  else
    {
      gsl_vector_view S = gsl_vector_subvector(work->S, 0, p);
      gsl_vector_view workp = gsl_matrix_subcolumn(work->QSI, 0, 0, p);
      gcv_params params;
      double G;

      params.S = &S.vector;
      params.UTy = UTy;
      params.delta0 = delta0;
      params.np = n - p;
      params.workp = &workp.vector;

      G = gcv_func(lambda, &params);

      return G;
    }
}

/*
gsl_multifit_linear_gcv()
  Calculate Generalized Cross Validation curve for a set
of regularization parameters

Inputs: y         - right hand side vector
        reg_param - (output) regularization parameters
        G         - (output) GCV curve values
        lambda    - (output) optimal regularization parameter which
                    minimizes GCV curve
        G_lambda  - (output) G(lambda) value at optimal parameter
        work      - workspace
*/

int
gsl_multifit_linear_gcv(const gsl_vector * y,
                        gsl_vector * reg_param,
                        gsl_vector * G,
                        double * lambda,
                        double * G_lambda,
                        gsl_multifit_linear_workspace * work)
{
  const size_t n = y->size;
  const size_t N = G->size; /* number of points on GCV curve */

  if (n != work->n)
    {
      GSL_ERROR("y vector does not match workspace", GSL_EBADLEN);
    }
  else if (reg_param->size != N)
    {
      GSL_ERROR ("size of reg_param and G vectors do not match",
                 GSL_EBADLEN);
    }
  else
    {
      int status;
      const size_t p = work->p;
      gsl_vector_view UTy = gsl_vector_subvector(work->xt, 0, p);
      double delta0;

      status = gsl_multifit_linear_gcv_init(y, reg_param, &UTy.vector, &delta0, work);
      if (status)
        return status;

      status = gsl_multifit_linear_gcv_curve(reg_param, &UTy.vector, delta0, G, work);
      if (status)
        return status;

      status = gsl_multifit_linear_gcv_min(reg_param, &UTy.vector, G, delta0, lambda, work);
      if (status)
        return status;

      *G_lambda = gsl_multifit_linear_gcv_calc(*lambda, &UTy.vector, delta0, work);

      return GSL_SUCCESS;
    }
}

static double
gcv_func(double lambda, void * params)
{
  gcv_params * par = (gcv_params *) params;
  const gsl_vector *S = par->S;
  const gsl_vector *UTy = par->UTy;
  double delta0 = par->delta0;
  size_t np = par->np;
  gsl_vector *workp = par->workp;
  const size_t p = S->size;
  size_t i;
  double lambda_sq = lambda * lambda;
  double G, d, norm;
  double sumf = 0.0;

  /* compute workp = 1 - filter_factors */
  for (i = 0; i < p; ++i)
    {
      double si = gsl_vector_get(S, i);
      double fi = lambda_sq / (si * si + lambda_sq);
      gsl_vector_set(workp, i, fi);
      sumf += fi;
    }

  d = (double)np + sumf;

  gsl_vector_mul(workp, UTy);
  norm = gsl_blas_dnrm2(workp);

  G = (norm*norm + delta0) / (d * d);

  return G;
}


#ifndef TRANS_MYFUNC
#define TRANS_MYFUNC

#include <stdarg.h>
#include <gsl/gsl_vector.h>
#include "../include/type.h"

void mle_result_set(mle_result* mle, double sum, gsl_vector* psi1, gsl_vector* psi2,
                    double beta0, double beta1, double var1, double var2);

void log_vector(gsl_vector *vec);

double myfunc_multivar(const double x[], va_list argv);

void myfunc_multivar_der(const double x[], double res[], va_list argv);

double myfunc_1_2(const double x[], va_list argv);

void myfunc_der_1_2(const double x[], double res[], va_list argv);

double myfunc_marginal_1_2(const double x[], va_list argv);

void myfunc_marginal_1_2_der(const double x[], double res[], va_list argv);

double myfunc_individual(const double x[], va_list argv);

void myfunc_individual_der(const double x[], double res[], va_list argv);

double myfunc_marginal(const double x[], va_list argv);

void myfunc_marginal_der(const double x[], double res[], va_list argv);

int MLE_marginal_iteration(gsl_vector* i1, gsl_vector* i2,
                           gsl_vector* s1, gsl_vector* s2,
                           const int inclu_len, const int skip_len,
                           mle_result* mle);

int MLE_marginal_iteration_constrain(gsl_vector* i1, gsl_vector* i2,
                                     gsl_vector* s1, gsl_vector* s2,
                                     const int inclu_len, const int skip_len,
                                     mle_result* mle);

void* thread_wrapper_for_LT(void* arg);

void* batch_wrapper_for_LT(void* arg);

double likelihood_test(gsl_vector *i1, gsl_vector *i2, gsl_vector *s1, gsl_vector *s2,
                        int inclu_len, int skip_len, int flag, char* id);

int vec2psi(gsl_vector* psi, gsl_vector *inc, gsl_vector *skp,
            int inclu_len, int skip_len);

#endif


#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <gbpLib.h>
#include <gbpRNG.h>
#include <gbpMCMC.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_fit.h>
#include <gsl/gsl_interp.h>

void free_MCMC_covariance(MCMC_info *MCMC) {
    int           i_DS;
    MCMC_DS_info *current_DS;
    MCMC_DS_info *next_DS;

    if(MCMC->n_M != NULL) {
        SID_log("Freeing MCMC covariance matrix...", SID_LOG_OPEN);

        SID_free(SID_FARG MCMC->V);
        if(MCMC->m != NULL) {
            gsl_matrix_free(MCMC->m);
            MCMC->m = NULL;
        }
        if(MCMC->b != NULL) {
            gsl_vector_free(MCMC->b);
            MCMC->b = NULL;
        }

        SID_log("Done.", SID_LOG_CLOSE);
    }
}


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

#include <config.h>

#if defined( _MSC_VER ) && defined( GSL_DLL )
#undef inline
#define inline __forceinline
#endif

#if (!GSL_RANGE_CHECK) && defined(HAVE_INLINE)
#undef GSL_RANGE_CHECK
#define GSL_RANGE_CHECK 1
#endif

#include <stdlib.h>
#include <unistd.h>
#include <fcntl.h>
#include <stdio.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>

int status = 0;

#ifndef DESC
#define DESC ""
#endif

#define BASE_GSL_COMPLEX_LONG
#include "templates_on.h"
#include "test_complex_source.c"
#include "templates_off.h"
#undef  BASE_GSL_COMPLEX_LONG

#define BASE_GSL_COMPLEX
#include "templates_on.h"
#include "test_complex_source.c"
#include "templates_off.h"
#undef  BASE_GSL_COMPLEX

#define BASE_GSL_COMPLEX_FLOAT
#include "templates_on.h"
#include "test_complex_source.c"
#include "templates_off.h"
#undef  BASE_GSL_COMPLEX_FLOAT

#define BASE_LONG_DOUBLE
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_LONG_DOUBLE

#define BASE_DOUBLE
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_DOUBLE

#define BASE_FLOAT
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_FLOAT

#define BASE_ULONG
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_ULONG

#define BASE_LONG
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_LONG

#define BASE_UINT
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_UINT

#define BASE_INT
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_INT

#define BASE_USHORT
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_USHORT

#define BASE_SHORT
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_SHORT

#define BASE_UCHAR
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_UCHAR

#define BASE_CHAR
#include "templates_on.h"
#include "test_source.c"
#include "templates_off.h"
#undef  BASE_CHAR

void my_error_handler (const char *reason, const char *file,
                       int line, int err);

int
main (void)
{
  size_t stride, ostride, N;

  gsl_ieee_env_setup ();

  for (N = 10; N < 1024; N = 2*N + 1)
    {
      for (stride = 1; stride < 5 ; stride++)
        {
          test_func (stride, N);
          test_float_func (stride, N);
          test_long_double_func (stride, N);
          test_ulong_func (stride, N);
          test_long_func (stride, N);
          test_uint_func (stride, N);
          test_int_func (stride, N);
          test_ushort_func (stride, N);
          test_short_func (stride, N);
          test_uchar_func (stride, N);
          test_char_func (stride, N);

          test_complex_func (stride, N);
          test_complex_float_func (stride, N);
          test_complex_long_double_func (stride, N);

          for (ostride = 1; ostride < 5 ; ostride++)
            {
              test_ops (stride, ostride, N);
              test_float_ops (stride, ostride, N);
              test_long_double_ops (stride, ostride, N);
              test_ulong_ops (stride, ostride, N);
              test_long_ops (stride, ostride, N);
              test_uint_ops (stride, ostride, N);
              test_int_ops (stride, ostride, N);
              test_ushort_ops (stride, ostride, N);
              test_short_ops (stride, ostride, N);
              test_uchar_ops (stride, ostride, N);
              test_char_ops (stride, ostride, N);
              test_complex_ops (stride, ostride, N);
              test_complex_float_ops (stride, ostride, N);
              test_complex_long_double_ops (stride, ostride, N);
            }

          test_text (stride, N);
          test_float_text (stride, N);
#if HAVE_PRINTF_LONGDOUBLE
          test_long_double_text (stride, N);
#endif
          test_ulong_text (stride, N);
          test_long_text (stride, N);
          test_uint_text (stride, N);
          test_int_text (stride, N);
          test_ushort_text (stride, N);
          test_short_text (stride, N);
          test_uchar_text (stride, N);
          test_char_text (stride, N);

          test_complex_text (stride, N);
          test_complex_float_text (stride, N);
#if HAVE_PRINTF_LONGDOUBLE
          test_complex_long_double_text (stride, N);
#endif

          test_file (stride, N);
          test_float_file (stride, N);
          test_long_double_file (stride, N);
          test_ulong_file (stride, N);
          test_long_file (stride, N);
          test_uint_file (stride, N);
          test_int_file (stride, N);
          test_ushort_file (stride, N);
          test_short_file (stride, N);
          test_uchar_file (stride, N);
          test_char_file (stride, N);
          test_complex_file (stride, N);
          test_complex_float_file (stride, N);
          test_complex_long_double_file (stride, N);
        }
    }

#if GSL_RANGE_CHECK
  gsl_set_error_handler (&my_error_handler);

  for (N = 1; N < 1024; N *=2)
    {
      for (stride = 1; stride < 5 ; stride++)
        {
          test_trap (stride, N);
          test_float_trap (stride, N);
          test_long_double_trap (stride, N);
          test_ulong_trap (stride, N);
          test_long_trap (stride, N);
          test_uint_trap (stride, N);
          test_int_trap (stride, N);
          test_ushort_trap (stride, N);
          test_short_trap (stride, N);
          test_uchar_trap (stride, N);
          test_char_trap (stride, N);
          test_complex_trap (stride, N);
          test_complex_float_trap (stride, N);
          test_complex_long_double_trap (stride, N);
        }
    }
#endif

  exit (gsl_test_summary ());
}

void
my_error_handler (const char *reason, const char *file, int line, int err)
{
  if (0)
    printf ("(caught [%s:%d: %s (%d)])\n", file, line, reason, err);
  status = 1;
}


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

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_sf_exp.h>
#include <gsl/gsl_sf_result.h>

int
gsl_sf_result_smash_e(const gsl_sf_result_e10 * re, gsl_sf_result * r)
{
  if(re->e10 == 0) {
    /* nothing to smash */
    r->val = re->val;
    r->err = re->err;
    return GSL_SUCCESS;
  }
  else {
    const double av = fabs(re->val);
    const double ae = fabs(re->err);

    if(   GSL_SQRT_DBL_MIN < av && av < GSL_SQRT_DBL_MAX
       && GSL_SQRT_DBL_MIN < ae && ae < GSL_SQRT_DBL_MAX
       && 0.49*GSL_LOG_DBL_MIN  < re->e10 && re->e10 < 0.49*GSL_LOG_DBL_MAX
       ) {
      const double scale = exp(re->e10 * M_LN10);
      r->val = re->val * scale;
      r->err = re->err * scale;
      return GSL_SUCCESS;
    }
    else {
      return gsl_sf_exp_mult_err_e(re->e10*M_LN10, 0.0, re->val, re->err, r);
    }
  }
/*
  int stat_v;
  int stat_e;

  if(re->val == 0.0) {
    r->val = 0.0;
    stat_v = GSL_SUCCESS;
  }
  else {
    gsl_sf_result r_val;
    const double s = GSL_SIGN(re->val);
    const double x_v = re->e10*M_LN10 + log(fabs(re->val));
    stat_v = gsl_sf_exp_e(x_v, &r_val);
    r->val = s * r_val.val;
  }

  if(re->err == 0.0) {
    r->err = 0.0;
    stat_e = GSL_SUCCESS;
  }
  else if(re->val != 0.0) {
    r->err = fabs(r->val * re->err/re->val);
    stat_e = GSL_SUCCESS;
  }
  else {
    gsl_sf_result r_err;
    const double x_e = re->e10*M_LN10 + log(fabs(re->err));
    stat_e = gsl_sf_exp_e(x_e, &r_err);
    r->err = r_err.val;
  }

  return GSL_ERROR_SELECT_2(stat_v, stat_e);
*/
}


/**
 *
 * @file core_cgetrf.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:48 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex32_t
 *
 *  CORE_cgetrf - Computes an LU factorization of a general M-by-N matrix A
 *  using the tile LU algorithm with partial tile pivoting with row interchanges.
 *
 *******************************************************************************
 *
 * @param[in] m
 *          The number of rows of the matrix A. m >= 0.
 *
 * @param[in] n
 *          The number of columns of the matrix A. n >= 0.
 *
 * @param[in,out] A
 *          On entry, the M-by-N matrix to be factored.
 *          On exit, the tile factors L and U from the factorization.
 *
 * @param[in] lda
 *          The leading dimension of the array A. LDA >= max(1,M).
 *
 * @param[out] IPIV
 *          The pivot indices that define the permutations.
 *
 * @param[out] info
 *          - 0 on successful exit
 *          - <0 if -i, the i-th argument had an illegal value
 *          - >0 if i, U(i,i) is exactly zero. The factorization has been
 *            completed, but the factor U is exactly singular, and division by
 *            zero will occur if it is used to solve a system of equations.
 *
 *******************************************************************************
 *
 * @return
 *         \retval PLASMA_SUCCESS successful exit
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_cgetrf = PCORE_cgetrf
#define CORE_cgetrf PCORE_cgetrf
#endif
int CORE_cgetrf(int m, int n,
                 PLASMA_Complex32_t *A, int lda,
                 int *IPIV, int *info)
{
    *info = LAPACKE_cgetrf_work(LAPACK_COL_MAJOR, m, n, A, lda, IPIV );
    return PLASMA_SUCCESS;
}


/* eigen/genv.c
 *
 * Copyright (C) 2007 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 <stdlib.h>
#include <math.h>

#include <config.h>
#include <gsl/gsl_eigen.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_vector_complex.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_errno.h>

/*
 * This module computes the eigenvalues and eigenvectors of a
 * real generalized eigensystem A x = \lambda B x. Left and right
 * Schur vectors are optionally computed as well.
 *
 * This file contains routines based on original code from LAPACK
 * which is distributed under the modified BSD license.
 */

static int genv_get_right_eigenvectors(const gsl_matrix *S,
                                       const gsl_matrix *T,
                                       gsl_matrix *Z,
                                       gsl_matrix_complex *evec,
                                       gsl_eigen_genv_workspace *w);
static void genv_normalize_eigenvectors(gsl_vector_complex *alpha,
                                        gsl_matrix_complex *evec);

/*
gsl_eigen_genv_alloc()
  Allocate a workspace for solving the generalized eigenvalue problem.
The size of this workspace is O(7n).

Inputs: n - size of matrices

Return: pointer to workspace
*/

gsl_eigen_genv_workspace *
gsl_eigen_genv_alloc(const size_t n)
{
  gsl_eigen_genv_workspace *w;

  if (n == 0)
    {
      GSL_ERROR_NULL ("matrix dimension must be positive integer",
                      GSL_EINVAL);
    }

  w = (gsl_eigen_genv_workspace *) calloc (1, sizeof (gsl_eigen_genv_workspace));

  if (w == 0)
    {
      GSL_ERROR_NULL ("failed to allocate space for workspace", GSL_ENOMEM);
    }

  w->size = n;
  w->Q = NULL;
  w->Z = NULL;

  w->gen_workspace_p = gsl_eigen_gen_alloc(n);

  if (w->gen_workspace_p == 0)
    {
      gsl_eigen_genv_free(w);
      GSL_ERROR_NULL ("failed to allocate space for gen workspace", GSL_ENOMEM);
    }

  /* compute the full Schur forms */
  gsl_eigen_gen_params(1, 1, 1, w->gen_workspace_p);

  w->work1 = gsl_vector_alloc(n);
  w->work2 = gsl_vector_alloc(n);
  w->work3 = gsl_vector_alloc(n);
  w->work4 = gsl_vector_alloc(n);
  w->work5 = gsl_vector_alloc(n);
  w->work6 = gsl_vector_alloc(n);

  if (w->work1 == 0 || w->work2 == 0 || w->work3 == 0 ||
      w->work4 == 0 || w->work5 == 0 || w->work6 == 0)
    {
      gsl_eigen_genv_free(w);
      GSL_ERROR_NULL ("failed to allocate space for additional workspace", GSL_ENOMEM);
    }

  return (w);
} /* gsl_eigen_genv_alloc() */

/*
gsl_eigen_genv_free()
  Free workspace w
*/

void
gsl_eigen_genv_free(gsl_eigen_genv_workspace *w)
{
  RETURN_IF_NULL (w);

  if (w->gen_workspace_p)
    gsl_eigen_gen_free(w->gen_workspace_p);

  if (w->work1)
    gsl_vector_free(w->work1);

  if (w->work2)
    gsl_vector_free(w->work2);

  if (w->work3)
    gsl_vector_free(w->work3);

  if (w->work4)
    gsl_vector_free(w->work4);

  if (w->work5)
    gsl_vector_free(w->work5);

  if (w->work6)
    gsl_vector_free(w->work6);

  free(w);
} /* gsl_eigen_genv_free() */

/*
gsl_eigen_genv()

Solve the generalized eigenvalue problem

A x = \lambda B x

for the eigenvalues \lambda and right eigenvectors x.

Inputs: A     - general real matrix
        B     - general real matrix
        alpha - (output) where to store eigenvalue numerators
        beta  - (output) where to store eigenvalue denominators
        evec  - (output) where to store eigenvectors
        w     - workspace

Return: success or error
*/

int
gsl_eigen_genv (gsl_matrix * A, gsl_matrix * B, gsl_vector_complex * alpha,
                gsl_vector * beta, gsl_matrix_complex *evec,
                gsl_eigen_genv_workspace * w)
{
  const size_t N = A->size1;

  /* check matrix and vector sizes */

  if (N != A->size2)
    {
      GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
    }
  else if ((N != B->size1) || (N != B->size2))
    {
      GSL_ERROR ("B matrix dimensions must match A", GSL_EBADLEN);
    }
  else if (alpha->size != N || beta->size != N)
    {
      GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
    }
  else if (w->size != N)
    {
      GSL_ERROR ("matrix size does not match workspace", GSL_EBADLEN);
    }
  else if (evec->size1 != N)
    {
      GSL_ERROR ("eigenvector matrix has wrong size", GSL_EBADLEN);
    }
  else
    {
      int s;
      gsl_matrix Z;

      /*
       * We need a place to store the right Schur vectors, so we will
       * treat evec as a real matrix and store them in the left
       * half - the factor of 2 in the tda corresponds to the
       * complex multiplicity
       */
      Z.size1 = N;
      Z.size2 = N;
      Z.tda = 2 * N;
      Z.data = evec->data;
      Z.block = 0;
      Z.owner = 0;

      s = gsl_eigen_gen_QZ(A, B, alpha, beta, w->Q, &Z, w->gen_workspace_p);

      if (w->Z)
        {
          /* save right Schur vectors */
          gsl_matrix_memcpy(w->Z, &Z);
        }

      /* only compute eigenvectors if we found all eigenvalues */
      if (s == GSL_SUCCESS)
        {
          /* compute eigenvectors */
          s = genv_get_right_eigenvectors(A, B, &Z, evec, w);

          if (s == GSL_SUCCESS)
            genv_normalize_eigenvectors(alpha, evec);
        }

      return s;
    }
} /* gsl_eigen_genv() */

/*
gsl_eigen_genv_QZ()

Solve the generalized eigenvalue problem

A x = \lambda B x

for the eigenvalues \lambda and right eigenvectors x. Optionally
compute left and/or right Schur vectors Q and Z which satisfy:

A = Q S Z^t
B = Q T Z^t

where (S, T) is the generalized Schur form of (A, B)

Inputs: A     - general real matrix
        B     - general real matrix
        alpha - (output) where to store eigenvalue numerators
        beta  - (output) where to store eigenvalue denominators
        evec  - (output) where to store eigenvectors
        Q     - (output) if non-null, where to store left Schur vectors
        Z     - (output) if non-null, where to store right Schur vectors
        w     - workspace

Return: success or error
*/

int
gsl_eigen_genv_QZ (gsl_matrix * A, gsl_matrix * B,
                   gsl_vector_complex * alpha, gsl_vector * beta,
                   gsl_matrix_complex * evec,
                   gsl_matrix * Q, gsl_matrix * Z,
                   gsl_eigen_genv_workspace * w)
{
  if (Q && (A->size1 != Q->size1 || A->size1 != Q->size2))
    {
      GSL_ERROR("Q matrix has wrong dimensions", GSL_EBADLEN);
    }
  else if (Z && (A->size1 != Z->size1 || A->size1 != Z->size2))
    {
      GSL_ERROR("Z matrix has wrong dimensions", GSL_EBADLEN);
    }
  else
    {
      int s;

      w->Q = Q;
      w->Z = Z;

      s = gsl_eigen_genv(A, B, alpha, beta, evec, w);

      w->Q = NULL;
      w->Z = NULL;

      return s;
    }
} /* gsl_eigen_genv_QZ() */

/********************************************
 *           INTERNAL ROUTINES              *
 ********************************************/

/*
genv_get_right_eigenvectors()
  Compute right eigenvectors of the Schur form (S, T) and then
backtransform them using the right Schur vectors to get right
eigenvectors of the original system.

Inputs: S     - upper quasi-triangular Schur form of A
        T     - upper triangular Schur form of B
        Z     - right Schur vectors
        evec  - (output) where to store eigenvectors
        w     - workspace

Return: success or error

Notes: 1) based on LAPACK routine DTGEVC
       2) eigenvectors are stored in the order that their
          eigenvalues appear in the Schur form
*/

static int
genv_get_right_eigenvectors(const gsl_matrix *S, const gsl_matrix *T,
                            gsl_matrix *Z,
                            gsl_matrix_complex *evec,
                            gsl_eigen_genv_workspace *w)
{
  const size_t N = w->size;
  const double small = GSL_DBL_MIN * N / GSL_DBL_EPSILON;
  const double big = 1.0 / small;
  const double bignum = 1.0 / (GSL_DBL_MIN * N);
  size_t i, j, k, end;
  int is;
  double anorm, bnorm;
  double temp, temp2, temp2r, temp2i;
  double ascale, bscale;
  double salfar, sbeta;
  double acoef, bcoefr, bcoefi, acoefa, bcoefa;
  double creala, cimaga, crealb, cimagb, cre2a, cim2a, cre2b, cim2b;
  double dmin, xmax;
  double scale;
  size_t nw, na;
  int lsa, lsb;
  int complex_pair;
  gsl_complex z_zero, z_one;
  double bdiag[2] = { 0.0, 0.0 };
  double sum[4];
  int il2by2;
  size_t jr, jc, ja;
  double xscale;
  gsl_vector_complex_view ecol;
  gsl_vector_view re, im, re2, im2;

  GSL_SET_COMPLEX(&z_zero, 0.0, 0.0);
  GSL_SET_COMPLEX(&z_one, 1.0, 0.0);

  /*
   * Compute the 1-norm of each column of (S, T) excluding elements
   * belonging to the diagonal blocks to check for possible overflow
   * in the triangular solver
   */

  anorm = fabs(gsl_matrix_get(S, 0, 0));
  if (N > 1)
    anorm += fabs(gsl_matrix_get(S, 1, 0));
  bnorm = fabs(gsl_matrix_get(T, 0, 0));

  gsl_vector_set(w->work1, 0, 0.0);
  gsl_vector_set(w->work2, 0, 0.0);

  for (j = 1; j < N; ++j)
    {
      temp = temp2 = 0.0;
      if (gsl_matrix_get(S, j, j - 1) == 0.0)
        end = j;
      else
        end = j - 1;

      for (i = 0; i < end; ++i)
        {
          temp += fabs(gsl_matrix_get(S, i, j));
          temp2 += fabs(gsl_matrix_get(T, i, j));
        }

      gsl_vector_set(w->work1, j, temp);
      gsl_vector_set(w->work2, j, temp2);

      for (i = end; i < GSL_MIN(j + 2, N); ++i)
        {
          temp += fabs(gsl_matrix_get(S, i, j));
          temp2 += fabs(gsl_matrix_get(T, i, j));
        }

      anorm = GSL_MAX(anorm, temp);
      bnorm = GSL_MAX(bnorm, temp2);
    }

  ascale = 1.0 / GSL_MAX(anorm, GSL_DBL_MIN);
  bscale = 1.0 / GSL_MAX(bnorm, GSL_DBL_MIN);

  complex_pair = 0;
  for (k = 0; k < N; ++k)
    {
      size_t je = N - 1 - k;

      if (complex_pair)
        {
          complex_pair = 0;
          continue;
        }

      nw = 1;
      if (je > 0)
        {
          if (gsl_matrix_get(S, je, je - 1) != 0.0)
            {
              complex_pair = 1;
              nw = 2;
            }
        }

      if (!complex_pair)
        {
          if (fabs(gsl_matrix_get(S, je, je)) <= GSL_DBL_MIN &&
              fabs(gsl_matrix_get(T, je, je)) <= GSL_DBL_MIN)
            {
              /* singular matrix pencil - unit eigenvector */
              for (i = 0; i < N; ++i)
                gsl_matrix_complex_set(evec, i, je, z_zero);

              gsl_matrix_complex_set(evec, je, je, z_one);

              continue;
            }

          /* clear vector */
          for (i = 0; i < N; ++i)
            gsl_vector_set(w->work3, i, 0.0);
        }
      else
        {
          /* clear vectors */
          for (i = 0; i < N; ++i)
            {
              gsl_vector_set(w->work3, i, 0.0);
              gsl_vector_set(w->work4, i, 0.0);
            }
        }

      if (!complex_pair)
        {
          /* real eigenvalue */

          temp = 1.0 / GSL_MAX(GSL_DBL_MIN,
                               GSL_MAX(fabs(gsl_matrix_get(S, je, je)) * ascale,
                                       fabs(gsl_matrix_get(T, je, je)) * bscale));
          salfar = (temp * gsl_matrix_get(S, je, je)) * ascale;
          sbeta = (temp * gsl_matrix_get(T, je, je)) * bscale;
          acoef = sbeta * ascale;
          bcoefr = salfar * bscale;
          bcoefi = 0.0;

          /* scale to avoid underflow */
          scale = 1.0;
          lsa = fabs(sbeta) >= GSL_DBL_MIN && fabs(acoef) < small;
          lsb = fabs(salfar) >= GSL_DBL_MIN && fabs(bcoefr) < small;
          if (lsa)
            scale = (small / fabs(sbeta)) * GSL_MIN(anorm, big);
          if (lsb)
            scale = GSL_MAX(scale, (small / fabs(salfar)) * GSL_MIN(bnorm, big));

          if (lsa || lsb)
            {
              scale = GSL_MIN(scale,
                        1.0 / (GSL_DBL_MIN *
                               GSL_MAX(1.0,
                                 GSL_MAX(fabs(acoef), fabs(bcoefr)))));
              if (lsa)
                acoef = ascale * (scale * sbeta);
              else
                acoef *= scale;

              if (lsb)
                bcoefr = bscale * (scale * salfar);
              else
                bcoefr *= scale;
            }

          acoefa = fabs(acoef);
          bcoefa = fabs(bcoefr);

          /* first component is 1 */
          gsl_vector_set(w->work3, je, 1.0);
          xmax = 1.0;

          /* compute contribution from column je of A and B to sum */

          for (i = 0; i < je; ++i)
            {
              gsl_vector_set(w->work3, i,
                bcoefr*gsl_matrix_get(T, i, je) -
                acoef * gsl_matrix_get(S, i, je));
            }
        }
      else
        {
          gsl_matrix_const_view vs =
            gsl_matrix_const_submatrix(S, je - 1, je - 1, 2, 2);
          gsl_matrix_const_view vt =
            gsl_matrix_const_submatrix(T, je - 1, je - 1, 2, 2);

          /* complex eigenvalue */

          gsl_schur_gen_eigvals(&vs.matrix,
                                &vt.matrix,
                                &bcoefr,
                                &temp2,
                                &bcoefi,
                                &acoef,
                                &temp);
          if (bcoefi == 0.0)
            {
              GSL_ERROR("gsl_schur_gen_eigvals failed on complex block", GSL_FAILURE);
            }

          /* scale to avoid over/underflow */
          acoefa = fabs(acoef);
          bcoefa = fabs(bcoefr) + fabs(bcoefi);
          scale = 1.0;

          if (acoefa*GSL_DBL_EPSILON < GSL_DBL_MIN && acoefa >= GSL_DBL_MIN)
            scale = (GSL_DBL_MIN / GSL_DBL_EPSILON) / acoefa;
          if (bcoefa*GSL_DBL_EPSILON < GSL_DBL_MIN && bcoefa >= GSL_DBL_MIN)
            scale = GSL_MAX(scale, (GSL_DBL_MIN/GSL_DBL_EPSILON) / bcoefa);
          if (GSL_DBL_MIN*acoefa > ascale)
            scale = ascale / (GSL_DBL_MIN * acoefa);
          if (GSL_DBL_MIN*bcoefa > bscale)
            scale = GSL_MIN(scale, bscale / (GSL_DBL_MIN*bcoefa));
          if (scale != 1.0)
            {
              acoef *= scale;
              acoefa = fabs(acoef);
              bcoefr *= scale;
              bcoefi *= scale;
              bcoefa = fabs(bcoefr) + fabs(bcoefi);
            }

          /* compute first two components of eigenvector */

          temp = acoef * gsl_matrix_get(S, je, je - 1);
          temp2r = acoef * gsl_matrix_get(S, je, je) -
                   bcoefr * gsl_matrix_get(T, je, je);
          temp2i = -bcoefi * gsl_matrix_get(T, je, je);

          if (fabs(temp) >= fabs(temp2r) + fabs(temp2i))
            {
              gsl_vector_set(w->work3, je, 1.0);
              gsl_vector_set(w->work4, je, 0.0);
              gsl_vector_set(w->work3, je - 1, -temp2r / temp);
              gsl_vector_set(w->work4, je - 1, -temp2i / temp);
            }
          else
            {
              gsl_vector_set(w->work3, je - 1, 1.0);
              gsl_vector_set(w->work4, je - 1, 0.0);
              temp = acoef * gsl_matrix_get(S, je - 1, je);
              gsl_vector_set(w->work3, je,
                (bcoefr*gsl_matrix_get(T, je - 1, je - 1) -
                 acoef*gsl_matrix_get(S, je - 1, je - 1)) / temp);
              gsl_vector_set(w->work4, je,
                bcoefi*gsl_matrix_get(T, je - 1, je - 1) / temp);
            }

          xmax = GSL_MAX(fabs(gsl_vector_get(w->work3, je)) +
                         fabs(gsl_vector_get(w->work4, je)),
                         fabs(gsl_vector_get(w->work3, je - 1)) +
                         fabs(gsl_vector_get(w->work4, je - 1)));

          /* compute contribution from column je and je - 1 */

          creala = acoef * gsl_vector_get(w->work3, je - 1);
          cimaga = acoef * gsl_vector_get(w->work4, je - 1);
          crealb = bcoefr * gsl_vector_get(w->work3, je - 1) -
                   bcoefi * gsl_vector_get(w->work4, je - 1);
          cimagb = bcoefi * gsl_vector_get(w->work3, je - 1) +
                   bcoefr * gsl_vector_get(w->work4, je - 1);
          cre2a = acoef * gsl_vector_get(w->work3, je);
          cim2a = acoef * gsl_vector_get(w->work4, je);
          cre2b = bcoefr * gsl_vector_get(w->work3, je) -
                  bcoefi * gsl_vector_get(w->work4, je);
          cim2b = bcoefi * gsl_vector_get(w->work3, je) +
                  bcoefr * gsl_vector_get(w->work4, je);

          for (i = 0; i < je - 1; ++i)
            {
              gsl_vector_set(w->work3, i,
                -creala * gsl_matrix_get(S, i, je - 1) +
                crealb * gsl_matrix_get(T, i, je - 1) -
                cre2a * gsl_matrix_get(S, i, je) +
                cre2b * gsl_matrix_get(T, i, je));
              gsl_vector_set(w->work4, i,
                -cimaga * gsl_matrix_get(S, i, je - 1) +
                cimagb * gsl_matrix_get(T, i, je - 1) -
                cim2a * gsl_matrix_get(S, i, je) +
                cim2b * gsl_matrix_get(T, i, je));
            }
        }

      dmin = GSL_MAX(GSL_DBL_MIN,
               GSL_MAX(GSL_DBL_EPSILON*acoefa*anorm,
                       GSL_DBL_EPSILON*bcoefa*bnorm));

      /* triangular solve of (a A - b B) x = 0 */

      il2by2 = 0;
      for (is = (int) je - (int) nw; is >= 0; --is)
        {
          j = (size_t) is;

          if (!il2by2 && j > 0)
            {
              if (gsl_matrix_get(S, j, j - 1) != 0.0)
                {
                  il2by2 = 1;
                  continue;
                }
            }

          bdiag[0] = gsl_matrix_get(T, j, j);
          if (il2by2)
            {
              na = 2;
              bdiag[1] = gsl_matrix_get(T, j + 1, j + 1);
            }
          else
            na = 1;

          if (nw == 1)
            {
              gsl_matrix_const_view sv =
                gsl_matrix_const_submatrix(S, j, j, na, na);
              gsl_vector_view xv, bv;

              bv = gsl_vector_subvector(w->work3, j, na);

              /*
               * the loop below expects the solution in the first column
               * of sum, so set stride to 2
               */
              xv = gsl_vector_view_array_with_stride(sum, 2, na);

              gsl_schur_solve_equation(acoef,
                                       &sv.matrix,
                                       bcoefr,
                                       bdiag[0],
                                       bdiag[1],
                                       &bv.vector,
                                       &xv.vector,
                                       &scale,
                                       &temp,
                                       dmin);
            }
          else
            {
              double bdat[4];
              gsl_matrix_const_view sv =
                gsl_matrix_const_submatrix(S, j, j, na, na);
              gsl_vector_complex_view xv =
                gsl_vector_complex_view_array(sum, na);
              gsl_vector_complex_view bv =
                gsl_vector_complex_view_array(bdat, na);
              gsl_complex z;

              bdat[0] = gsl_vector_get(w->work3, j);
              bdat[1] = gsl_vector_get(w->work4, j);
              if (na == 2)
                {
                  bdat[2] = gsl_vector_get(w->work3, j + 1);
                  bdat[3] = gsl_vector_get(w->work4, j + 1);
                }

              GSL_SET_COMPLEX(&z, bcoefr, bcoefi);

              gsl_schur_solve_equation_z(acoef,
                                         &sv.matrix,
                                         &z,
                                         bdiag[0],
                                         bdiag[1],
                                         &bv.vector,
                                         &xv.vector,
                                         &scale,
                                         &temp,
                                         dmin);
            }

          if (scale < 1.0)
            {
              for (jr = 0; jr <= je; ++jr)
                {
                  gsl_vector_set(w->work3, jr,
                    scale * gsl_vector_get(w->work3, jr));
                  if (nw == 2)
                    {
                      gsl_vector_set(w->work4, jr,
                        scale * gsl_vector_get(w->work4, jr));
                    }
                }
            }

          xmax = GSL_MAX(scale * xmax, temp);

          for (jr = 0; jr < na; ++jr)
            {
              gsl_vector_set(w->work3, j + jr, sum[jr*na]);
              if (nw == 2)
                gsl_vector_set(w->work4, j + jr, sum[jr*na + 1]);
            }

          if (j > 0)
            {
              xscale = 1.0 / GSL_MAX(1.0, xmax);
              temp = acoefa * gsl_vector_get(w->work1, j) +
                     bcoefa * gsl_vector_get(w->work2, j);
              if (il2by2)
                {
                  temp = GSL_MAX(temp,
                           acoefa * gsl_vector_get(w->work1, j + 1) +
                           bcoefa * gsl_vector_get(w->work2, j + 1));
                }

              temp = GSL_MAX(temp, GSL_MAX(acoefa, bcoefa));
              if (temp > bignum * xscale)
                {
                  for (jr = 0; jr <= je; ++jr)
                    {
                      gsl_vector_set(w->work3, jr,
                        xscale * gsl_vector_get(w->work3, jr));
                      if (nw == 2)
                        {
                          gsl_vector_set(w->work4, jr,
                            xscale * gsl_vector_get(w->work4, jr));
                        }
                    }
                  xmax *= xscale;
                }

              for (ja = 0; ja < na; ++ja)
                {
                  if (complex_pair)
                    {
                      creala = acoef * gsl_vector_get(w->work3, j + ja);
                      cimaga = acoef * gsl_vector_get(w->work4, j + ja);
                      crealb = bcoefr * gsl_vector_get(w->work3, j + ja) -
                               bcoefi * gsl_vector_get(w->work4, j + ja);
                      cimagb = bcoefi * gsl_vector_get(w->work3, j + ja) +
                               bcoefr * gsl_vector_get(w->work4, j + ja);
                      for (jr = 0; jr <= j - 1; ++jr)
                        {
                          gsl_vector_set(w->work3, jr,
                            gsl_vector_get(w->work3, jr) -
                            creala * gsl_matrix_get(S, jr, j + ja) +
                            crealb * gsl_matrix_get(T, jr, j + ja));
                          gsl_vector_set(w->work4, jr,
                            gsl_vector_get(w->work4, jr) -
                            cimaga * gsl_matrix_get(S, jr, j + ja) +
                            cimagb * gsl_matrix_get(T, jr, j + ja));
                        }
                    }
                  else
                    {
                      creala = acoef * gsl_vector_get(w->work3, j + ja);
                      crealb = bcoefr * gsl_vector_get(w->work3, j + ja);
                      for (jr = 0; jr <= j - 1; ++jr)
                        {
                          gsl_vector_set(w->work3, jr,
                            gsl_vector_get(w->work3, jr) -
                            creala * gsl_matrix_get(S, jr, j + ja) +
                            crealb * gsl_matrix_get(T, jr, j + ja));
                        }
                    } /* if (!complex_pair) */
                } /* for (ja = 0; ja < na; ++ja) */
            } /* if (j > 0) */

          il2by2 = 0;
        } /* for (i = 0; i < je - nw; ++i) */

      for (jr = 0; jr < N; ++jr)
        {
          gsl_vector_set(w->work5, jr,
            gsl_vector_get(w->work3, 0) * gsl_matrix_get(Z, jr, 0));
          if (nw == 2)
            {
              gsl_vector_set(w->work6, jr,
                gsl_vector_get(w->work4, 0) * gsl_matrix_get(Z, jr, 0));
            }
        }

      for (jc = 1; jc <= je; ++jc)
        {
          for (jr = 0; jr < N; ++jr)
            {
              gsl_vector_set(w->work5, jr,
                gsl_vector_get(w->work5, jr) +
                gsl_vector_get(w->work3, jc) * gsl_matrix_get(Z, jr, jc));
              if (nw == 2)
                {
                  gsl_vector_set(w->work6, jr,
                    gsl_vector_get(w->work6, jr) +
                    gsl_vector_get(w->work4, jc) * gsl_matrix_get(Z, jr, jc));
                }
            }
        }

      /* store the eigenvector */

      if (complex_pair)
        {
          ecol = gsl_matrix_complex_column(evec, je - 1);
          re = gsl_vector_complex_real(&ecol.vector);
          im = gsl_vector_complex_imag(&ecol.vector);

          ecol = gsl_matrix_complex_column(evec, je);
          re2 = gsl_vector_complex_real(&ecol.vector);
          im2 = gsl_vector_complex_imag(&ecol.vector);
        }
      else
        {
          ecol = gsl_matrix_complex_column(evec, je);
          re = gsl_vector_complex_real(&ecol.vector);
          im = gsl_vector_complex_imag(&ecol.vector);
        }

      for (jr = 0; jr < N; ++jr)
        {
          gsl_vector_set(&re.vector, jr, gsl_vector_get(w->work5, jr));
          if (complex_pair)
            {
              gsl_vector_set(&im.vector, jr, gsl_vector_get(w->work6, jr));
              gsl_vector_set(&re2.vector, jr, gsl_vector_get(w->work5, jr));
              gsl_vector_set(&im2.vector, jr, -gsl_vector_get(w->work6, jr));
            }
          else
            {
              gsl_vector_set(&im.vector, jr, 0.0);
            }
        }

      /* scale eigenvector */
      xmax = 0.0;
      if (complex_pair)
        {
          for (j = 0; j < N; ++j)
            {
              xmax = GSL_MAX(xmax,
                             fabs(gsl_vector_get(&re.vector, j)) +
                             fabs(gsl_vector_get(&im.vector, j)));
            }
        }
      else
        {
          for (j = 0; j < N; ++j)
            {
              xmax = GSL_MAX(xmax, fabs(gsl_vector_get(&re.vector, j)));
            }
        }

      if (xmax > GSL_DBL_MIN)
        {
          xscale = 1.0 / xmax;
          for (j = 0; j < N; ++j)
            {
              gsl_vector_set(&re.vector, j,
                             gsl_vector_get(&re.vector, j) * xscale);
              if (complex_pair)
                {
                  gsl_vector_set(&im.vector, j,
                                 gsl_vector_get(&im.vector, j) * xscale);
                  gsl_vector_set(&re2.vector, j,
                                 gsl_vector_get(&re2.vector, j) * xscale);
                  gsl_vector_set(&im2.vector, j,
                                 gsl_vector_get(&im2.vector, j) * xscale);
                }
            }
        }
    } /* for (k = 0; k < N; ++k) */

  return GSL_SUCCESS;
} /* genv_get_right_eigenvectors() */

/*
genv_normalize_eigenvectors()
  Normalize eigenvectors so that their Euclidean norm is 1

Inputs: alpha - eigenvalue numerators
        evec  - eigenvectors
*/

static void
genv_normalize_eigenvectors(gsl_vector_complex *alpha,
                            gsl_matrix_complex *evec)
{
  const size_t N = evec->size1;
  size_t i;     /* looping */
  gsl_complex ai;
  gsl_vector_complex_view vi;
  gsl_vector_view re, im;
  double scale; /* scaling factor */

  for (i = 0; i < N; ++i)
    {
      ai = gsl_vector_complex_get(alpha, i);
      vi = gsl_matrix_complex_column(evec, i);

      re = gsl_vector_complex_real(&vi.vector);

      if (GSL_IMAG(ai) == 0.0)
        {
          scale = 1.0 / gsl_blas_dnrm2(&re.vector);
          gsl_blas_dscal(scale, &re.vector);
        }
      else if (GSL_IMAG(ai) > 0.0)
        {
          im = gsl_vector_complex_imag(&vi.vector);

          scale = 1.0 / gsl_hypot(gsl_blas_dnrm2(&re.vector),
                                  gsl_blas_dnrm2(&im.vector));
          gsl_blas_zdscal(scale, &vi.vector);

          vi = gsl_matrix_complex_column(evec, i + 1);
          gsl_blas_zdscal(scale, &vi.vector);
        }
    }
} /* genv_normalize_eigenvectors() */