/* applying a t-model to performance data to obtain a robust
   estimate of the mean via ML of the loglikelihood function */

/* PREPROCESSOR FLAGS:
   NR - Algorithms from Numerical Recipes
     NELDER - Nelder-Mead algorithm, not working
     POWELL - Powell's method
     QUASI_NEWTON - quasi-Newton (Newton-Raphson) method
   GSL - algrithms from GSL library
     (select Conjugate gradient, BFGS or steepest decent in function
     gsl_minimize_loglikelihood)
   MAIN - compile with main() and test data
   SUMMARY - short output of results
   DEBUG - turns on various output
*/

// Nealder and Mead: does not work
//gcc -DNR -DMAIN -DNELDER robust.c dfpmin.c lnsrch.c nrutil.c amoeba.c amotry.c -I/usr/include/gsl -lm -L/usr/local/lib -lgsl -lgslcblas -g  -o test.x

// quasi-Newton:
//gcc -DNR -DMAIN -DQUASI_NEWTON robust.c dfpmin.c lnsrch.c nrutil.c -I/usr/include/gsl -lm -L/usr/local/lib -lgsl -lgslcblas -g  -o test.x

// Powell:
// gcc -DNR -DMAIN -DPOWELL robust.c  nrutil.c  powell.c linmin.c f1dim.c mnbrak.c brent.c -I/usr/include/gsl -lm -L/usr/local/lib -lgsl -lgslcblas -g  -o test.x

// GSL:
// gcc -DGSL -DMAIN robust.c dfpmin.c lnsrch.c nrutil.c -I/usr/include/gsl -lm -L/usr/local/lib -lgsl -lgslcblas -g  -o test.x
#if defined(GSL) || defined(NR)

#ifdef NR
#include <stdlib.h>
#include <stdio.h>
#define NRANSI
#include "nr.h"
#include "nrutil.h"
#endif

#ifdef GSL
#include <gsl_math.h>
#include <gsl_sort.h>
#include <gsl_sf_gamma.h>
#include <gsl_sf_psi.h>
#include <gsl_sf_log.h>
#include <gsl/gsl_sf_pow_int.h>
#include <gsl_statistics_double.h>
#include <gsl/gsl_sf_pow_int.h>
#include <gsl_multimin.h>
#endif

#ifdef NR
void get_starting_value(float* x0);
void output_results(float* x0, int iter, float* val);
#endif
#ifdef GSL
void get_starting_value(gsl_vector* x0, void* params);
void output_results(gsl_vector* x0, int iter, double* val, void* params);

void loglikelihood_fdf (const gsl_vector *x, void *params, double *f,
   gsl_vector *df);
int  gsl_minimize_loglikelihood(const double step_size, const double tol,
   const double eps_abs, const int maxiter, gsl_vector* x0, double* val, int* iter,
   void* params);
int  gsl_minimize_loglikelihood_old(const double step_size, const double tol,
   const double eps_abs, const int maxiter, gsl_vector* x0, double* val, int* iter,
   void* params);
#endif

#ifdef NR
void nelder_mead(float* x0, float (*func)(float []), float* ftol,
   float* val);
#endif

static int nfunc;  // number of function calls
static int ndfunc; // number of calls to compute derivative
double nu=3;
int with_nu;
double nustart=4.0;
int ndim;

#ifdef MAIN
/* speed of light data set */
double c_data[66] = {
      28.0, 26.0, 33.0, 24.0, 34.0, -44.0, 27.0, 16.0, 40.0, -2.0,
      29.0, 22.0, 24.0, 21.0, 25.0, 30.0, 23.0, 29.0, 31.0, 19.0,
      24.0, 20.0, 36.0, 32.0, 36.0, 28.0, 25.0, 21.0, 28.0, 29.0,
      37.0, 25.0, 28.0, 26.0, 30.0, 32.0, 36.0, 26.0, 30.0, 22.0,
      36.0, 23.0, 27.0, 27.0, 28.0, 27.0, 31.0, 27.0, 26.0, 33.0,
      26.0, 32.0, 32.0, 24.0, 39.0, 28.0, 24.0, 25.0, 32.0, 25.0,
      29.0, 27.0, 28.0, 29.0, 16.0, 23.0};
#endif

int     ndata;    // #data points
double *data;

/*****************************************************************************/
#ifdef NR
float loglikelihood_f(float x[])
#endif
#ifdef GSL
double loglikelihood_f(const gsl_vector *x, void *params)
#endif
/*****************************************************************************/
{
   double mu, // estimate of location
     sigma2;  // estimate of scale
   double delta, g, psi;

#ifdef GSL
   int ndata;
   double nu, *data;
   double * tmp = (double *) params;
#endif
   double y;  // temporary variable
   int i;

   nfunc++;

#ifdef NR
   mu      = x[1];
   sigma2  = x[2];
   if (with_nu) nu = x[3];
#else
   /* extract arguments and parameters */
   mu     = gsl_vector_get(x, 0);
   sigma2 = gsl_vector_get(x, 1);
   nu     = tmp[0];
   if (nu == 0){
      with_nu = 1;
      nu = gsl_vector_get(x,2);
   }
   ndata   = (int) tmp[1];
   data    = &(tmp[2]);
   //printf("%d %f %f\n", n, nu, data[0]);
#endif

   y = - 0.5 * gsl_sf_log(sigma2) * ndata;
   for (i=0; i<ndata; i++){
     delta = (data[i] - mu)*( data[i] - mu) / (nu * sigma2);
     y = y - 0.5 * (nu + 1.) * gsl_sf_log( 1+delta );
   }

   if (with_nu){ /* compute whole log likelyhood function */
      g =  gsl_sf_lngamma(0.5*(nu+1.)) - gsl_sf_lngamma(0.5*nu)
           - 0.5 * gsl_sf_log(nu);
      y = y + ndata * g;
   }

#ifdef DEBUG
   if (with_nu)
      printf("mu=%.12f, sigma=%.12f, nu=%.12f, y=%.12f\n", mu, sqrt(sigma2), nu, y);
   else
      printf("mu=%.12f, sigma=%.12f, y=%.12f\n", mu, sqrt(sigma2), y);
#endif

   return -y; /* since we're minimizing, not maximizing */

}

/*****************************************************************************/
#ifdef NR
void loglikelihood_df(float x[],float df[])
#endif
#ifdef GSL
void loglikelihood_df(const gsl_vector *x, void *params, gsl_vector *df)
#endif
/*****************************************************************************/
/* this function should store the n-dimensional gradient
g_i = d f(x,params) / d x_i in the vector g for argument x and parameters
params, returning an appropriate error code if the function cannot be computed. */
{
   double mu, sigma2;

   int i, k;
   double dldtheta, dldphi, dldnu, y, r, t, d, g, s1, s2;
#ifdef GSL
   int ndata, with_nu = 0;
   double nu, *data;
   double * tmp = (double *) params;
#endif

   ndfunc++;

#ifdef NR
   /* extract arguments and parameters */
   mu     = x[1];
   sigma2 = x[2];
   if (with_nu)    nu = x[3];
#endif
#ifdef GSL
   /* extract arguments and parameters */
   mu       = gsl_vector_get(x, 0);
   sigma2   = gsl_vector_get(x, 1);
   nu       = tmp[0];
   if (nu == 0){
      with_nu = 1;
      nu = gsl_vector_get(x,2);
   }
   ndata    = (int) tmp[1];
   data     = &(tmp[2]);
   //printf("%d %f %f\n", ndata, nu, data[0]);
   //printf("df mu=%lf sigma=%lf nu=%lf \n", mu, sqrt(sigma2), nu);
#endif

   dldtheta = 0.;
   dldphi   = 0.;
   if (with_nu) {
      dldnu = 0.;
      s1 = 0.;
      s2 = 0.;
   }

   /* calculate terms depending on data[i] */
   for (i=0; i<ndata; i++){
      y = data[i];
      d = y - mu;
      r = d*d / (sigma2*nu);

      dldtheta = dldtheta + d / ( 1 + r );
      dldphi   = dldphi + r / (1+r); // + 0.5/sigma2;
      if (with_nu){
         s1 = s1 +  r / (1+r);  //t * d;
         s2 = s2 +  gsl_sf_log(1+r) ;
      }
   }

   /* add constant terms */
   dldtheta = (nu+1)/(sigma2*nu) * dldtheta;
   dldphi   = - 0.5*ndata/sigma2 + 0.5*(nu+1)/sigma2 * dldphi;
   if (with_nu) {
      /* digamma(z) = psi(z) = d/dz( ln gamma(z) ) */
      g =  0.5 * ndata * ( gsl_sf_psi((nu+1)/2) - gsl_sf_psi(0.5*nu) - 1./nu );
      dldnu    = g + 0.5*(nu+1)/nu * s1 - 0.5 * s2;
   }

   /* change signs since we are minimizing, not maximizing */
#ifdef NR
   df[1] = - dldtheta;
   df[2] = - dldphi;
   if (with_nu)  df[3] = - dldnu;
#endif
#ifdef GSL
   gsl_vector_set(df, 0, - dldtheta);
   gsl_vector_set(df, 1, - dldphi);
   if (with_nu) {
      gsl_vector_set(df, 2, - dldnu);
   }
#endif

#ifdef DEBUG
#ifdef NR
   if (with_nu) printf("  df %lf %lf %lf\n", df[1], df[2], df[3]);
   else printf("  df %lf %lf \n", df[1], df[2]);
#endif
#ifdef GSL
   if (with_nu) printf("  df %lf %lf %lf\n", gsl_vector_get(df, 0), gsl_vector_get(df, 1),
       gsl_vector_get(df, 2));
   else printf("  df %lf %lf \n", gsl_vector_get(df, 0), gsl_vector_get(df, 1));
#endif
#endif
}

/*****************************************************************************/
#ifdef NR
int ml(const int ndata_loc,  double* const data_loc, double* nu, double* mu,
       double* sigma, float* val)
#endif
#ifdef GSL
int ml(const int ndata,      double* const data,     double* nu, double* mu,
       double* sigma, double* val)
#endif
/*****************************************************************************/
/* performs a ML method for a t model
   ndata  (in)      size of data
   data   (in)      data / measurements
   nu     (in/out)  if nu is 0, optimize also for nu and return
                    optimized value
                    if nu is != 0, accept nu as parameter
   mu     (out)     optimized value for mu
   sigma  (out)     optimized value for sigma
   val    (out)     if nu is variable, value of log likelihood function
                    if nu is fixed, value of simplified log likelihood
                    function*/
{
#ifdef NR
   float *x0;            // starting point / maximum
#endif
#ifdef GSL
   gsl_vector *x0;       // starting point / maximum
   double *params;

   double step_size, tol, eps_abs;
#endif
   int maxiter = 1000;
   int iter = 0, i, j;

   /* init starting point */
   if (*nu == 0)
      ndim = 3;
   else
      ndim = 2;

#ifdef NR
   ndata = ndata_loc;
   data  = data_loc;

   x0  = vector(1,ndim);
#endif

#ifdef GSL
   /* init parameters */
   params = malloc((ndata+2)*sizeof(double));
   params[0] = *nu;
   params[1] = (double) ndata;
   for (i=0; i<ndata; i++){
      params[2+i] = data[i];
   }

   x0  = gsl_vector_alloc(ndim);
#endif

#ifdef NR
   get_starting_value(x0);
#endif
#ifdef GSL
   get_starting_value(x0, params);
#endif

   nfunc = ndfunc = 0;

#ifdef NR

#ifdef NELDER
   float ftol = 1.0e-6;
   nelder_mead(x0, loglikelihood_f, &(ftol), val);
#endif

#ifdef POWELL
   float ftol = 1.0e-6;
   float **p;

   p=matrix(1,ndim,1,ndim);
   for (i=1;i<=ndim;i++)
      for (j=1;j<=ndim;j++)
         p[i][j]=(i == j ? 1. : 0.0);
   if (with_nu)
      p[3][3] = 0.01;

   iter = maxiter;
   powell(x0,p,ndim,ftol,&iter,val,loglikelihood_f);

   free_matrix(p,1,ndim,1,ndim);
#endif

#ifdef QUASI_NEWTON
   float gtol = 1.0e-8;
   dfpmin(x0,ndim,gtol,&iter,val,loglikelihood_f,loglikelihood_df);
#endif

// endif NR
#endif

#ifdef GSL
   step_size = 0.1;   // size of first trial step
   tol       = 0.1;   // accuracy of line minimization, 0.1 will do
   eps_abs   = 1e-8;

   gsl_minimize_loglikelihood(step_size, tol, eps_abs, maxiter, x0, val,
      &(iter), params);
#endif

#ifdef SUMMARY
#ifdef NR
   output_results(x0, iter, val);
#endif
#ifdef GSL
   output_results(x0, iter, val, params);
#endif
#endif

#ifdef NR
   *mu     = (double) x0[1];
   *sigma = sqrt((double) x0[2]);
   if (with_nu)
      *nu = (double) x0[3];

   free_vector(x0,1,ndim);
#endif
#ifdef GSL
   *mu    = gsl_vector_get(x0, 0);
   *sigma = sqrt(gsl_vector_get(x0, 1));
   if (with_nu)
      *nu = gsl_vector_get(x0, 2);

   gsl_vector_free(x0);
   free (params);
#endif

   return 0;

}

