#include <iostream>
#include <vector>
#include <memory>
#include <cstdlib>
#include <cstddef>
#ifdef ENABLE_GSL
#include <gsl/gsl_integration.h>
#include <gsl/gsl_deriv.h>
#include <cmath>

#endif

#ifndef PI
#define PI  3.141593
#endif

#ifndef Grav
#define Grav 4.7788e-20  // Newton's over c^2 in Mpc / Msun
#endif

#ifndef lightspeed
#define lightspeed 2.99792458e5  // km / s
#endif

#ifndef error_message
#define error_message
#define ERROR_MESSAGE() std::cerr << "ERROR: file: " << __FILE__ << " line: " << __LINE__ << std::endl;
#endif

#define CRITD 2.49783e18    /* critical density / Ho^2 solar/Mpc */
#define CRITD2 2.7752543e11 /* critical density / h^2 M_sun/Mpc^3 */

#ifndef cosmo_declare

enum CosmoParamSet {WMAP5yr,Millennium,Planck1yr,Planck15,Planck18,BigMultiDark,none};

std::ostream &operator<<(std::ostream &os, CosmoParamSet p);

/**
 *
 * \brief The cosmology and all the functions required to calculated quantities based on the cosmology.
 *
 * This class is used to store the cosmological parameters, calculate cosmological distances, calculate
 * the power spectrum of density fluctuations and the mass function of halos.
 *
 * As set now, there are no baryon acoustic oscillations in the power spectrum, but this can be changed
 * at the expense of not including neutrinos.
 */
class COSMOLOGY{
public:

  COSMOLOGY(CosmoParamSet cosmo_p = WMAP5yr);
  /// if justdistances== true
  COSMOLOGY(double omegam,double omegal,double h, double w = -1,double wa = 0
            ,bool justdistances=false /// if true the internals needed calculate structure formation will not be calculated making constructuion faster
  );
  COSMOLOGY(const COSMOLOGY &cosmo);
  ~COSMOLOGY();

  COSMOLOGY& operator=(const COSMOLOGY &cosmo);

  // returns the parameter set if any
  CosmoParamSet ParamSet(){return cosmo_set;}

  void PrintCosmology(short physical = 0) const;
  std::string print(short physical= 0) const;

  // Lengths
  double rcurve() const;
  //double emptyDist(double zo,double z);
  double coorDist(double zo,double z) const;
  double coorDist(double z) const {return coorDist(0,z);}
  double radDist(double zo,double z) const;
  double radDist(double z) const {return radDist(0,z);}
  double angDist(double zo,double z) const;
  double angDist(double z) const {return angDist(0,z);}
  double lumDist(double zo,double z) const;
  double lumDist(double z) const {return lumDist(0,z);}

  /// derivative of coordinate distance with respect to Omo in flat cosmology.  Useful for Fisher matrix calculations
  double d_coorDist_dOmo(double zo,double z) const;
  /// derivative of coordinate distance with respect to w.  Useful for Fisher matrix calculations
  double d_coorDist_dw(double zo,double z) const;
  /// derivative of coordinate distance with respect to w1.  Useful for Fisher matrix calculations
  double d_coorDist_dw1(double zo,double z) const;

  double DRradius(double zo,double z,double pfrac);
  double DRradius2(double zo,double z);

  double invCoorDist(double d) const;
  double invRadDist(double d) const;
  double invComovingDist(double d) const;

  double scalefactor(double rad) const;
  double Omegam(double z) const;
  double rho_crit_comoving(double z) const;
  //double drdz_empty(double x);
  double drdz(double x) const;
  //double adrdz(double x) const;
  double drdz_dark(double x) const;
  inline double dark_factor(double x) const;
  //double adrdz_dark(double x) const;

  /// the critical over density
  double delta_c() const;

  double DeltaVir(double z,int caseunit=0) const;
  double Deltao(double m) const;
  double time(double z) const;
  double nonlinMass(double z) const;

  // Stuff having to do with the power spectrum
  double power_normalize(double sigma8);
  /**
   * \brief Linear power spectrum P(k,z)/a^2
   */
  double power_linear(double k,double z);
  double Dgrowth(double z) const;

