#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <nlopt.h>
#include "mpi.h"

int numTasks, mpiRank;

#include "myFunc.h"

void writeParam(char *filename, int nParam, double *x)
{
  FILE *fn=fopen(filename,"w");
  if(!fn) {
    fprintf(stderr,"Cannot open %s\n",filename);
    exit(1);
  }

  uint32_t n=nParam; // ensure size is uint32_t
  fwrite(&n,sizeof(uint32_t), 1, fn);
  for(int i=0; i < nParam; i++) {
    float tmp=x[i];
    fwrite(&tmp,sizeof(float), 1, fn);
  }
  fclose(fn);
}

int masterOP=1;
void startClient(void * restrict my_func_data)
{
  int op;
  double xFromMPI[N_PARAM];
  double partialError,sum;

  for(;;) { // loop until the master says I am done - then exit
    MPI_Bcast(&op, 1, MPI_INT, 0, MPI_COMM_WORLD); // receive the op code
    if(op==0) { // we are done, normal exit
      break;
    }
    MPI_Bcast(xFromMPI, N_PARAM, MPI_DOUBLE, 0, MPI_COMM_WORLD); // receive the parameters
    partialError = objFunc(N_PARAM,  xFromMPI, NULL, my_func_data);
    MPI_Reduce(&partialError, &sum, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
  }
}

double mpiObjFunc(unsigned n,  const double * restrict x, double * restrict grad,
		  void * restrict my_func_data)
{
  int op;
  double partialError, totalError=0.;

  MPI_Bcast(&masterOP, 1, MPI_INT, 0, MPI_COMM_WORLD); // Send the master op code
  MPI_Bcast((void*) x, N_PARAM, MPI_DOUBLE, 0, MPI_COMM_WORLD); // Send the parameters
  partialError = objFunc(N_PARAM,  x, NULL, my_func_data);
  MPI_Reduce(&partialError, &totalError, 1, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD); // get the totalError

  return(totalError);
}

int main(int argc, char* argv[])
{
  nlopt_opt opt;
  userData_t uData = {0};
  FILE *fout_mpi;

  if(argc < 4) {
    fprintf(stderr,"Use: datafile paramFile mpiTimingFile\n");
    return -1;
  }

  int ret = MPI_Init(&argc,&argv);
  if (ret != MPI_SUCCESS) {
    printf ("Error in MPI_Init()!\n");
    MPI_Abort(MPI_COMM_WORLD, ret);
  }

  MPI_Comm_size(MPI_COMM_WORLD,&numTasks);
  MPI_Comm_rank(MPI_COMM_WORLD,&mpiRank);

#if defined(NO_IO_EXAMPLES)
#pragma message "TEST case: Clients use random memory values"
    init_noIO(NO_IO_EXAMPLES,&uData);
#else
#pragma message "TEST case: all clients perform file reads"
  { // for simplicity, append the mpiRank to the data filename
    char filename[256];
    sprintf(filename,"%s.%d",argv[1],mpiRank);
    //fprintf(stderr,"Loading %s into coprocessor %d\n", filename, MIC_DEV);
    init(filename,&uData);
  }
#endif

  if(mpiRank > 0) {
    startClient(&uData);
  } else { // Master code

    { // open MPI results file for this size run
      char buf[256];
      sprintf(buf, "%s.%04d.txt",argv[3],numTasks);
      fout_mpi = fopen(buf,"w");
      if(!fout_mpi) {
	fprintf(stderr,"Cannot open file %s\n",buf);
	return -1;
      }
    }

    printf ("Number of tasks= %d My rank= %d, number clients %d\n", numTasks,mpiRank,numTasks);
#ifdef MPI_NUM_COPROC_PER_NODE
    printf ("Number of coprocessors per node= %d\n", MPI_NUM_COPROC_PER_NODE);
#endif
    printf("myFunc %s\n", desc);
    printf("nExamples %d\n", uData.nExamples);
    printf("Number Parameters %d\n", N_PARAM);

    opt = nlopt_create(NLOPT_LN_PRAXIS, N_PARAM); // algorithm and dimensionality
    // NOTE: alternative optimization methods ...
    //opt = nlopt_create(NLOPT_LN_NEWUOA, N_PARAM);
    //opt = nlopt_create(NLOPT_LN_COBYLA, N_PARAM);
    //opt = nlopt_create(NLOPT_LN_BOBYQA, N_PARAM);
    //opt = nlopt_create(NLOPT_LN_AUGLAG, N_PARAM);

    nlopt_set_min_objective(opt, mpiObjFunc, (void*) &uData);
/*
#if defined(MAX_RUNTIME)
  fprintf(stderr,"Warning: performing a quick %d second test!\n", MAX_RUNTIME);
  nlopt_set_maxtime(opt, MAX_RUNTIME); // Use for running quick tests
#else
  fprintf(stderr,"MAX runtime %d seconds!\n", 120*60);
  nlopt_set_maxtime(opt, (120. * 60.)); // maximum runtime in seconds
#endif
*/
    double minf; /* the minimum objective value, upon return */

    __declspec(align(64)) double x[N_PARAM];
    for(int i=0; i < N_PARAM; i++) x[i] = 0.1*(random()/(double)RAND_MAX);

    double startTime=getTime();
    ret=nlopt_optimize(opt, x, &minf);
    printf("Optimization Time %g\n",getTime()-startTime);

    if (ret < 0) {
      printf("nlopt failed! ret %d\n", ret);
    } else {
      printf("found minimum %0.10g ret %d\n", minf,ret);
    }
    writeParam(argv[2],N_PARAM, x);

    nlopt_destroy(opt);

    masterOP = 0; // signal completion
    MPI_Bcast(&masterOP, 1, MPI_INT, 0, MPI_COMM_WORLD); // Send the master op code
    printf("----------- performance times for the Master ----------\n");
    fini(&uData);
  }

  int client_nExamples[numTasks];
  double client_timeObjFunc[numTasks];
  int client_countObjFunc[numTasks];
  double client_timeDataLoad[numTasks];
  double client_minTime[numTasks];
  double client_maxTime[numTasks];

  MPI_Gather(&uData.nExamples, 1, MPI_INT, client_nExamples, 1, MPI_INT, 0, MPI_COMM_WORLD);
  MPI_Gather(&uData.countObjFunc, 1, MPI_INT, client_countObjFunc, 1, MPI_INT, 0, MPI_COMM_WORLD);
  MPI_Gather(&uData.timeDataLoad, 1, MPI_DOUBLE, client_timeDataLoad, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
  MPI_Gather(&uData.timeObjFunc, 1, MPI_DOUBLE, client_timeObjFunc, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
  MPI_Gather(&uData.minTime, 1, MPI_DOUBLE, client_minTime, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);
  MPI_Gather(&uData.maxTime, 1, MPI_DOUBLE, client_maxTime, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD);

  if(mpiRank==0) {
    printf("----------- performance times for the MPI run ----------\n");
    printf("function: %s\n",desc);

    uint64_t totalExamples=0;
    for(int i=0; i < numTasks; i++) totalExamples += client_nExamples[i];
    printf("totalExamples %g\n",(double) totalExamples);

    printf("AveObjTime %g, countObjFunc %d, totalObjTime %g\n",
	   uData.timeObjFunc/uData.countObjFunc, uData.countObjFunc, uData.timeObjFunc);
#ifdef FLOP_ESTIMATE
    printf("Estimated flops in myFunc %d, estimated average TFlop/s %g, nClients %d\n", FLOP_ESTIMATE,
	   (((double)totalExamples * (double)FLOP_ESTIMATE)/(uData.timeObjFunc/uData.countObjFunc)/1.e12),
	   numTasks);
    printf("Estimated maximum TFlop/s %g, minimum TFLop/s %g\n",
	   (((double)totalExamples*(double)FLOP_ESTIMATE)/(uData.minTime)/1.e12),
	   (((double)totalExamples*(double)FLOP_ESTIMATE)/(uData.maxTime)/1.e12) );
#endif

    fprintf(fout_mpi, "nExamples countObjFunc timeDataLoad  timeObjFunc minObjFcnTime maxObjFcnTime\n");
    for(int i=0; i < numTasks; i++) {
      fprintf(fout_mpi, "%g %g %g %g %g %g\n",
	      (double) client_nExamples[i], (double) client_countObjFunc[i], client_timeDataLoad[i],
	      client_timeObjFunc[i], client_minTime[i], client_maxTime[i]);
    }
  }

  MPI_Finalize();

  return 0;
}


/**
 * File: trfit_utils.h
 *
 */
#ifndef _TRFIT_UTILS_H
#define _TRFIT_UTILS_H
#include "aper_conf.h"
#include <gsl/gsl_multifit_nlin.h>

#define N_COLUMNS_FIT 6
#define N_KAPPASIG_ITER 3
#define N_KAPPASIG_SIG  3.0
#define N_ITER_IPC  5
#define KAPPA_IPC  3.0

// the ipc fit to the
// data must be lower than this number
// to initialize a correction of the spectrum
#define MIN_IPC_LENGTH 60.0

typedef struct
{
  int n_data;

  double *x_values;
  double *y_values;
  double *e_values;
}
  fit_data;

struct function_data {
  int      n;
  double * x;
  double * y;
  double * sig;
};

extern gsl_vector *
fit_beamtrace(const aperture_conf  *conf, observation *obs,
	      const int beamID, beam act_beam);

double
gagauss(const double x, const double *params);

extern gsl_vector *
fit_wuttke(const fit_data *f_data);

extern gsl_vector *
fit_wuttke_talk(const fit_data *f_data);

extern d_point
find_grav_center(const fit_data *f_data);

extern px_point
get_fit_xrange(const aperture_conf  *conf, const observation *obs,
	       beam act_beam);

extern gsl_vector *
fit_function(const fit_data *f_data);

extern fit_data *
get_fitdata(observation *obs, int np, px_point tr_point);

extern fit_data *
alloc_fit_data(const int n_data);

void
print_fit_data(fit_data *f_data);

extern void
free_fit_data(fit_data *f_data);

int
gauss_f(const gsl_vector *x, void *params, gsl_vector *f);

int
gauss_df(const gsl_vector *x, void *params, gsl_matrix *J);

int
gauss_fdf (const gsl_vector *x, void *params, gsl_vector *f, gsl_matrix *J);

extern void
print_fit_state (size_t iter, gsl_multifit_fdfsolver * s);

extern double
comp_intrel_max(const fit_data *f_data);

extern gsl_matrix *
bcksub_observation(observation *obs, observation *bck);

extern double *
evaluate_ipc_fit(fit_data *f_data, double *gpars, double *fpars);

extern void
write_ipc_fit(fit_data *f_data, double *y_values, const char *ipc_file, const double qual, double *yfract);

extern double
fit_ipc_data(fit_data *fdata, double *gpars, int n_gpars,
	     double *fpars, int n_fpars);

extern fit_data *
get_ipc_fdata(const aperture_conf  *conf, observation *obs,
	      gsl_matrix *data_vals, beam act_beam);

extern double *
get_wf_special(const aperture_conf  *conf,  observation *obs,
	       gsl_matrix *data_vals, beam act_beam, double yoffs);

extern gsl_vector *
get_ipc_coldata(gsl_matrix *img_data, int np, px_point tr_point);

extern fit_data *
strip_fitdata(fit_data *old_fdata, int i_max);

extern double *
strip_wf_special(fit_data *old_fdata, double *y_fract, int i_max);

extern d_point
kappa_sigma_klipp_ipc(const aperture_conf  *conf, observation *obs,
		      gsl_matrix *data_matrix, beam act_beam,
		      const char *ipc_file);

extern void
reject_kappasigma(fit_data *f_data, double *y_values, double max_diff);

extern double
calculate_sigma(fit_data *f_data, double *y_values);
#endif


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

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_multifit.h>
#include <gsl/gsl_multilarge.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_ieee_utils.h>

static void test_random_matrix_orth(gsl_matrix *m, const gsl_rng *r);
static void test_random_matrix_ill(gsl_matrix *m, const gsl_rng *r);
static void test_random_vector(gsl_vector *v, const gsl_rng *r,
                               const double lower, const double upper);
static void test_random_matrix(gsl_matrix *m, const gsl_rng *r,
                               const double lower, const double upper);
static void test_random_vector_noise(const gsl_rng *r, gsl_vector *y);
static void test_compare_vectors(const double tol, const gsl_vector * a,
                                 const gsl_vector * b, const char * desc);
static void test_multifit_solve(const double lambda, const gsl_matrix * X,
                                const gsl_vector * y, const gsl_vector * wts,
                                const gsl_vector * diagL, const gsl_matrix * L,
                                double *rnorm, double *snorm, gsl_vector * c);
static void test_multilarge_solve(const gsl_multilarge_linear_type * T, const double lambda,
                                  const gsl_matrix * X, const gsl_vector * y, gsl_vector * wts,
                                  const gsl_vector * diagL, const gsl_matrix * L,
                                  double *rnorm, double *snorm, gsl_vector * c);

/* generate random square orthogonal matrix via QR decomposition */
static void
test_random_matrix_orth(gsl_matrix *m, const gsl_rng *r)
{
  const size_t M = m->size1;
  gsl_matrix *A = gsl_matrix_alloc(M, M);
  gsl_vector *tau = gsl_vector_alloc(M);
  gsl_matrix *R = gsl_matrix_alloc(M, M);

  test_random_matrix(A, r, -1.0, 1.0);
  gsl_linalg_QR_decomp(A, tau);
  gsl_linalg_QR_unpack(A, tau, m, R);

  gsl_matrix_free(A);
  gsl_matrix_free(R);
  gsl_vector_free(tau);
}

/* construct ill-conditioned matrix via SVD */
static void
test_random_matrix_ill(gsl_matrix *m, const gsl_rng *r)
{
  const size_t M = m->size1;
  const size_t N = m->size2;
  gsl_matrix *U = gsl_matrix_alloc(M, M);
  gsl_matrix *V = gsl_matrix_alloc(N, N);
  gsl_vector *S = gsl_vector_alloc(N);
  gsl_matrix_view Uv = gsl_matrix_submatrix(U, 0, 0, M, N);
  const double smin = 16.0 * GSL_DBL_EPSILON;
  const double smax = 10.0;
  const double ratio = pow(smin / smax, 1.0 / (N - 1.0));
  double s;
  size_t j;

  test_random_matrix_orth(U, r);
  test_random_matrix_orth(V, r);

  /* compute U * S */

  s = smax;
  for (j = 0; j < N; ++j)
    {
      gsl_vector_view uj = gsl_matrix_column(U, j);

      gsl_vector_scale(&uj.vector, s);
      s *= ratio;
    }

  /* compute m = (U * S) * V' */
  gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &Uv.matrix, V, 0.0, m);

  gsl_matrix_free(U);
  gsl_matrix_free(V);
  gsl_vector_free(S);
}

static void
test_random_vector(gsl_vector *v, const gsl_rng *r,
                   const double lower, const double upper)
{
  size_t i;
  size_t N = v->size;

  for (i = 0; i < N; ++i)
    {
      gsl_vector_set(v, i,
                     gsl_rng_uniform(r) * (upper - lower) + lower);
    }
}

static void
test_random_matrix(gsl_matrix *m, const gsl_rng *r,
                   const double lower, const double upper)
{
  size_t i, j;
  size_t M = m->size1;
  size_t N = m->size2;

  for (i = 0; i < M; ++i)
    {
      for (j = 0; j < N; ++j)
      {
        gsl_matrix_set(m, i, j,
                       gsl_rng_uniform(r) * (upper - lower) + lower);
      }
    }
}

/* generate Vandermonde matrix using equally spaced input points
 * on [0,1] */
static void
test_vander_matrix(gsl_matrix * m)
{
  const size_t M = m->size1;
  const size_t N = m->size2;
  const double dt = 1.0 / (M - 1.0);
  size_t i, j;

  for (i = 0; i < M; ++i)
    {
      double ti = i * dt;
      double mij = 1.0;

      for (j = 0; j < N; ++j)
        {
          gsl_matrix_set(m, i, j, mij);
          mij *= ti;
        }
    }
}

static void
test_random_vector_noise(const gsl_rng *r, gsl_vector *y)
{
  size_t i;

  for (i = 0; i < y->size; ++i)
    {
      double *ptr = gsl_vector_ptr(y, i);
      *ptr += 1.0e-3 * gsl_rng_uniform(r);
    }
}

static void
test_compare_vectors(const double tol, const gsl_vector * a,
                     const gsl_vector * b, const char * desc)
{
  size_t i;

  for (i = 0; i < a->size; ++i)
    {
      double ai = gsl_vector_get(a, i);
      double bi = gsl_vector_get(b, i);

      gsl_test_rel(bi, ai, tol, "%s i=%zu", desc, i);
    }
}

/* solve least squares system with multifit SVD */
static void
test_multifit_solve(const double lambda, const gsl_matrix * X,
                    const gsl_vector * y, const gsl_vector * wts,
                    const gsl_vector * diagL, const gsl_matrix * L,
                    double *rnorm, double *snorm, gsl_vector * c)
{
  const size_t n = X->size1;
  const size_t p = X->size2;
  gsl_multifit_linear_workspace *w =
    gsl_multifit_linear_alloc(n, p);
  gsl_matrix *Xs = gsl_matrix_alloc(n, p);
  gsl_vector *ys = gsl_vector_alloc(n);
  gsl_vector *cs = gsl_vector_alloc(p);
  gsl_matrix *LQR = NULL;
  gsl_vector *Ltau = NULL;
  gsl_matrix *M = NULL;

  /* convert to standard form */
  if (diagL)
    {
      gsl_multifit_linear_wstdform1(diagL, X, wts, y, Xs, ys, w);
    }
  else if (L)
    {
      const size_t m = L->size1;

      LQR = gsl_matrix_alloc(m, p);
      Ltau = gsl_vector_alloc(GSL_MIN(m, p));
      M = (m >= p) ? gsl_matrix_alloc(m, p) : gsl_matrix_alloc(n, p);

      gsl_matrix_memcpy(LQR, L);
      gsl_multifit_linear_L_decomp(LQR, Ltau);
      gsl_multifit_linear_wstdform2(LQR, Ltau, X, wts, y, Xs, ys, M, w);
    }
  else
    {
      gsl_matrix_memcpy(Xs, X);
      gsl_vector_memcpy(ys, y);
    }

  gsl_multifit_linear_svd(Xs, w);
  gsl_multifit_linear_solve(lambda, Xs, ys, cs, rnorm, snorm, w);

  /* convert to general form */
  if (diagL)
    gsl_multifit_linear_genform1(diagL, cs, c, w);
  else if (L)
    gsl_multifit_linear_wgenform2(LQR, Ltau, X, wts, y, cs, M, c, w);
  else
    gsl_vector_memcpy(c, cs);

  gsl_multifit_linear_free(w);
  gsl_matrix_free(Xs);
  gsl_vector_free(ys);
  gsl_vector_free(cs);

  if (LQR)
    gsl_matrix_free(LQR);
  if (Ltau)
    gsl_vector_free(Ltau);
  if (M)
    gsl_matrix_free(M);
}

/* solve least squares system with multilarge */
static void
test_multilarge_solve(const gsl_multilarge_linear_type * T, const double lambda,
                      const gsl_matrix * X, const gsl_vector * y, gsl_vector * wts,
                      const gsl_vector * diagL, const gsl_matrix * L,
                      double *rnorm, double *snorm, gsl_vector * c)
{
  const size_t n = X->size1;
  const size_t p = X->size2;
  const size_t nblock = 5;
  const size_t nrows = n / nblock; /* number of rows per block */
  gsl_multilarge_linear_workspace *w =
    gsl_multilarge_linear_alloc(T, p);
  gsl_matrix *Xs = gsl_matrix_alloc(nrows, p);
  gsl_vector *ys = gsl_vector_alloc(nrows);
  gsl_vector *cs = gsl_vector_alloc(p);
  gsl_matrix *LQR = NULL;
  gsl_vector *Ltau = NULL;
  size_t rowidx = 0;

  if (L)
    {
      const size_t m = L->size1;

      LQR = gsl_matrix_alloc(m, p);
      Ltau = gsl_vector_alloc(p);

      gsl_matrix_memcpy(LQR, L);
      gsl_multilarge_linear_L_decomp(LQR, Ltau);
    }

  while (rowidx < n)
    {
      size_t nleft = n - rowidx;
      size_t nr = GSL_MIN(nrows, nleft);
      gsl_matrix_const_view Xv = gsl_matrix_const_submatrix(X, rowidx, 0, nr, p);
      gsl_vector_const_view yv = gsl_vector_const_subvector(y, rowidx, nr);
      gsl_vector_view wv;
      gsl_matrix_view Xsv = gsl_matrix_submatrix(Xs, 0, 0, nr, p);
      gsl_vector_view ysv = gsl_vector_subvector(ys, 0, nr);

      if (wts)
        wv = gsl_vector_subvector(wts, rowidx, nr);

      /* convert to standard form */
      if (diagL)
        {
          gsl_multilarge_linear_wstdform1(diagL, &Xv.matrix, wts ? &wv.vector : NULL,
                                          &yv.vector, &Xsv.matrix, &ysv.vector, w);
        }
      else if (L)
        {
          gsl_multilarge_linear_wstdform2(LQR, Ltau, &Xv.matrix, wts ? &wv.vector : NULL,
                                          &yv.vector, &Xsv.matrix, &ysv.vector, w);
        }
      else
        {
          gsl_matrix_memcpy(&Xsv.matrix, &Xv.matrix);
          gsl_vector_memcpy(&ysv.vector, &yv.vector);
        }

      gsl_multilarge_linear_accumulate(&Xsv.matrix, &ysv.vector, w);

      rowidx += nr;
    }

  gsl_multilarge_linear_solve(lambda, cs, rnorm, snorm, w);

  if (diagL)
    gsl_multilarge_linear_genform1(diagL, cs, c, w);
  else if (L)
    gsl_multilarge_linear_genform2(LQR, Ltau, cs, c, w);
  else
    gsl_vector_memcpy(c, cs);

  gsl_multilarge_linear_free(w);
  gsl_matrix_free(Xs);
  gsl_vector_free(ys);
  gsl_vector_free(cs);

  if (LQR)
    gsl_matrix_free(LQR);
  if (Ltau)
    gsl_vector_free(Ltau);
}

static void
test_random(const gsl_multilarge_linear_type * T,
            const size_t n, const size_t p,
            const double tol,
            const gsl_rng * r)
{
  const double tol1 = 1.0e3 * tol;
  gsl_matrix *X = gsl_matrix_alloc(n, p);
  gsl_vector *y = gsl_vector_alloc(n);
  gsl_vector *c = gsl_vector_alloc(p);
  gsl_vector *w = gsl_vector_alloc(n);
  gsl_vector *diagL = gsl_vector_alloc(p);
  gsl_matrix *Lsqr = gsl_matrix_alloc(p, p);
  gsl_matrix *Ltall = gsl_matrix_alloc(5*p, p);
  gsl_vector *c0 = gsl_vector_alloc(p);
  gsl_vector *c1 = gsl_vector_alloc(p);
  double rnorm0, snorm0;
  double rnorm1, snorm1;
  char str[2048];
  size_t i;

  /* generate LS system */
  test_random_matrix_ill(X, r);
  /*test_random_matrix(X, r, -1.0, 1.0);*/
  test_random_vector(c, r, -1.0, 1.0);

  /* compute y = X c + noise */
  gsl_blas_dgemv(CblasNoTrans, 1.0, X, c, 0.0, y);
  test_random_vector_noise(r, y);

  /* random weights */
  test_random_vector(w, r, 0.0, 1.0);

  /* random diag(L) */
  test_random_vector(diagL, r, 1.0, 5.0);

  /* random square L */
  test_random_matrix(Lsqr, r, -5.0, 5.0);

  /* random tall L */
  test_random_matrix(Ltall, r, -10.0, 10.0);

  for (i = 0; i < 2; ++i)
    {
      double lambda = pow(10.0, -(double) i);

      /* unweighted with L = I */
      {
        test_multifit_solve(lambda, X, y, NULL, NULL, NULL, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, NULL, NULL, NULL, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s unweighted stdform n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* weighted, L = diag(L) */
      {
        test_multifit_solve(lambda, X, y, w, diagL, NULL, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, w, diagL, NULL, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s weighted diag(L) n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* unweighted, L = diag(L) */
      {
        test_multifit_solve(lambda, X, y, NULL, diagL, NULL, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, NULL, diagL, NULL, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s unweighted diag(L) n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* weighted, L = square */
      {
        test_multifit_solve(lambda, X, y, w, NULL, Lsqr, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, w, NULL, Lsqr, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s weighted Lsqr n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* unweighted, L = square */
      {
        test_multifit_solve(lambda, X, y, NULL, NULL, Lsqr, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, NULL, NULL, Lsqr, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s unweighted Lsqr n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* weighted, L = tall */
      {
        test_multifit_solve(lambda, X, y, w, NULL, Ltall, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, w, NULL, Ltall, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s weighted Ltall n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }

      /* unweighted, L = tall */
      {
        test_multifit_solve(lambda, X, y, NULL, NULL, Ltall, &rnorm0, &snorm0, c0);
        test_multilarge_solve(T, lambda, X, y, NULL, NULL, Ltall, &rnorm1, &snorm1, c1);

        sprintf(str, "random %s unweighted Ltall n=%zu p=%zu lambda=%g",
                T->name, n, p, lambda);
        test_compare_vectors(tol, c0, c1, str);

        gsl_test_rel(rnorm1, rnorm0, tol1, "rnorm %s", str);
        gsl_test_rel(snorm1, snorm0, tol, "snorm %s", str);
      }
    }

  gsl_matrix_free(X);
  gsl_vector_free(y);
  gsl_vector_free(c);
  gsl_vector_free(w);
  gsl_vector_free(diagL);
  gsl_matrix_free(Lsqr);
  gsl_matrix_free(Ltall);
  gsl_vector_free(c0);
  gsl_vector_free(c1);
}

int
main (void)
{
  gsl_rng *r = gsl_rng_alloc(gsl_rng_default);

  gsl_ieee_env_setup();

  {
    const double tol1 = 1.0e-8;
    const double tol2 = 1.0e-11;
    const size_t n_vals[] = { 40, 356, 501 };
    const size_t p_vals[] = { 40, 213, 345 };
    size_t i;

    for (i = 0; i < 2; ++i)
      {
        size_t n = n_vals[i];
        size_t p = p_vals[i];

        /* generate random ill-conditioned LS system and test */
        test_random(gsl_multilarge_linear_normal, n, p, tol1, r);
        test_random(gsl_multilarge_linear_tsqr, n, p, tol2, r);
      }
  }

  gsl_rng_free(r);

  exit (gsl_test_summary ());
}


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

/* MISER.  Based on the algorithm described in the following article,

   W.H. Press, G.R. Farrar, "Recursive Stratified Sampling for
   Multidimensional Monte Carlo Integration", Computers in Physics,
   v4 (1990), pp190-195.

*/

/* Author: MJB */
/* Modified by Brian Gough 12/2000 */

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

#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_monte_miser.h>

static int
estimate_corrmc (gsl_monte_function * f,
		 const double xl[], const double xu[],
		 size_t dim, size_t calls,
		 gsl_rng * r,
		 gsl_monte_miser_state * state,
		 double *result, double *abserr,
		 const double xmid[], double sigma_l[], double sigma_r[]);

int
gsl_monte_miser_integrate (gsl_monte_function * f,
			   const double xl[], const double xu[],
			   size_t dim, size_t calls,
			   gsl_rng * r,
			   gsl_monte_miser_state * state,
			   double *result, double *abserr)
{
  size_t n, estimate_calls, calls_l, calls_r;
  const size_t min_calls = state->min_calls;
  size_t i;
  size_t i_bisect;
  int found_best;

  double res_est = 0, err_est = 0;
  double res_r = 0, err_r = 0, res_l = 0, err_l = 0;
  double xbi_l, xbi_m, xbi_r, s;

  double vol;
  double weight_l, weight_r;

  double *x = state->x;
  double *xmid = state->xmid;
  double *sigma_l = state->sigma_l, *sigma_r = state->sigma_r;

  if (dim != state->dim)
    {
      GSL_ERROR ("number of dimensions must match allocated size", GSL_EINVAL);
    }

  for (i = 0; i < dim; i++)
    {
      if (xu[i] <= xl[i])
	{
	  GSL_ERROR ("xu must be greater than xl", GSL_EINVAL);
	}

      if (xu[i] - xl[i] > GSL_DBL_MAX)
	{
	  GSL_ERROR ("Range of integration is too large, please rescale",
		     GSL_EINVAL);
	}
    }

  if (state->alpha < 0)
    {
      GSL_ERROR ("alpha must be non-negative", GSL_EINVAL);
    }

  /* Compute volume */

  vol = 1;

  for (i = 0; i < dim; i++)
    {
      vol *= xu[i] - xl[i];
    }

  if (calls < state->min_calls_per_bisection)
    {
      double m = 0.0, q = 0.0;

      if (calls < 2)
	{
	  GSL_ERROR ("insufficient calls for subvolume", GSL_EFAILED);
	}

      for (n = 0; n < calls; n++)
	{
	  /* Choose a random point in the integration region */

	  for (i = 0; i < dim; i++)
	    {
	      x[i] = xl[i] + gsl_rng_uniform_pos (r) * (xu[i] - xl[i]);
	    }

	  {
	    double fval = GSL_MONTE_FN_EVAL (f, x);

	    /* recurrence for mean and variance */

	    double d = fval - m;
	    m += d / (n + 1.0);
	    q += d * d * (n / (n + 1.0));
	  }
	}

      *result = vol * m;

      *abserr = vol * sqrt (q / (calls * (calls - 1.0)));

      return GSL_SUCCESS;
    }

  estimate_calls = GSL_MAX (min_calls, calls * (state->estimate_frac));

  if (estimate_calls < 4 * dim)
    {
      GSL_ERROR ("insufficient calls to sample all halfspaces", GSL_ESANITY);
    }

  /* Flip coins to bisect the integration region with some fuzz */

  for (i = 0; i < dim; i++)
    {
      s = (gsl_rng_uniform (r) - 0.5) >= 0.0 ? state->dither : -state->dither;
      state->xmid[i] = (0.5 + s) * xl[i] + (0.5 - s) * xu[i];
    }

  /* The idea is to chose the direction to bisect based on which will
     give the smallest total variance.  We could (and may do so later)
     use MC to compute these variances.  But the NR guys simply estimate
     the variances by finding the min and max function values
     for each half-region for each bisection. */

  estimate_corrmc (f, xl, xu, dim, estimate_calls,
		   r, state, &res_est, &err_est, xmid, sigma_l, sigma_r);

  /* We have now used up some calls for the estimation */

  calls -= estimate_calls;

  /* Now find direction with the smallest total "variance" */

  {
    double best_var = GSL_DBL_MAX;
    double beta = 2.0 / (1.0 + state->alpha);
    found_best = 0;
    i_bisect = 0;
    weight_l = weight_r = 1.0;

    for (i = 0; i < dim; i++)
      {
	if (sigma_l[i] >= 0 && sigma_r[i] >= 0)
	  {
	    /* estimates are okay */
	    double var = pow (sigma_l[i], beta) + pow (sigma_r[i], beta);

	    if (var <= best_var)
	      {
		found_best = 1;
		best_var = var;
		i_bisect = i;
		weight_l = pow (sigma_l[i], beta);
		weight_r = pow (sigma_r[i], beta);
	      }
	  }
	else
	  {
	    if (sigma_l[i] < 0)
	      {
		GSL_ERROR ("no points in left-half space!", GSL_ESANITY);
	      }
	    if (sigma_r[i] < 0)
	      {
		GSL_ERROR ("no points in right-half space!", GSL_ESANITY);
	      }
	  }
      }
  }

  if (!found_best)
    {
      /* All estimates were the same, so chose a direction at random */

      i_bisect = gsl_rng_uniform_int (r, dim);
    }

  xbi_l = xl[i_bisect];
  xbi_m = xmid[i_bisect];
  xbi_r = xu[i_bisect];

  /* Get the actual fractional sizes of the two "halves", and
     distribute the remaining calls among them */

  {
    double fraction_l = fabs ((xbi_m - xbi_l) / (xbi_r - xbi_l));
    double fraction_r = 1 - fraction_l;

    double a = fraction_l * weight_l;
    double b = fraction_r * weight_r;

    calls_l = min_calls + (calls - 2 * min_calls) * a / (a + b);
    calls_r = min_calls + (calls - 2 * min_calls) * b / (a + b);
  }

  /* Compute the integral for the left hand side of the bisection */

  /* Due to the recursive nature of the algorithm we must allocate
     some new memory for each recursive call */

  {
    int status;

    double *xu_tmp = (double *) malloc (dim * sizeof (double));

    if (xu_tmp == 0)
      {
	GSL_ERROR_VAL ("out of memory for left workspace", GSL_ENOMEM, 0);
      }

    for (i = 0; i < dim; i++)
      {
	xu_tmp[i] = xu[i];
      }

    xu_tmp[i_bisect] = xbi_m;

    status = gsl_monte_miser_integrate (f, xl, xu_tmp,
					dim, calls_l, r, state,
					&res_l, &err_l);
    free (xu_tmp);

    if (status != GSL_SUCCESS)
      {
	return status;
      }
  }

  /* Compute the integral for the right hand side of the bisection */

  {
    int status;

    double *xl_tmp = (double *) malloc (dim * sizeof (double));

    if (xl_tmp == 0)
      {
	GSL_ERROR_VAL ("out of memory for right workspace", GSL_ENOMEM, 0);
      }

    for (i = 0; i < dim; i++)
      {
	xl_tmp[i] = xl[i];
      }

    xl_tmp[i_bisect] = xbi_m;

    status = gsl_monte_miser_integrate (f, xl_tmp, xu,
					dim, calls_r, r, state,
					&res_r, &err_r);
    free (xl_tmp);

    if (status != GSL_SUCCESS)
      {
	return status;
      }
  }

  *result = res_l + res_r;
  *abserr = sqrt (err_l * err_l + err_r * err_r);

  return GSL_SUCCESS;
}

gsl_monte_miser_state *
gsl_monte_miser_alloc (size_t dim)
{
  gsl_monte_miser_state *s =
    (gsl_monte_miser_state *) malloc (sizeof (gsl_monte_miser_state));

  if (s == 0)
    {
      GSL_ERROR_VAL ("failed to allocate space for miser state struct",
		     GSL_ENOMEM, 0);
    }

  s->x = (double *) malloc (dim * sizeof (double));

  if (s->x == 0)
    {
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for x", GSL_ENOMEM, 0);
    }

  s->xmid = (double *) malloc (dim * sizeof (double));

  if (s->xmid == 0)
    {
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for xmid", GSL_ENOMEM, 0);
    }

  s->sigma_l = (double *) malloc (dim * sizeof (double));

  if (s->sigma_l == 0)
    {
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for sigma_l", GSL_ENOMEM, 0);
    }

  s->sigma_r = (double *) malloc (dim * sizeof (double));

  if (s->sigma_r == 0)
    {
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for sigma_r", GSL_ENOMEM, 0);
    }

  s->fmax_l = (double *) malloc (dim * sizeof (double));

  if (s->fmax_l == 0)
    {
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fmax_l", GSL_ENOMEM, 0);
    }

  s->fmax_r = (double *) malloc (dim * sizeof (double));

  if (s->fmax_r == 0)
    {
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fmax_r", GSL_ENOMEM, 0);
    }

  s->fmin_l = (double *) malloc (dim * sizeof (double));

  if (s->fmin_l == 0)
    {
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fmin_l", GSL_ENOMEM, 0);
    }

  s->fmin_r = (double *) malloc (dim * sizeof (double));

  if (s->fmin_r == 0)
    {
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fmin_r", GSL_ENOMEM, 0);
    }

  s->fsum_l = (double *) malloc (dim * sizeof (double));

  if (s->fsum_l == 0)
    {
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum_l", GSL_ENOMEM, 0);
    }

  s->fsum_r = (double *) malloc (dim * sizeof (double));

  if (s->fsum_r == 0)
    {
      free (s->fsum_l);
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum_r", GSL_ENOMEM, 0);
    }

  s->fsum2_l = (double *) malloc (dim * sizeof (double));

  if (s->fsum2_l == 0)
    {
      free (s->fsum_r);
      free (s->fsum_l);
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum2_l", GSL_ENOMEM, 0);
    }

  s->fsum2_r = (double *) malloc (dim * sizeof (double));

  if (s->fsum2_r == 0)
    {
      free (s->fsum2_l);
      free (s->fsum_r);
      free (s->fsum_l);
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum2_r", GSL_ENOMEM, 0);
    }

  s->hits_r = (size_t *) malloc (dim * sizeof (size_t));

  if (s->hits_r == 0)
    {
      free (s->fsum2_r);
      free (s->fsum2_l);
      free (s->fsum_r);
      free (s->fsum_l);
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum2_r", GSL_ENOMEM, 0);
    }

  s->hits_l = (size_t *) malloc (dim * sizeof (size_t));

  if (s->hits_l == 0)
    {
      free (s->hits_r);
      free (s->fsum2_r);
      free (s->fsum2_l);
      free (s->fsum_r);
      free (s->fsum_l);
      free (s->fmin_r);
      free (s->fmin_l);
      free (s->fmax_r);
      free (s->fmax_l);
      free (s->sigma_r);
      free (s->sigma_l);
      free (s->xmid);
      free (s->x);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for fsum2_r", GSL_ENOMEM, 0);
    }

  s->dim = dim;

  gsl_monte_miser_init (s);

  return s;
}

int
gsl_monte_miser_init (gsl_monte_miser_state * s)
{
  /* We use 8 points in each halfspace to estimate the variance. There are
     2*dim halfspaces. A variance estimate requires a minimum of 2 points. */
  s->min_calls = 16 * s->dim;
  s->min_calls_per_bisection = 32 * s->min_calls;
  s->estimate_frac = 0.1;
  s->alpha = 2.0;
  s->dither = 0.0;

  return GSL_SUCCESS;
}

void
gsl_monte_miser_free (gsl_monte_miser_state * s)
{
  free (s->hits_r);
  free (s->hits_l);
  free (s->fsum2_r);
  free (s->fsum2_l);
  free (s->fsum_r);
  free (s->fsum_l);
  free (s->fmin_r);
  free (s->fmin_l);
  free (s->fmax_r);
  free (s->fmax_l);
  free (s->sigma_r);
  free (s->sigma_l);
  free (s->xmid);
  free (s->x);
  free (s);
}

static int
estimate_corrmc (gsl_monte_function * f,
		 const double xl[], const double xu[],
		 size_t dim, size_t calls,
		 gsl_rng * r,
		 gsl_monte_miser_state * state,
		 double *result, double *abserr,
		 const double xmid[], double sigma_l[], double sigma_r[])
{
  size_t i, n;

  double *x = state->x;
  double *fsum_l = state->fsum_l;
  double *fsum_r = state->fsum_r;
  double *fsum2_l = state->fsum2_l;
  double *fsum2_r = state->fsum2_r;
  size_t *hits_l = state->hits_l;
  size_t *hits_r = state->hits_r;

  double m = 0.0, q = 0.0;
  double vol = 1.0;

  for (i = 0; i < dim; i++)
    {
      vol *= xu[i] - xl[i];
      hits_l[i] = hits_r[i] = 0;
      fsum_l[i] = fsum_r[i] = 0.0;
      fsum2_l[i] = fsum2_r[i] = 0.0;
      sigma_l[i] = sigma_r[i] = -1;
    }

  for (n = 0; n < calls; n++)
    {
      double fval;

      unsigned int j = (n/2) % dim;
      unsigned int side = (n % 2);

      for (i = 0; i < dim; i++)
	{
          double z = gsl_rng_uniform_pos (r) ;

          if (i != j)
            {
              x[i] = xl[i] + z * (xu[i] - xl[i]);
            }
          else
            {
              if (side == 0)
                {
                  x[i] = xmid[i] + z * (xu[i] - xmid[i]);
                }
              else
                {
                  x[i] = xl[i] + z * (xmid[i] - xl[i]);
                }
            }
	}

      fval = GSL_MONTE_FN_EVAL (f, x);

      /* recurrence for mean and variance */
      {
	double d = fval - m;
	m += d / (n + 1.0);
	q += d * d * (n / (n + 1.0));
      }

      /* compute the variances on each side of the bisection */
      for (i = 0; i < dim; i++)
	{
	  if (x[i] <= xmid[i])
	    {
	      fsum_l[i] += fval;
	      fsum2_l[i] += fval * fval;
	      hits_l[i]++;
	    }
	  else
	    {
	      fsum_r[i] += fval;
	      fsum2_r[i] += fval * fval;
	      hits_r[i]++;
	    }
	}
    }

  for (i = 0; i < dim; i++)
    {
      double fraction_l = (xmid[i] - xl[i]) / (xu[i] - xl[i]);

      if (hits_l[i] > 0)
	{
	  fsum_l[i] /= hits_l[i];
	  sigma_l[i] = sqrt (fsum2_l[i] - fsum_l[i] * fsum_l[i] / hits_l[i]);
	  sigma_l[i] *= fraction_l * vol / hits_l[i];
	}

      if (hits_r[i] > 0)
	{
	  fsum_r[i] /= hits_r[i];
	  sigma_r[i] = sqrt (fsum2_r[i] - fsum_r[i] * fsum_r[i] / hits_r[i]);
	  sigma_r[i] *= (1 - fraction_l) * vol / hits_r[i];
	}
    }

  *result = vol * m;

  if (calls < 2)
    {
      *abserr = GSL_POSINF;
    }
  else
    {
      *abserr = vol * sqrt (q / (calls * (calls - 1.0)));
    }

  return GSL_SUCCESS;
}


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

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_sf_trig.h>
#include <gsl/gsl_sf_bessel.h>

#include "error.h"

#include "bessel.h"
#include "bessel_amp_phase.h"
#include "cheb_eval.c"

/*-*-*-*-*-*-*-*-*-*-*-* Private Section *-*-*-*-*-*-*-*-*-*-*-*/

/* based on SLATEC besy1, 1977 version, w. fullerton */

/* chebyshev expansions

 series for by1        on the interval  0.          to  1.60000d+01
                                        with weighted error   1.87e-18
                                         log weighted error  17.73
                               significant figures required  17.83
                                    decimal places required  18.30
*/

static double by1_data[14] = {
  0.03208047100611908629,
  1.262707897433500450,
  0.00649996189992317500,
 -0.08936164528860504117,
  0.01325088122175709545,
 -0.00089790591196483523,
  0.00003647361487958306,
 -0.00000100137438166600,
  0.00000001994539657390,
 -0.00000000030230656018,
  0.00000000000360987815,
 -0.00000000000003487488,
  0.00000000000000027838,
 -0.00000000000000000186
};
static cheb_series by1_cs = {
  by1_data,
  13,
  -1, 1,
  10
};

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

int gsl_sf_bessel_Y1_e(const double x, gsl_sf_result * result)
{
  const double two_over_pi = 2.0/M_PI;
  const double xmin = 1.571*GSL_DBL_MIN; /*exp ( amax1(alog(r1mach(1)), -alog(r1mach(2)))+.01) */
  const double x_small = 2.0 * GSL_SQRT_DBL_EPSILON;
  const double xmax    = 1.0/GSL_DBL_EPSILON;

  /* CHECK_POINTER(result) */

  if(x <= 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x < xmin) {
    OVERFLOW_ERROR(result);
  }
  else if(x < x_small) {
    const double lnterm = log(0.5*x);
    gsl_sf_result J1;
    gsl_sf_result c;
    int status = gsl_sf_bessel_J1_e(x, &J1);
    cheb_eval_e(&by1_cs, -1.0, &c);
    result->val = two_over_pi * lnterm * J1.val + (0.5 + c.val)/x;
    result->err = fabs(lnterm) * (fabs(GSL_DBL_EPSILON * J1.val) + J1.err) + c.err/x;
    return status;
  }
  else if(x < 4.0) {
    const double lnterm = log(0.5*x);
    int status;
    gsl_sf_result J1;
    gsl_sf_result c;
    cheb_eval_e(&by1_cs, 0.125*x*x-1.0, &c);
    status = gsl_sf_bessel_J1_e(x, &J1);
    result->val = two_over_pi * lnterm * J1.val + (0.5 + c.val)/x;
    result->err = fabs(lnterm) * (fabs(GSL_DBL_EPSILON * J1.val) + J1.err) + c.err/x;
    return status;
  }
  else if(x < xmax) {
    const double z = 32.0/(x*x) - 1.0;
    gsl_sf_result ca;
    gsl_sf_result ct;
    gsl_sf_result cp;
    const int stat_ca = cheb_eval_e(&_gsl_sf_bessel_amp_phase_bm1_cs,  z, &ca);
    const int stat_ct = cheb_eval_e(&_gsl_sf_bessel_amp_phase_bth1_cs, z, &ct);
    const int stat_cp = gsl_sf_bessel_cos_pi4_e(x, ct.val/x, &cp);
    const double sqrtx = sqrt(x);
    const double ampl  = (0.75 + ca.val) / sqrtx;
    result->val  = -ampl * cp.val;
    result->err  = fabs(cp.val) * ca.err/sqrtx + fabs(ampl) * cp.err;
    result->err += GSL_DBL_EPSILON * fabs(result->val);
    return GSL_ERROR_SELECT_3(stat_ca, stat_ct, stat_cp);
  }
  else {
    UNDERFLOW_ERROR(result);
  }
}

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

#include "eval.h"

double gsl_sf_bessel_Y1(const double x)
{
  EVAL_RESULT(gsl_sf_bessel_Y1_e(x, &result));
}


#ifndef BLAS_WRAPPER_H
#define BLAS_WRAPPER_H

#include <cassert>
#include <cmath>
#include <cstring>
#include <vector>

// Useful dense kernels from BLAS, with readable, overloaded, cross-platform names and some simplified calling
//  dot    (dot-product of vectors)
//  nrm2   (2-norm of a vector)
//  asum   (1-norm of a vector)
//  amax   (index of maximum absolute value in a vector)
//  swap   (exchanging values in two vectors)
//  copy   (copying values from one vector to another)
//  axpy   (adding a scalar times a vector to another vector)
//  scal   (multiplying a vector by a scalar)
//  gemv   (multiplying a matrix times a vector, scaling, and adding result to another vector))
//  gemm   (multiplying two matrices, scaling, and adding result to another matrix)
// In addition:
//  set_zero  (zero out all entries in a vector)
//  abs_max   (return the infinity norm of a vector, i.e. the magnitude of its largest element)
// There are also version using std::vector for convenience.

// Matrices are always assumed to be in column-major format.

// You can #define one of:
//    USE_FORTRAN_BLAS (if your BLAS calls should look like dgemm_ with FORTRAN calling conventions, as in GOTO BLAS)
//    USE_AMD_BLAS     (if using the AMD Math Library)
//    USE_CBLAS        (if instead you have calls like cblas_dgemm, and have a file "cblas.h" available)
// or, if you're on the Mac, it will default to the vecLib CBLAS if none of these are specified.

namespace BLAS{

    template<class T>
    inline void set_zero(int n, T *x)
    { std::memset(x, 0, n*sizeof(T)); }

}

//============================================================================
#ifdef USE_FORTRAN_BLAS

extern "C" {
    double dsdot_(const int*, const float*, const int*, const float*, const int*);
    double sdot_(const int*, const float*, const int*, const float*, const int*);
    double ddot_(const int*, const double*, const int*, const double*, const int*);
    float snrm2_(const int*, const float*, const int*);
    double dnrm2_(const int*, const double*, const int*);
    float sasum_(const int*, const float*, const int*);
    double dasum_(const int*, const double*, const int*);
    int isamax_(const int*, const float*, const int*);
    int idamax_(const int*, const double*, const int*);
    void sswap_(const int*, float*, const int*, float*, const int*);
    void dswap_(const int*, double*, const int*, double*, const int*);
    void scopy_(const int*, const float*, const int*, float*, const int*);
    void dcopy_(const int*, const double*, const int*, double*, const int*);
    void saxpy_(const int*, const float*, const float*, const int*, float*, const int*);
    void daxpy_(const int*, const double*, const double*, const int*, double*, const int*);
    void sscal_(const int*, const float*, float*, const int*);
    void dscal_(const int*, const double*, double*, const int*);
    void sgemv_(const char*, const int*, const int*, const float*, const float*, const int*, const float*, const int*, const float*, float*, const int*);
    void dgemv_(const char*, const int*, const int*, const double*, const double*, const int*, const double*, const int*, const double*, double*, const int*);
    void sgemm_(const char*, const char*, const int*, const int*, const int*, const float*, const float*, const int*, const float*, const int*, const float*, float*, const int*);
    void dgemm_(const char*, const char*, const int*, const int*, const int*, const double*, const double*, const int*, const double*, const int*, const double*, double*, const int*);
}

namespace BLAS{

    enum Transpose {NoTrans='N', Trans='T'};
    enum UpperLower {Upper='U', Lower='L'};
    enum UnitDiag {NonUnit='N', Unit='U'};
    enum Side {Left='L', Right='R'};

    // dot products

    inline double dot(int n, const float *x, int incx, const float *y, int incy=1)
    { return dsdot_(&n, x, &incx, y, &incy); }

    inline double dot(int n, const float *x, const float *y, int incy=1)
    { const int one=1; return dsdot_(&n, x, &one, y, &incy); }

    inline float dotf(int n, const float *x, int incx, const float *y, int incy=1)
    { return (float)sdot_(&n, x, &incx, y, &incy); }

    inline float dotf(int n, const float *x, const float *y, int incy=1)
    { const int one=1; return (float)sdot_(&n, x, &one, y, &incy); }

    inline double dot(int n, const double *x, int incx, const double *y, int incy=1)
    { return ddot_(&n, x, &incx, y, &incy); }

    inline double dot(int n, const double *x, const double *y, int incy=1)
    { const int one=1; return ddot_(&n, x, &one, y, &incy); }

    // 2-norm

    inline float norm2(int n, const float *x, int incx=1)
    { return snrm2_(&n, x, &incx); }

    inline double norm2(int n, const double *x, int incx=1)
    { return dnrm2_(&n, x, &incx); }

    // 1-norm (sum of absolute values)

    inline float abs_sum(int n, const float *x, int incx=1)
    { return sasum_(&n, x, &incx); }

    inline double abs_sum(int n, const double *x, int incx=1)
    { return dasum_(&n, x, &incx); }

    // inf-norm (maximum absolute value: index of max returned)

    inline int index_abs_max(int n, const float *x, int incx=1)
    { return isamax_(&n, x, &incx)-1; }

    inline int index_abs_max(int n, const double *x, int incx=1)
    { return idamax_(&n, x, &incx)-1; }

    inline float abs_max(int n, const float *x, int incx=1)
    { return std::fabs(x[isamax_(&n, x, &incx)-1]); }

    inline double abs_max(int n, const double *x, int incx=1)
    { return std::fabs(x[idamax_(&n, x, &incx)-1]); }

    // swap (actual data exchanged, not just pointers)

    inline void swap(int n, float *x, int incx, float *y, int incy=1)
    { sswap_(&n, x, &incx, y, &incy); }

    inline void swap(int n, float *x, float *y, int incy=1)
    { const int one=1; sswap_(&n, x, &one, y, &incy); }

    inline void swap(int n, double *x, int incx, double *y, int incy=1)
    { dswap_(&n, x, &incx, y, &incy); }

    inline void swap(int n, double *x, double *y, int incy=1)
    { const int one=1; dswap_(&n, x, &one, y, &incy); }

    // copy (y=x)

    inline void copy(int n, const float *x, int incx, float *y, int incy=1)
    { scopy_(&n, x, &incx, y, &incy); }

    inline void copy(int n, const float *x, float *y, int incy=1)
    { const int one=1; scopy_(&n, x, &one, y, &incy); }

    inline void copy(int n, const double *x, int incx, double *y, int incy=1)
    { dcopy_(&n, x, &incx, y, &incy); }

    inline void copy(int n, const double *x, double *y, int incy=1)
    { const int one=1; dcopy_(&n, x, &one, y, &incy); }

    // saxpy (y=alpha*x+y)

    inline void add_scaled(int n, float alpha, const float *x, int incx, float *y, int incy=1)
    { saxpy_(&n, &alpha, x, &incx, y, &incy); }

    inline void add_scaled(int n, float alpha, const float *x, float *y, int incy=1)
    { const int one=1; saxpy_(&n, &alpha, x, &one, y, &incy); }

    inline void add_scaled(int n, double alpha, const double *x, int incx, double *y, int incy=1)
    { daxpy_(&n, &alpha, x, &incx, y, &incy); }

    inline void add_scaled(int n, double alpha, const double *x, double *y, int incy=1)
    { const int one=1; daxpy_(&n, &alpha, x, &one, y, &incy); }

    // scale (x=alpha*x)

    inline void scale(int n, float alpha, float *x, int incx=1)
    { sscal_(&n, &alpha, x, &incx); }

    inline void scale(int n, double alpha, double *x, int incx=1)
    { dscal_(&n, &alpha, x, &incx); }

    // gemv (y=alpha*A*x+beta*y, or using A^T)
    // The matrix is always m*n; the size of x and y depend on if A is transposed.

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, float alpha, const float *A, int lda,
                                       const float *x, int incx, float beta, float *y, int incy=1)
    { sgemv_((const char*)&transpose, &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }

    inline void multiply_matrix_vector(int m, int n, const float *A, const float *x, float *y, int incy=1) // y=A*x
    { const int onei=1; const float zero=0, onef=1; sgemv_("N", &m, &n, &onef, A, &m, x, &onei, &zero, y, &incy); }

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, double alpha, const double *A, int lda,
                                       const double *x, int incx, double beta, double *y, int incy=1)
    { dgemv_((const char*)&transpose, &m, &n, &alpha, A, &lda, x, &incx, &beta, y, &incy); }

    inline void multiply_matrix_vector(int m, int n, const double *A, const double *x, double *y, int incy=1) // y=A*x
    { const int onei=1; const double zero=0, onef=1; dgemv_("N", &m, &n, &onef, A, &m, x, &onei, &zero, y, &incy); }

    // gemm (C=alpha*A*B+beta*C)

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, float alpha, const float *A, int lda,
                                       const float *B, int ldb, float beta, float *C, int ldc)
    { sgemm_((const char*)&transA, (const char*)&transB, &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const float *A, const float *B, float *C)
    { const float zero=0, one=1; sgemm_("N", "N", &m, &n, &k, &one, A, &m, B, &k, &zero, C, &m); } // C=A*B

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, double alpha, const double *A, int lda,
                                       const double *B, int ldb, double beta, double *C, int ldc)
    { dgemm_((const char*)&transA, (const char*)&transB, &m, &n, &k, &alpha, A, &lda, B, &ldb, &beta, C, &ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const double *A, const double *B, double *C)
    { const double zero=0, one=1; dgemm_("N", "N", &m, &n, &k, &one, A, &m, B, &k, &zero, C, &m); } // C=A*B

};

//============================================================================
#elif defined USE_AMD_BLAS

#include <acml.h>

namespace BLAS{

    enum Transpose {NoTrans='N', Trans='T'};
    enum UpperLower {Upper='U', Lower='L'};
    enum UnitDiag {NonUnit='N', Unit='U'};
    enum Side {Left='L', Right='R'};

    // dot products

    inline double dot(int n, const float *x, int incx, const float *y, int incy=1)
    { return dsdot(n, (float*)x, incx, (float*)y, incy); }

    inline double dot(int n, const float *x, const float *y, int incy=1)
    { return dsdot(n, (float*)x, 1, (float*)y, incy); }

    inline float dotf(int n, const float *x, int incx, const float *y, int incy=1)
    { return sdot(n, (float*)x, incx, (float*)y, incy); }

    inline float dotf(int n, const float *x, const float *y, int incy=1)
    { return sdot(n, (float*)x, 1, (float*)y, incy); }

    inline double dot(int n, const double *x, int incx, const double *y, int incy=1)
    { return ddot(n, (double *)x, incx, (double *)y, incy); }

    inline double dot(int n, const double *x, const double *y, int incy=1)
    { return ddot(n, (double *)x, 1, (double *)y, incy); }

    // 2-norm

    inline float norm2(int n, const float *x, int incx=1)
    { return snrm2(n, (float*)x, incx); }

    inline double norm2(int n, const double *x, int incx=1)
    { return dnrm2(n, (double*)x, incx); }

    // 1-norm (sum of absolute values)

    inline float abs_sum(int n, const float *x, int incx=1)
    { return sasum(n, (float*)x, incx); }

    inline double abs_sum(int n, const double *x, int incx=1)
    { return dasum(n, (double*)x, incx); }

    // inf-norm (maximum absolute value: index of max returned)

    inline int index_abs_max(int n, const float *x, int incx=1)
    { return isamax(n, (float*)x, incx)-1; }

    inline int index_abs_max(int n, const double *x, int incx=1)
    { return idamax(n, (double*)x, incx)-1; }

    inline float abs_max(int n, const float *x, int incx=1)
    { return std::fabs(x[isamax(n, (float*)x, incx)]-1); }

    inline double abs_max(int n, const double *x, int incx=1)
    { return std::fabs(x[idamax(n, (double*)x, incx)]-1); }

    // swap (actual data exchanged, not just pointers)

    inline void swap(int n, float *x, int incx, float *y, int incy=1)
    { sswap(n, x, incx, y, incy); }

    inline void swap(int n, float *x, float *y, int incy=1)
    { sswap(n, x, 1, y, incy); }

    inline void swap(int n, double *x, int incx, double *y, int incy=1)
    { dswap(n, x, incx, y, incy); }

    inline void swap(int n, double *x, double *y, int incy=1)
    { dswap(n, x, 1, y, incy); }

    // copy (y=x)

    inline void copy(int n, const float *x, int incx, float *y, int incy=1)
    { scopy(n, (float*)x, incx, y, incy); }

    inline void copy(int n, const float *x, float *y, int incy=1)
    { scopy(n, (float*)x, 1, y, incy); }

    inline void copy(int n, const double *x, int incx, double *y, int incy=1)
    { dcopy(n, (double *)x, incx, y, incy); }

    inline void copy(int n, const double *x, double *y, int incy=1)
    { dcopy(n, (double *)x, 1, y, incy); }

    // saxpy (y=alpha*x+y)

    inline void add_scaled(int n, float alpha, const float *x, int incx, float *y, int incy=1)
    { saxpy(n, alpha, (float*)x, incx, y, incy); }

    inline void add_scaled(int n, float alpha, const float *x, float *y, int incy=1)
    { saxpy(n, alpha, (float*)x, 1, y, incy); }

    inline void add_scaled(int n, double alpha, const double *x, int incx, double *y, int incy=1)
    { daxpy(n, alpha, (double*)x, incx, y, incy); }

    inline void add_scaled(int n, double alpha, const double *x, double *y, int incy=1)
    { daxpy(n, alpha, (double*)x, 1, y, incy); }

    // scale (x=alpha*x)

    inline void scale(int n, float alpha, float *x, int incx=1)
    { sscal(n, alpha, x, incx); }

    inline void scale(int n, double alpha, double *x, int incx=1)
    { dscal(n, alpha, x, incx); }

    // gemv (y=alpha*A*x+beta*y, or using A^T)
    // The matrix is always m*n; the size of x and y depend on if A is transposed.

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, float alpha, const float *A, int lda,
                                       const float *x, int incx, float beta, float *y, int incy=1)
    { sgemv(transpose, m, n, alpha, (float*)A, lda, (float*)x, incx, beta, y, incy); }

    inline void multiply_matrix_vector(int m, int n, const float *A, const float *x, float *y, int incy=1) // y=A*x
    { sgemv(NoTrans, m, n, 1.f, (float*)A, m, (float*)x, 1, 0.f, y, incy); }

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, double alpha, const double *A, int lda,
                                       const double *x, int incx, double beta, double *y, int incy=1)
    { dgemv(transpose, m, n, alpha, (double*)A, lda, (double*)x, incx, beta, y, incy); }

    inline void multiply_matrix_vector(int m, int n, const double *A, const double *x, double *y, int incy=1) // y=A*x
    { dgemv(NoTrans, m, n, 1., (double*)A, m, (double*)x, 1, 0., y, incy); }

    // gemm (C=alpha*A*B+beta*C)

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, float alpha, const float *A, int lda,
                                       const float *B, int ldb, float beta, float *C, int ldc)
    { sgemm(transA, transB, m, n, k, alpha, (float*)A, lda, (float*)B, ldb, beta, C, ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const float *A, const float *B, float *C)
    { sgemm(NoTrans, NoTrans, m, n, k, 1.f, (float*)A, m, (float*)B, k, 0.f, C, m); } // C=A*B

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, double alpha, const double *A, int lda,
                                       const double *B, int ldb, double beta, double *C, int ldc)
    { dgemm(transA, transB, m, n, k, alpha, (double*)A, lda, (double*)B, ldb, beta, C, ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const double *A, const double *B, double *C)
    { dgemm(NoTrans, NoTrans, m, n, k, 1., (double*)A, m, (double*)B, k, 0., C, m); } // C=A*B

};

//============================================================================
#elif defined USE_CBLAS || defined __APPLE__

#ifdef USE_CBLAS
#include <cblas.h>
#elif defined __APPLE__
#include <Accelerate/Accelerate.h>
#endif

namespace BLAS{

    enum Transpose {NoTrans=CblasNoTrans, Trans=CblasTrans};
    enum UpperLower {Upper=CblasUpper, Lower=CblasLower};
    enum UnitDiag {NonUnit=CblasNonUnit, Unit=CblasUnit};
    enum Side {Left=CblasLeft, Right=CblasRight};

    // dot products

    inline float dotf(int n, const float *x, int incx, const float *y, int incy=1)
    { return cblas_sdot(n, x, incx, y, incy); }

    inline float dotf(int n, const float *x, const float *y, int incy=1)
    { return cblas_sdot(n, x, 1, y, incy); }

    inline double dot(int n, const float *x, int incx, const float *y, int incy=1)
    { return cblas_dsdot(n, x, incx, y, incy); }

    inline double dot(int n, const float *x, const float *y, int incy=1)
    { return cblas_dsdot(n, x, 1, y, incy); }

    inline double dot(int n, const double *x, int incx, const double *y, int incy=1)
    { return cblas_ddot(n, x, incx, y, incy); }

    inline double dot(int n, const double *x, const double *y, int incy=1)
    { return cblas_ddot(n, x, 1, y, incy); }

    // 2-norm

    inline float norm2(int n, const float *x, int incx=1)
    { return cblas_snrm2(n, x, incx); }

    inline double norm2(int n, const double *x, int incx=1)
    { return cblas_dnrm2(n, x, incx); }

    // 1-norm (sum of absolute values)

    inline float abs_sum(int n, const float *x, int incx=1)
    { return cblas_sasum(n, x, incx); }

    inline double abs_sum(int n, const double *x, int incx=1)
    { return cblas_dasum(n, x, incx); }

    // inf-norm (maximum absolute value)

    inline int index_abs_max(int n, const float *x, int incx=1)
    { return cblas_isamax(n, x, incx); }

    inline int index_abs_max(int n, const double *x, int incx=1)
    { return cblas_idamax(n, x, incx); }

    inline float abs_max(int n, const float *x, int incx=1)
    { return std::fabs(x[cblas_isamax(n, x, incx)]); }

    inline double abs_max(int n, const double *x, int incx=1)
    { return std::fabs(x[cblas_idamax(n, x, incx)]); }

    // swap (actual data exchanged, not just pointers)

    inline void swap(int n, float *x, int incx, float *y, int incy=1)
    { cblas_sswap(n, x, incx, y, incy); }

    inline void swap(int n, float *x, float *y, int incy=1)
    { cblas_sswap(n, x, 1, y, incy); }

    inline void swap(int n, double *x, int incx, double *y, int incy=1)
    { cblas_dswap(n, x, incx, y, incy); }

    inline void swap(int n, double *x, double *y, int incy=1)
    { cblas_dswap(n, x, 1, y, incy); }

    // copy (y=x)

    inline void copy(int n, const float *x, int incx, float *y, int incy=1)
    { cblas_scopy(n, x, incx, y, incy); }

    inline void copy(int n, const float *x, float *y, int incy=1)
    { cblas_scopy(n, x, 1, y, incy); }

    inline void copy(int n, const double *x, int incx, double *y, int incy=1)
    { cblas_dcopy(n, x, incx, y, incy); }

    inline void copy(int n, const double *x, double *y, int incy=1)
    { cblas_dcopy(n, x, 1, y, incy); }

    // saxpy (y=alpha*x+y)

    inline void add_scaled(int n, float alpha, const float *x, int incx, float *y, int incy=1)
    { cblas_saxpy(n, alpha, x, incx, y, incy); }

    inline void add_scaled(int n, float alpha, const float *x, float *y, int incy=1)
    { cblas_saxpy(n, alpha, x, 1, y, incy); }

    inline void add_scaled(int n, double alpha, const double *x, int incx, double *y, int incy=1)
    { cblas_daxpy(n, alpha, x, incx, y, incy); }

    inline void add_scaled(int n, double alpha, const double *x, double *y, int incy=1)
    { cblas_daxpy(n, alpha, x, 1, y, incy); }

    // scale (x=alpha*x)

    inline void scale(int n, float alpha, float *x, int incx=1)
    { cblas_sscal(n, alpha, x, incx); }

    inline void scale(int n, double alpha, double *x, int incx=1)
    { cblas_dscal(n, alpha, x, incx); }

    // gemv (y=alpha*A*x+beta*y, or using A^T)
    // The matrix is always m*n; the size of x and y depend on if A is transposed.

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, float alpha, const float *A, int lda,
                                       const float *x, int incx,
                                       float beta, float *y, int incy=1)
    { cblas_sgemv(CblasColMajor, (CBLAS_TRANSPOSE)transpose, m, n, alpha, A, lda, x, incx, beta, y, incy); }

    inline void multiply_matrix_vector(int m, int n, const float *A, const float *x, float *y, int incy=1) // y=A*x
    { cblas_sgemv(CblasColMajor, CblasNoTrans, m, n, 1.f, A, m, x, 1, 0.f, y, incy); }

    inline void multiply_matrix_vector(Transpose transpose,
                                       int m, int n, double alpha, const double *A, int lda,
                                       const double *x, int incx, double beta, double *y, int incy=1)
    { cblas_dgemv(CblasColMajor, (CBLAS_TRANSPOSE)transpose, m, n, alpha, A, lda, x, incx, beta, y, incy); }

    inline void multiply_matrix_vector(int m, int n, const double *A, const double *x, double *y, int incy=1) // y=A*x
    { cblas_dgemv(CblasColMajor, CblasNoTrans, m, n, 1., A, m, x, 1, 0., y, incy); }

    // gemm (C=alpha*A*B+beta*C)

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, float alpha, const float *A, int lda,
                                       const float *B, int ldb, float beta, float *C, int ldc)
    { cblas_sgemm(CblasColMajor, (CBLAS_TRANSPOSE)transA, (CBLAS_TRANSPOSE)transB, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const float *A, const float *B, float *C)
    { cblas_sgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, m, n, k, 1.f, A, m, B, k, 0.f, C, m); } // C=A*B

    inline void multiply_matrix_matrix(Transpose transA, Transpose transB,
                                       int m, int n, int k, double alpha, const double *A, int lda,
                                       const double *B, int ldb, double beta, double *C, int ldc)
    { cblas_dgemm(CblasColMajor, (CBLAS_TRANSPOSE)transA, (CBLAS_TRANSPOSE)transB, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc); }

    inline void multiply_matrix_matrix(int m, int n, int k, const double *A, const double *B, double *C)
    { cblas_dgemm(CblasColMajor, CblasNoTrans, CblasNoTrans, m, n, k, 1., A, m, B, k, 0., C, m); } // C=A*B

    inline void rank_one_update( int m, int n, double alpha, const double* x, const double* y, double* A )
    {
        cblas_dger( CblasColMajor, m, n, alpha, x, 1, y, 1, A, m );
    }

}  // namespace BLAS

#endif

// std::vector calls =========================================================
namespace BLAS{

    template<class T>
    inline void set_zero(std::vector<T> &x)
    { set_zero((int)x.size(), &x[0]); }

    inline float dotf(const std::vector<float> &x, const std::vector<float> &y)
    { assert(x.size()==y.size()); return dotf((int)x.size(), &x[0], &y[0]); }

    inline double dot(const std::vector<float> &x, const std::vector<float> &y)
    { assert(x.size()==y.size()); return dot((int)x.size(), &x[0], &y[0]); }

    inline double dot(const std::vector<double> &x, const std::vector<double> &y)
    { assert(x.size()==y.size()); return dot((int)x.size(), &x[0], &y[0]); }

    inline float norm2(const std::vector<float> &x)
    { return norm2((int)x.size(), &x[0]); }

    inline double norm2(const std::vector<double> &x)
    { return norm2((int)x.size(), &x[0]); }

    inline float abs_sum(const std::vector<float> &x)
    { return abs_sum((int)x.size(), &x[0]); }

    inline double abs_sum(const std::vector<double> &x)
    { return abs_sum((int)x.size(), &x[0]); }

    inline int index_abs_max(const std::vector<float> &x)
    { return index_abs_max((int)x.size(), &x[0]); }

    inline int index_abs_max(const std::vector<double> &x)
    { return index_abs_max((int)x.size(), &x[0]); }

    inline float abs_max(const std::vector<float> &x)
    { return abs_max((int)x.size(), &x[0]); }

    inline double abs_max(const std::vector<double> &x)
    { return abs_max((int)x.size(), &x[0]); }

    inline void swap(std::vector<float> &x, std::vector<float> &y)
    { assert(x.size()==y.size()); swap((int)x.size(), &x[0], &y[0]); }

    inline void swap(std::vector<double> &x, std::vector<double> &y)
    { assert(x.size()==y.size()); swap((int)x.size(), &x[0], &y[0]); }

    inline void copy(const std::vector<float> &x, std::vector<float> &y)
    { assert(x.size()==y.size()); copy((int)x.size(), &x[0], &y[0]); }

    inline void copy(const std::vector<double> &x, std::vector<double> &y)
    { assert(x.size()==y.size()); copy((int)x.size(), &x[0], &y[0]); }

    inline void add_scaled(float alpha, const std::vector<float> &x, std::vector<float> &y)
    { assert(x.size()==y.size()); add_scaled((int)x.size(), alpha, &x[0], &y[0]); }

    inline void add_scaled(double alpha, const std::vector<double> &x, std::vector<double> &y)
    { assert(x.size()==y.size()); add_scaled((int)x.size(), alpha, &x[0], &y[0]); }

    inline void scale(float alpha, std::vector<float> &x)
    { scale((int)x.size(), alpha, &x[0]); }

    inline void scale(float alpha, std::vector<double> &x)
    { scale((int)x.size(), alpha, &x[0]); }

    // I'm not sure if it makes sense to include level 2 or level 3 std::vector versions,
    // since there isn't an STL matrix type...

}  // namespace BLAS

#endif


// Copyright (c) 2013-2017 Anton Kozhevnikov, Thomas Schulthess
// 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.

/** \file sbessel.h
 *
 *  \brief Contains implementation of sirius::Spherical_Bessel_functions and sirius::sbessel_approx classes.
 */

#ifndef __SBESSEL_PW_H__
#define __SBESSEL_PW_H__

#include <gsl/gsl_sf_bessel.h>
#include "eigenproblem.h"
#include "Unit_cell/unit_cell.h"

namespace sirius
{

/// Spherical Bessel functions \f$ j_{\ell}(q x) \f$ up to lmax.
class Spherical_Bessel_functions
{
    private:
        int lmax_{-1};
        double q_{0};
        Radial_grid<double> const* rgrid_{nullptr};

        std::vector<Spline<double>> sbessel_;

    public:

        Spherical_Bessel_functions()
        {
        }

        Spherical_Bessel_functions(int lmax__, Radial_grid<double> const& rgrid__, double q__)
            : lmax_(lmax__)
            , q_(q__)
            , rgrid_(&rgrid__)
        {
            assert(q_ >= 0);

            sbessel_ = std::vector<Spline<double>>(lmax__ + 2);
            for (int l = 0; l <= lmax__ + 1; l++) {
                sbessel_[l] = Spline<double>(rgrid__);
            }

            std::vector<double> jl(lmax__ + 2);
            for (int ir = 0; ir < rgrid__.num_points(); ir++) {
                double t = rgrid__[ir] * q__;
                gsl_sf_bessel_jl_array(lmax__ + 1, t, &jl[0]);
                for (int l = 0; l <= lmax__ + 1; l++) {
                    sbessel_[l](ir) = jl[l];
                }
            }

            for (int l = 0; l <= lmax__ + 1; l++) {
                sbessel_[l].interpolate();
            }
        }

        static void sbessel(int lmax__, double t__, double* jl__)
        {
            gsl_sf_bessel_jl_array(lmax__, t__, jl__);
        }

        static void sbessel_deriv_q(int lmax__, double q__, double x__, double* jl_dq__)
        {
            std::vector<double> jl(lmax__ + 2);
            sbessel(lmax__ + 1, x__ * q__, &jl[0]);

            for (int l = 0; l <= lmax__; l++) {
                if (q__ != 0) {
                    jl_dq__[l] = (l / q__) * jl[l] - x__ * jl[l + 1];
                } else {
                    if (l == 1) {
                        jl_dq__[l] = x__ / 3;
                    } else {
                        jl_dq__[l] = 0;
                    }
                }
            }
        }

        Spline<double> const& operator[](int l__) const
        {
            assert(l__ <= lmax_);
            return sbessel_[l__];
        }

        /// Derivative of Bessel function with respect to q.
        /** \f[
         *    \frac{\partial j_{\ell}(q x)}{\partial q} = \frac{\ell}{q} j_{\ell}(q x) - x j_{\ell+1}(q x)
         *  \f]
         */
        Spline<double> deriv_q(int l__)
        {
            assert(l__ <= lmax_);
            assert(q_ >= 0);
            Spline<double> s(*rgrid_);
            if (q_ != 0) {
                for (int ir = 0; ir < rgrid_->num_points(); ir++) {
                    s(ir) = (l__ / q_) * sbessel_[l__](ir) - (*rgrid_)[ir] * sbessel_[l__ + 1](ir);
                }
            } else {
                if (l__ == 1) {
                    for (int ir = 0; ir < rgrid_->num_points(); ir++) {
                        s(ir) = (*rgrid_)[ir] / 3;
                    }
                }
            }
            s.interpolate();
            return std::move(s);
        }
};

class sbessel_approx
{
    private:

        Unit_cell const& unit_cell_;

        int lmax_;

        mdarray<std::vector<double>, 2> qnu_;
        mdarray<double, 4> coeffs_;

        int nqnu_max_;

        static double sbessel_l2norm(double nu, int l, double R)
        {
            if (std::abs(nu) < 1e-10) TERMINATE_NOT_IMPLEMENTED;

            if (l == 0)
            {
                return (nu * R * 2 - std::sin(nu * R * 2)) / 4 / std::pow(nu, 3);
            }
            else
            {
                double jl[l + 2];
                gsl_sf_bessel_jl_array(l + 1, R * nu, &jl[0]);
                return std::pow(R, 3) * (jl[l] * jl[l] - jl[l + 1] * jl[l - 1]) / 2;
            }
        }

    public:

        sbessel_approx(Unit_cell const& unit_cell__,
                       int lmax__,
                       double const qmin__,
                       double const qmax__,
                       double const eps__)
            : unit_cell_(unit_cell__),
              lmax_(lmax__)
        {
            PROFILE("sirius::sbessel_approx");

            qnu_ = mdarray<std::vector<double>, 2>(lmax_ + 1, unit_cell_.num_atom_types());

            for (int l = 0; l <= lmax_; l++) {
                for (int iat = 0; iat < unit_cell_.num_atom_types(); iat++) {
                    qnu_(l, iat) = build_approx_freq(qmin__, qmax__, l, unit_cell_.atom_type(iat).mt_radius(), eps__);
                }
            }

            nqnu_max_ = 0;
            for (int l = 0; l <= lmax_; l++) {
                for (int iat = 0; iat < unit_cell_.num_atom_types(); iat++) {
                    nqnu_max_ = std::max(nqnu_max_, static_cast<int>(qnu_(l, iat).size()));
                }
            }
        }

        void approximate(std::vector<double> const& q__)
        {
            PROFILE("sirius::sbessel_approx::approximate");

            coeffs_ = mdarray<double, 4>(nqnu_max_, q__.size(), lmax_ + 1, unit_cell_.num_atom_types());

            #pragma omp parallel for
            for (int l = 0; l <= lmax_; l++)
            {
                for (int iat = 0; iat < unit_cell_.num_atom_types(); iat++)
                {
                    int n = nqnu(l, iat);

                    mdarray<double, 2> A(n, n);
                    for (int iq = 0; iq < n; iq++)
                    {
                        for (int jq = 0; jq <= iq; jq++)
                        {
                            A(jq, iq) = A(iq, jq) = overlap(qnu_(l, iat)[jq], qnu_(l, iat)[iq], l,
                                                            unit_cell_.atom_type(iat).mt_radius());
                        }

                        for (int j = 0; j < (int)q__.size(); j++)
                        {
                            if (std::abs(q__[j]) < 1e-12)
                            {
                                coeffs_(iq, j, l, iat) = 0;
                            }
                            else
                            {
                                coeffs_(iq, j, l, iat) = overlap(qnu_(l, iat)[iq], q__[j], l,
                                                                 unit_cell_.atom_type(iat).mt_radius());
                            }
                        }
                    }
                    linalg<CPU>::gesv(n, (int)q__.size(), A.at<CPU>(), A.ld(), &coeffs_(0, 0, l, iat), coeffs_.ld());
                }
            }
        }

        inline double qnu(int const iq, int const l, int const iat)
        {
            return qnu_(l, iat)[iq];
        }

        inline int nqnu(int const l, int const iat)
        {
            return static_cast<int>(qnu_(l, iat).size());
        }

        inline int nqnu_max()
        {
            return nqnu_max_;
        }

        inline double coeff(int const iq, int const j, int const l, int const iat)
        {
            return coeffs_(iq, j, l, iat);
        }

        // \int_0^{R} j(nu1 * r) * j(nu2 * r) * r^2 dr
        // this integral can be computed analytically
        static double overlap(double nu1__, double nu2__, int l__, double R__)
        {
            if (std::abs(nu1__) < 1e-10 || std::abs(nu2__) < 1e-10) TERMINATE_NOT_IMPLEMENTED;

            if (std::abs(nu1__ - nu2__) < 1e-12)
            {
                if (l__ == 0)
                {
                    return (nu2__ * R__ * 2 - std::sin(nu2__ * R__ * 2)) / 4 / std::pow(nu2__, 3);
                }
                else
                {
                    double jl[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &jl[0]);
                    return std::pow(R__, 3) * (jl[l__] * jl[l__] - jl[l__ + 1] * jl[l__ - 1]) / 2;
                }
            }
            else
            {
                if (l__ == 0)
                {
                    return (nu2__ * std::cos(nu2__ * R__) * std::sin(nu1__ * R__) - nu1__ * std::cos(nu1__ * R__) * std::sin(nu2__ * R__)) /
                           (std::pow(nu1__, 3) * nu2__ - nu1__ * std::pow(nu2__, 3));
                }
                else
                {
                    double j1[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu1__, &j1[0]);

                    double j2[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &j2[0]);

                    return std::pow(R__, 2) * (nu2__ * j2[l__ - 1] * j1[l__] - nu1__ * j1[l__ - 1] * j2[l__]) / (std::pow(nu1__, 2) - std::pow(nu2__, 2));
                }
            }
        }

        std::vector<double> build_approx_freq(double const qmin__,
                                              double const qmax__,
                                              int const l__,
                                              double const R__,
                                              double const eps__)
        {
            std::vector<double> qnu;

            double min_val;
            int n = 2;

            do
            {
                n++;
                qnu.resize(n);
                for (int i = 0; i < n; i++) qnu[i] = qmin__ + (qmax__ - qmin__) * i / (n - 1);

                dmatrix<double_complex> ovlp(n, n);
                for (int i = 0; i < n; i++)
                {
                    for (int j = 0; j <= i; j++)
                    {
                        double o = overlap(qnu[j], qnu[i], l__, R__);
                        ovlp(j, i) = o / sbessel_l2norm(qnu[i], l__, R__) / sbessel_l2norm(qnu[j], l__, R__);
                    }
                }

                std::vector<double> eval(n);
                dmatrix<double_complex> z(n, n);

                Eigensolver_lapack<double_complex> solver;
                solver.solve(n, ovlp, &eval[0], z);
                min_val = eval[0];

            } while (min_val > eps__);

            return qnu;
        }
};

class Spherical_Bessel_approximant
{
    private:

        int lmax_;

        double R_;

        /// List of Bessel function scaling factors for each angular momentum.
        std::vector< std::vector<double> > qnu_;

        //mdarray<double, 4> coeffs_;

        int nqnu_max_;

        static double sbessel_l2norm(double nu, int l, double R)
        {
            if (std::abs(nu) < 1e-10)
            {
                if (l == 0) return std::pow(R, 3) / 3.0;
                return 0;
            }

            if (l == 0)
            {
                return (nu * R * 2 - std::sin(nu * R * 2)) / 4 / std::pow(nu, 3);
            }
            else
            {
                double jl[l + 2];
                gsl_sf_bessel_jl_array(l + 1, R * nu, &jl[0]);
                return std::pow(R, 3) * (jl[l] * jl[l] - jl[l + 1] * jl[l - 1]) / 2;
            }
        }

    public:

        Spherical_Bessel_approximant(int lmax__,
                                     double R__,
                                     double const qmin__,
                                     double const qmax__,
                                     double const eps__)
            : lmax_(lmax__),
              R_(R__)
        {
            PROFILE("sirius::Spherical_Bessel_approximant");

            qnu_ = std::vector< std::vector<double> >(lmax_ + 1);

            #pragma omp parallel for
            for (int l = 0; l <= lmax_; l++)
                qnu_[l] = build_approx_freq(qmin__, qmax__, l, R_, eps__);

            nqnu_max_ = 0;
            for (int l = 0; l <= lmax_; l++)
                nqnu_max_ = std::max(nqnu_max_, nqnu(l));
        }

        std::vector<double> approximate(int l__, double nu__)
        {
            int n = nqnu(l__);
            std::vector<double> x(n);
            matrix<double> A(n, n);

            for (int iq = 0; iq < n; iq++)
            {
                for (int jq = 0; jq <= iq; jq++)
                {
                    A(jq, iq) = A(iq, jq) = overlap(qnu(jq, l__), qnu(iq, l__), l__, R_);
                }
                x[iq] = overlap(qnu(iq, l__), nu__, l__, R_);
            }
            linalg<CPU>::gesv(n, 1, A.at<CPU>(), A.ld(), &x[0], n);
            return x;
        }

        void approximate(std::vector<double> const& q__)
        {
            //runtime::Timer t("sirius::sbessel_approx::approximate");

            //coeffs_ = mdarray<double, 4>(nqnu_max_, q__.size(), lmax_ + 1, unit_cell_.num_atom_types());
            //
            //#pragma omp parallel for
            //for (int l = 0; l <= lmax_; l++)
            //{
            //    for (int iat = 0; iat < unit_cell_.num_atom_types(); iat++)
            //    {
            //        int n = nqnu(l, iat);

            //        mdarray<double, 2> A(n, n);
            //        for (int iq = 0; iq < n; iq++)
            //        {
            //            for (int jq = 0; jq <= iq; jq++)
            //            {
            //                A(jq, iq) = A(iq, jq) = overlap(qnu_(l, iat)[jq], qnu_(l, iat)[iq], l,
            //                                                unit_cell_.atom_type(iat).mt_radius());
            //            }

            //            for (int j = 0; j < (int)q__.size(); j++)
            //            {
            //                if (std::abs(q__[j]) < 1e-12)
            //                {
            //                    coeffs_(iq, j, l, iat) = 0;
            //                }
            //                else
            //                {
            //                    coeffs_(iq, j, l, iat) = overlap(qnu_(l, iat)[iq], q__[j], l,
            //                                                     unit_cell_.atom_type(iat).mt_radius());
            //                }
            //            }
            //        }
            //        linalg<CPU>::gesv(n, (int)q__.size(), A.at<CPU>(), A.ld(), &coeffs_(0, 0, l, iat), coeffs_.ld());
            //    }
            //}
        }

        inline double qnu(int const iq, int const l) const
        {
            return qnu_[l][iq];
        }

        inline int nqnu(int const l) const
        {
            return static_cast<int>(qnu_[l].size());
        }

        inline int nqnu_max() const
        {
            return nqnu_max_;
        }

        //inline double coeff(int const iq, int const j, int const l, int const iat)
        //{
        //    return coeffs_(iq, j, l, iat);
        //}
        //

        // \int_0^{R} j(nu1 * r) * j(nu2 * r) * r^2 dr
        // this integral can be computed analytically
        static double overlap(double nu1__, double nu2__, int l__, double R__)
        {
            if (std::abs(nu1__) < 1e-10 && std::abs(nu2__) < 1e-10 && l__ == 0) return std::pow(R__, 3) / 3.0;

            if ((std::abs(nu1__) < 1e-10 || std::abs(nu2__) < 1e-10) && l__ > 0) return 0;

            if ((std::abs(nu1__) < 1e-10 || std::abs(nu2__) < 1e-10) && l__ == 0)
            {
                double nu = std::max(nu1__, nu2__);
                double nuR = nu * R__;
                return (std::sin(nuR) - nuR * std::cos(nuR)) / std::pow(nu, 3);
            }

            if (std::abs(nu1__ - nu2__) < 1e-12)
            {
                if (l__ == 0)
                {
                    return (nu2__ * R__ * 2 - std::sin(nu2__ * R__ * 2)) / 4 / std::pow(nu2__, 3);
                }
                else
                {
                    double jl[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &jl[0]);
                    return std::pow(R__, 3) * (jl[l__] * jl[l__] - jl[l__ + 1] * jl[l__ - 1]) / 2;
                }
            }
            else
            {
                if (l__ == 0)
                {
                    return (nu2__ * std::cos(nu2__ * R__) * std::sin(nu1__ * R__) - nu1__ * std::cos(nu1__ * R__) * std::sin(nu2__ * R__)) /
                           (std::pow(nu1__, 3) * nu2__ - nu1__ * std::pow(nu2__, 3));
                }
                else
                {
                    double j1[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu1__, &j1[0]);

                    double j2[l__ + 2];
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &j2[0]);

                    return std::pow(R__, 2) * (nu2__ * j2[l__ - 1] * j1[l__] - nu1__ * j1[l__ - 1] * j2[l__]) / (std::pow(nu1__, 2) - std::pow(nu2__, 2));
                }
            }
            TERMINATE("this is wrong");
            return -1;
        }

        std::vector<double> build_approx_freq(double const qmin__,
                                              double const qmax__,
                                              int const l__,
                                              double const R__,
                                              double const eps__)
        {
            std::vector<double> qnu;

            double min_val;
            int n = 2;

            do
            {
                n++;
                qnu.resize(n);
                for (int i = 0; i < n; i++) qnu[i] = qmin__ + (qmax__ - qmin__) * i / (n - 1);

                dmatrix<double> ovlp(n, n);
                for (int i = 0; i < n; i++)
                {
                    for (int j = 0; j <= i; j++)
                    {
                        double o = overlap(qnu[j], qnu[i], l__, R__);
                        ovlp(j, i) = o / sbessel_l2norm(qnu[i], l__, R__) / sbessel_l2norm(qnu[j], l__, R__);
                    }
                }

                std::vector<double> eval(n);
                dmatrix<double> z(n, n);

                Eigensolver_lapack<double> solver;
                solver.solve(n, ovlp, &eval[0], z);
                min_val = eval[0];

            } while (min_val > eps__);

            return qnu;
        }
};

class Spherical_Bessel_approximant2
{
    private:

        int lmax_;

        double R_;

        /// List of Bessel function scaling factors for each angular momentum.
        std::vector<double> qnu_;

        static double sbessel_l2norm(double nu, int l, double R)
        {
            if (std::abs(nu) < 1e-10)
            {
                if (l == 0) return std::pow(R, 3) / 3.0;
                return 0;
            }

            if (l == 0)
            {
                return (nu * R * 2 - std::sin(nu * R * 2)) / 4 / std::pow(nu, 3);
            }
            else
            {
                double jl[l + 2];
                gsl_sf_bessel_jl_array(l + 1, R * nu, &jl[0]);
                return std::pow(R, 3) * (jl[l] * jl[l] - jl[l + 1] * jl[l - 1]) / 2;
            }
        }

    public:

        Spherical_Bessel_approximant2(int lmax__,
                                     double R__,
                                     double const qmin__,
                                     double const qmax__,
                                     int nq__)
            : lmax_(lmax__),
              R_(R__)
        {
            PROFILE("sirius::Spherical_Bessel_approximant");

            int nq = nfreq(qmin__, qmax__, 0, R__, 1e-12);
            qnu_.resize(nq);
            for (int i = 0; i < nq; i++) qnu_[i] = qmin__ + (qmax__ - qmin__) * i / (nq - 1);

        }

        std::vector<double> approximate(int l__, double nu__)
        {
            int n = nqnu();
            std::vector<double> x(n);
            matrix<double> A(n, n);

            for (int iq = 0; iq < n; iq++)
            {
                for (int jq = 0; jq <= iq; jq++)
                {
                    A(jq, iq) = A(iq, jq) = overlap(qnu(jq), qnu(iq), l__, R_);
                }
                x[iq] = overlap(qnu(iq), nu__, l__, R_);
            }
            linalg<CPU>::gesv(n, 1, A.at<CPU>(), A.ld(), &x[0], n);
            return x;
        }

        inline double qnu(int const iq) const
        {
            return qnu_[iq];
        }

        inline int nqnu() const
        {
            return static_cast<int>(qnu_.size());
        }

        // \int_0^{R} j(nu1 * r) * j(nu2 * r) * r^2 dr
        // this integral can be computed analytically
        static double overlap(double nu1__, double nu2__, int l__, double R__)
        {
            if (std::abs(nu1__) < 1e-10 && std::abs(nu2__) < 1e-10 && l__ == 0) return std::pow(R__, 3) / 3.0;

            if ((std::abs(nu1__) < 1e-10 || std::abs(nu2__) < 1e-10) && l__ > 0) return 0;

            if ((std::abs(nu1__) < 1e-10 || std::abs(nu2__) < 1e-10) && l__ == 0)
            {
                double nu = std::max(nu1__, nu2__);
                double nuR = nu * R__;
                return (std::sin(nuR) - nuR * std::cos(nuR)) / std::pow(nu, 3);
            }

            if (std::abs(nu1__ - nu2__) < 1e-12)
            {
                if (l__ == 0)
                {
                    return (nu2__ * R__ * 2 - std::sin(nu2__ * R__ * 2)) / 4 / std::pow(nu2__, 3);
                }
                else
                {
                    std::vector<double> jl(l__ + 2);
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &jl[0]);
                    return std::pow(R__, 3) * (jl[l__] * jl[l__] - jl[l__ + 1] * jl[l__ - 1]) / 2;
                }
            }
            else
            {
                if (l__ == 0)
                {
                    return (nu2__ * std::cos(nu2__ * R__) * std::sin(nu1__ * R__) - nu1__ * std::cos(nu1__ * R__) * std::sin(nu2__ * R__)) /
                           (std::pow(nu1__, 3) * nu2__ - nu1__ * std::pow(nu2__, 3));
                }
                else
                {
                    std::vector<double> j1(l__ + 2);
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu1__, &j1[0]);

                    std::vector<double> j2(l__ + 2);
                    gsl_sf_bessel_jl_array(l__ + 1, R__ * nu2__, &j2[0]);

                    return std::pow(R__, 2) * (nu2__ * j2[l__ - 1] * j1[l__] - nu1__ * j1[l__ - 1] * j2[l__]) / (std::pow(nu1__, 2) - std::pow(nu2__, 2));
                }
            }
            TERMINATE("this is wrong");
            return -1;
        }

        int nfreq(double const qmin__,
                  double const qmax__,
                  int const l__,
                  double const R__,
                  double const eps__)
        {
            std::vector<double> qnu;

            double min_val;
            int n = 2;

            do
            {
                n++;
                qnu.resize(n);
                for (int i = 0; i < n; i++) qnu[i] = qmin__ + (qmax__ - qmin__) * i / (n - 1);

                dmatrix<double> ovlp(n, n);
                for (int i = 0; i < n; i++)
                {
                    for (int j = 0; j <= i; j++)
                    {
                        double o = overlap(qnu[j], qnu[i], l__, R__);
                        ovlp(j, i) = o / sbessel_l2norm(qnu[i], l__, R__) / sbessel_l2norm(qnu[j], l__, R__);
                    }
                }

                std::vector<double> eval(n);
                dmatrix<double> z(n, n);

                Eigensolver_lapack<double> solver;
                solver.solve(n, ovlp, &eval[0], z);
                min_val = eval[0];

                if (n > 100) return 100;

            } while (min_val > eps__);

            return n;
        }
};

};

#endif