#ifdef MAIN
/*****************************************************************************/
int main()
/*****************************************************************************/
{
   int i, varnu=0;
#ifdef NR
   float val;
#endif
#ifdef GSL
   double val;
#endif
   double mu, sigma;

   const int ndata_loc = 66;
   double *data_loc = &(c_data[0]);

   //nu = 0.0; with_nu = 1;
   nu =  4.0; with_nu = 0;

   ml(ndata_loc, data_loc, &(nu), &(mu), &(sigma), &(val));

#ifdef SUMMARY
   printf("\n\nReturn values:\n");
   printf("nu=%.5lf mu=%.5lf sigma=%.5lf val=%.5lf\n", nu, mu, sigma, val);
#endif

   return 0;

}
#endif

/*****************************************************************************/
#ifdef NR
void get_starting_value(float* x0)
#endif
#ifdef GSL
void get_starting_value(gsl_vector* x0, void* params)
#endif
/*****************************************************************************/
/* computes an estimate of location and scale                                */
/*****************************************************************************/
{
   double mean, variance;
   double median, *madv, mad;
   int i;

#ifdef GSL
   double* tmp = (double*) params;
   int ndata   = (int) tmp[1];
   double* data    = &(tmp[2]);
#endif

   /* Possiblity I: Use mean and variance as starting value
                    this is probably going to crash when outliers are present */
   mean = gsl_stats_mean(&(data[0]), (size_t) 1,(size_t) ndata);
   variance = gsl_stats_variance_with_fixed_mean(&(data[0]),
      (size_t) 1, (size_t) ndata, mean);
#ifdef NR
   x0[1] = mean;
   x0[2] = variance;
#endif
#ifdef GSL
   gsl_vector_set(x0, 0, mean);
   gsl_vector_set(x0, 1, variance);
#endif

   /* Possiblity II: Use median and 1.483*MAD as starting value
                     Absolute Deviatons MAD(x) = med_i {|x_i - med_j (x_j)|} */
   gsl_sort(data, (size_t) 1, (size_t) ndata);
   median = gsl_stats_median_from_sorted_data(data, (size_t) 1, (size_t) ndata);
   madv = (double*) malloc(ndata * sizeof(double));
   for (i=0; i<ndata; i++){
       madv[i] = abs(data[i] - median);
   }
   gsl_sort(madv, (size_t) 1, (size_t) ndata);
   mad = 1.483 * gsl_stats_median_from_sorted_data(madv, (size_t) 1, (size_t) ndata);
   //printf("median: %20.5f, mad     : %20.5f\n", median, mad);
   //mad = 2 * median; //5.25 * gsl_stats_median_from_sorted_data(madv, (size_t) 1, (size_t) ndata);
   free(madv);

#ifdef NR
   x0[1] = median;
   x0[2] = 0.7*mad*mad;
   if (with_nu)
      x0[3] = nustart;
#ifdef SUMMARY
   printf("\nStarting vector        : ");
   for (i=1;i<=ndim;i++) printf("%12.6f",x0[i]);
#endif
#endif

#ifdef GSL
   gsl_vector_set(x0, 0, median);
   gsl_vector_set(x0, 1, 0.7*mad*mad);
   if (with_nu)
      gsl_vector_set(x0, 2, nustart);
#ifdef SUMMARY
   printf("\nStarting vector        : ");
   for (i=0;i<ndim;i++) printf("%12.6f", gsl_vector_get(x0, i));
#endif
#endif

}

/*****************************************************************************/
#ifdef NR
void output_results(float* x0, int iter, float* val)
#endif
#ifdef GSL
void output_results(gsl_vector* x0, int iter, double* val, void* params)
#endif
/*****************************************************************************/
/* output of minimum  and statistics                                         */
/*****************************************************************************/
{
   int i;
#ifdef NR
   float      *xdf;        // gradient at maximum
   xdf = vector(1,ndim);
#endif

#ifdef GSL
   int with_nu = 0;
   gsl_vector *xdf;      // gradient at maximum
   double* tmp = (double*) params;
   double nu;

   xdf = gsl_vector_alloc(ndim);

   nu = tmp[0];
   if (nu == 0.0) with_nu = 1;
#endif

   printf("\n\nIterations             : %3d\n",iter);
   printf("Func. evals            : %3d\n",nfunc);
#ifdef QUASI_NEWTON
   printf("Deriv. evals           : %3d\n",ndfunc);
#endif

   printf("\nMaximum found at       : ");
#ifdef NR
   x0[2] = sqrt(x0[2]);
   for (i=1;i<=ndim;i++) printf("%12.6f",x0[i]);
   x0[2] = x0[2] * x0[2];
#endif
#ifdef GSL
   gsl_vector_set(x0, 1, sqrt(gsl_vector_get(x0, 1)));
   for (i=0;i<ndim;i++) printf("%12.6f", gsl_vector_get(x0, i));
   gsl_vector_set(x0, 1, gsl_vector_get(x0, 1) * gsl_vector_get(x0, 1));
#endif

   printf("\nMaximum function value : %12.6f\n",*val);

   printf("Derivative at maximum  : ");
#ifdef NR
   loglikelihood_df(x0, xdf);
   for (i=1;i<=ndim;i++) printf("%12.6f",xdf[i]);
#endif
#ifdef GSL
   loglikelihood_df(x0, params, xdf);
   for (i=0;i<ndim;i++) printf("%12.6f",gsl_vector_get(xdf, i));
#endif

#ifdef MAIN
   if (with_nu){ // for variable nu
       printf("\n\nTrue maximum is at (mu_hat, sigma_hat, vu) = (27.40, 3.81, 2.13)\n");
#ifdef NR
       x0[1] =  27.40;
       x0[2] =  3.81*3.81;
       x0[3] =  2.13;
       printf("Test: function value at maximum = %12.6f\n",  loglikelihood_f(x0));
       printf("Derivative at maximum           : ");
       loglikelihood_df(x0, xdf);
       for (i=1;i<=ndim;i++) printf("%12.6f",xdf[i]);
#endif
#ifdef GSL
       gsl_vector_set(x0, 0, 27.40);
       gsl_vector_set(x0, 1, 3.81*3.81);
       gsl_vector_set(x0, 2, 2.13);

       printf("Test: function value at maximum = %12.6f\n",  loglikelihood_f(x0, params));
       loglikelihood_df(x0, params, xdf);
       printf("Derivative at maximum           : ");
       for (i=0;i<ndim;i++) printf("%12.6f",gsl_vector_get(xdf, i));
#endif
   } else {         // for fixed nu=4:
       printf("\n\nTrue maximum is at (mu_hat, sigma_hat) = (27.49, 4.51)\n");
#ifdef NR
       x0[1] =  27.49;
       x0[2] =  4.51 * 4.51;
       printf("Test: function value at maximum : %12.6f\n",  loglikelihood_f(x0));
       printf("Derivative at true maximum      : ");
       loglikelihood_df(x0, xdf);
       for (i=1;i<=ndim;i++) printf("%12.6f",xdf[i]);
#endif
#ifdef GSL
       gsl_vector_set(x0, 0, 27.40);
       gsl_vector_set(x0, 1, 4.51 * 4.51);
       printf("Test: function value at maximum : %12.6f\n",  loglikelihood_f(x0, params));
       loglikelihood_df(x0, params, xdf);
       printf("Derivative at true maximum      : ");
       for (i=0;i<ndim;i++) printf("%12.6f",gsl_vector_get(xdf, i));
#endif
   }
#endif

#ifdef NR
   free_vector(xdf,1,ndim);
#endif
#ifdef GSL
   gsl_vector_free(xdf);
#endif

}

#ifdef NR
#ifdef NELDER
/*****************************************************************************/
void nelder_mead(float* x0, float(*func)(float []), float* ftol,
   float* val)
/*****************************************************************************/
/* computes minimum with method of Nelder and Mead from numerical recipes    */
/*
/* parameters:
/* x0    on input: starting value; on output: minimum
/* func  function
/* ftol  tolerance
/* val   function value at minimum */
/*****************************************************************************/
{
   int i, j;
   float *x, *y, **p;
   double delta_mu, delta_sigma2;

   if (ndim != 2) {
      printf("ndim != 2 not implemented\n");
      exit(0);
   }

   x=vector(1,ndim);
   y=vector(1,ndim+1);
   p=matrix(1,ndim+1,1,ndim);

   delta_mu = 0.5e0;
   delta_sigma2 = 1e0;

   for (i=1;i<=ndim+1;i++) {
      x[1] = p[i][1]=(i == (j+1) ? x0[1] + delta_mu     : x0[1] - delta_mu    );
      x[2] = p[i][2]=(i == (j+1) ? x0[2] + delta_sigma2 : x0[2] - delta_sigma2);
      y[i]=loglikelihood_f(x);
   }

   amoeba(p,y,ndim,*ftol,func,&nfunc);
   y[2] = sqrt(y[2]);

   printf("Vertices of final 3-d simplex and\n");
   printf("function values at the vertices:\n\n");
   printf("%3s %10s %12s %14s\n\n",
      "i","x[i]","y[i]", "function");
   for (i=1;i<=ndim+1;i++) {
      printf("%3d ",i);
      for (j=1;j<=ndim;j++) printf("%12.6f ",p[i][j]);
         printf("%12.6f\n",y[i]);
   }

   for (j=1;j<=ndim;j++) {
      // sum up vertices of final simplex
      x0[j] = p[1][j];
      for (i=2;i<=ndim+1;i++)
         x0[j] = x0[j] + p[i][j];
      // ... and average ...
      x0[j] = x0[j]/(ndim+1);
   }

   // calculate average function value at maximum
   *val = y[1];
   for (i=2;i<=ndim+1;i++)
      *val = *val + y[i];
   *val = *val / (ndim+1);

   free_vector(x,1,ndim);
   free_matrix(p,1,ndim+1,1,ndim);
   free_vector(y,1,ndim+1);
}
//endif NELDER
#endif

//endif NR
#endif

#ifdef GSL
/* Compute both f and df together. */
void loglikelihood_fdf (const gsl_vector *x, void *params, double *f,
   gsl_vector *df)
{
     *f = loglikelihood_f(x, params);
     loglikelihood_df(x, params, df);

     //printf("fdf =%lf %lf %lf %lf \n", gsl_vector_get(x,0), gsl_vector_get(x,1),
     //   gsl_vector_get(df,0), gsl_vector_get(df,1));
}

int  gsl_minimize_loglikelihood(const double step_size, const double tol,
   const double eps_abs, const int maxiter, gsl_vector* x0, double* val, int* iter,
   void* params){
   /*
   s       (in)      GSL multimin fminimizer object
   eps_abs (in)
   maxiter (in)      maximum number of iterations
   iter    (in/out)  number of iterations             */

   const gsl_multimin_fdfminimizer_type *T;
   gsl_multimin_fdfminimizer *s;
   gsl_multimin_function_fdf my_func;
   double* tmp = (double*) params;
   double nu = tmp[0];
   double sigma2;
   int my_iter = 0;
   int status;

   /* init function object */
   if (nu != 0.0) my_func.n = 2;
   else           my_func.n = 3;
   my_func.f   = &loglikelihood_f;
   my_func.df  = &loglikelihood_df;
   my_func.fdf = &loglikelihood_fdf;
   my_func.params = params;

   /* set up solver */
   T = gsl_multimin_fdfminimizer_conjugate_fr;
   // T = gsl_multimin_fdfminimizer_vector_bfgs;
   // T = gsl_multimin_fdfminimizer_steepest_descent;
   if (nu != 0.0)  s = gsl_multimin_fdfminimizer_alloc(T,2);
   else            s = gsl_multimin_fdfminimizer_alloc(T,3);

   /* call minimizer */
   //s->f = my_func->f;
   //gsl_multimin_fminimizer_set(s, &my_func, x0, step_size)
   gsl_multimin_fdfminimizer_set(s, &my_func, x0, step_size, tol);

   /* let gsl minimizer iterate */
   do
   {
      status = gsl_multimin_fdfminimizer_iterate(s);
      if (status) break;

      status = gsl_multimin_test_gradient(s->gradient, eps_abs);
      /* if (status == GSL_SUCCESS){
         printf("Maximum found after %d iterations at:\n", *iter);
      }
      printf ("%5d %.5f %.5f %10.5f\n", *iter,
        gsl_vector_get (s->x, 0), sqrt(gsl_vector_get (s->x, 1)), s->f); */
      (*iter)++;
   } while (status == GSL_CONTINUE && *iter < maxiter);

   /* just precaution */
   sigma2 =  gsl_vector_get(x0, 1);
   if (isnan(sigma2)){
     printf("!!! sigma2 is nan\n");
     printf("%5d %15.5f %15.5f", *iter,
     gsl_vector_get(s->x, 0),
     sqrt(gsl_vector_get(s->x, 1)));
     if (nu == 0.0) printf("%15.5f", gsl_vector_get(s->x, 2));
     printf("%15.5f\n", -gsl_multimin_fdfminimizer_minimum(s));

     exit;
   }

   /* set return values */
   gsl_vector_set(x0, 0, gsl_vector_get(s->x, 0));
   gsl_vector_set(x0, 1, gsl_vector_get(s->x, 1));
   if (nu == 0.0)  /* return optimized value */
       gsl_vector_set(x0, 2, gsl_vector_get(s->x, 2));
   *val   = -gsl_multimin_fdfminimizer_minimum(s);

   /* clean up */
   //gsl_multimin_fminimizer_free(s);
   gsl_multimin_fdfminimizer_free(s);

   return 0;
}