  /**
   * \brief  powerCDM.c calculates the nonlinear P(k,z)/a(r)^2
   *
   * The method of Peacock & Dodds 1996 is used to convert the linear
   * power spectrum into the nonlinear one.
   * This could be updated to a more recent nonlinear power spectrum
   */
  double powerCDMz(double k,double z);
  double psdfdm(double z,double m,int caseunit=0);
  double halo_bias (double m, double z, int t=0);
  double stdfdm(double z,double m,int caseunit=0);
  double powerlawdfdm(double z,double m,double alpha,int caseunit=0);
  double haloNumberDensity(double m,double z,double a, int t,double alpha = 0.0);

  /** \brief Dark matter correlation function
   *
   *  This integrates powerCDMz() to get the correlation function as a function of comoving radius.
   *  Care should be taken that the right range of k is integrated over if the radius is very small or large.
   */
  double CorrelationFunction(double radius,double redshift
                      ,double k_max = 100,double k_min = 1.0e-3);

  struct CorrFunctorType{
    CorrFunctorType(COSMOLOGY *cosmo,double radius,double redshift)
    : cosmology(cosmo),z(redshift),r(radius)
    {
      norm = 0.5/PI/PI/(1+z)/(1+z);
    };

    COSMOLOGY *cosmology;
    double z;
    double r;

    double norm;

    double operator () (double k) {

      double rk = r*k;
      double jo = sin(rk)/rk;
      if(rk < 1.0e-3) jo = 1.0;

      return norm*jo*k*k*cosmology->powerCDMz(k,z);
    }
  };

  double haloNumberDensityOnSky (double m,double z1,double z2,int t,double alpha = 0.0);
  double haloNumberInBufferedCone (double mass ,double z1,double z2,double fov,double buffer ,int type ,double alpha=0.0);
  double haloMassInBufferedCone (double mass ,double z1,double z2,double fov,double buffer ,int type ,double alpha=0.0);

  double TopHatVariance(double m) const;
  double TopHatVarianceR(double R,double z);
  double TopHatVarianceM(double M,double z);
  //double gradius(double R,double rd);

  double getTimefromDeltaC(double dc);
  double getZfromDeltaC(double dc);

  /// accesser functions:

  /// Hubble paremters in units of 100 km/s/Mpc, renormalizes P(k) to keep sig8 fixed
  void sethubble(double ht){ h = ht; TFmdm_set_cosm();
    power_normalize(sig8); 	calc_interp_dist(); cosmo_set = none;}
  double gethubble() const {return h;}
  /// Hubble parameter in 1/Mpc units
  double getHubble() const {return 100*h/lightspeed;}

  /// Primordial spectral index, renormalizes P(k) to keep sig8 fixed
  void setindex(double nn){ n = nn;  power_normalize(sig8); cosmo_set = none;}
  double getindex() const { return n;}

  /// Omega matter, renormalizes P(k) to keep sig8 fixed
  void setOmega_matter(double Omega_matter,bool FLAT = false){Omo = Omega_matter; if(FLAT) Oml = 1-Omo ; TFmdm_set_cosm(); power_normalize(sig8); calc_interp_dist(); cosmo_set = none;}
  double getOmega_matter() const {return Omo;}

  /// Omega lambda, renormalizes P(k) to keep sig8 fixed
  void setOmega_lambda(double Omega_lambda,bool FLAT = false){Oml = Omega_lambda;  if(FLAT) Oml = 1-Omo ; TFmdm_set_cosm(); power_normalize(sig8); calc_interp_dist(); cosmo_set = none;}
  double getOmega_lambda() const {return Oml;}

  /// Omega baryon, renormalizes P(k) to keep sig8 fixed
  void setOmega_baryon(double Omega_baryon){Omb = Omega_baryon; TFmdm_set_cosm(); power_normalize(sig8); calc_interp_dist(); cosmo_set = none;
  }
  double getOmega_baryon() const {return Omb;}

  /// Omega neutrino, renormalizes P(k) to keep sig8 fixed
  void setOmega_neutrino(double Omega_neutrino){Omnu = Omega_neutrino; TFmdm_set_cosm(); power_normalize(sig8); 	calc_interp_dist(); cosmo_set = none;
  }
  double getOmega_neutrino() const {return Omnu;}

  /// Number of neutrino species, renormalizes P(k) to keep sig8 fixed
  void setNneutrino(double Nneutrino){Nnu = Nneutrino; TFmdm_set_cosm(); power_normalize(sig8); cosmo_set = none;}
  double getNneutrino() const {return Nnu;}