// obsolete
int  gsl_minimize_loglikelihood_old(const double step_size, const double tol,
   const double eps_abs, const int maxiter, gsl_vector* x0, double* val, int* iter,
   void* params){
   /*
   s       (in)      GSL multimin fminimizer object
   eps_abs (in)
   maxiter (in)      maximum number of iterations
   iter    (in/out)  number of iterations             */

   const gsl_multimin_fdfminimizer_type *T;
   gsl_multimin_fdfminimizer *s;
   gsl_multimin_function_fdf my_func;
   double* tmp = (double*) params;
   double nu = tmp[0];
   double sigma2;
   int my_iter = 0;
   int status;

   int converged = 0;
   double start=0.4;
   double median = gsl_vector_get(x0, 0);
   double mad    = gsl_vector_get(x0, 1);
   mad = sqrt(mad/0.7);

   /* init function object */
   if (nu != 0.0) my_func.n = 2;
   else           my_func.n = 3;
   my_func.f   = &loglikelihood_f;
   my_func.df  = &loglikelihood_df;
   my_func.fdf = &loglikelihood_fdf;
   my_func.params = params;

   /* set up solver */
   T = gsl_multimin_fdfminimizer_conjugate_fr;
   // T = gsl_multimin_fdfminimizer_vector_bfgs;
   // T = gsl_multimin_fdfminimizer_steepest_descent;
   if (nu != 0.0)  s = gsl_multimin_fdfminimizer_alloc(T,2);
   else            s = gsl_multimin_fdfminimizer_alloc(T,3);

   /* call minimizer */
   //s->f = my_func->f;
   //gsl_multimin_fminimizer_set(s, &my_func, x0, step_size)

   gsl_multimin_fdfminimizer_set(s, &my_func, x0, step_size, tol);

   do {//while (!converged && my_iter < 10){
      converged = 1;

      /* let gsl minimizer iterate */
      do
      {
         status = gsl_multimin_fdfminimizer_iterate(s);
         if (status) break;

         status = gsl_multimin_test_gradient(s->gradient, eps_abs);
         /* if (status == GSL_SUCCESS){
            printf("Maximum found after %d iterations at:\n", *iter);
         }
         printf ("%5d %.5f %.5f %10.5f\n", *iter,
            gsl_vector_get (s->x, 0), sqrt(gsl_vector_get (s->x, 1)), s->f); */
         (*iter)++;
      } while (status == GSL_CONTINUE && *iter < maxiter);

      sigma2 =  gsl_vector_get(x0, 1);
      if (!isnan(sigma2)) break;

      gsl_vector_set(x0, 0, median);
      gsl_vector_set(x0, 1, start*mad*mad);
      gsl_multimin_fdfminimizer_set (s, &my_func, x0, step_size, tol);
      start = start + 0.5;
      my_iter = my_iter + 1;
      if (my_iter > 1) printf("-- it=%d, sigma=%lf\n", my_iter, sqrt(sigma2));
   } while (my_iter < 10);
  if (*iter > maxiter){
     printf("!!! sigma2 is nan\n");
     printf("%5d %15.5f %15.5f", *iter,
     gsl_vector_get(s->x, 0),
     sqrt(gsl_vector_get(s->x, 1)));
     if (nu == 0.0) printf("%15.5f", gsl_vector_get(s->x, 2));
     printf("%15.5f\n", -gsl_multimin_fdfminimizer_minimum(s));
   }

   gsl_vector_set(x0, 0, gsl_vector_get(s->x, 0));
   gsl_vector_set(x0, 1, gsl_vector_get(s->x, 1));
   if (nu == 0.0)  /* return optimized value */
       gsl_vector_set(x0, 2, gsl_vector_get(s->x, 2));
   *val   = -gsl_multimin_fdfminimizer_minimum(s);

   /* clean up */
   //gsl_multimin_fminimizer_free(s);
   gsl_multimin_fdfminimizer_free(s);

   return 0;
}
//endif GSL
#endif

#endif
// GSL || NR


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

int
main()
{
	unsigned int const len = 1000;
	double x[len];
	double y[len];
	for (int i = 0; i < len; i++)
	{
		x[i] = rand() / (double)RAND_MAX;
		y[i] = rand() / (double)RAND_MAX;
	}
	double ret;
	int inc = 1;
	for (int i = 0; i < len*len; i++)
		ret = cblas_ddot(len, x, inc, y, inc);
	return (int)ret;
}


/* Copyright 2016. The Regents of the University of California.
 * Copyright 2016-2020. Uecker Lab. University Medical Center Göttingen.
 * All rights reserved. Use of this source code is governed by
 * a BSD-style license which can be found in the LICENSE file.
 *
 * Authors:
 * 2016 Jonathan Tamir <jtamir@eecs.berkeley.edu>
 * 2016-2020 Martin Uecker <martin.uecker@med.uni-goettingen.de>
 * 2019-2020 Moritz Blumenthal
 */

#include <assert.h>
#include <complex.h>
#include <stdbool.h>

#include "misc/misc.h"

#ifdef USE_MACPORTS
#include <cblas_openblas.h>
#elif USE_MKL
#include <mkl.h>
#else
#include <cblas.h>
#endif

#ifdef _OPENMP
#include <omp.h>
#endif

#ifdef USE_CUDA
#include <cuComplex.h>
#include <cublas_v2.h>

#include "num/gpuops.h"
#endif

#include "blas.h"

#ifdef USE_CUDA
//blas2_* means, we use the new blas interface, i.e. scalar parameters are written an read by pointers.
//These pointers can point to cpu or gpu memory.

//blas_* uses the old interface where scalar parameters/results are provided/written by value/return.

static void cublas_error(int line, cublasStatus_t code)
{
	error("cublas error: %d in line %d \n", code, line);
}

#define CUBLAS_ERROR(x)	({ cublasStatus_t errval = (x); if (CUBLAS_STATUS_SUCCESS != errval) cublas_error(__LINE__, errval); })

static cublasHandle_t handle;
static _Bool handle_created = false;

static cublasHandle_t get_handle(void)
{
	if (!handle_created)
		CUBLAS_ERROR(cublasCreate(&handle));

	handle_created = true;

	return handle;
}

static void destroy_handle(void)
{
	CUBLAS_ERROR(cublasDestroy(handle));
	handle_created = false;
}

static void cublas_set_pointer_host(void)
{
	(void)get_handle();

	CUBLAS_ERROR(cublasSetPointerMode(handle, CUBLAS_POINTER_MODE_HOST));
}

static void cublas_set_pointer_device(void)
{
	(void)get_handle();

	CUBLAS_ERROR(cublasSetPointerMode(handle, CUBLAS_POINTER_MODE_DEVICE));
}

static cublasOperation_t cublas_trans(char trans)
{
	if (('N' == trans) || ('n'==trans))
		return CUBLAS_OP_N;

	if (('T' == trans) || ('t'==trans))
		return CUBLAS_OP_T;

	if (('C' == trans) || ('c'==trans))
		return CUBLAS_OP_C;

	assert(0);
}
#endif

static void openblas_set_threads(void)
{
#ifndef USE_OPENBLAS
	return;
#else

#ifndef _OPENMP
	return;
#else
	if (1 != openblas_get_parallel())
		return; //pthread version of openblas

	#pragma omp critical
	openblas_set_num_threads(omp_in_parallel() ? 1 : omp_get_max_threads());
#endif
#endif
}

void blas2_cgemm(char transa, char transb, long M, long N, long K, const complex float* alpha, long lda, const complex float* A, long ldb, const complex float* B, const complex float* beta, long ldc, complex float* C)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasCgemm(get_handle(), cublas_trans(transa), cublas_trans(transb), M, N, K, (const cuComplex*)alpha,
			    (const cuComplex*)A, lda, (const cuComplex*)B, ldb, (const cuComplex*)beta, (cuComplex*)C, ldc);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cgemm(CblasColMajor, ('T' == transa) ? CblasTrans : (('C' == transa) ? CblasConjTrans : CblasNoTrans),
		    ('T' == transb) ? CblasTrans : (('C' == transb) ? CblasConjTrans : CblasNoTrans),
		    M, N, K, (void*)alpha, (void*)A, lda, (void*)B, ldb, (void*)beta, (void*)C, ldc);
}

void blas_cgemm(char transa, char transb, long M, long N,  long K, const complex float alpha, long lda, const complex float* A, long ldb, const complex float* B, const complex float beta, long ldc, complex float* C)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasCgemm(get_handle(), cublas_trans(transa), cublas_trans(transb), M, N, K, (const cuComplex*)(&alpha),
			    (const cuComplex*)A, lda, (const cuComplex*)B, ldb, (const cuComplex*)(&beta), (cuComplex*)C, ldc);

		return;
	}
#endif

	openblas_set_threads();

	cblas_cgemm(CblasColMajor, ('T' == transa) ? CblasTrans : (('C' == transa) ? CblasConjTrans : CblasNoTrans),
		    ('T' == transb) ? CblasTrans : (('C' == transb) ? CblasConjTrans : CblasNoTrans),
		    M, N, K, (void*)(&alpha), (void*)A, lda, (void*)B, ldb, (void*)(&beta), (void*)C, ldc);
}

void blas2_cgemv(char trans, long M, long N, const complex float* alpha, long lda, const complex float* A, long incx, const complex float* x, complex float* beta, long incy, complex float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasCgemv(get_handle(), cublas_trans(trans), M, N, (const cuComplex*)alpha,
			    (const cuComplex*)A, lda, (const cuComplex*)x, incx, (const cuComplex*)beta, (cuComplex*)y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cgemv(CblasColMajor, ('T' == trans) ? CblasTrans : (('C' == trans) ? CblasConjTrans : CblasNoTrans),
		    M, N, (void*)alpha, (void*)A, lda, (void*)x, incx, (void*)beta, (void*)y, incy);
}

void blas_cgemv(char trans, long M, long N, complex float alpha, long lda, const complex float* A, long incx, const complex float* x, complex float beta, long incy, complex float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasCgemv(get_handle(), cublas_trans(trans), M, N, (const cuComplex*)&alpha,
			    (const cuComplex*)A, lda, (const cuComplex*)x, incx, (const cuComplex*)&beta, (cuComplex*)y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cgemv(CblasColMajor, ('T' == trans) ? CblasTrans : (('C' == trans) ? CblasConjTrans : CblasNoTrans),
		    M, N, (void*)&alpha, (void*)A, lda, (void*)x, incx, (void*)&beta, (void*)y, incy);
}

void blas2_cgeru(long M, long N, const complex float* alpha, long incx, const complex float* x, long incy, const complex float* y, long lda, complex float* A)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasCgeru(get_handle(), M, N, (const cuComplex*)alpha,
			    (const cuComplex*)x, incx, (const cuComplex*)y, incy, (cuComplex*)A, lda);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cgeru(CblasColMajor, M, N, alpha, x, incx, y, incy, A, lda);
}

void blas_cgeru(long M, long N, complex float alpha, long incx, const complex float* x, long incy, const complex float* y, long lda, complex float* A)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasCgeru(get_handle(), M, N, (const cuComplex*)&alpha,
			    (const cuComplex*)x, incx, (const cuComplex*)y, incy, (cuComplex*)A, lda);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cgeru(CblasColMajor, M, N, &alpha, x, incx, y, incy, (float*)A, lda);
}

void blas2_caxpy(long N, const complex float* alpha, long incx, const complex float* x, long incy, complex float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasCaxpy(get_handle(), N, (const cuComplex*)alpha, (const cuComplex*)x, incx, (cuComplex*)y, incy);

		return;
	}
#endif

	openblas_set_threads();

	cblas_caxpy(N, alpha, x, incx, y, incy);
}

void blas_caxpy(long N, const complex float alpha, long incx, const complex float* x, long incy, complex float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_host();

		cublasCaxpy(get_handle(), N, (const cuComplex*)&alpha, (const cuComplex*)x, incx, (cuComplex*)y, incy);

		return;
	}
#endif

	openblas_set_threads();

	cblas_caxpy(N, &alpha, x, incx, y, incy);
}

void blas2_cscal(long N, const complex float* alpha, long incx, complex float* x)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasCscal(get_handle(), N, (const cuComplex*)alpha, (cuComplex*)x, incx);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cscal(N, alpha, x, incx);
}

void blas_cscal(long N, const complex float alpha, long incx, complex float* x)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_host();

		cublasCscal(get_handle(), N, (const cuComplex*)&alpha, (cuComplex*)x, incx);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cscal(N, &alpha, x, incx);
}

void blas2_cdotu(complex float* result, long N, long incx, const complex float* x, long incy, const complex float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasCdotu(get_handle(), N, (const cuComplex*)x, incx, (const cuComplex*)y, incy, (cuComplex*)result);

		return;
	}
#endif
	openblas_set_threads();

	cblas_cdotu_sub(N, x, incx, y, incy, (void*)result);
}

void blas2_sgemm(char transa, char transb, long M, long N, long K, const float* alpha, long lda, const float* A, long ldb, const float* B, const float* beta, long ldc, float* C)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasSgemm(get_handle(), cublas_trans(transa), cublas_trans(transb), M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sgemm(CblasColMajor, ('T' == transa) ? CblasTrans : (('C' == transa) ? CblasConjTrans : CblasNoTrans),
		    ('T' == transb) ? CblasTrans : (('C' == transb) ? CblasConjTrans : CblasNoTrans),
		    M, N, K, *alpha, A, lda, B, ldb, *beta, C, ldc);
}

void blas_sgemm(char transa, char transb, long M, long N,  long K, const float alpha, long lda, const float* A, long ldb, const float* B, const float beta, long ldc, float* C)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasSgemm(get_handle(), cublas_trans(transa), cublas_trans(transb), M, N, K, &alpha, A, lda, B, ldb, &beta, C, ldc);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sgemm(CblasColMajor, ('T' == transa) ? CblasTrans : (('C' == transa) ? CblasConjTrans : CblasNoTrans),
		    ('T' == transb) ? CblasTrans : (('C' == transb) ? CblasConjTrans : CblasNoTrans),
		    M, N, K, alpha, A, lda, B, ldb, beta, C, ldc);
}

void blas2_sgemv(char trans, long M, long N, const float* alpha, long lda, const float* A, long incx, const float* x, float* beta, long incy, float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasSgemv(get_handle(), cublas_trans(trans), M, N, alpha,
			    (const float*)A, lda, x, incx, beta, y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sgemv(CblasColMajor, ('T' == trans) ? CblasTrans : CblasNoTrans, M, N, *alpha,
		    (const float*)A, lda, x, incx, *beta, y, incy);
}

void blas_sgemv(char trans, long M, long N, const float alpha, long lda, const float* A, long incx, const float* x, float beta, long incy, float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasSgemv(get_handle(), cublas_trans(trans), M, N, &alpha,
			    (const float*)A, lda, x, incx, &beta, y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sgemv(CblasColMajor, ('T' == trans) ? CblasTrans : CblasNoTrans, M, N, alpha,
		    (const float*)A, lda, x, incx, beta, y, incy);
}

void blas2_sger(long M, long N, const float* alpha, long incx, const float* x, long incy, const float* y, long lda, float* A)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_device();

		cublasSger(get_handle(), M, N, alpha, x, incx, y, incy, (float*)A, lda);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sger(CblasColMajor, M, N, *alpha, x, incx, y, incy, (float*)A, lda);
}

void blas_sger(long M, long N, const float alpha, long incx, const float* x, long incy, const float* y, long lda, float* A)
{
#ifdef USE_CUDA

	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		cublasSger(get_handle(), M, N, &alpha, x, incx, y, incy, (float*)A, lda);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sger(CblasColMajor, M, N, alpha, x, incx, y, incy, (float*)A, lda);
}

void blas2_saxpy(long N, const float* alpha, long incx, const float* x, long incy, float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasSaxpy(get_handle(), N, alpha, x, incx, y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_saxpy(N, *alpha, x, incx, y, incy);
}

void blas_saxpy(long N, const float alpha, long incx, const float* x, long incy, float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_host();

		cublasSaxpy(get_handle(), N, &alpha, x, incx, y, incy);

		return;
	}
#endif
	openblas_set_threads();

	cblas_saxpy(N, alpha, x, incx, y, incy);
}

void blas2_sscal(long N, const float* alpha, long incx, float* x)
{
#ifdef USE_CUDA

	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasSscal(get_handle(), N, alpha, x, incx);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sscal(N, *alpha, x, incx);
}

void blas_sscal(long N, float alpha, long incx, float* x)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_host();

		cublasSscal(get_handle(), N, &alpha, x, incx);

		return;
	}
#endif
	openblas_set_threads();

	cblas_sscal(N, alpha, x, incx);
}

void blas2_sdot(float* result, long N, long incx, const float* x, long incy, const float* y)
{
#ifdef USE_CUDA
	if (cuda_ondevice(x)) {

		cublas_set_pointer_device();

		cublasSdot(get_handle(), N, x, incx, y, incy, result);

		return;
	}
#endif
	openblas_set_threads();

	*result = cblas_sdot(N, x, incx, y, incy);
}

void blas_cdgmm(long M, long N, _Bool left_mul, const complex float* A, long lda, const complex float* x, long incx, complex float* C, long ldc)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublasCdgmm(get_handle(), left_mul ? CUBLAS_SIDE_LEFT : CUBLAS_SIDE_RIGHT,
			    M, N, (const cuComplex*)A, lda, (const cuComplex*)x, incx, (cuComplex*)C, ldc);

		return;
	}
#endif
	UNUSED(M);
	UNUSED(N);
	UNUSED(left_mul);
	UNUSED(A);
	UNUSED(lda);
	UNUSED(x);
	UNUSED(incx);
	UNUSED(C);
	UNUSED(ldc);

	assert(0);
}

void blas_sdgmm(long M, long N, _Bool left_mul, const float* A, long lda, const float* x, long incx, float* C, long ldc)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublasSdgmm(get_handle(), left_mul ? CUBLAS_SIDE_LEFT : CUBLAS_SIDE_RIGHT,
			    M, N, A, lda, x, incx, C, ldc);

		return;
	}
#endif
	UNUSED(M);
	UNUSED(N);
	UNUSED(left_mul);
	UNUSED(A);
	UNUSED(lda);
	UNUSED(x);
	UNUSED(incx);
	UNUSED(C);
	UNUSED(ldc);

	assert(0);
}

//B = alpha * op(A)
void blas_cmatcopy(char trans, long M, long N, complex float alpha, const complex float* A, long lda, complex float* B, long ldb)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		complex float zero = 0.;

		cublasCgeam(get_handle(), cublas_trans(trans), cublas_trans('N'),
			    M, N, (const cuComplex*)&alpha, (const cuComplex*)A, lda, (const cuComplex*)&zero, (const cuComplex*)B, ldb, (cuComplex*)B, ldb);

		return;
	}
#endif
	UNUSED(trans);
	UNUSED(M);
	UNUSED(N);
	UNUSED(alpha);
	UNUSED(lda);
	UNUSED(A);
	UNUSED(ldb);
	UNUSED(B);

	assert(0);
}

//B = alpha * op(A)
void blas2_cmatcopy(char trans, long M, long N, const complex float* alpha, const complex float* A, long lda, complex float* B, long ldb)
{
#ifdef USE_CUDA

	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		complex float* zero = cuda_malloc(8);
		cuda_clear(8, zero);

		cublasCgeam(get_handle(), cublas_trans(trans), cublas_trans('N'),
			    M, N, (const cuComplex*)alpha, (const cuComplex*)A, lda, (const cuComplex*)zero, (const cuComplex*)B, ldb, (cuComplex*)B, ldb);

		cuda_free(zero);

		return;
	}
#endif
	UNUSED(trans);
	UNUSED(M);
	UNUSED(N);
	UNUSED(alpha);
	UNUSED(lda);
	UNUSED(A);
	UNUSED(ldb);
	UNUSED(B);

	assert(0);
}

//B = alpha * op(A)
void blas_smatcopy(char trans, long M, long N, float alpha, const float* A, long lda, float* B, long ldb)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		float zero = 0.;

		cublasSgeam(get_handle(), cublas_trans(trans), cublas_trans('N'),
			    M, N, &alpha, A, lda, &zero, B, ldb, B, ldb);

		return;
	}
#endif
	UNUSED(trans);
	UNUSED(M);
	UNUSED(N);
	UNUSED(alpha);
	UNUSED(lda);
	UNUSED(A);
	UNUSED(ldb);
	UNUSED(B);

	assert(0);
}

//B = alpha * op(A)
void blas2_smatcopy(char trans, long M, long N, const float* alpha, const float* A, long lda, float* B, long ldb)
{
#ifdef USE_CUDA
	if (cuda_ondevice(A)) {

		cublas_set_pointer_host();

		float* zero = cuda_malloc(4);
		cuda_clear(4, zero);

		cublasSgeam(get_handle(), cublas_trans(trans), cublas_trans('N'),
			    M, N, alpha, A, lda, zero, B, ldb, B, ldb);

		cuda_free(zero);

		return;
	}
#endif
	UNUSED(trans);
	UNUSED(M);
	UNUSED(N);
	UNUSED(alpha);
	UNUSED(lda);
	UNUSED(A);
	UNUSED(ldb);
	UNUSED(B);

	assert(0);
}

void blas_csyrk(char uplo, char trans, long N, long K, const complex float alpha, long lda, const complex float A[][lda], complex float beta, long ldc, complex float C[][ldc])
{
	assert('U' == uplo);
	assert(('T' == trans) || ('N' == trans));

	cblas_csyrk(CblasColMajor, CblasUpper, ('T' == trans) ? CblasTrans : CblasNoTrans, N, K, (void*)&alpha, (void*)A, lda, (void*)&beta, (void*)C, ldc);
}

void blas_sger_fmac(long M, long N, float* A, const float* x, const float* y)
{
	blas_sger(M, N, 1., 1, x, 1, y, M, A);
}

void blas_gemv_zfmac(long M, long N, complex float* y, const complex float* A, char trans, const complex float* x)
{
	assert((trans == 'N') || (trans == 'T') || (trans == 'C'));

	blas_cgemv(trans,M, N, 1., M, A, 1, x, 1., 1, y);
}

void blas_gemv_fmac(long M, long N, float* y, const float* A, char trans, const float* x)
{
	assert((trans == 'N') || (trans == 'T'));

	blas_sgemv(trans,M, N, 1., M, A, 1, x, 1., 1, y);
}

void blas_matrix_multiply(long M, long N, long K, complex float C[N][M], const complex float A[K][M], const complex float B[N][K])
{
	blas_cgemm('N', 'N', M, N, K, 1. , M, (const complex float*)A, K, (const complex float*)B, 0., M, (complex float*)C);
}

void blas_matrix_zfmac(long M, long N, long K, complex float* C, const complex float* A, char transa, const complex float* B, char transb)
{
	assert((transa == 'N') || (transa == 'T') || (transa == 'C'));
	assert((transb == 'N') || (transb == 'T') || (transb == 'C'));

	long lda = (transa == 'N' ? M: K);
	long ldb = (transb == 'N' ? K: N);

	blas_cgemm(transa, transb, M, N, K, 1., lda, A, ldb, B, 1., M, C);
}


#ifndef __GSL_WRAPPER_H__
#define __GSL_WRAPPER_H__

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

#include <iostream>
#include <cassert>

namespace dvrlib{

struct gsl_exception {
  const char* reason;
  const char* file;
  int line;
  int gsl_errno;
};

void gsl_enable_exceptions();

class vector_view;

class vector {
  gsl_vector* v;
  vector();
public:
  vector(int n);
  vector(int n, double x);
  vector(int n, const double* x);
  vector(const vector& src);
  ~vector();

  gsl_vector* gsl_internal();
  const gsl_vector* gsl_internal() const;

  int size() const;
  void set(int i, double val);
  double get(int i) const;
  double operator[](int i);

  vector& operator=(const vector& src);
  vector& operator+=(const vector& src);
  vector operator+(const vector& src) const;
  vector& operator-=(const vector& src);
  vector operator-(const vector& src) const;
  vector operator-() const;

  vector& operator*=(double d);
  vector operator*(double d) const;
  double norm1() const;
  double norm2() const;

  vector_view subvector(int k, int n);
  const vector_view subvector(int k, int n) const;
  friend class vector_view;
  friend class matrix;
};

vector operator*(double d, const vector& src);
std::ostream& operator<<(std::ostream& out, const vector& vec);

class vector_view: public vector {
  gsl_vector_view vv;
  vector_view(gsl_vector_view vv);

public:
  vector_view(const vector_view& src);
  gsl_vector_view* gsl_internal();
  vector_view& operator=(const vector& src);

  friend class vector;
  friend class matrix;
};

class matrix_view;

class matrix {
  gsl_matrix* m;
  matrix();
public:
  matrix(int n1, int n2, bool id=false, const double* diag=0);
  matrix(int n1, int n2, const double* x);
  template<int n>
    matrix(int n1, int n2, const double (*x)[n]);

  matrix(const matrix& src);
  matrix(const gsl_matrix* src);
  ~matrix();

  gsl_matrix* gsl_internal();
  const gsl_matrix* gsl_internal() const;