  /// Dark energy equation of state parameter p/rho = w + w_1 (1+z)
  void setW(double w){ww = w; 	calc_interp_dist(); cosmo_set = none;}
  double getW() const {return ww;}
  void setW1(double w){ww1 = w; 	calc_interp_dist(); cosmo_set = none;}
  double getW1() const {return ww1;}

  /// Running of primordial spectral index, P(k)_primordial \propto pow(k/h,n+dndlnk*log(k)), renormalizes P(k) to keep sig8 fixed
  void setdndlnk(double w){dndlnk = w; power_normalize(sig8); cosmo_set = none;}
  double getdndlnk() const {return dndlnk;}

  /// Alternative to w for dark energy/ alt. grav. structure evolution
  void setgamma(double gamm){gamma = gamm; cosmo_set = none;}
  double getgamma() const {return gamma;}
  // If physical = 1 all Omega are Omega*h^2 otherwise they have the usual definitions.
  // 2 gamma parameterization is used for dark energy
  void setDEtype(short tt){darkenergy = tt; cosmo_set = none;}
  short getDEtype() const {return darkenergy;}

  void setSigma8(double my_sig8){power_normalize(my_sig8); cosmo_set = none;}
  double getSigma8() const {return sig8;}

  void dzdangDist(double D,double z[],double dzdD[]);

  double totalMassDensityinHalos(int t,double alpha,double m_min,double z,double z1,double z2);

  /// set interpolation range and number of points
  void setInterpolation(double z_interp, std::size_t n_interp);

  /// The lensing critical density in Msun / Mpc^2
  double SigmaCrit(double zlens,double zsource) const;

protected:
  void SetConcordenceCosmology(CosmoParamSet cosmo_p);

  CosmoParamSet cosmo_set;