  int size1() const;
  int size2() const;
  void set(int i, int j, double val);
  double get(int i, int j) const;
  vector_view operator[](int i);

  matrix& operator=(const matrix& src);

  matrix operator+(const matrix& src) const;
  matrix operator+=(const matrix& src) const;
  matrix operator-(const matrix& src) const;
  matrix operator-=(const matrix& src) const;
  matrix operator-() const;

  vector operator*(const vector& src) const;
  matrix operator*(const matrix& src) const;
  matrix operator*(double d) const;
  matrix operator*=(double d) const;

  matrix transpose() const;
  matrix inverse() const;
  vector linsolve(const vector& b) const;
  void svd(matrix& U, matrix& V, vector& s) const;
  vector svd() const;

  matrix_view submatrix(int k1, int k2, int n1, int n2);
  const matrix_view submatrix(int k1, int k2, int n1, int n2) const;
  friend class matrix_view;
};

template<int n>
matrix::matrix(int n1, int n2, const double (*x)[n]) {
  assert(n==n2);
  m = gsl_matrix_alloc(n1, n2);
  gsl_matrix_const_view  src = gsl_matrix_const_view_array(x[0], n1, n2);
  gsl_matrix_memcpy(m, &src.matrix);
}

matrix operator*(double d, const matrix& src);

std::ostream& operator<<(std::ostream& out, const matrix& vec);

class matrix_view: public matrix {
  gsl_matrix_view mv;
  matrix_view(gsl_matrix_view mv);

public:
  matrix_view(const matrix_view& src);
  gsl_matrix_view* gsl_internal();
  matrix_view& operator=(const matrix& src);

  friend class matrix;
};

std::ostream& operator<<(std::ostream& out, const gsl_vector& v);
std::ostream& operator<<(std::ostream& out, const gsl_matrix& m);
std::ostream& operator<<(std::ostream& out, const gsl_matrix_view& mv);

} // namespace dvrlib

#endif // __GSL_WRAPPER_H__


#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <signal.h>
#include <string.h>
#include <math.h>
#include "cblas.h"
#include <lapacke.h>
#include <unistd.h>
#include <sys/types.h>

#include "spidriver_host.h"
#include "adcdriver_host.h"
#include "matrix_utils.h"

#define PI 3.1415926535

// Length of data buffer
#define NUMPTS 128

// Number of signal vectors
#define PSIG 2

// Sampling frequency.  Must match the sampling frequency commanded
// to the A/D.
#define FSAMP 15625

// Parameters used in searching for peak
#define MAXRECURSIONS 5
#define NGRID 25

//===========================================================
// Utility functions for MUSIC

//-----------------------------------------------------
void find_bracket(int N, float *u, int *ileft, int *iright) {
  // Given input vector y, this finds the max element,
  // then returns the indices of the vectors to its
  // left and right.

  int i;

  i = maxeltf(N, u);
  if (i == 0) {
    *ileft = 0;
    *iright = 1;
  } else if (i == (N-1)) {
    *ileft = N-2;
    *iright = N-1;
  } else {
    *ileft = i-1;
    *iright = i+1;
  }
  return;
}

//-----------------------------------------------------
void extract_noise_vectors(float *A, int m, int n, int c, float *E) {
  // This fcn takes input matrix A of size mxn.  It extracts the vectors
  // of A to the right, starting at col c, and puts the extracted
  // vectors into E.  E has size [m, n-c]

  //printf("Entered extract_noise_vectors, m = %d, n = %d, c = %d\n", m, n, c);
  int i, j, l;
  for (i = 0; i < m; i++) {
    for (j = c; j < n; j++) {
      // printf("i = %d, j = %d, A[i,j] = %f\n", i, j, MATRIX_ELEMENT(A, m, n, i, j));
      l = lindex(m, n-c, i, j-c);
      // printf("lindex(m, n-c, i,j-c) = %d\n", l);
      E[l] = MATRIX_ELEMENT(A, m, n, i, j);
    }
  }
}

//-----------------------------------------------------
float music_sum(float f, float *v, int Mr, int Mc) {
  // This performs the sum over noise space vectors.
  // Since complex numbers are not supported, I split
  // the computation into two parts, real and imag.

  int i, j;

  float *er;
  float *ei;
  float *vi;
  float s, tr, ti;

  // printf("--> Entered music_sum, [row, col] = [%d, %d]\n", Mr, Mc);

  er = (float*) malloc(Mr*sizeof(float));
  ei = (float*) malloc(Mr*sizeof(float));
  vi = (float*) malloc(Mr*sizeof(float));

  // Create e vector
  for(i=0; i<Mr; i++) {
    er[i] = cos(2*PI*i*f);
    ei[i] = sin(2*PI*i*f);
  }

  // Compute denominator
  s = 0;
  for(i=0; i<Mc; i++) {     // iterate over columns.

    // v is a matrix, so extract noise vector vi as column vector.
    for(j=0; j<Mr; j++) {   // iterate over rows
      vi[j] = v[lindex(Mr, Mc, j, i)];
    }
    tr = cblas_sdot(Mr, er, 1, vi, 1);
    ti = cblas_sdot(Mr, ei, 1, vi, 1);
    s = s + tr*tr + ti*ti;
  }

  free(er);
  free(ei);
  free(vi);

  // Must guard against returning inf or nan.
  return (1.0f/s);
}

//-----------------------------------------------------
// Called when Ctrl+C is pressed - triggers the program to stop.
void stopHandler(int sig) {
  adc_quit();
  exit(0);
}

//==========================================================
// This is the main program.  It runs a loop, takes a buffer
// of data from the A/D, then uses the MUSIC algorithm to
// compute the frequency of the input sine wave.
int main (void)
{
  // Loop variables
  uint32_t i, j;

  // Buffers for tx and rx data from A/D registers.
  uint32_t tx_buf[3];
  uint32_t rx_buf[4];

  // Used in LAPACK computations
  int m = NUMPTS;
  int info;
  float superb[NUMPTS-1];

  // Measured voltages from A/D
  float v[NUMPTS];           // Vector of measurements
  float Rxx[NUMPTS*NUMPTS];  // Covariance matrix.
  float U[NUMPTS * NUMPTS];
  float S[NUMPTS];
  float VT[NUMPTS * NUMPTS];

  float Nu[NUMPTS * (NUMPTS-PSIG)];  // Vector of noises

  // Used in finding peak corresponding to dominant frequency
  float f[NGRID];
  float Pmu[NGRID];
  int ileft, iright;
  float fleft, fright, fpeak;

  // Stuff used with "hit return when ready..."
  char dummy[8];

  printf("------------   Starting main.....   -------------\n");

  // Run until Ctrl+C pressed:
  signal(SIGINT, stopHandler);

  // Sanity check user.
  if(getuid()!=0){
     printf("You must run this program as root. Exiting.\n");
     exit(EXIT_FAILURE);
  }

  // Initialize A/D converter
  adc_config();
  adc_set_samplerate(SAMP_RATE_15625);
  adc_set_chan0();

  // Now loop forever, read buffer, and compute frequency.
  // printf("--------------------------------------------------\n");
  while(1) {

    // Do A/D read to fill buffer with NUMPTS measurements.
    adc_read_multiple(NUMPTS, v);
    //printf("Values read = \n");
    //for (i=0; i<NUMPTS; i++) {
    //  printf("i = %d, v = %e\n", i, v[i]);
    //}

    // Zero out Rxx prior to filling it using sger
    zeros(m, m, Rxx);

    // Create covariance matrix by doing outer product of v with
    // itself.
    cblas_sger(CblasRowMajor,    /* Row-major storage */
               m,                /* Row count for Rxx  */
               m,                /* Col count for Rxx  */
               1.0f,             /* scale factor to apply to v*v' */
               v,
               1,                /* stride between elements of v. */
               v,
               1,                /* stride between elements of v. */
               Rxx,
               m);               /* leading dimension of matrix Rxx. */
    //printf("\nMatrix Rxx (%d x %d) =\n", m, m);
    //print_matrix(Rxx, m, m);

    // Now compute SVD of Rxx.
    info = LAPACKE_sgesvd(LAPACK_ROW_MAJOR, 'A', 'A',
                  m, m, Rxx,
                  m, S, U, m,
                  VT, m, superb);
    if (info != 0)  {
      fprintf(stderr, "Error: dgesvd returned with a non-zero status (info = %d)\n", info);
      return(-1);
    }

    //printf("\nMatrix U (%d x %d) is:\n", m, m);
    //print_matrix(U, m, m);

    //printf("\nVector S (%d x %d) is:\n", m, 1);
    //print_matrix(S, m, 1);

    //printf("\nMatrix VT (%d x %d) is:\n", m, m);
    //print_matrix(VT, m, m);

    // Extract noise vectors here.  The noise vectors are held in Nu
    extract_noise_vectors(U, m, m, PSIG, Nu);
    //printf("\nMatrix Nu (%d x %d) is:\n", m, NUMPTS-PSIG);
    //print_matrix(Nu, m, NUMPTS-PSIG);

    // Now find max freq.  Set up initial grid endpoints.  Freqs are
    // in units of Hz.
    fleft = 0.0f;
    fright = FSAMP/2.0f;

    for (j=0; j<MAXRECURSIONS; j++) {
      // printf("fleft = %f, fright = %f\n", fleft, fright);

      // Set up search grid
      linspace(fleft, fright, NGRID, f);
      //printf("\nVector f =\n");
      //print_matrix(f, NGRID, 1);

      // Compute vector of amplitudes Pmu on grid.  music_sum wants normalized
      // frequencies
      for (i = 0; i < NGRID; i++) {
        Pmu[i] = music_sum(f[i]/FSAMP, Nu, NUMPTS, NUMPTS-PSIG);
      }
      //printf("\nVector Pmu =\n");
      //print_matrix(Pmu, NGRID, 1);

      find_bracket(NGRID, Pmu, &ileft, &iright);
      fleft = f[ileft];
      fright = f[iright];
    }
    fpeak = (fleft+fright)/2.0f;   // Assume peak is average of fleft and fright
    printf("Peak frequency found at f = %f Hz\n", fpeak);

    // usleep(500000);   // delay 1/2 sec.
  }

}


#ifndef structs_h
#define structs_h

#include <ceed.h>
#include <petsc.h>
#include "../problems/cl-problems.h"

// -----------------------------------------------------------------------------
// Command Line Options
// -----------------------------------------------------------------------------
// Forcing function options
typedef enum {
  FORCE_NONE = 0, FORCE_CONST = 1, FORCE_MMS = 2
} forcingType;
static const char *const forcing_types[] = {"none",
                                            "constant",
                                            "mms",
                                            "forcingType","FORCE_",0
                                           };
static const char *const forcing_types_for_disp[] = {"None",
                                                     "Constant",
                                                     "Manufactured solution"
                                                    };

// Multigrid options
typedef enum {
  MULTIGRID_LOGARITHMIC = 0, MULTIGRID_UNIFORM = 1, MULTIGRID_NONE = 2
} multigridType;
static const char *const multigrid_types [] = {"logarithmic",
                                               "uniform",
                                               "none",
                                               "multigridType","MULTIGRID",0
                                              };
static const char *const multigrid_types_for_disp[] = {"P-multigrid, logarithmic coarsening",
                                                       "P-multigrind, uniform coarsening",
                                                       "No multigrid"
                                                      };

// -----------------------------------------------------------------------------
// Application data structs
// -----------------------------------------------------------------------------
// Units
typedef struct Units_ *Units;
struct Units_ {
  // Fundamental units
  PetscScalar meter;
  PetscScalar kilogram;
  PetscScalar second;
  // Derived unit
  PetscScalar Pascal;
};

// Application context from user command line options
typedef struct AppCtx_ *AppCtx;
struct AppCtx_ {
  const char    *name, *name_for_disp;                 // problem name
  char          ceed_resource[PETSC_MAX_PATH_LEN];     // libCEED backend
  char          mesh_file[PETSC_MAX_PATH_LEN];         // exodusII mesh file
  char          output_dir[PETSC_MAX_PATH_LEN];
  PetscBool     test_mode;
  PetscBool     view_soln;
  PetscBool     view_final_soln;
  PetscViewer   energy_viewer;
  problemType   problem_choice;
  forcingType   forcing_choice;
  multigridType multigrid_choice;
  PetscInt      degree;
  PetscInt      q_extra;
  PetscInt      num_levels;
  PetscInt      *level_degrees;
  PetscInt      num_increments;                        // Number of steps
  PetscInt      bc_clamp_count;
  PetscInt      bc_clamp_faces[16];
  // [translation; 3] [rotation axis; 3] [rotation magnitude c_0, c_1]
  // The rotations are (c_0 + c_1 s) \pi, where s = x · axis
  PetscScalar   bc_clamp_max[16][8];
  PetscInt      bc_traction_count;
  PetscInt      bc_traction_faces[16];
  PetscScalar   bc_traction_vector[16][3];
  PetscScalar   forcing_vector[3];
  PetscReal     test_tol;
  PetscReal     expect_final_strain;
};

// Forcing function data
typedef struct {
  CeedQFunctionUser setup_forcing;
  const char        *setup_forcing_loc;
} forcingData;

extern forcingData forcing_options[3];

// Data for PETSc Matshell
typedef struct UserMult_ *UserMult;
struct UserMult_ {
  MPI_Comm        comm;
  DM              dm;
  Vec             X_loc, Y_loc, neumann_bcs;
  CeedVector      x_ceed, y_ceed;
  CeedOperator    op;
  CeedQFunction   qf;
  Ceed            ceed;
  PetscScalar     load_increment;
  CeedQFunctionContext ctx_phys, ctx_phys_smoother;
};

// Data for Jacobian setup routine
typedef struct FormJacobCtx_ *FormJacobCtx;
struct FormJacobCtx_ {
  UserMult     *jacob_ctx;
  PetscInt     num_levels;
  SNES         snes_coarse;
  Mat          *jacob_mat, jacob_mat_coarse;
  Vec          u_coarse;
};

// Data for PETSc Prolongation/Restriction Matshell
typedef struct UserMultProlongRestr_ *UserMultProlongRestr;
struct UserMultProlongRestr_ {
  MPI_Comm     comm;
  DM           dm_c, dm_f;
  Vec          loc_vec_c, loc_vec_f;
  CeedVector   ceed_vec_c, ceed_vec_f;
  CeedOperator op_prolong, op_restrict;
  Ceed         ceed;
};

#define SOLIDS_MAX_NUMBER_FIELDS 16

// libCEED data struct for level
typedef struct CeedData_ *CeedData;
struct CeedData_ {
  Ceed                ceed;
  CeedBasis           basis_x, basis_u, basis_c_to_f, basis_energy,
                      basis_diagnostic;
  CeedElemRestriction elem_restr_x, elem_restr_u, elem_restr_geo_data_i,
                      elem_restr_energy, elem_restr_diagnostic,
                      elem_restr_geo_data_diagnostic_i,
                      elem_restr_stored_fields_i[SOLIDS_MAX_NUMBER_FIELDS];
  CeedQFunction       qf_residual, qf_jacobian, qf_energy, qf_diagnostic;
  CeedOperator        op_residual, op_jacobian, op_restrict, op_prolong,
                      op_energy,
                      op_diagnostic;
  CeedVector          geo_data, geo_data_diagnostic, x_ceed, y_ceed,
                      true_soln, stored_fields[SOLIDS_MAX_NUMBER_FIELDS];
};

typedef struct {
  CeedQFunctionUser setup_geo, residual, jacobian, energy,
                    diagnostic, true_soln;
  const char *setup_geo_loc, *residual_loc, *jacobian_loc, *energy_loc,
        *diagnostic_loc, *true_soln_loc;
  CeedQuadMode quadrature_mode;
  CeedInt geo_data_size, number_fields_stored;
  CeedInt *field_sizes;
  const char *const *field_names;
} ProblemData;

#endif // structs_h


/**
 *
 * @file core_zlaset2.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 Hatem Ltaief
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_zlaset2 - Sets the elements of the matrix A to alpha.
 *  Not LAPACK compliant! Read below.
 *
 *******************************************************************************
 *
 * @param[in] uplo
 *          Specifies which elements of the matrix are to be set
 *          = PlasmaUpper: STRICT Upper part of A is set to alpha;
 *          = PlasmaLower: STRICT Lower part of A is set to alpha;
 *          = PlasmaUpperLower: ALL elements of A are set to alpha.
 *          Not LAPACK Compliant.
 *
 * @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] alpha
 *         The constant to which the elements are to be set.
 *
 * @param[in,out] A
 *         On entry, the M-by-N tile A.
 *         On exit, A has been set to alpha accordingly.
 *
 * @param[in] LDA
 *         The leading dimension of the array A.  LDA >= max(1,M).
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlaset2 = PCORE_zlaset2
#define CORE_zlaset2 PCORE_zlaset2
#endif
void CORE_zlaset2(PLASMA_enum uplo, int M, int N,
                  PLASMA_Complex64_t alpha, PLASMA_Complex64_t *A, int LDA)
{
    if (uplo == PlasmaUpper) {
        LAPACKE_zlaset_work(
            LAPACK_COL_MAJOR,
            lapack_const(uplo),
            M, N-1, alpha, alpha, A+LDA, LDA);
    }
    else if (uplo == PlasmaLower) {
        LAPACKE_zlaset_work(
            LAPACK_COL_MAJOR,
            lapack_const(uplo),
            M-1, N, alpha, alpha, A+1, LDA);
    }
    else {
        LAPACKE_zlaset_work(
            LAPACK_COL_MAJOR,
            lapack_const(uplo),
            M, N, alpha, alpha, A, LDA);
    }
}


#if MKL_FOUND
#include <mkl.h>
#elif BLAS_FOUND
  #if WASM_COMPATIBLE_BLAS
    #include "3rd_party/onnxjs/src/wasm-ops/gemm.h"
  #else
    #include <cblas.h>
  #endif // WASM_COMPATIBLE_BLAS
#endif

inline void sgemm(bool transA,
                  bool transB,
                  int rows_a,
                  int rows_b,
                  int width,
                  float alpha,
                  float* a,
                  int lda,
                  float* b,
                  int ldb,
                  float beta,
                  float* c,
                  int ldc) {
#if BLAS_FOUND
    #if WASM_COMPATIBLE_BLAS
        gemm_f32_imp(transA, transB, rows_a, rows_b, width, alpha, a, b, beta, c);
    #else
        cblas_sgemm(CblasRowMajor,
                    transA ? CblasTrans : CblasNoTrans,
                    transB ? CblasTrans : CblasNoTrans,
                    rows_a,
                    rows_b,
                    width,
                    alpha,
                    a,
                    lda,
                    b,
                    ldb,
                    beta,
                    c,
                    ldc);
    #endif
#else
    transA; transB; rows_a; rows_b; width; alpha; a; lda; b; ldb; beta; c; ldc; // make compiler happy
    ABORT("Marian must be compiled with a BLAS library");
#endif
}


#ifndef EXAMPLE_GENERATOR_H
#define EXAMPLE_GENERATOR_H

#include <opencv/cv.h>
#include <opencv2/core/core.hpp>
#include <opencv2/highgui/highgui.hpp>

#include "helper/bounding_box.h"
#include "loader/loader_imagenet_det.h"
#include "loader/video.h"
#include "helper/Common.h"
#include "helper/CommonCV.h"
#include "helper/Constants.h"

#include <stdlib.h>     /* srand, rand */
#include <time.h>       /* time */
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h> /* GAUSSIAN*/

struct BBParams {
  double lambda_shift;
  double lambda_scale;
  double min_scale;
  double max_scale;
};

// Generates additional training examples by taking random crops of the target object,
// causing apparent translation and scale changes.
class ExampleGenerator
{
public:
  ExampleGenerator(const double lambda_shift, const double lambda_scale,
                   const double min_scale, const double max_scale);

  // Set up to train on the previous and current image, and the previous and current bounding boxes.
  void Reset(const BoundingBox& bbox_prev, const BoundingBox& bbox_curr,
             const cv::Mat& image_prev, const cv::Mat& image_curr);

  // Shift the whole bounding box for the current frame
  // (simulates camera motion)
  void MakeTrainingExampleBBShift(const bool visualize_example,
                                  cv::Mat* image_rand_focus,
                                  cv::Mat* target_pad,
                                  BoundingBox* bbox_gt_scaled) const;
  void MakeTrainingExampleBBShift(cv::Mat* image_rand_focus,
                                  cv::Mat* target_pad,
                                  BoundingBox* bbox_gt_scaled) const;

  // Focus the current image at the location of the previous frame's
  // bounding box (true motion).
  void MakeTrueExample(cv::Mat* image_focus, cv::Mat* target_pad,
                       BoundingBox* bbox_gt_scaled) const;
  void MakeTrueExampleTight(cv::Mat* image_focus, cv::Mat* target_tight,
                      BoundingBox* bbox_gt_scaled) const;

  // Make batch_size training examples according to the input parameters.
  void MakeTrainingExamples(const int num_examples, std::vector<cv::Mat>* images,
                            std::vector<cv::Mat>* targets,
                            std::vector<BoundingBox>* bboxes_gt_scaled);

  // Helper function to generate one moved box, non-gaussian version
  // trans_range, scale_range are defaults for uniform sampling of uniform samples
  static BoundingBox GenerateOneRandomCandidate(BoundingBox &bbox, gsl_rng* rng, int W, int H,
                                                const string method = "uniform", const double trans_range = POS_TRANS_RANGE, const double scale_range = POS_SCALE_RANGE,
                                                const double sd_x = SD_X, const double sd_y = SD_Y, const double sd_scale = SD_SCALE);

  // Make candidates given one frame
  // candidates: 200 neg and 50 pos candidates
  // labels: vector of scalar 1 means pos and 0 means neg
  // fixed number output, candidates and labels will have size == num_pos + num_neg
  void MakeCandidatesAndLabels(vector<Mat> *candidates, vector<double> *labels,
                               const int num_pos = POS_CANDIDATES,
                               const int num_neg = NEG_CANDIDATES);

  // Actual woker under MakeCandidatesAndLabels
  void MakeCandidatesAndLabelsBBox(vector<BoundingBox> *candidate_bboxes, vector<double> *labels,
                                   const int num_pos = POS_CANDIDATES,
                                   const int num_neg = NEG_CANDIDATES);

  void MakeCandidatesPos(vector<BoundingBox> *candidates, const int num = POS_CANDIDATES,
                                  const string method = "gaussian", const double trans_range = POS_TRANS_RANGE, const double scale_range = POS_SCALE_RANGE,
                                  const double sd_x = SD_X, const double sd_y = SD_Y, const double sd_scale = SD_SCALE, const double pos_iou_th = POS_IOU_TH );

  void MakeCandidatesNeg(vector<BoundingBox> *candidates, const int num = NEG_CANDIDATES,
                                  const string method = "uniform", const double trans_range = 2 * SD_X, const double scale_range = POS_SCALE_RANGE,
                                  const double sd_x = SD_X, const double sd_y = SD_Y, const double sd_scale = SD_SCALE);

  void set_indices(const int video_index, const int frame_index) {
    video_index_ = video_index; frame_index_ = frame_index;
  }

private:
  void MakeTrainingExampleBBShift(const bool visualize_example,
                                  const BBParams& bbparams,
                                  cv::Mat* image_rand_focus,
                                  cv::Mat* target_pad,
                                  BoundingBox* bbox_gt_scaled) const;

  void VisualizeExample(const cv::Mat& target_pad,
                        const cv::Mat& image_rand_focus,
                        const BoundingBox& bbox_gt_scaled) const;

  void get_default_bb_params(BBParams* default_params) const;

  // To generate synethic examples, shift the bounding box by an exponential with the given lambda parameter.
  double lambda_shift_;

  // To generate synethic examples, shift the bounding box by an exponential with the given lambda parameter.
  double lambda_scale_;

  // Do not scale the synthetic examples by more than max_scale_ shrink them by more than min_scale_.
  double min_scale_;
  double max_scale_;

  // Current training image.
  cv::Mat image_curr_;

  // Location of the target within the current and previous images.
  BoundingBox bbox_curr_gt_;
  BoundingBox bbox_prev_gt_;

  // Cropped and scaled image of the target object from the previous image.
  cv::Mat target_pad_;
  // tight previous target in previous image
  cv::Mat target_tight_;

  // Video and frame index from which the current example was generated.
  // These values are only used when saving images to a file, to assign them
  // a unique identifier.
  int video_index_;
  int frame_index_;

  gsl_rng* rng_;

  static std::mt19937 engine_;
};

#endif // EXAMPLE_GENERATOR_H


/* Copyright (c) 2014, Giuseppe Argentieri <giuseppe.argentieri@ts.infn.it>

 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * 1. Redistributions of source code must retain the above copyright notice,
 * this list of conditions and the following disclaimer.
 *
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 * this list of conditions and the following disclaimer in the documentation
 * and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 * POSSIBILITY OF SUCH DAMAGE.
 *
 */
/*
 *
 *
 *       Filename:  posit.c
 *
 *    Description:  Determine the positivity violation of the Redfield dynamics
 *    			on a given initial pure state
 *
 *        Version:  1.0
 *        Created:  20/07/2014 09:59:35
 *       Revision:  none
 *        License:  BSD
 *
 *         Author:  Giuseppe Argentieri (ga), giuseppe.argentieri@ts.infn.it
 *   Organization:  Università degli Studi di Trieste
 *
 *
 */

#include "initial.h"
#include "funcs.h"

#include <stdlib.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>

/*
 *      FUNCTION
 *         Name:  main
 *  Description:
 *
 */