  // structure rappers to make integration thread safe
  struct drdz_struct{
    drdz_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.drdz(x);}
    COSMOLOGY const &cos;
  };
  struct drdzdark_struct{
    drdzdark_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.drdz_dark(x);}
    COSMOLOGY const &cos;
  };
  struct adrdz_struct{
    adrdz_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.drdz(x)/x;}
    COSMOLOGY const &cos;
  };
  struct adrdzdark_struct{
    adrdzdark_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.drdz_dark(x)/x;}
    COSMOLOGY const &cos;
  };

  struct normL_struct{
    normL_struct(COSMOLOGY &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.normL(x);}
    COSMOLOGY &cos;
  };

  double ddrdzdOmo(double x) const;
  double ddrdzdw(double x) const;
  double ddrdzdw1(double x) const;

  struct ddrdzdOmo_struct{
    ddrdzdOmo_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.ddrdzdOmo(x);}
    COSMOLOGY const &cos;
  };
  struct ddrdzdw_struct{
    ddrdzdw_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.ddrdzdw(x);}
    COSMOLOGY const &cos;
  };
  struct ddrdzdw1_struct{
    ddrdzdw1_struct(COSMOLOGY const &cosmo):cos(cosmo){};
    double operator()(double x) const {return cos.ddrdzdw1(x);}
    COSMOLOGY const &cos;
  };

  bool init_structure_functions;

  /// Hubble paremters in units of 100 km/s/Mpc
  double h;
  /// Primordial spectral index
  double n;
  /// Omega matter, dark matter + baryons
  double Omo;
  /// Omega lambda
  double Oml;
  /// Omega baryon
  double Omb;
  /// Omega neutrino
  double Omnu;
  /// Number of neutrino species
  double Nnu;
  /// Dark energy equation of state parameter p/rho = ww + ww_1 (1+z)
  double ww;
  /// Dark energy equation of state parameter p/rho = ww + ww_1 (1+z)
  double ww1;
  /// Running of primordial spectral index, P(k)_primordial \propto pow(k/h,n+dndlnk*log(k))
  double dndlnk;

  /// Alternative to w for dark energy/ alt. grav. structure evolution
  double gamma;
  // If physical = 1 all Omega are Omega*h^2 otherwise they have the usual definitions.
  //short physical;
  // 2 gamma parameterization is used for dark energy
  short darkenergy;

  /* table for growth parameter */
  //std::auto_ptr<double> *aa;
  //std::auto_ptr<double> *growth;
  //int Ntable;

  double A;
  double sig8;  /* do not access these normalization outside */

  double Rtophat;
  double ztmp;

  double powerEH(double k,double z);
  double powerEHv2(double k);
  double powerloc(double k,double z);
  double npow(double k);
  double normL(double lgk);
  double gradius(double R,double rd) const;

  int nbin;  // number of points when binning to interpolate
  std:: vector<double> vDeltaCz,vlz,vt;
  double DpropDz(double z);
  double dsigdM(double m);
  double timeEarly(double a) const;
  double dNdz(double z);

  typedef double (COSMOLOGY::*pt2MemFunc)(double) const;
  typedef double (COSMOLOGY::*pt2MemFuncNonConst)(double);

  double nintegrateDcos(pt2MemFunc func,double a,double b,double tols) const;
  double trapzdDcoslocal(pt2MemFunc func, double a, double b, int n, double *s2) const;
  void polintD(double xa[], double ya[], int n, double x, double *y, double *dy) const;
  double nintegrateDcos(pt2MemFuncNonConst func,double a,double b,double tols);
  double trapzdDcoslocal(pt2MemFuncNonConst func, double a, double b, int n, double *s2);
  double dfridrDcos(pt2MemFunc func, double x, double h, double *err);
  double f4(double u) const;

  int ni;
  std::vector<float> xf, wf;

  // The parameters used in Eisenstein & Hu power spectrum
  /* in powerEH.c */
  short TFmdm_set_cosm_change_z(double redshift);
  short TFmdm_set_cosm();
  double TFmdm_onek_mpc(double kk);
  double TFmdm_onek_hmpc(double kk);

  double f_baryon;	// Baryon fraction
  double f_bnu;		// Baryon + Massive Neutrino fraction
  double f_cb;		// Baryon + CDM fraction
  double f_cdm;		// CDM fraction
  double f_hdm;		// Massive Neutrino fraction

  double alpha_gamma;	 // sqrt(alpha_nu)
  double alpha_nu;	     // The small-scale suppression
  double beta_c;		 // The correction to the log in the small-scale
  double num_degen_hdm;	 // Number of degenerate massive neutrino species
  double growth_k0;	     // D_1(z) -- the growth function as k->0
  double growth_to_z0;	 // D_1(z)/D_1(0) -- the growth relative to z=0
  double k_equality;	 // The comoving wave number of the horizon at equality
  double obhh;		     // Omega_baryon * hubble^2
  double omega_curv;	 // = 1 - omega_matter - omega_lambda
  double omega_lambda_z; // Omega_lambda at the given redshift
  double omega_matter_z; // Omega_matter at the given redshift
  double omhh;		     // Omega_matter * hubble^2
  double onhh;		     // Omega_hdm * hubble^2
  double p_c;		     // The correction to the exponent before drag epoch
  double p_cb;		     // The correction to the exponent after drag epoch
  double sound_horizon_fit;  // The sound horizon at the drag epoch
  double theta_cmb;	     // The temperature of the CMB, in units of 2.7 K
  double y_drag;		 // Ratio of z_equality to z_drag
  double z_drag;		 // Redshift of the drag epoch
  double z_equality;	 // Redshift of matter-radiation equality

  void setinternals();
  // in powerEHv2.c
  void TFset_parameters(double omega0hh, double f_baryon, double Tcmb);
  double TFfit_onek(double k, double *tf_baryon, double *tf_cdm);

  double R_drag;		// Photon-baryon ratio at drag epoch
  double R_equality;	// Photon-baryon ratio at equality epoch
  double sound_horizon;	// Sound horizon at drag epoch, in Mpc
  double k_silk;		// Silk damping scale, in Mpc^-1
  double alpha_c;	    // CDM suppression
  double alpha_b;	    // Baryon suppression
  double beta_b;		// Baryon envelope shift
  double beta_node;	// Sound horizon shift
  double k_peak;		// Fit to wavenumber of first peak, in Mpc^-1

  // temporary variables for doing interations
  int tmp_type;
  double tmp_alpha;
  double tmp_mass;
  double tmp_a;

  // interpolation of functions
  double z_interp;
  std::size_t n_interp;
  void calc_interp_dist();
  double interp(const std::vector<double>& table, double z) const;
  double invert(const std::vector<double>& table, double f_z) const;
  std::vector<double> redshift_interp;
  std::vector<double> coorDist_interp;
  std::vector<double> radDist_interp;
};

typedef COSMOLOGY *CosmoHndl;
/**
 *  \brief Class for calculating properties of NFW halo profile.
 *
 *   This class does not take into affect the cosmological correlation between concentration and mass.
 *   For this see the HALOCalculator class.
 */
class NFW_Utility {
public:
  NFW_Utility(){return;}
  ~NFW_Utility(){};

  // methods for NFW profile
  double NFW_V200(double M200,double R200);
  double NFW_Vmax(double cons,double M200,double R200);
  double NFW_Vr(double x,double cons,double M200,double R200);
  double NFW_M(double x,double cons,double M200);
  double NFW_deltac(double cons);
  double NFW_Concentration(double Vmax,double M200,double R200);
  double NFW_rho(double cons,double x);

  void match_nfw(float Vmax,float R_half,float mass,float *cons,float *Rsize);
  float Rsize(float cons,float Vmax,float mass);
  float g_func(float x);

private:
  float Vmax,R_half,mass;       /// Mass (solar masses)

  typedef float (NFW_Utility::*MemFunc)(float);
  float zbrentD(MemFunc func, float a,float b,float tols);
  float nfwfunc(float cons);
  float funcforconcentration(float cons);
};

/// wrapper functions for gsl integration / differentiation
double drdz_wrapper(double x, void *params);
double drdz_dark_wrapper(double x, void *params);
double Deltao_wrapper(double m, void *params);

#define cosmo_declare
#endif

/*** in cosmo.c ***/
int cosmo_compare(CosmoHndl cos1,CosmoHndl cos2);
void cosmo_copy(CosmoHndl cos1,CosmoHndl cos2);
void ders(double z,double Da[],double dDdz[]);
void dir(double r,double a[],double dadr[]);
double arctanh(double x);
double fmini(double a,double b);
double fmaxi(double a,double b);
double **dmatrixcos(long nrl, long nrh, long ncl, long nch);
void free_dmatrixcos(double **m, long nrl, long nrh, long ncl, long nch);

/* in nfw.c */

/* in powerEHv2.c */
void TFset_parameters(double omega0hh, double f_baryon, double Tcmb);
double TFfit_onek(double k, double *tf_baryon, double *tf_cdm);


#include <stdio.h>
#include <math.h>
#include "mf.h"
#include <gsl/gsl_integration.h>

//****************************the functions are listed below**********
double func1 (double y, double T)  //The self-consistent equation f(y)=0
{
	double res = tanh(3*y/T)-y;
	return res;
}
double func2 (double y, double T) //The free energy per site
{
	double res = 0.5*3*y*y-T*log(2*cosh(3*y)/T);
	return res;
}
//*****************************************************************************
int main()
{
	FILE *fp;
	int anyi;
	if((fp=fopen(filename,"w"))==NULL)
	{
		printf("cannot open the file: %s\n",filename);
		printf("Please input an integer to end the program:");
		scanf("%d",&anyi);
		return 0;
	}

	FILE *ffp;
	if((ffp=fopen(filename2,"w"))==NULL)
	{
		printf("cannot open the file: %s\n",filename2);
		printf("Please input an integer to end the program:");
		scanf("%d",&anyi);
		return 0;
	}

	double tem0;          //judge indicator
	double T_step;             //the step of Temperature
	T_step = (T_high-T_low)/(N_T-1);    //note N_T is the tatal points of T
//	printf("The temperature step is %lf\n",T_step);

	double y_1;
	double y_2;

	double tem_1;
	double tem_2;

	double T = T_low;

	int i,j;    //loop indicator
	for(i=0;i<N_T;i++)
	{
		T = T_low + i*T_step;

		y_1=1e-1;
		y_2=1e7;
		tem_1 =  func1(y_1, T);
		tem_2 =  func1(y_2, T);
		//if(tem_1<0||tem_2>0)
		if(tem_1*tem_2>0)
		{
			printf("The two points in the boundary isn't good! Give up them now. Do it, baby!\n");
			return 0;
		}

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

		for(j=10;j>1;j++)
		{
			tem_1 = func1(y_1, T);
			tem_2 = func1(y_2, T);
			tem0 = func1((y_1+y_2)/2.,T);
		//	printf("tem_1:%lf\ttem_2:%lf\n",tem_1,tem_2);
			if((tem_1<precision&&tem_1>=0)||(tem_1>-precision&&tem_1<=0))
			{
				fprintf(fp,"%lf\t%lf\n",T,y_1);
				fprintf(ffp,"%lf\t%lf\t%lf\n",T,func2(y_1,T),func2(-y_1,T));
				j=0;
			}
			if((tem_2<precision&&tem_2>=0)||(tem_2>-precision&&tem_2<=0))
			{
				fprintf(fp,"%lf\t%lf\n",T,y_2);
				fprintf(ffp,"%lf\t%lf\t%lf\n",T,func2(y_2,T),func2(-y_2,T));
				j=0;
			}
			if(tem_1*tem0>0)
			{
				y_1 = (y_1+y_2)/2;
			}
			if(tem_2*tem0>0)
			{
				y_2 = (y_1+y_2)/2;
			}
			printf("%lf\n",(y_1+y_2)/2); //the mediate point value

		}
	}
	return 1;
}