int main ( int argc, char *argv[] )
{
	double o_eff = gsl_hypot(OMEGA, D);

	/* sigma^z eigenstates, Bloch vectorial form */
	double z_minus[] = { 1, 0, -OMEGA/o_eff, -D/o_eff };
	double z_plus[]  = { 1, 0,  OMEGA/o_eff,  D/o_eff };
	gsl_vector* z_m = gsl_vector_calloc(4);
	gsl_vector* z_p = gsl_vector_calloc(4);

	int i;
	for ( i = 0; i < 4; i++ ) {
		gsl_vector_set( z_m, i, z_minus[i] );
		gsl_vector_set( z_p, i, z_plus[i]  );
	}

	/* parameters */
	double r, theta;

	return EXIT_SUCCESS;
}				/* ----------  end of function main  ---------- */

/*
 *      FUNCTION
 *         Name:  state_matrix
 *  Description:  return the density patrix of the pure state |psi><psi|
 *
 */
gsl_matrix_complex* state_matrix ( double r, double theta )
{
	gsl_matrix_complex* psi = gsl_matrix_complex_calloc (2, 2);
	gsl_matrix_complex_set ( psi, 1, 1, gsl_complex_rect(r*r, 0) );
	gsl_matrix_complex_set ( psi, 1, 2, gsl_complex_rect(r*sqrt(1-r*r)*cos(theta),
				r*sqrt(1-r*r)*sin(theta)) );
	gsl_matrix_complex_set ( psi, 2, 1, gsl_complex_rect(r*sqrt(1-r*r)*cos(theta),
				-r*sqrt(1-r*r)*sin(theta)) );
	gsl_matrix_complex_set ( psi, 2, 2, gsl_complex_rect(1-r*r, 0) );

	return psi;
}		/* -----  end of function state_matrix  ----- */

/*
 *      FUNCTION
 *         Name:  rotate
 *  Description:  return the density matrix in the rotated frame of reference
 *  			of an angle OMEGA*t
 *
 */
gsl_matrix_complex* rotate ( gsl_matrix_complex* m, double t )
{
	/* copy m into a working matrix M */
	gsl_matrix_complex* M = gsl_matrix_complex_calloc ( 2, 2);
	gsl_matrix_complex_memcpy( M, m );

	/* rotation matrix */
	gsl_matrix_complex* Rot = gsl_matrix_complex_calloc( 2, 2 );

	gsl_matrix_complex_set ( Rot, 1, 1, gsl_complex_rect( cos(OMEGA*t/2), 0) );
	gsl_matrix_complex_set ( Rot, 1, 2, gsl_complex_rect( -sin(OMEGA*t/2), 0));
	gsl_matrix_complex_set ( Rot, 2, 1, gsl_complex_rect( sin(OMEGA*t/2), 0) );
	gsl_matrix_complex_set ( Rot, 2, 2, gsl_complex_rect( cos(OMEGA*t/2), 0) );

	/* inverse of Rot:
	 *
	 * first perform the LU decomposition of Rot: */
	gsl_permutation* perm = gsl_permutation_calloc(2);
	int signum;
	gsl_matrix_complex* Rot_lu = gsl_matrix_complex_calloc( 2, 2 );
	gsl_matrix_complex_memcpy ( Rot_lu, Rot );
	gsl_linalg_complex_LU_decomp ( Rot_lu, perm, &signum);
	/* then calculate Rot_inv: */
	gsl_matrix_complex* Rot_inv = gsl_matrix_complex_calloc( 2, 2 );
	gsl_linalg_complex_LU_invert ( Rot_lu, perm, Rot_inv );

	/* Finally calculate Rot * m * Rot_inv */
	gsl_blas_zgemm ( CblasNoTrans, CblasNoTrans, gsl_complex_rect(1.,0),
			Rot, M, gsl_complex_rect(0,0), M );
	gsl_blas_zgemm ( CblasNoTrans, CblasNoTrans, gsl_complex_rect(1.,0),
			M, Rot_inv, gsl_complex_rect(0,0), M );

	return (M);
}		/* -----  end of function rotate  ----- */

/*
 *      FUNCTION
 *         Name:  D_psi
 *  Description:  the matrix D[|psi><psi|]
 *
 */
gsl_matrix_complex* D_psi ( gsl_matrix_complex* dpsi )
{
	gsl_matrix_complex* dp = gsl_matrix_complex_calloc(2, 2);

	return (dp);
}		/* -----  end of function D_psi  ----- */


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

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_rng.h>

/* This file provides support for random() generators. There are three
   versions in widespread use today,

   - The original BSD version, e.g. on SunOS 4.1 and FreeBSD.

   - The Linux libc5 version, which is differs from the BSD version in
   its seeding procedure, possibly due to the introduction of a typo
   in the multiplier.

   - The GNU glibc2 version, which has a new (and better) seeding
   procedure.

   They all produce different numbers, due to the different seeding
   algorithms, but the algorithm for the generator is the same in each
   case.

 */

static inline long int random_get (int * i, int * j, int n, long int * x);

static inline unsigned long int random8_get (void *vstate);
static inline unsigned long int random32_get (void *vstate);
static inline unsigned long int random64_get (void *vstate);
static inline unsigned long int random128_get (void *vstate);
static inline unsigned long int random256_get (void *vstate);

static double random8_get_double (void *vstate);
static double random32_get_double (void *vstate);
static double random64_get_double (void *vstate);
static double random128_get_double (void *vstate);
static double random256_get_double (void *vstate);

static void random8_glibc2_set (void *state, unsigned long int s);
static void random32_glibc2_set (void *state, unsigned long int s);
static void random64_glibc2_set (void *state, unsigned long int s);
static void random128_glibc2_set (void *state, unsigned long int s);
static void random256_glibc2_set (void *state, unsigned long int s);

static void random8_libc5_set (void *state, unsigned long int s);
static void random32_libc5_set (void *state, unsigned long int s);
static void random64_libc5_set (void *state, unsigned long int s);
static void random128_libc5_set (void *state, unsigned long int s);
static void random256_libc5_set (void *state, unsigned long int s);

static void random8_bsd_set (void *state, unsigned long int s);
static void random32_bsd_set (void *state, unsigned long int s);
static void random64_bsd_set (void *state, unsigned long int s);
static void random128_bsd_set (void *state, unsigned long int s);
static void random256_bsd_set (void *state, unsigned long int s);

static void bsd_initialize (long int * x, int n, unsigned long int s);
static void libc5_initialize (long int * x, int n, unsigned long int s);
static void glibc2_initialize (long int * x, int n, unsigned long int s);

typedef struct
  {
    long int x;
  }
random8_state_t;

typedef struct
  {
    int i, j;
    long int x[7];
  }
random32_state_t;

typedef struct
  {
    int i, j;
    long int x[15];
  }
random64_state_t;

typedef struct
  {
    int i, j;
    long int x[31];
  }
random128_state_t;

typedef struct
  {
    int i, j;
    long int x[63];
  }
random256_state_t;

static inline unsigned long int
random8_get (void *vstate)
{
  random8_state_t *state = (random8_state_t *) vstate;

  state->x = (1103515245 * state->x + 12345) & 0x7fffffffUL;
  return state->x;
}

static inline long int
random_get (int * i, int * j, int n, long int * x)
{
  long int k ;

  x[*i] += x[*j] ;
  k = (x[*i] >> 1) & 0x7FFFFFFF ;

  (*i)++ ;
  if (*i == n)
    *i = 0 ;

  (*j)++ ;
  if (*j == n)
    *j = 0 ;

  return k ;
}

static inline unsigned long int
random32_get (void *vstate)
{
  random32_state_t *state = (random32_state_t *) vstate;
  unsigned long int k = random_get (&state->i, &state->j, 7, state->x) ;
  return k ;
}

static inline unsigned long int
random64_get (void *vstate)
{
  random64_state_t *state = (random64_state_t *) vstate;
  long int k = random_get (&state->i, &state->j, 15, state->x) ;
  return k ;
}

static inline unsigned long int
random128_get (void *vstate)
{
  random128_state_t *state = (random128_state_t *) vstate;
  unsigned long int k = random_get (&state->i, &state->j, 31, state->x) ;
  return k ;
}

static inline unsigned long int
random256_get (void *vstate)
{
  random256_state_t *state = (random256_state_t *) vstate;
  long int k = random_get (&state->i, &state->j, 63, state->x) ;
  return k ;
}

static double
random8_get_double (void *vstate)
{
  return random8_get (vstate) / 2147483648.0 ;
}

static double
random32_get_double (void *vstate)
{
  return random32_get (vstate) / 2147483648.0 ;
}

static double
random64_get_double (void *vstate)
{
  return random64_get (vstate) / 2147483648.0 ;
}

static double
random128_get_double (void *vstate)
{
  return random128_get (vstate) / 2147483648.0 ;
}

static double
random256_get_double (void *vstate)
{
  return random256_get (vstate) / 2147483648.0 ;
}

static void
random8_bsd_set (void *vstate, unsigned long int s)
{
  random8_state_t *state = (random8_state_t *) vstate;

  if (s == 0)
    s = 1;

  state->x = s;
}

static void
random32_bsd_set (void *vstate, unsigned long int s)
{
  random32_state_t *state = (random32_state_t *) vstate;
  int i;

  bsd_initialize (state->x, 7, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 7 ; i++)
    random32_get (state) ;
}

static void
random64_bsd_set (void *vstate, unsigned long int s)
{
  random64_state_t *state = (random64_state_t *) vstate;
  int i;

  bsd_initialize (state->x, 15, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 15 ; i++)
    random64_get (state) ;
}

static void
random128_bsd_set (void *vstate, unsigned long int s)
{
  random128_state_t *state = (random128_state_t *) vstate;
  int i;

  bsd_initialize (state->x, 31, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 31 ; i++)
    random128_get (state) ;
}

static void
random256_bsd_set (void *vstate, unsigned long int s)
{
  random256_state_t *state = (random256_state_t *) vstate;
  int i;

  bsd_initialize (state->x, 63, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 63 ; i++)
    random256_get (state) ;
}

static void
bsd_initialize (long int * x, int n, unsigned long int s)
{
  int i;

  if (s == 0)
    s = 1 ;

  x[0] = s;

  for (i = 1 ; i < n ; i++)
    x[i] = 1103515245 * x[i-1] + 12345 ;
}

static void
libc5_initialize (long int * x, int n, unsigned long int s)
{
  int i;

  if (s == 0)
    s = 1 ;

  x[0] = s;

  for (i = 1 ; i < n ; i++)
    x[i] = 1103515145 * x[i-1] + 12345 ;
}

static void
glibc2_initialize (long int * x, int n, unsigned long int s)
{
  int i;

  if (s == 0)
    s = 1 ;

  x[0] = s;

  for (i = 1 ; i < n ; i++)
    {
      const long int h = s / 127773;
      const long int t = 16807 * (s - h * 127773) - h * 2836;
      if (t < 0)
        {
          s = t + 2147483647 ;
        }
      else
        {
          s = t ;
        }

    x[i] = s ;
    }
}

static void
random8_glibc2_set (void *vstate, unsigned long int s)
{
  random8_state_t *state = (random8_state_t *) vstate;

  if (s == 0)
    s = 1;

  state->x = s;
}

static void
random32_glibc2_set (void *vstate, unsigned long int s)
{
  random32_state_t *state = (random32_state_t *) vstate;
  int i;

  glibc2_initialize (state->x, 7, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 7 ; i++)
    random32_get (state) ;
}

static void
random64_glibc2_set (void *vstate, unsigned long int s)
{
  random64_state_t *state = (random64_state_t *) vstate;
  int i;

  glibc2_initialize (state->x, 15, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 15 ; i++)
    random64_get (state) ;
}

static void
random128_glibc2_set (void *vstate, unsigned long int s)
{
  random128_state_t *state = (random128_state_t *) vstate;
  int i;

  glibc2_initialize (state->x, 31, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 31 ; i++)
    random128_get (state) ;
}

static void
random256_glibc2_set (void *vstate, unsigned long int s)
{
  random256_state_t *state = (random256_state_t *) vstate;
  int i;

  glibc2_initialize (state->x, 63, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 63 ; i++)
    random256_get (state) ;
}

static void
random8_libc5_set (void *vstate, unsigned long int s)
{
  random8_state_t *state = (random8_state_t *) vstate;

  if (s == 0)
    s = 1;

  state->x = s;
}

static void
random32_libc5_set (void *vstate, unsigned long int s)
{
  random32_state_t *state = (random32_state_t *) vstate;
  int i;

  libc5_initialize (state->x, 7, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 7 ; i++)
    random32_get (state) ;
}

static void
random64_libc5_set (void *vstate, unsigned long int s)
{
  random64_state_t *state = (random64_state_t *) vstate;
  int i;

  libc5_initialize (state->x, 15, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 15 ; i++)
    random64_get (state) ;
}

static void
random128_libc5_set (void *vstate, unsigned long int s)
{
  random128_state_t *state = (random128_state_t *) vstate;
  int i;

  libc5_initialize (state->x, 31, s) ;

  state->i = 3;
  state->j = 0;

  for (i = 0 ; i < 10 * 31 ; i++)
    random128_get (state) ;
}