//
//  gemm.h
//  Linear Algebra Template Library
//
//  Created by Rodney James on 1/30/12.
//  Copyright (c) 2012 University of Colorado Denver. All rights reserved.
//

#ifndef _gemm_h
#define _gemm_h

/// @file gemm.h Computes general matrix-matrix products.

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

namespace LATL
{
   /// @brief Computes products of real matrices.
   ///
   /// For real matrices A,B,C and real scalars alpha, beta
   ///
   ///        C := alpha * op(A) * op(B) + beta * C
   ///
   /// is calculated, where op(X) = X or X'.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param transA Specifies whether op(A)=A or A' as follows:
   ///
   ///        if transA = 'N' or 'n' then op(A)=A
   ///        if transA = 'T' or 't' then op(A)=A'
   ///        if transA = 'C' or 'c' then op(A)=A'
   ///
   /// @param transB Specifies whether op(B)=B or B' as follows:
   ///
   ///        if transB = 'N' or 'n' then op(B)=B
   ///        if transB = 'T' or 't' then op(B)=B'
   ///        if transB = 'C' or 'c' then op(B)=B'
   ///
   /// @param m The number of rows of the matrices C and op(A).  m>=0
   /// @param n The number of columns of the matrices C and op(B).  n>=0
   /// @param k The number of columns of the matrix op(A), and the number of rows of the matrix op(B).  k>=0
   /// @param alpha Real scalar.
   /// @param A Pointer to real matrix A, where op(A) is m-by-k.
   /// @param ldA Column length of the matrix A.  If transA='N' or 'n', ldA>=m; otherwise, ldA>=k.
   /// @param B Pointer to real matrix B, where op(B) is k-by-n.
   /// @param ldB Column length of the matrix B.  If transB='N' or 'n', ldB>=k; otherwise, ldA>=n.
   /// @param beta Real scalar.
   /// @param C Pointer to real matrix C, where C is m-by-n.
   /// @param ldC Column length of the matrix C.  ldC>=m.
   /// @ingroup BLAS