static void
random256_libc5_set (void *vstate, unsigned long int s)
{
  random256_state_t *state = (random256_state_t *) vstate;
  int i;

  libc5_initialize (state->x, 63, s) ;

  state->i = 1;
  state->j = 0;

  for (i = 0 ; i < 10 * 63 ; i++)
    random256_get (state) ;
}

static const gsl_rng_type random_glibc2_type =
{"random-glibc2",                       /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_glibc2_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random8_glibc2_type =
{"random8-glibc2",                      /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random8_state_t),
 &random8_glibc2_set,
 &random8_get,
 &random8_get_double};

static const gsl_rng_type random32_glibc2_type =
{"random32-glibc2",                     /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random32_state_t),
 &random32_glibc2_set,
 &random32_get,
 &random32_get_double};

static const gsl_rng_type random64_glibc2_type =
{"random64-glibc2",                     /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random64_state_t),
 &random64_glibc2_set,
 &random64_get,
 &random64_get_double};

static const gsl_rng_type random128_glibc2_type =
{"random128-glibc2",                    /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_glibc2_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random256_glibc2_type =
{"random256-glibc2",                    /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random256_state_t),
 &random256_glibc2_set,
 &random256_get,
 &random256_get_double};

static const gsl_rng_type random_libc5_type =
{"random-libc5",                        /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_libc5_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random8_libc5_type =
{"random8-libc5",                       /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random8_state_t),
 &random8_libc5_set,
 &random8_get,
 &random8_get_double};

static const gsl_rng_type random32_libc5_type =
{"random32-libc5",                      /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random32_state_t),
 &random32_libc5_set,
 &random32_get,
 &random32_get_double};

static const gsl_rng_type random64_libc5_type =
{"random64-libc5",                      /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random64_state_t),
 &random64_libc5_set,
 &random64_get,
 &random64_get_double};

static const gsl_rng_type random128_libc5_type =
{"random128-libc5",                     /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_libc5_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random256_libc5_type =
{"random256-libc5",                     /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random256_state_t),
 &random256_libc5_set,
 &random256_get,
 &random256_get_double};

static const gsl_rng_type random_bsd_type =
{"random-bsd",                  /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_bsd_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random8_bsd_type =
{"random8-bsd",                 /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random8_state_t),
 &random8_bsd_set,
 &random8_get,
 &random8_get_double};

static const gsl_rng_type random32_bsd_type =
{"random32-bsd",                        /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random32_state_t),
 &random32_bsd_set,
 &random32_get,
 &random32_get_double};

static const gsl_rng_type random64_bsd_type =
{"random64-bsd",                        /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random64_state_t),
 &random64_bsd_set,
 &random64_get,
 &random64_get_double};

static const gsl_rng_type random128_bsd_type =
{"random128-bsd",               /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random128_state_t),
 &random128_bsd_set,
 &random128_get,
 &random128_get_double};

static const gsl_rng_type random256_bsd_type =
{"random256-bsd",               /* name */
 0x7fffffffUL,                  /* RAND_MAX */
 0,                             /* RAND_MIN */
 sizeof (random256_state_t),
 &random256_bsd_set,
 &random256_get,
 &random256_get_double};

const gsl_rng_type *gsl_rng_random_libc5    = &random_libc5_type;
const gsl_rng_type *gsl_rng_random8_libc5   = &random8_libc5_type;
const gsl_rng_type *gsl_rng_random32_libc5  = &random32_libc5_type;
const gsl_rng_type *gsl_rng_random64_libc5  = &random64_libc5_type;
const gsl_rng_type *gsl_rng_random128_libc5 = &random128_libc5_type;
const gsl_rng_type *gsl_rng_random256_libc5 = &random256_libc5_type;

const gsl_rng_type *gsl_rng_random_glibc2    = &random_glibc2_type;
const gsl_rng_type *gsl_rng_random8_glibc2   = &random8_glibc2_type;
const gsl_rng_type *gsl_rng_random32_glibc2  = &random32_glibc2_type;
const gsl_rng_type *gsl_rng_random64_glibc2  = &random64_glibc2_type;
const gsl_rng_type *gsl_rng_random128_glibc2 = &random128_glibc2_type;
const gsl_rng_type *gsl_rng_random256_glibc2 = &random256_glibc2_type;

const gsl_rng_type *gsl_rng_random_bsd    = &random_bsd_type;
const gsl_rng_type *gsl_rng_random8_bsd   = &random8_bsd_type;
const gsl_rng_type *gsl_rng_random32_bsd  = &random32_bsd_type;
const gsl_rng_type *gsl_rng_random64_bsd  = &random64_bsd_type;
const gsl_rng_type *gsl_rng_random128_bsd = &random128_bsd_type;
const gsl_rng_type *gsl_rng_random256_bsd = &random256_bsd_type;


/******************************************************************************
 * gsl_sprng.c: rewrite of gsl-sprng.h to use sprng streams                   *
 * Author: Yan Y. Liu <yanliu@illinois.edu>                                   *
 * Date: 2014/08/17                                                           *
 * Copyright and license of this source file are specified in LICENSE.TXT     *
 * under the root directory of this software package.                         *
 ******************************************************************************/
#ifndef GSL_SPRNG_C
#define GSL_SPRNG_C

#include <sys/time.h>
#include <stdio.h>
#include <gsl/gsl_rng.h>
#include "gsl-sprng.h"
/***************************/
/* gsl definition of sprng */
/***************************/
void sprng_set(void * vstate, unsigned long int seed)
{
    gsl_sprng_state_t *mysprng = (gsl_sprng_state_t*) vstate;

    if (mysprng->stream != NULL) {
        free_sprng(mysprng->stream);
    }
    mysprng->stream = init_sprng(
                DEFAULT_RNG_TYPE,
                mysprng->streamnum,
                mysprng->nstreams,
                seed,
                SPRNG_DEFAULT);
}

unsigned long sprng_get(void * vstate)
{
    return( (long) isprng( ((gsl_sprng_state_t*) vstate)->stream ) );
}

double sprng_get_double(void * vstate)
{
    return( (double) sprng( ((gsl_sprng_state_t*) vstate)->stream ) );
}

/* global sprng 2.0 type for gsl initialization */
const gsl_rng_type gsl_rng_sprng20 = {
    "sprng20",        /* name */
    0x7fffffffUL,     /* RAND_MAX */
    0,                /* RAND_MIN */
    0,                /* size of state - not sure about this */
    &sprng_set,          /* initialisation */
    &sprng_get,          /* get integer RN */
    &sprng_get_double    /* get double RN */
};

/***************************/
/*      gsl_sprng API      */
/***************************/

// if stream=NULL, create a new stream
// otherwise, just use the stream
gsl_rng *gsl_sprng_alloc (int streamnum, int nstreams, int seed, int * stream)
{
    gsl_sprng_state_t *  gsl_sprng_state =
   	    (gsl_sprng_state_t*)  malloc( sizeof( gsl_sprng_state_t ) );

    if (gsl_sprng_state == NULL) {
        GSL_ERROR_VAL (
	   	  "failed to allocate space for gsl_sprng_state_t struct",
                     GSL_ENOMEM, 0);
        return NULL; // not reachable
    }
    gsl_sprng_state->streamnum = streamnum;
    gsl_sprng_state->nstreams = nstreams;
    // set seed
    if (seed == -1) {
        struct timeval tv; struct timezone tz;
        gettimeofday(&tv, &tz);
        seed = (int)(tv.tv_sec * streamnum);
    } else if (seed == 0) {
        seed = gsl_rng_default_seed; // zero, too, in fact
    }
    gsl_sprng_state->seed = seed;
    // sprng init
    if (stream == NULL) {
        stream = init_sprng(
                DEFAULT_RNG_TYPE,
                streamnum,
                nstreams,
                seed,
                SPRNG_DEFAULT);
    }
    gsl_sprng_state->stream = stream;
    // gsl_rng init
    gsl_rng * r = (gsl_rng *) malloc (sizeof (gsl_rng));
    if (r == NULL) {
        GSL_ERROR_VAL ("gsl_sprng: failed to allocate space for gsl_rng struct",
                        GSL_ENOMEM, 0);
        free(gsl_sprng_state); // not reachable
        return NULL;
    }
    r->type = &gsl_rng_sprng20;
    r->state = gsl_sprng_state;

    return r;
}

void gsl_sprng_free (gsl_rng * r)
{
    if (r==NULL) return;
    gsl_sprng_state_t *  gsl_sprng_state = (gsl_sprng_state_t *) r->state;
    if (gsl_sprng_state != NULL) {
        int numAvail = free_sprng(gsl_sprng_state->stream);
        fprintf(stdout, "gsl_sprng: free random stream. %d streams left\n", numAvail);
        free(r->state);
    }
    free(r);
}

void gsl_sprng_print (gsl_rng *r)
{
    if (r==NULL) return;
    gsl_sprng_state_t *  gsl_sprng_state = (gsl_sprng_state_t *) r->state;
    if (gsl_sprng_state == NULL) return;
    printf("gsl_sprng: streamnum=%d, nstreams=%d, seed=%d\n", gsl_sprng_state->streamnum, gsl_sprng_state->nstreams, gsl_sprng_state->seed);
    int * stream = gsl_sprng_state->stream;
    if (stream == NULL) return;
    print_sprng(stream);
}

int gsl_sprng_fread (char * fpath, gsl_rng * r)
{
    // delete old stream
    if (r!=NULL) {
        gsl_sprng_free(r);
        r = NULL;
    }
    // allocate memory to load data
    char buf[MAX_PACKED_LENGTH];
    // read stream from file to array
    FILE * f;
    int size;
    if ((f=fopen(fpath, "r")) == NULL) {
        fprintf(stderr, "gsl_sprng_fread(): failed to open %s for reading\n", fpath);
        return 0;
    }
    fread(&size,sizeof(int),1,f);
    fprintf(stdout, "sprng_fread[%s]: size=%d\n", fpath, size);
    int numRead = fread(buf, sizeof(char), size, f);
    if (numRead != size) {
        fprintf(stderr, "gsl_sprng_fread(): failed to read stream of size %d\n", size);
        fclose(f);
        return 0;
    }
    fclose(f);
    // load stream from array
    int * stream = unpack_sprng(buf);
    if (stream == NULL) {
        fprintf(stderr, "gsl_sprng_fread(): failed to read stream of size %d\n", size);
        return 0;
    }
    print_sprng(stream);
    // create new gsl_rng
    r = gsl_sprng_alloc(0, 0, 0, stream);
    if (r==NULL) return 0;
    return 1;
}

int gsl_sprng_fwrite (char * fpath, const gsl_rng * r)
{
    if (r==NULL) return 0;
    gsl_sprng_state_t *  gsl_sprng_state = (gsl_sprng_state_t*) r->state;
    if (gsl_sprng_state == NULL) return 0;
    int * stream = gsl_sprng_state->stream;
    if (stream==NULL) return 0;
    // write state to array
    char *buf;
    int size = pack_sprng(stream, &buf);
    // write array to file
    FILE * f;
    if ((f=fopen(fpath, "w")) == NULL) {
        fprintf(stderr, "gsl_sprng_fwrite(): failed to open %s for writing\n", fpath);
        return 0;
    }
    // our format: filesize, filecontent
    fwrite(&size,sizeof(int),1,f);
    int numWrote = fwrite(buf, sizeof(char), size, f);
    if (numWrote != size) {
        fprintf(stderr, "gsl_sprng_fwrite(): failed to write stream of size %d\n", size);
    }
    fclose(f);
    // sprng uses malloc() to allocate buf, we must free it properly
    free(buf);

    return 1;
}

#endif


/**
 *
 * @file core_zlacpy.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 Julien Langou
 * @author Henricus Bouwmeester
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_PLASMA_zlacpycopies all or part of a two-dimensional matrix A to another
 *  matrix B
 *
 *******************************************************************************
 *
 * @param[in] uplo
 *          Specifies the part of the matrix A to be copied to B.
 *            = PlasmaUpperLower: All the matrix A
 *            = PlasmaUpper: Upper triangular part
 *            = PlasmaLower: Lower triangular part
 *
 * @param[in] M
 *          The number of rows of the matrices A and B. M >= 0.
 *
 * @param[in] N
 *          The number of columns of the matrices A and B. N >= 0.
 *
 * @param[in] A
 *          The M-by-N matrix to copy.
 *
 * @param[in] LDA
 *          The leading dimension of the array A. LDA >= max(1,M).
 *
 * @param[out] B
 *          The M-by-N copy of the matrix A.
 *          On exit, B = A ONLY in the locations specified by uplo.
 *
 * @param[in] LDB
 *          The leading dimension of the array B. LDB >= max(1,M).
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlacpy = PCORE_zlacpy
#define CORE_zlacpy PCORE_zlacpy
#endif
void CORE_zlacpy(PLASMA_enum uplo, int M, int N,
                 const PLASMA_Complex64_t *A, int LDA,
                 PLASMA_Complex64_t *B, int LDB)
{
    LAPACKE_zlacpy_work(
        LAPACK_COL_MAJOR,
        lapack_const(uplo),
        M, N, A, LDA, B, LDB);
}