   template<typename real_t>
   int GEMM(char transA, char transB, int_t m, int_t n, int_t k, real_t alpha, real_t *A, int_t ldA, real_t *B, int_t ldB, real_t beta, real_t *C, int_t ldC)
   {
      using std::toupper;
      const real_t zero(0.0);
      const real_t one(1.0);
      int_t i,j,l;
      real_t s,t;
      real_t *a,*b,*c;

      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;
      else if((m==0)||(n==0)||(((alpha==zero)||(k==0))&&(beta==one)))
         return 0;

      if(alpha==zero)
      {
         c=C;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            c+=ldC;
         }
      }
      else if((transA=='N')&&(transB=='N'))
      {
         c=C;
         b=B;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            a=A;
            for(l=0;l<k;l++)
            {
               for(i=0;i<m;i++)
               {
                  c[i]+=alpha*b[l]*a[i];
               }
               a+=ldA;
            }
            b+=ldB;
            c+=ldC;
         }
      }
      else if((transA!='N')&&(transB=='N'))
      {
         b=B;
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               for(l=0;l<k;l++)
               {
                  s+=a[l]*b[l];
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            b+=ldB;
            c+=ldC;
         }
      }
      else if((transA=='N')&&(transB!='N'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            a=A;
            b=B;
            for(l=0;l<k;l++)
            {
               t=alpha*b[j];
               for(i=0;i<m;i++)
               {
                  c[i]+=t*a[i];
               }
               a+=ldA;
               b+=ldB;
            }
            c+=ldC;
         }
      }
      else
      {
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               b=B;
               for(l=0;l<k;l++)
               {
                  s+=a[l]*b[j];
                  b+=ldB;
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            c+=ldC;
         }

      }
      return 0;
   }

   /// @brief Computes products of complex matrices.
   ///
   /// For complex matrices A,B,C and complex scalars alpha, beta
   ///
   ///        C := alpha * op(A) * op(B) + beta * C
   ///
   /// is calculated, where op(X) = X, X' or X.'.
   /// @return 0 if success.
   /// @return -i if the ith argument is invalid.
   /// @tparam real_t Floating point type.
   /// @param transA Specifies whether op(A)=A, A.' or A' as follows:
   ///
   ///        if transA = 'N' or 'n' then op(A)=A
   ///        if transA = 'T' or 't' then op(A)=A.'
   ///        if transA = 'C' or 'c' then op(A)=A'
   ///
   /// @param transB Specifies whether op(B)=B, B.' or B' as follows:
   ///
   ///        if transB = 'N' or 'n' then op(B)=B
   ///        if transB = 'T' or 't' then op(B)=B.'
   ///        if transB = 'C' or 'c' then op(B)=B'
   ///
   /// @param m The number of rows of the matrices C and op(A).  m>=0
   /// @param n The number of columns of the matrices C and op(B).  n>=0
   /// @param k The number of columns of the matrix op(A), and the number of rows of the matrix op(B).  k>=0
   /// @param alpha Complex scalar.
   /// @param A Pointer to complex matrix A, where op(A) is m-by-k.
   /// @param ldA Column length of the matrix A.  If transA='N' or 'n', ldA>=m; otherwise, ldA>=k.
   /// @param B Pointer to complex matrix B, where op(B) is k-by-n.
   /// @param ldB Column length of the matrix B.  If transB='N' or 'n', ldB>=k; otherwise, ldA>=n.
   /// @param beta Complex scalar.
   /// @param C Pointer to complex matrix C, where C is m-by-n.
   /// @param ldC Column length of the matrix C.  ldC>=m.
   /// @ingroup BLAS

   template<typename real_t>
   int GEMM(char transA, char transB, int_t m, int_t n, int_t k, complex<real_t> alpha, complex<real_t> *A, int_t ldA, complex<real_t> *B, int_t ldB, complex<real_t> beta, complex<real_t> *C, int_t ldC)
   {
      using std::conj;
      using std::toupper;
      const complex<real_t> zero(0.0,0.0);
      const complex<real_t> one(1.0,0.0);
      int_t i,j,l;
      complex<real_t> *a,*b,*c;
      complex<real_t> s,t;

      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;
      else if((m==0)||(n==0)||(((alpha==zero)||(k==0))&&(beta==one)))
         return 0;

      if(alpha==zero)
      {
         c=C;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            c+=ldC;
         }
      }
      else if((transA=='N')&&(transB=='N'))
      {
         c=C;
         b=B;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            a=A;
            for(l=0;l<k;l++)
            {
               for(i=0;i<m;i++)
               {
                  c[i]+=alpha*b[l]*a[i];
               }
               a+=ldA;
            }
            b+=ldB;
            c+=ldC;
         }
      }
      else if((transA=='T')&&(transB=='N'))
      {
         b=B;
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               for(l=0;l<k;l++)
               {
                  s+=a[l]*b[l];
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            b+=ldB;
            c+=ldC;
         }
      }
      else if((transA=='C')&&(transB=='N'))
      {
         b=B;
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               for(l=0;l<k;l++)
               {
                  s+=conj(a[l])*b[l];
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            b+=ldB;
            c+=ldC;
         }
      }
      else if((transA=='N')&&(transB=='T'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            a=A;
            b=B;
            for(l=0;l<k;l++)
            {
               t=alpha*b[j];
               for(i=0;i<m;i++)
               {
                  c[i]+=t*a[i];
               }
               a+=ldA;
               b+=ldB;
            }
            c+=ldC;
         }
      }
      else if((transA=='N')&&(transB=='C'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            for(i=0;i<m;i++)
               c[i]*=beta;
            a=A;
            b=B;
            for(l=0;l<k;l++)
            {
               t=alpha*conj(b[j]);
               for(i=0;i<m;i++)
               {
                  c[i]+=t*a[i];
               }
               a+=ldA;
               b+=ldB;
            }
            c+=ldC;
         }
      }
      else if((transA=='T')&&(transB=='T'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               b=B;
               for(l=0;l<k;l++)
               {
                  s+=a[l]*b[j];
                  b+=ldB;
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            c+=ldC;
         }
      }
      else if((transA=='C')&&(transB=='T'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               b=B;
               for(l=0;l<k;l++)
               {
                  s+=conj(a[l])*b[j];
                  b+=ldB;
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            c+=ldC;
         }
      }
      else if((transA=='T')&&(transB=='C'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               b=B;
               for(l=0;l<k;l++)
               {
                  s+=a[l]*conj(b[j]);
                  b+=ldB;
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            c+=ldC;
         }
      }
      else if((transA=='C')&&(transB=='C'))
      {
         c=C;
         for(j=0;j<n;j++)
         {
            a=A;
            for(i=0;i<m;i++)
            {
               s=zero;
               b=B;
               for(l=0;l<k;l++)
               {
                  s+=conj(a[l])*conj(b[j]);
                  b+=ldB;
               }
               c[i]=alpha*s+beta*c[i];
               a+=ldA;
            }
            c+=ldC;
         }
      }
      return 0;
   }

#ifdef __latl_cblas
#include <cblas.h>

   template<> int GEMM<float>(char transA, char transB, int_t m, int_t n, int_t k, float alpha, float *A, int_t ldA, float *B, int_t ldB, float beta, float *C, int_t ldC)
   {
      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;

      const CBLAS_TRANSPOSE TransA=(transA=='N')?CblasNoTrans:((transA=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_TRANSPOSE TransB=(transB=='N')?CblasNoTrans:((transB=='T')?CblasTrans:CblasConjTrans);

      cblas_sgemm(CblasColMajor,TransA,TransB,m,n,k,alpha,A,ldA,B,ldB,beta,C,ldC);

      return 0;
   }

   template<> int GEMM<double>(char transA, char transB, int_t m, int_t n, int_t k, double alpha, double *A, int_t ldA, double *B, int_t ldB, double beta, double *C, int_t ldC)
   {
      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;

      const CBLAS_TRANSPOSE TransA=(transA=='N')?CblasNoTrans:((transA=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_TRANSPOSE TransB=(transB=='N')?CblasNoTrans:((transB=='T')?CblasTrans:CblasConjTrans);

      cblas_dgemm(CblasColMajor,TransA,TransB,m,n,k,alpha,A,ldA,B,ldB,beta,C,ldC);

      return 0;
   }

   template<> int GEMM<float>(char transA, char transB, int_t m, int_t n, int_t k, complex<float> alpha, complex<float> *A, int_t ldA, complex<float> *B, int_t ldB, complex<float> beta, complex<float> *C, int_t ldC)
   {
      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;

      const CBLAS_TRANSPOSE TransA=(transA=='N')?CblasNoTrans:((transA=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_TRANSPOSE TransB=(transB=='N')?CblasNoTrans:((transB=='T')?CblasTrans:CblasConjTrans);

      cblas_cgemm(CblasColMajor,TransA,TransB,m,n,k,&alpha,A,ldA,B,ldB,&beta,C,ldC);

      return 0;
   }

   template<> int GEMM<double>(char transA, char transB, int_t m, int_t n, int_t k, complex<double> alpha, complex<double> *A, int_t ldA, complex<double> *B, int_t ldB, complex<double> beta, complex<double> *C, int_t ldC)
   {
      transA=toupper(transA);
      transB=toupper(transB);

      if((transA!='N')&&(transA!='T')&&(transA!='C'))
         return -1;
      else if((transB!='N')&&(transB!='T')&&(transB!='C'))
         return -2;
      else if(m<0)
         return -3;
      else if(n<0)
         return -4;
      else if(k<0)
         return -5;
      else if(ldA<((transA!='N')?k:m))
         return -8;
      else if(ldB<((transB!='N')?n:k))
         return -10;
      else if(ldC<m)
         return -13;

      const CBLAS_TRANSPOSE TransA=(transA=='N')?CblasNoTrans:((transA=='T')?CblasTrans:CblasConjTrans);
      const CBLAS_TRANSPOSE TransB=(transB=='N')?CblasNoTrans:((transB=='T')?CblasTrans:CblasConjTrans);

      cblas_zgemm(CblasColMajor,TransA,TransB,m,n,k,&alpha,A,ldA,B,ldB,&beta,C,ldC);

      return 0;
   }

#endif
}
#endif