/**
 *
 * Copyright (c) 2017-2020  King Abdullah University of Science and Technology
 * All rights reserved.
 *
 * ExaGeoStat is a software package provided by KAUST
 **/
/**
 *
 * @file MLE_misc.h
 *
 * Header file of  auxiliary functions that are needed by ExaGeoStat.
 *
 * @version 1.1.0
 *
 * @author Sameh Abdulah
 * @date 2020-06-06
 *
 **/
#ifndef _MLE_MISC_H_
#define _MLE_MISC_H_
#include <stdbool.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include <unistd.h>
#include <sys/time.h>
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include "common.h"
#include "descriptor.h"
#include "chameleon/morse_runtime.h"
#include <nlopt.h>
#include <math.h>
#include <morse.h>
#include <lapacke.h>
#include <starpu.h>
#include <cblas.h>
#include "../../include/flops.h"
#include <starpu_profiling.h>
#if defined(CHAMELEON_USE_MPI)
#include <starpu_mpi.h>
#else
#endif
#if defined(CHAMELEON_USE_CUDA) && !defined(CHAMELEON_SIMULATION)
#include <starpu_scheduler.h>
#include <starpu_cuda.h>
#endif
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_fft_complex.h>
#include "../../include/morse_starpu.h"
/** ****************************************************************************
 * PI value
 **/
#define PI (3.141592653589793)
/** ****************************************************************************
 * The radius of the  eartch (used by Great Circle Distance (GCD)
 **/
#define earthRadiusKm 6371.0
/** ****************************************************************************
 * Start timing macro
 **/
#define START_TIMING(_t)     _t =- cWtime();
/** ****************************************************************************
 * Stop timing macro
 **/
#define STOP_TIMING(_t)      _t += cWtime();
/*******************************************************************************/
/**
 *  Internal function to return address of block (m,n) with m,n = block indices
 */

inline static void *chameleon_getaddr_null(const MORSE_desc_t *A, int m, int n)
{
    (void)A; (void)m; (void)n;
    return NULL;
}

/**
 *  Internal function to return the leading dimension of element A(m,*) with m,n = block indices
 */
inline static int chameleon_getblkldd_ccrb(const MORSE_desc_t *A, int m)
{
    int mm = m + A->i / A->mb;
    return ( ((mm+1) == A->lmt) && ((A->lm % A->mb) != 0)) ? A->lm % A->mb : A->mb;
}

/**
 *  Internal function to return MPI rank of element A(m,n) with m,n = block indices
 */
inline static int chameleon_getrankof_2d(const MORSE_desc_t *desc, int m, int n)
{

    if(m>=n)
        return (m % desc->p) * desc->q + (n % desc->q);
    else
        return (n % desc->p) * desc->q + (m % desc->q);
}

/** ****************************************************************************
 * Allocate matrix in different modes
 **/
#define EXAGEOSTAT_ALLOCATE_MATRIX_TILE(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_ , _lda_, _n_, _smb_, _snb_, _m_, _n2_, _p_, _q_) \
    if (data->ooc && _memspace_ == NULL && _mb_ != 1  && _nb_ !=1)                                                         \
MORSE_Desc_Create_OOC(_desc_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_, _smb_, _snb_, _m_, _n2_, \
        _p_, _q_);             \
else                                                            \
MORSE_Desc_Create(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_,_smb_, _snb_ , _m_, _n2_, \
        _p_, _q_); 	\

#define EXAGEOSTAT_ALLOCATE_FULL_MATRIX_TILE(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_ , _lda_, _n_, _smb_, _snb_, _m_, _n2_, _p_, _q_) \
    if (data->ooc && _memspace_ == NULL && _mb_ != 1  && _nb_ !=1)                                                         \
MORSE_Desc_Create_OOC(_desc_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_, _smb_, _snb_, _m_, _n2_, \
        _p_, _q_);             \
else                                                            \
MORSE_Desc_Create_User(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_,_smb_, _snb_ , _m_, _n2_, \
        _p_, _q_, morse_getaddr_null, morse_getblkldd_ccrb, chameleon_getrankof_2d );	\

#define EXAGEOSTAT_ALLOCATE_DIAG_MATRIX_TILE(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_ , _lda_, _n_, _smb_, _snb_, _m_, _n2_, _p_, _q_) \
    if (data->ooc && _memspace_ == NULL && _mb_ != 1  && _nb_ !=1)                                                         \
MORSE_Desc_Create_OOC(_desc_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_, _smb_, _snb_, _m_, _n2_, \
        _p_, _q_);             \
else                                                            \
MORSE_Desc_Create_User(_desc_, _memspace_, _type2_, _mb_, _nb_, _mbXnb_, _lda_, _n_,_smb_, _snb_ , _m_, _n2_, \
        _p_, _q_, morse_getaddr_null, morse_getblkldd_ccrb, morse_getrankof_2d_diag );   \

/** ****************************************************************************
 *  Structure for  identifies two dimensions struct with two vectors (x and y).
 **/
typedef struct {
    double *x;				///< Values in X dimension.
    double *y;				///< Values in Y dimension.
    double *z;                              ///< Values in Z dimension.
} location;

/** ****************************************************************************
 *  Structure for reading real datasets through STARS-H
 **/
typedef struct {
    double xy;                              ///< Locations (x, y)
    double z;                               ///< Measurements.
} sdata;

/** ****************************************************************************
 *  Structure for output results
 **/
typedef struct {
    int problem_size;
    char* computation;
    char* kernel;
    char* ds_type;
    char* precision;
    int z_sample;
    int dense_ts;
    int lr_ts;
    int lr_acc;
    int lr_maxrank;
    int ncores;
    int ngpus;
    int p;
    int q;
    int num_params;
    double *initial_theta;
    double *starting_theta;
    double *estimated_theta;
    double final_loglik;
    double time_per_iteration;
    double flops_per_iteration;
    double total_mle_time;
    double mse_pred1;
    double mse_pred2;
    double mse_pred;
    double total_pred_time;
    double total_pred_flops;
    double mloe;
    double mmom;
    char* mloe_exec;
    double total_mloe_mmom_time;
    double matrix_gen_mloe_mmom_time;
    double cho_fact_mloe_mmom_time;
    double loop_mloe_mmom_time;
    double total_mloe_mmom_flops;
} output;

/** ****************************************************************************
 *  Structure for  uniquely identifies three different parameters for accuracy
 *  measurments accuracyDenseAppDiff, normDenseAppDiff, and normA.
 **/
/*typedef struct{
  double accuracyDenseAppDiff; 		///< Accuracy different between dense format and approx format.
  double normDenseAppDiff;		///< Norm difference between dense format and approx format.
  double normA;   			///< normA.
  } acc_struct;
  */

/** ****************************************************************************
 *  Structure for  uniquely identifies different variables that are needed
 *  by  EXAGEOSTAT to  ease arguments pass.
 **/
typedef struct
{
    double variance;            ///< Variance parameter.
    double variance1;           ///< Variance1 parameter.
    double variance2;           ///< Variance2 parameter.
    char *computation;		    ///< Exact or approx computation.
    char *c_fun;	            ///< Matern or pow-exp kernels.
    int test;			        ///< Synthetic or real dataset execution.
    int async;			        ///< Running mode: synchronous or asynchronous.
    int iter_count;			    ///< Number of iterations to converge.
    location  l1;			    ///< 2D locations for the first dataset.
    location lmiss;			    ///< 2D locations for the missing data (prediction stage).
    location lobs;			    ///< 2D locations for the observed data (prediction stage).
    location lm;  		        ///< 2D locations for the median data point.
    void *descC;			    ///< Covariance matrix C descriptor.
    void *descsubC11;           ///< Covariance sub matrix C11 descriptor.
    void *descsubC12;           ///< Covariance sub matrix C12 descriptor.
    void *descsubC21;           ///< Covariance sub matrix C21 descriptor.
    void *descsubC22;           ///< Covariance sub matrix C22 descriptor.
    void *descZ;			    ///< Measurements Z descriptor.
    void *descZ1;               ///< Measurements Z1 submatrix descriptor.
    void *descZ2;               ///< Measurements Z2 submatrix descriptor.
    double *Adense;			    ///< Dense matrix descriptor in the case of approximation mode - accuracy check.
    double *Adense2;		    ///< Dense matrix descriptor2 in the case of approximation mode - accuracy check.
    void *descZcpy;			    ///< A copy of Measurements Z descriptor.
    void *descdet;			    ///< Determinant descriptor.
    void *descproduct;		    ///< Dot product descriptor.
    void *descproduct1;         ///< Dot product descriptor.
    void *descproduct2;         ///< Dot product descriptor.
    void *descZmiss;		    ///< Missing measurements descriptor.
    void *descC12;			    ///< Covariance Matrix C12 descriptor.
    void *descC22;			    ///< Covariance Matrix C22 descriptor.
    void *descZactual;		    ///< Actual Measurements Z descriptor.
    void *descZobs;			    ///< observed Measurements Z descriptor.
    void *descmse1;        		///< Mean Square Error (MSE) descriptor.
    void *descmse2;             ///< Mean Square Error (MSE) descriptor.
    void *descmse;              ///< Mean Square Error (MSE) descriptor.
    void *sequence;			    ///< MORSE sequence.
    void *request;			    ///< MORSE request.
    int verbose;			    ///< Verbose indicator.
    int check;			        ///< Check indicator -- approximation mode.
    int log;			        ///< Log files generation indicator, 0--> no, 1--> yes.
    double avg_exec_time_per_iter;	///< Avergae execution time per iteration (only used in verbose mode).
    double total_exec_time;		///< Total execution time (only used in verbose mode).
    double avg_flops_per_iter;	///< Avergae flops per iteration (only used in verbose mode).
    double final_loglik;		///< Final log likelihood value.
    char *locsFPath;		    ///< Locations file path -- in the case of real dataset (real mode).
    char *obsFPath;			    ///< Observations file path --  in the case of real dataset (real mode).
    char *obsFPath2;            ///< Observations file path2 (bivariate case) --  in the case of real dataset (real mode).
    char *actualZFPath;		    ///< Actual observations file path -- in the case of prediction.
    char *actualZFPath2;        ///< Actual observations file path -- in the case of prediction.
    char *actualZLocFPath;		///< Actial locations file path -- in the case of prediction.
    double det;			        ///< determinant value.
    double  dotp;			    ///< double dot product value.
    double  dotp1;              ///< double dot2 product value.
    double  dotp2;              ///< double dot3 product value.
    float sdotp;			    ///< single dot product value.
    double mserror;			    ///< Mean Square Error (MSE) value.
    double mserror1;            ///< Mean Square Error (MSE) value, variable 1 in case of bivariate.
    double mserror2;            ///< Mean Square Error (MSE) value, variable 2 in case of bivariate.
    char *dm;			        ///< Distance metric to be used ed->Euclidian Distance -- gcd->Great Circle Distance.
    int diag_thick;		        ///< The thick of used diagonal in the case of diagonal approximation approach.
    char *nFileLog;			    ///< log file name (only used if log -->1).
    FILE *pFileLog;			    ///< log file path (only used if log -->1).
    int hicma_maxrank;		    ///< Max Rank in the case of LR-HiCMA approx
    int hicma_data_type;        ///< To define the type of the problem to HiCMA (HICMA_STARSH_PROB_GEOSTAT (Synthetic) or HICMA_STARSH_PROB_GEOSTAT_POINT (real))
    void *hicma_descC;		    ///< HiCMA descC descriptor (for accuracy check).
    void *hicma_descZ;		    ///< HiCMA descZ descriptor.
    void *hicma_descCD;		    ///< HiCMA descCD descriptor.
    void *hicma_descCUV;		///< HiCMA descCUV descriptor.
    void *hicma_descCrk;		///< HiCMA descCrk descriptor.
    void *hicma_descZcpy;       ///< A copy of Measurements Z descriptor.
    void *hicma_descdet;        ///< Determinant descriptor.
    void *hicma_descproduct;    ///< Dot product descriptor.
    void *hicma_descC12D;		///< HiCMA descCD descriptor.
    void *hicma_descC12UV;		///< HiCMA descCUV descriptor.
    void *hicma_descC12rk;		///< HiCMA descCrk descriptor.
    void *hicma_descC22D;		///< HiCMA descCD descriptor.
    void *hicma_descC22UV;		///< HiCMA descCUV descriptor.
    void *hicma_descC22rk;		///< HiCMA descCrk descriptor.
    double hicma_acc;		    ///< Accuracy in the case of LR-HiCMA approx.
    void *hsequence;            ///< HiCMA sequence.
    void *hrequest;             ///< HiCMA request.
    int opt_tol; 	            ///< The parameter tol is a tolerance that is used for the purpose of stopping criteria only.
    int opt_max_iters;	        ///< Maximum number of mle iterations.
    int ooc;                    ///< Support Out-Of-Core execution, 0-->no, 1-->yes.
    char* kernel_fun;           ///< stationary_matern, or non_stationary_matern.
    int precision;              ///< (0)Double, (1)Single, and (2)Mixed.
    //Mixed Precision
    void *desctemp;             ///< Temporary descriptor for mixed precision Cholesky factorization.
    void *desctemp22;           ///< Temporary descriptor for mixed precision Cholesky factorization.
    //MLOE and MMOM
    void *desck_t;
    void *desck_a;
    void *desck_ttmp;
    void *desck_atmp;
    void *descK_ttmp;
    void *descK_t;
    void *descK_a;
    void *descexpr1;
    void *descexpr2;
    void *descexpr3;
    void *descexpr4;
    void *descestimatedalpha;
    void *desctruthalpha;
    void *desc_mloe_mmom;
    double expr1;
    double expr2;
    double expr3;
    double expr4;
    double mloe;
    double mmom;
    int mloe_mmom;
    int mloe_mmom_async;
    int mspe;
    char* recovery_file;
    char* checkpoint_file;
    int time_slots;
    int idw;
} MLE_data;

/** ****************************************************************************
 * Verbose Macro.
 **/
#define VERBOSE(str)	\
    if (data->verbose == 1 && MORSE_My_Mpi_Rank() == 0){	\
        fprintf(stdout, "%s", str);	\
        fflush(stdout);\
    }

/** ****************************************************************************
 *  Success Macro.
 **/
#define SUCCESS(success, str) \
    if (success != MORSE_SUCCESS){ \
        fprintf(stdout, "%s", str);\
        fflush(stdout);\
        exit(EXIT_FAILURE);\
    }

output results;

void pick_random_points(MLE_data *data, double *Zobs, double *Zactual,
        int nZmiss, int nZobs, int N);

void generate_interior_points(MLE_data *data, double *Zobs, double *Zactual,
        int nZmiss, int nZobs, int N);

void split_data(MLE_data * data, location *locations, double *Z,
        double *Zactual,
        int *N, int nZmiss);

void init_data_values(MLE_data *data);

int locations_obs_zsort_inplace(int n, location *locations, double *z);

void zsort_locations_obs(int n, location *locations, double *z);

double uniform_distribution(double rangeLow, double rangeHigh);

void print_dmatrix(char* desc, int m, int n,
        double* a, int lda);

void print_diagonal(char* desc, int m, double* a,
        int lda);

void print_smatrix(char* desc, int m, int n,
        float* a, int lda);

location* GenerateXYLoc(int n, int seed);

int countlines(char *filename);

void checkpointing(char *path, int iter_count, double* theta,
        double loglik, int num_params);

bool recover(char *path, int iter_count, double* theta,
        double* loglik, int num_params);

void write_to_file(char * path, int matrix_size,int ncores,
        int tile_size, int test, char *computation,
        int async, char *obsFPath,double total_exec_time,
        double avg_exec_time_per_iter, double avg_flops_per_iter,
        int p_grid, int q_grid, double final_loglik, int n);

void theta_parser2(double *theta_vec, char * kern, int num_params);

void write_vectors(double * zvec, MLE_data * data, int n);

void write_to_thetafile(char * path, double *theta, int num_params,
        int n, double time_per_iter, int total_no_iters,
        double prediction_error, double mloe,  double mmom);
//void readObsFile(char *obsfile, int n, double * streamdata);

void shuffle(double *array, location* locations, size_t n);

void theta_parser(double *initial_theta, double *target_theta,
        double *starting_theta, char *ikernel, char *kernel,
        double *lb, double *up, int test, int num_params);

void init_optimizer(nlopt_opt* opt, double *lb, double *up,
        double tol);

void print_summary(int test, int N, int ncores, int gpus,
        int ts, int lts, char *computation,
        int zvecs, int p_grid, int q_grid, int precision);

int print_result(MLE_data *data, double *starting_theta, int N,
        int zvecs, int ncores, int ts, int test,
        double *initial_theta, char *computation,
        int p_grid, int q_grid, double final_loglik,
        double prediction_error);

double cWtime(void);

void readlocfile(char* loc_file, int n,  location* l1);

void write_prediction_result(char *path, int matrix_size, int no_missing,
        double MSE1, double MSE2, double MSE,
        double solve_time, double flops);

int doesFileExist(const char *filename);

void init_log (MLE_data * data);

void finalize_log (MLE_data * data);
//acc_struct check_acc(MLE_data * HICMA_data, int n, int ts);
double core_matern_vector (double x0, double y0, double x1,
        double y1, double *localtheta, int distance_metric);

void pick_random_points2(MLE_data *data, double *Zobs, double *Zactual,
        int nZmiss, int nZobs, int N);

location* GenerateXYLoc_ST(int n, int t_slots, int seed);
void pick_random_points_noshuffle(MLE_data *data, double *Zobs, double *Zactual,
        int nZmiss, int nZobs, int N);

double* pred_idw(MLE_data *data, double *z_miss, double *z_actual,
        double*z_obs, int nZmiss, int nZobs);

void write_to_estimatedtheta(char * path, double *theta, int num_params,
        int n, double prediction_time,
        double mloe_mmom_time,
        double prediction_error1,
        double prediction_error2,
        double prediction_error,
        double mloe,
        double mmom,
        int zvecs);
#endif


#include "redisgears.h"
#include "redisai.h"
#include "minmax_heap.h"
#include <math.h>
#include "redisgears_memory.h"
#include <cblas.h>
#include <sys/time.h>

#define STR1(a) #a
#define STR(e) STR1(e)

#define MIN(a,b) (((a)<(b))?(a):(b))
#define MAX(a,b) (((a)>(b))?(a):(b))

static RedisModuleCtx* staticCtx;

static RecordType* ScoreRecordType = NULL;
static RecordType* HeapRecordType = NULL;

#define VEC_SIZE 128

#define VEC_HOLDER_SIZE 1024 * 1024

typedef struct VecsHolder VecsHolder;

typedef struct VecDT{
    size_t index;
    VecsHolder* holder;
    RedisModuleString* keyName;
}VecDT;

typedef struct VecsHolder{
    size_t size;
    VecDT* vecDT[VEC_HOLDER_SIZE];
    float vecs[VEC_HOLDER_SIZE * VEC_SIZE];
}VecsHolder;

#define HOLDER_VECDT(h, i) (h->vecDT[i])
#define HOLDER_VEC(h, i) (h->vecs[i * VEC_SIZE])

VecsHolder** vecList = NULL;
RedisModuleType *vecRedisDT;

typedef struct VecReaderCtx{
    size_t index;
    Record** pendings;
    float vec[VEC_SIZE];
    size_t topK;
}VecReaderCtx;

typedef struct TopKArg{
    size_t topK;
}TopKArg;

typedef struct ScoreRecord{
    Record baseRecord;
    RedisModuleString* key;
    float score;
}ScoreRecord;

typedef struct HeapRecord{
    Record baseRecord;
    heap_t* heap;
}HeapRecord;

static VecReaderCtx* VecReaderCtx_Create(float* data, size_t topK){
    VecReaderCtx* ctx = RG_ALLOC(sizeof(*ctx));
    ctx->index = 0;
    ctx->pendings = array_new(Record*, 10);
    ctx->topK = topK;
    if(data){
        memcpy(ctx->vec, data, VEC_SIZE * sizeof(*data));
        float denom_vec = cblas_snrm2(VEC_SIZE, ctx->vec, 1);
        for(size_t i = 0 ; i < VEC_SIZE ; ++i){
            ctx->vec[i] /= denom_vec;
        }
    }
    return ctx;
}

static void VecReaderCtx_Free(VecReaderCtx* ctx){
    for(size_t i = 0 ; i < array_len(ctx->pendings) ; ++i){
        Record* r = ctx->pendings[i];
        RedisGears_FreeRecord(r);
    }

    array_free(ctx->pendings);

    RG_FREE(ctx);
}

static Record* to_score_records(ExecutionCtx* rctx, Record *data, void* arg){
    HeapRecord* hr = (HeapRecord*)data;

    Record* lr = RedisGears_ListRecordCreate(hr->heap->count);

    size_t count = hr->heap->count;
    for(size_t i = 0 ; i < count ; ++i){
        ScoreRecord* sr = mmh_pop_min(hr->heap);
        RedisGears_ListRecordAdd(lr, &sr->baseRecord);
    }

    RedisGears_FreeRecord(data);

    return lr;
}

static int heap_cmp(const void *a, const void *b, const void *udata){
    ScoreRecord* s1 = (ScoreRecord*)a;
    ScoreRecord* s2 = (ScoreRecord*)b;
    if(s1->score < s2->score){
        return -1;
    }else if(s1->score > s2->score){
        return 1;
    }else {
        return 0;
    }
}

static Record* top_k(ExecutionCtx* rctx, Record *accumulate, Record *r, void* arg){
    TopKArg* topKArg = arg;

    HeapRecord* heap = (HeapRecord*)accumulate;

    if(!heap){
        heap = (HeapRecord*)RedisGears_RecordCreate(HeapRecordType);
        heap->heap = mmh_init_with_size(topKArg->topK, heap_cmp, NULL, (mmh_free_func)RedisGears_FreeRecord);
    }

    heap_t* h = heap->heap;

    ScoreRecord* currSr = (ScoreRecord*)r;

    // If the queue is not full - we just push the result into it
    // If the pool size is 0 we always do that, letting the heap grow dynamically
    if (h->count < topKArg->topK) {
        mmh_insert(h, r);
    } else {
        // find the min result
        ScoreRecord* sr = mmh_peek_min(h);
        if(sr->score < currSr->score){
            void* temp = mmh_pop_min(h);
            RedisModule_Assert(temp == sr);
            RedisGears_FreeRecord(&(sr->baseRecord));
            mmh_insert(h, r);
        }else{
            RedisGears_FreeRecord(r);
        }
    }

    return &(heap->baseRecord);
}

static void on_done(ExecutionPlan* ctx, void* privateData){
    RedisModuleBlockedClient *bc = privateData;
    RedisModuleCtx *rctx = RedisModule_GetThreadSafeContext(bc);
    RedisGears_ReturnResultsAndErrors(ctx, rctx);
    RedisModule_UnblockClient(bc, NULL);
    RedisGears_DropExecution(ctx);
    RedisModule_FreeThreadSafeContext(rctx);
}

VecDT* vec_insert(RedisModuleString *keyName, const float* data){
    VecsHolder* holder = NULL;
    if(!vecList){
        vecList = array_new(VecsHolder*, 1);
    }
    if(array_len(vecList) == 0){
        holder = RG_CALLOC(1, sizeof(VecsHolder));
        vecList = array_append(vecList, holder);
    }else{
        holder = vecList[array_len(vecList) - 1];
    }

    if(holder->size >= VEC_HOLDER_SIZE){
        // we need to create a new holder
        holder = RG_CALLOC(1, sizeof(VecsHolder));
        vecList = array_append(vecList, holder);
    }

    float* v = &HOLDER_VEC(holder, holder->size);
    memcpy(v, data, sizeof(float) * VEC_SIZE);

    float demon = cblas_snrm2(VEC_SIZE, v, 1);

    for(size_t i = 0 ; i < VEC_SIZE ; ++i){
        v[i] /= demon;
    }

    VecDT* vDT = RG_CALLOC(1, sizeof(*vDT));
    vDT->holder = holder;
    vDT->index = holder->size;
    vDT->keyName = keyName;
    RedisModule_RetainString(NULL, vDT->keyName);
    HOLDER_VECDT(holder, holder->size) = vDT;

    ++holder->size;

    return vDT;
}

/*
 * rg.vec_add <k> <blob>
 */
int vec_add_command(RedisModuleCtx *ctx, RedisModuleString **argv, int argc){
    if(argc != 3){
        return RedisModule_WrongArity(ctx);
    }

    size_t dataLen;
    float* data = (float*)RedisModule_StringPtrLen(argv[2], &dataLen);
    if(dataLen != (VEC_SIZE * sizeof(float))){
        RedisModule_ReplyWithError(ctx, "Given blob is not float vector of size " STR(VEC_SIZE));
        return REDISMODULE_OK;
    }

    RedisModuleKey *kp = RedisModule_OpenKey(ctx, argv[1], REDISMODULE_WRITE);
    if(RedisModule_KeyType(kp) != REDISMODULE_KEYTYPE_EMPTY){
        RedisModule_ReplyWithError(ctx, "Key is not empty");
        RedisModule_CloseKey(kp);
        return REDISMODULE_OK;
    }

    VecDT* vDT = vec_insert(argv[1], data);

    RedisModule_ModuleTypeSetValue(kp, vecRedisDT, vDT);

    RedisModule_CloseKey(kp);

    RedisModule_ReplicateVerbatim(ctx);

    RedisModule_ReplyWithSimpleString(ctx, "OK");

    return REDISMODULE_OK;
}

/*
 * rg.vec_sim <k> <blob>
 */
int vec_sim_command(RedisModuleCtx *ctx, RedisModuleString **argv, int argc){

    if(argc != 3){
        return RedisModule_WrongArity(ctx);
    }

    char* err = NULL;

    long long topK;
    if(RedisModule_StringToLongLong(argv[1], &topK) != REDISMODULE_OK){
        RedisModule_ReplyWithError(ctx, "Failed extracting <k>");
        return REDISMODULE_OK;
    }

    size_t dataSize;
    float* data = (float*)RedisModule_StringPtrLen(argv[2], &dataSize);
    if(dataSize != (VEC_SIZE * sizeof(float))){
        RedisModule_ReplyWithError(ctx, "Given blob is not at the right size");
        return REDISMODULE_OK;
    }

    TopKArg* topKArg2 = RG_ALLOC(sizeof(*topKArg2));
    topKArg2->topK = topK;

    FlatExecutionPlan* fep = RGM_CreateCtx(VecReader, &err);

    VecReaderCtx* rCtx = VecReaderCtx_Create(data, topK);

    RGM_Collect(fep);

    RGM_Accumulate(fep, top_k, topKArg2);

    RGM_FlatMap(fep, to_score_records, NULL);

    ExecutionPlan* ep = RGM_Run(fep, ExecutionModeAsync, rCtx, NULL, NULL, &err);

    if(!ep){
        RedisGears_FreeFlatExecution(fep);
        RedisModule_ReplyWithError(ctx, err);
        return REDISMODULE_OK;
    }

    RedisModuleBlockedClient *bc = RedisModule_BlockClient(ctx, NULL, NULL, NULL, 0);
    RedisGears_AddOnDoneCallback(ep, on_done, bc);
    RedisGears_FreeFlatExecution(fep);

    return REDISMODULE_OK;
}

static int ScoreRecord_SendReply(Record* base, RedisModuleCtx* rctx){
    ScoreRecord* sr = (ScoreRecord*)base;
    RedisModule_ReplyWithArray(rctx, 2);
    RedisModule_ReplyWithString(rctx, sr->key);
    RedisModule_ReplyWithDouble(rctx, sr->score);
    return REDISMODULE_OK;
}

static int ScoreRecord_RecordSerialize(ExecutionCtx* ctx, Gears_BufferWriter* bw, Record* base){
    ScoreRecord* sr = (ScoreRecord*)base;
    const char* keyStr = RedisModule_StringPtrLen(sr->key, NULL);
    RedisGears_BWWriteString(bw, keyStr);
    RedisGears_BWWriteBuffer(bw, (char*)(&(sr->score)), sizeof(sr->score));
    return REDISMODULE_OK;
}

static Record* ScoreRecord_RecordDeserialize(ExecutionCtx* ctx, Gears_BufferReader* br){
    ScoreRecord* sr = (ScoreRecord*)RedisGears_RecordCreate(ScoreRecordType);
    const char* keyStr = RedisGears_BRReadString(br);
    sr->key = RedisModule_CreateString(NULL, keyStr, strlen(keyStr));
    size_t len;
    char* data = RedisGears_BRReadBuffer(br, &len);
    RedisModule_Assert(len == sizeof(float));
    sr->score = *((float*)(data));

    return &sr->baseRecord;
}

static void ScoreRecord_RecordFree(Record* base){
    ScoreRecord* sr = (ScoreRecord*)base;
    if(sr->key){
        RedisModule_FreeString(NULL, sr->key);
    }

}

static int HeapRecord_SendReply(Record* base, RedisModuleCtx* rctx){
    RedisModule_Assert(false);
    return REDISMODULE_OK;
}

static int HeapRecord_Serialize(ExecutionCtx* ctx, Gears_BufferWriter* bw, Record* base){
    RedisModule_Assert(false);
    return REDISMODULE_OK;
}

static Record* HeapRecord_Deserialize(ExecutionCtx* ctx, Gears_BufferReader* br){
    RedisModule_Assert(false);
    return REDISMODULE_OK;
}

static void HeapRecord_Free(Record* base){
    HeapRecord* hr = (HeapRecord*)base;
    mmh_free(hr->heap);
}

static void TopKArg_ObjectFree(void* arg){
    RG_FREE(arg);
}

static void* TopKArg_ArgDuplicate(void* arg){
    TopKArg* topK = arg;
    TopKArg* topKDup = RG_ALLOC(sizeof(*topKDup));
    topKDup->topK = topK->topK;
    return topKDup;
}

static int TopKArg_ArgSerialize(FlatExecutionPlan* fep, void* arg, Gears_BufferWriter* bw, char** err){
    TopKArg* topK = arg;
    RedisGears_BWWriteLong(bw, topK->topK);
    return REDISMODULE_OK;
}

static void* TopKArg_ArgDeserialize(FlatExecutionPlan* fep, Gears_BufferReader* br, int version, char** err){
    TopKArg* topKDup = RG_ALLOC(sizeof(*topKDup));
    topKDup->topK = RedisGears_BRReadLong(br);
    return topKDup;
}

static char* TopKArg_ArgToString(void* arg){
    return RG_STRDUP("I am topk argument :)");
}

#define TopKTypeVersion 1

#define VS_PLUGIN_NAME "VECTOR_SIM"
#define REDISGEARSJVM_PLUGIN_VERSION 1

#define VEC_TYPE_VERSION 1

static void* VecDT_Load(RedisModuleIO *rdb, int encver){
    RedisModuleString *keyName = RedisModule_LoadString(rdb);
    size_t dataLen;
    float* data = (float*)RedisModule_LoadStringBuffer(rdb, &dataLen);
    RedisModule_Assert(dataLen == sizeof(float) * VEC_SIZE);

    VecDT* vDT = vec_insert(keyName, data);

    RedisModule_FreeString(NULL, keyName);
    RedisModule_Free(data);

    return vDT;
}

static void VecDT_Save(RedisModuleIO *rdb, void *value){
    VecDT* vDT = value;

    RedisModule_SaveString(rdb, vDT->keyName);
    RedisModule_SaveStringBuffer(rdb, (char*)&HOLDER_VEC(vDT->holder, vDT->index), sizeof(float) * VEC_SIZE);
}

static void VecDT_Free(void *value){
    VecDT* vDT = value;
    VecsHolder* holder = vDT->holder;
    size_t index = vDT->index;

    RedisModule_FreeString(NULL, vDT->keyName);
    RG_FREE(vDT);

    if(!holder){
        // we probably inside flush, the vector DT was detached and we can just return.
        return;
    }

    // get the last vector
    VecsHolder* lastVH = vecList[array_len(vecList) - 1];
    --lastVH->size;
    VecDT* lastVDT = HOLDER_VECDT(lastVH, lastVH->size);

    if(lastVDT != vDT){
        // swap last with current
        memmove(&HOLDER_VEC(holder, index), &HOLDER_VEC(lastVH, lastVH->size), VEC_SIZE * sizeof(float));

        HOLDER_VECDT(holder, index) = lastVDT;
        lastVDT->holder = holder;
        lastVDT->index = index;
    }

    if(lastVH->size == 0){
        // free the holder, it has no more data.
        RG_FREE(lastVH);
        if(array_len(vecList) > 1){
            vecList = array_trimm_cap(vecList, array_len(vecList) - 1);
        }else{
            array_free(vecList);
            vecList = NULL;
        }
    }
}

static float scores[VEC_HOLDER_SIZE];

static Record* VecReader_Next(ExecutionCtx* rctx, void* ctx){
//    struct timeval stop, start;
    if(!vecList){
        return NULL;
    }

    VecReaderCtx* readerCtx = ctx;
    RedisModuleCtx* redisCtx = RedisGears_GetRedisModuleCtx(rctx);
    if(array_len(readerCtx->pendings) > 0){
        return array_pop(readerCtx->pendings);
    }

    RedisGears_LockHanlderAcquire(redisCtx);

    const float* b1 = readerCtx->vec;

    while(readerCtx->index < array_len(vecList)){
        VecsHolder* holder = vecList[readerCtx->index++];

        cblas_sgemv(CblasRowMajor, CblasNoTrans, holder->size, VEC_SIZE, 1, holder->vecs, VEC_SIZE, b1, 1, 0, scores, 1);

        for(size_t i = 0 ; i < MIN(holder->size, readerCtx->topK) ; ++i){
            size_t index = cblas_isamax(holder->size, scores, 1);
            ScoreRecord* s = (ScoreRecord*)RedisGears_RecordCreate(ScoreRecordType);
            s->key = HOLDER_VECDT(holder, index)->keyName;
            RedisModule_RetainString(NULL, s->key);
            s->score = scores[index];
            readerCtx->pendings = array_append(readerCtx->pendings, &s->baseRecord);
            scores[index] = 0;
        }

        if(array_len(readerCtx->pendings) > 0){
            RedisGears_LockHanlderRelease(redisCtx);
            return array_pop(readerCtx->pendings);
        }
    }

    RedisGears_LockHanlderRelease(redisCtx);

    return NULL;
}

static void VecReader_Free(void* ctx){
    VecReaderCtx_Free(ctx);
}

static int VecReader_Serialize(ExecutionCtx* ectx, void* ctx, Gears_BufferWriter* bw){
    VecReaderCtx* readerCtx = ctx;
    RedisGears_BWWriteBuffer(bw, (char*)readerCtx->vec, VEC_SIZE * sizeof(float));
    RedisGears_BWWriteLong(bw, readerCtx->topK);
    return REDISMODULE_OK;
}

static int VecReader_Deserialize(ExecutionCtx* ectx, void* ctx, Gears_BufferReader* br){
    VecReaderCtx* readerCtx = ctx;
    size_t dataLen;
    float* data = (float*)RedisGears_BRReadBuffer(br, &dataLen);
    RedisModule_Assert(dataLen == VEC_SIZE * sizeof(*data));

    readerCtx->topK = RedisGears_BRReadLong(br);

    memcpy(readerCtx->vec, data, VEC_SIZE * sizeof(*data));

    return REDISMODULE_OK;
}

static Reader* VecReader_CreateReaderCallback(void* arg){
    VecReaderCtx* ctx = arg;
    if(!ctx){
        ctx = VecReaderCtx_Create(NULL, 0);
    }
    Reader* r = RG_ALLOC(sizeof(*r));
    *r = (Reader){
        .ctx = ctx,
        .next = VecReader_Next,
        .free = VecReader_Free,
        .serialize = VecReader_Serialize,
        .deserialize = VecReader_Deserialize,
    };
    return r;
}

RedisGears_ReaderCallbacks VecReader = {
        .create = VecReader_CreateReaderCallback,
};

static void OnFlush(struct RedisModuleCtx *ctx, RedisModuleEvent eid, uint64_t subevent, void *data){
    if(subevent != REDISMODULE_SUBEVENT_FLUSHDB_START){
        return;
    }

    if(!vecList){
        return;
    }

    // before flush we need to clean all the Vector Holders and disconnect the keys
    for(size_t i = 0 ; i < array_len(vecList) ; ++i){
        VecsHolder* holder = vecList[i];
        for(size_t j = 0 ; j < holder->size ; ++j){
            VecDT* vDT = HOLDER_VECDT(holder, j);
            vDT->holder = NULL;
        }
        RG_FREE(holder);
    }

    array_free(vecList);

    vecList = NULL;
}

int RedisGears_OnLoad(RedisModuleCtx *ctx) {
    openblas_set_num_threads(1);

    if(RedisGears_InitAsGearPlugin(ctx, VS_PLUGIN_NAME, REDISGEARSJVM_PLUGIN_VERSION) != REDISMODULE_OK){
        RedisModule_Log(ctx, "warning", "Failed initialize RedisGears API");
        return REDISMODULE_ERR;
    }

    RedisModule_Log(ctx, "warning", "OpenBlac num of threads: %d", openblas_get_num_threads());

    staticCtx = RedisModule_GetThreadSafeContext(NULL);

    RedisModuleTypeMethods vecDT = {
        .version = REDISMODULE_TYPE_METHOD_VERSION,
        .rdb_load = VecDT_Load,
        .rdb_save = VecDT_Save,
        .free = VecDT_Free,
    };

    vecRedisDT = RedisModule_CreateDataType(ctx, "vec_index", VEC_TYPE_VERSION, &vecDT);
    if (vecRedisDT == NULL) {
        RedisModule_Log(ctx, "error", "Could not create vector type");
        return REDISMODULE_ERR;
    }

    RGM_RegisterReader(VecReader);

    ScoreRecordType = RedisGears_RecordTypeCreate("ScoreRecord",
                                                   sizeof(ScoreRecord),
                                                   ScoreRecord_SendReply,
                                                   ScoreRecord_RecordSerialize,
                                                   ScoreRecord_RecordDeserialize,
                                                   ScoreRecord_RecordFree);

    HeapRecordType = RedisGears_RecordTypeCreate("HeapRecord",
                                                 sizeof(HeapRecord),
                                                 HeapRecord_SendReply,
                                                 HeapRecord_Serialize,
                                                 HeapRecord_Deserialize,
                                                 HeapRecord_Free);

    ArgType* TopKType = RedisGears_CreateType("TopKType",
                                              TopKTypeVersion,
                                              TopKArg_ObjectFree,
                                              TopKArg_ArgDuplicate,
                                              TopKArg_ArgSerialize,
                                              TopKArg_ArgDeserialize,
                                              TopKArg_ArgToString);

    RGM_RegisterMap(to_score_records, NULL);
    RGM_RegisterAccumulator(top_k, TopKType);

    if (RedisModule_CreateCommand(ctx, "rg.vec_sim", vec_sim_command, "readonly", 0, 0, 0) != REDISMODULE_OK) {
        RedisModule_Log(ctx, "warning", "could not register command rg.vec_sim");
        return REDISMODULE_ERR;
    }

    if (RedisModule_CreateCommand(ctx, "rg.vec_add", vec_add_command, "write deny-oom", 1, 1, 1) != REDISMODULE_OK) {
        RedisModule_Log(ctx, "warning", "could not register command rg.vec_add");
        return REDISMODULE_ERR;
    }

    RedisModule_SubscribeToServerEvent(ctx, RedisModuleEvent_FlushDB, OnFlush);

    return REDISMODULE_OK;
}


#ifndef libceed_petsc_examples_bps_problem_data_h
#define libceed_petsc_examples_bps_problem_data_h

#include <ceed.h>
#include <petsc.h>
#include "../include/bcfunctions.h"
#include "../include/structs.h"
#include "../qfunctions/bps/bp1.h"
#include "../qfunctions/bps/bp2.h"
#include "../qfunctions/bps/bp3.h"
#include "../qfunctions/bps/bp4.h"
#include "../qfunctions/bps/common.h"

// -----------------------------------------------------------------------------
// BP Option Data
// -----------------------------------------------------------------------------

// BP options
typedef enum {
  CEED_BP1 = 0, CEED_BP2 = 1, CEED_BP3 = 2,
  CEED_BP4 = 3, CEED_BP5 = 4, CEED_BP6 = 5
} BPType;

BPData bp_options[6] = {
  [CEED_BP1] = {
    .num_comp_u = 1,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 1,
    .q_extra = 1,
    .setup_geo = SetupMassGeo,
    .setup_rhs = SetupMassRhs,
    .apply = Mass,
    .error = Error,
    .setup_geo_loc = SetupMassGeo_loc,
    .setup_rhs_loc = SetupMassRhs_loc,
    .apply_loc = Mass_loc,
    .error_loc = Error_loc,
    .in_mode = CEED_EVAL_INTERP,
    .out_mode = CEED_EVAL_INTERP,
    .q_mode = CEED_GAUSS,
    .enforce_bc = PETSC_FALSE,
    .bc_func = BCsMass
  },
  [CEED_BP2] = {
    .num_comp_u = 3,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 1,
    .q_extra = 1,
    .setup_geo = SetupMassGeo,
    .setup_rhs = SetupMassRhs3,
    .apply = Mass3,
    .error = Error3,
    .setup_geo_loc = SetupMassGeo_loc,
    .setup_rhs_loc = SetupMassRhs3_loc,
    .apply_loc = Mass3_loc,
    .error_loc = Error3_loc,
    .in_mode = CEED_EVAL_INTERP,
    .out_mode = CEED_EVAL_INTERP,
    .q_mode = CEED_GAUSS,
    .enforce_bc = PETSC_FALSE,
    .bc_func = BCsMass
  },
  [CEED_BP3] = {
    .num_comp_u = 1,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 7,
    .q_extra = 1,
    .setup_geo = SetupDiffGeo,
    .setup_rhs = SetupDiffRhs,
    .apply = Diff,
    .error = Error,
    .setup_geo_loc = SetupDiffGeo_loc,
    .setup_rhs_loc = SetupDiffRhs_loc,
    .apply_loc = Diff_loc,
    .error_loc = Error_loc,
    .in_mode = CEED_EVAL_GRAD,
    .out_mode = CEED_EVAL_GRAD,
    .q_mode = CEED_GAUSS,
    .enforce_bc = PETSC_TRUE,
    .bc_func = BCsDiff
  },
  [CEED_BP4] = {
    .num_comp_u = 3,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 7,
    .q_extra = 1,
    .setup_geo = SetupDiffGeo,
    .setup_rhs = SetupDiffRhs3,
    .apply = Diff3,
    .error = Error3,
    .setup_geo_loc = SetupDiffGeo_loc,
    .setup_rhs_loc = SetupDiffRhs3_loc,
    .apply_loc = Diff3_loc,
    .error_loc = Error3_loc,
    .in_mode = CEED_EVAL_GRAD,
    .out_mode = CEED_EVAL_GRAD,
    .q_mode = CEED_GAUSS,
    .enforce_bc = PETSC_TRUE,
    .bc_func = BCsDiff
  },
  [CEED_BP5] = {
    .num_comp_u = 1,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 7,
    .q_extra = 0,
    .setup_geo = SetupDiffGeo,
    .setup_rhs = SetupDiffRhs,
    .apply = Diff,
    .error = Error,
    .setup_geo_loc = SetupDiffGeo_loc,
    .setup_rhs_loc = SetupDiffRhs_loc,
    .apply_loc = Diff_loc,
    .error_loc = Error_loc,
    .in_mode = CEED_EVAL_GRAD,
    .out_mode = CEED_EVAL_GRAD,
    .q_mode = CEED_GAUSS_LOBATTO,
    .enforce_bc = PETSC_TRUE,
    .bc_func = BCsDiff
  },
  [CEED_BP6] = {
    .num_comp_u = 3,
    .num_comp_x = 3,
    .topo_dim = 3,
    .q_data_size = 7,
    .q_extra = 0,
    .setup_geo = SetupDiffGeo,
    .setup_rhs = SetupDiffRhs3,
    .apply = Diff3,
    .error = Error3,
    .setup_geo_loc = SetupDiffGeo_loc,
    .setup_rhs_loc = SetupDiffRhs3_loc,
    .apply_loc = Diff3_loc,
    .error_loc = Error3_loc,
    .in_mode = CEED_EVAL_GRAD,
    .out_mode = CEED_EVAL_GRAD,
    .q_mode = CEED_GAUSS_LOBATTO,
    .enforce_bc = PETSC_TRUE,
    .bc_func = BCsDiff
  }
};

#endif // libceed_petsc_examples_bps_problem_data_h


#include <pthread.h>
#include <math.h>
#include <fftw.h>
#include <stdio.h>

//C -> Very ugly code

//DEFINITION OF COMPLEX NUMBERS
typedef struct {
  double re, im;
} mycom;

//DEFINITION OF DATA ARRAY NEEDED FOR THE TRANSFORMATION (small space)
typedef struct {
  double* m;
  double* vi;
  double* vo;
  int*    nrop;
} transdata;

//DEFINITION OF DATA ARRAY NEEDED FOR THE TRANSFORMATION (large space)
typedef struct {
  double* m;
  double* vi;
  double* vo;
  long long int*    nrop;
} ltransdata;

//THREAD FUNCTION FOR FORWARD TRANSFORMATION (small space)
void transforeT(void* td){
  transdata* Td = (transdata *)td;
  double* Mat       = Td->m;
  double* Vec_in    = Td->vi;
  double* Vec_out   = Td->vo;
  int*       Nrop   = Td->nrop;
  int x, y;

  for(x = 0; x < 2* *Nrop; x++){
    Vec_out[x] = 0.;
  }

  for(x = 0; x < *Nrop; x++){
    for(y = 0; y < *Nrop; y++){
      Vec_out[2*x]    +=     Mat[(x* (*Nrop))+y]*Vec_in[2*y];
      Vec_out[2*x+1]  +=     Mat[(x* (*Nrop))+y]*Vec_in[2*y+1];
    }
  }

}

//THREAD FUNCTION FOR FORWARD TRANSFORMATION (large space)
void ltransforeT(void* td){
  ltransdata* Td = (ltransdata *)td;
  double* Mat       = Td->m;
  double* Vec_in    = Td->vi;
  double* Vec_out   = Td->vo;
  long long int*       Nrop   = Td->nrop;
  long long int x, y;

  for(x = 0; x < 2* *Nrop; x++){
    Vec_out[x] = 0.;
  }

  for(x = 0; x < *Nrop; x++){
    for(y = 0; y < *Nrop; y++){
      Vec_out[2*x]    +=     Mat[(x* (*Nrop))+y]*Vec_in[2*y];
      Vec_out[2*x+1]  +=     Mat[(x* (*Nrop))+y]*Vec_in[2*y+1];
    }
  }

}

//THREAD FUNCTION FOR BACKWARD TRANSFORMATION (small space)
void transbackT(void* td){
  transdata* Td = (transdata *)td;
  double* Mat       = Td->m;
  double* Vec_in    = Td->vi;
  double* Vec_out   = Td->vo;
  int*       Nrop   = Td->nrop;
  int x, y;

  for(x = 0; x < 2* *Nrop; x++){
    Vec_out[x] = 0.;
  }

  for(x = 0; x < *Nrop; x++){
    for(y = 0; y < *Nrop; y++){
      Vec_out[2*y]    +=     Mat[x* *Nrop+y]*Vec_in[2*x];
      Vec_out[2*y+1]  +=     Mat[x* *Nrop+y]*Vec_in[2*x+1];
    }
  }

}

//THREAD FUNCTION FOR BACKWARD TRANSFORMATION (large space)
void ltransbackT(void* td){
  ltransdata* Td = (ltransdata *)td;
  double* Mat       = Td->m;
  double* Vec_in    = Td->vi;
  double* Vec_out   = Td->vo;
  long long int*       Nrop   = Td->nrop;
  long long int x, y;

  for(x = 0; x < 2* *Nrop; x++){
    Vec_out[x] = 0.;
  }

  for(x = 0; x < *Nrop; x++){
    for(y = 0; y < *Nrop; y++){
      Vec_out[2*y]    +=     Mat[x* *Nrop+y]*Vec_in[2*x];
      Vec_out[2*y+1]  +=     Mat[x* *Nrop+y]*Vec_in[2*x+1];
    }
  }

}

//MAKE TRANSFORMATION MULTI THREADED (small space) DIR=1 is forward !!
void mk_thread_trans(int dir, double* mat1, double* mat2, mycom* vec_in1, mycom* vec_in2,
		     mycom* vec_out1, mycom* vec_out2, int* nrop1, int* nrop2){
  pthread_t thread1, thread2;
  int  iret1, iret2;
  transdata td1, td2;

  td1.m    = mat1;
  td1.vi   = (double* ) vec_in1;
  td1.vo   = (double* ) vec_out1;
  td1.nrop = nrop1;

  td2.m    = mat2;
  td2.vi   = (double* ) vec_in2;
  td2.vo   = (double* ) vec_out2;
  td2.nrop = nrop2;

  if(dir == 1){
    iret1 = pthread_create( &thread1, NULL,  (void* ) &transforeT , (void*) &td1);
    iret2 = pthread_create( &thread2, NULL,  (void* ) &transforeT , (void*) &td2);
  }else{
    iret1 = pthread_create( &thread1, NULL,  (void* ) &transbackT , (void*) &td1);
    iret2 = pthread_create( &thread2, NULL,  (void* ) &transbackT , (void*) &td2);
  }

  pthread_join( thread1, NULL);
  pthread_join( thread2, NULL);

}

//MAKE TRANSFORMATION MULTI THREADED (large space) DIR=1 is forward !!
void lmk_thread_trans(int dir, double* mat1, double* mat2, mycom* vec_in1, mycom* vec_in2,
		      mycom* vec_out1, mycom* vec_out2, long long int* nrop1, long long int* nrop2){
  pthread_t thread1, thread2;
  int  iret1, iret2;
  ltransdata td1, td2;

  td1.m    = mat1;
  td1.vi   = (double* ) vec_in1;
  td1.vo   = (double* ) vec_out1;
  td1.nrop = nrop1;

  td2.m    = mat2;
  td2.vi   = (double* ) vec_in2;
  td2.vo   = (double* ) vec_out2;
  td2.nrop = nrop2;

  if(dir == 1){
    iret1 = pthread_create( &thread1, NULL,  (void* ) &ltransforeT , (void*) &td1);
    iret2 = pthread_create( &thread2, NULL,  (void* ) &ltransforeT , (void*) &td2);
  }else{
    iret1 = pthread_create( &thread1, NULL,  (void* ) &ltransbackT , (void*) &td1);
    iret2 = pthread_create( &thread2, NULL,  (void* ) &ltransbackT , (void*) &td2);
  }

  pthread_join( thread1, NULL);
  pthread_join( thread2, NULL);

}


/**
 * \author Sylvain Marsat, University of Maryland - NASA GSFC
 *
 * \brief C header for the initialization of the instrumental noise for LIGO/VIRGO detectors.
 *
 *
 */

#ifndef _LLVNOISE_H
#define _LLVNOISE_H

#define _XOPEN_SOURCE 500

#ifdef __GNUC__
#define UNUSED __attribute__ ((unused))
#else
#define UNUSED
#endif

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <complex.h>
#include <time.h>
#include <unistd.h>
#include <getopt.h>
#include <stdbool.h>
#include <string.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_bspline.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_min.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_complex.h>

#include "constants.h"

/************************************************************************/
/****** Global variables storing min and max f for the noise PSD  *******/

extern double __LLVSimFD_LHONoise_fLow;
extern double __LLVSimFD_LHONoise_fHigh;
extern double __LLVSimFD_LLONoise_fLow;
extern double __LLVSimFD_LLONoise_fHigh;
extern double __LLVSimFD_VIRGONoise_fLow;
extern double __LLVSimFD_VIRGONoise_fHigh;

/**************************************************************************/
/****** Prototypes: functions loading and evaluating the noise PSD  *******/

/* Function parsing the environment variable $LLV_NOISE_DATA_PATH and trying to run LLVSimFD_Noise_Init in each */
int LLVSimFD_Noise_Init_ParsePath(void);
/* Function loading the noise data from a directory */
int LLVSimFD_Noise_Init(const char dir[]);

/* The noise functions themselves */
double NoiseSnLHO(const double f);
double NoiseSnLLO(const double f);
double NoiseSnVIRGO(const double f);

#if 0
{ /* so that editors will match succeeding brace */
#elif defined(__cplusplus)
}
#endif

#endif /* _LLVNOISE_H */


/* psl.c
////
Provide a library of gsl functions.

Features:
- request calculation via message
- function lookup
- inlets-on-demand

Author: shakfu
Repo: https://github.com/shakfu/pd-psl.git

*/
#include <math.h>
#include <string.h>

#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_sf_airy.h>
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_sf_clausen.h>
#include <gsl/gsl_sf_dawson.h>
#include <gsl/gsl_sf_debye.h>

#include "m_pd.h"
#include "tinyexpr.h"

// macros and defines
//  ---------------------------------------------------------------------------

#define MAX_ARGS 6
#define STR_BUF_SIZE 1000

// function lookup infratructure
// ---------------------------------------------------------------------------

unsigned long hash(const char *str) {
    unsigned int h = 0;
    int c;

    while ((c = *str++))
        h += (h << 1) + c;

    return h;
}

enum FUNC {
    ADD = 1273,
    LOG1P = 12931,
    EXPM1 = 12805,
    HYPOT = 13148,
    HYPOT3 = 39495,
    ACOSH = 11978,
    ASINH = 12341,
    ATANH = 12296,
    LDEXP = 12829,
    POW_INT = 122216,
    POW_2 = 13475,
    POW_3 = 13476,
    POW_4 = 13477,
    POW_5 = 13478,
    POW_6 = 13479,
    POW_7 = 13480,
    POW_8 = 13481,
    POW_9 = 13482,
    RANDO = 13254,
    FCMP = 4084,
    AIRY_AI = 109980,
    AIRY_BI = 109983,
    BESSEL_J0 = 987963,
    BESSEL_J1 = 987964,
    BESSEL_JN = 988025,
    BESSEL_Y0 = 988008,
    BESSEL_Y1 = 988009,
    BESSEL_YN = 988070,
    BESSEL_I0 = 987960,
    BESSEL_I1 = 987961,
    BESSEL_IN = 988022,
    CLAUSEN = 110879,
    DAWSON = 36848,
    DEBYE_1 = 109891,
    DEBYE_2 = 109892,
    DEBYE_3 = 109893,
    DEBYE_4 = 109894,
};

// forward declarations / prototypes
// ---------------------------------------------------------------------------

typedef struct _psl t_psl;

void select_default_function(t_psl *x, t_symbol *s);

// psl class objects
// ---------------------------------------------------------------------------

static t_class *psl_class;

static t_class *psl_inlet_class;

// psl class struct (data-space)
// ---------------------------------------------------------------------------

typedef void (*unary_func)(t_psl *, t_floatarg);
typedef void (*binary_func)(t_psl *, t_floatarg, t_floatarg);
typedef void (*tri_func)(t_psl *, t_floatarg, t_floatarg, t_floatarg);

typedef struct _psl_inlet
{
    t_class *x_pd;  // minimal pd object.
    t_psl   *owner; // the owning object to forward inlet messages to.
    int     id;     // the number of this inlet.
} t_psl_inlet;

typedef struct _psl {
    t_object x_obj;

    // assigned function
    t_symbol *func_name;
    int nargs;

    // function slots
    unary_func ufunc;
    binary_func bfunc;
    tri_func tfunc;

    // param_array
    t_float *arg_array;

    // for expression
    char expr_buffer[MAXPDSTRING];

    // inlets
    int inlets;          // # of extra inlets in addition to default
    t_psl_inlet *ins;    // the inlets themselves

    // outlets
    t_outlet *out_f;
} t_psl;

// psl class methods (operation-space)
// ---------------------------------------------------------------------------

// typed-methods

void psl_bang(t_psl *x) {
    if (x->nargs == 1 && x->inlets == 0) {
        x->ufunc(x, x->arg_array[0]);
    }

    if (x->nargs == 2 && x->inlets == 1) {
        x->bfunc(x, x->arg_array[0], x->arg_array[1]);
    }

    if (x->nargs == 3 && x->inlets == 2) {
        x->tfunc(x, x->arg_array[0], x->arg_array[1], x->arg_array[2]);

    }

}

void psl_float(t_psl *x, t_floatarg f) {
    post("psl_float: %f", f);
    if (x->nargs > 0) {
        x->arg_array[0] = f;
        psl_bang(x);
    } else {
        post("nothing to do: no function selected.");
        outlet_float(x->out_f, f);
    }
}

void psl_list(t_psl *x, t_symbol *s, int argc, t_atom *argv) {

    // atom_post("psl_list: ", argc, argv);

    if (s == gensym("list")) {
        post("s: list");

        if (argc == 0) {
            return;
        }

        if (argc == 1) {
            if (argv->a_type == A_FLOAT) {
                float f = atom_getfloat(argv);
                post("got float: %f", f);
                x->ufunc(x, f);
                return;
            }
        }

        if (argc == 2) {
            char buf[STR_BUF_SIZE];
            for (int i = 0; i < argc; i++) {
                atom_string((argv+i), buf, STR_BUF_SIZE);
                post("arg+%i: %s", i, buf);
            }
            if (argv->a_type == A_FLOAT && (argv + 1)->a_type == A_FLOAT) {
                float f1 = atom_getfloat(argv+0);
                float f2 = atom_getfloat(argv+1);
                post("f(%.2f, %.2f)", f1, f2);
                x->bfunc(x, f1, f2);
                return;
            }
        }

        if (argc == 3) {
            char buf[STR_BUF_SIZE];
            for (int i = 0; i < argc; i++) {
                atom_string((argv+i), buf, STR_BUF_SIZE);
                post("arg+%i: %s", i, buf);
            }
            if (argv->a_type == A_FLOAT && (argv+1)->a_type == A_FLOAT && (argv+2)->a_type == A_FLOAT) {
                float f1 = atom_getfloat(argv+0);
                float f2 = atom_getfloat(argv+1);
                float f3 = atom_getfloat(argv+2);
                post("f(%.2f, %.2f, %.2f)", f1, f2, f3);
                x->tfunc(x, f1, f2, f3);
                return;
            }
        }
    }

    post("list body");
    return;

    // error:
    //     pd_error(x, "psl_list error: incorrect arg type");
}

void psl_symbol(t_psl *x, t_symbol *s) {
    post("s: %s", s->s_name);

    // local buffer
    int length = strlen(s->s_name);
    char *buf = (char *)malloc(length * sizeof(char));
    strcpy(buf, s->s_name);
    post("buf: %s", buf);

    // clear expr_buffer
    memset(x->expr_buffer, 0, MAXPDSTRING);

    int j = 0;
    for (int i = 0; i < length; i++) {
        // remove escape `\` required for commas
        if (buf[i] != '\\') {
            x->expr_buffer[j++] = buf[i];
        } else if (x->expr_buffer[j - 1] == ' ') {
            j--;
        }
    }
    x->expr_buffer[length] = '\0';
    free(buf);

    post("x->expr_buffer: %s", x->expr_buffer);

    te_variable vars[] = {
        {"hypot", gsl_hypot, TE_FUNCTION2, NULL} /* TE_FUNCTION2 used because my_sum takes two arguments. */
    };

    te_expr *expr = te_compile(x->expr_buffer, vars, 2, 0);
    const double res = te_eval(expr);
    te_free(expr);
    outlet_float(x->out_f, res);
}

// message-methods

void psl_add(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, f1+f2);
}

void psl_rando(t_psl *x, t_floatarg n, t_floatarg seed) {
    post("rando: n:%.2f seed:%.2f", n, seed);
    gsl_rng_env_setup();

    int argc = (int)n;
    int _seed = (int)seed;

    gsl_rng *r = gsl_rng_alloc(gsl_rng_mt19937);
    gsl_rng_set(r, _seed);

    t_atom av[argc];
    for (int i = 0; i < argc; i++) {
        SETFLOAT(av + i, gsl_rng_uniform(r));
    }
    outlet_list(x->out_f, gensym("list"), argc, av);

    gsl_rng_free(r);
}

void psl_airy_ai(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_airy_Ai(f, GSL_PREC_APPROX));
}

void psl_airy_bi(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_airy_Bi(f, GSL_PREC_APPROX));
}

void psl_log1p(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_log1p(f));
}

void psl_expm1(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_expm1(f));
}

void psl_hypot(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_hypot(f1, f2));
}

void psl_hypot3(t_psl *x, t_floatarg f1, t_floatarg f2, t_floatarg f3) {
    outlet_float(x->out_f, gsl_hypot3(f1, f2, f3));
}

void psl_acosh(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_acosh(f));
}

void psl_asinh(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_asinh(f));
}

void psl_atanh(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_atanh(f));
}

void psl_ldexp(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_ldexp(f1, f2));
}

void psl_pow_int(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_pow_int(f1, f2));
}

void psl_pow_2(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_2(f));
}

void psl_pow_3(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_3(f));
}

void psl_pow_4(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_4(f));
}

void psl_pow_5(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_5(f));
}

void psl_pow_6(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_6(f));
}

void psl_pow_7(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_7(f));
}

void psl_pow_8(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_8(f));
}

void psl_pow_9(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_pow_9(f));
}

void psl_fcmp(t_psl *x, t_floatarg f1, t_floatarg f2, t_floatarg f3) {
    outlet_float(x->out_f, gsl_fcmp(f1, f2, f3));
}

void psl_bessel_j0(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_J0(f));
}

void psl_bessel_j1(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_J1(f));
}

void psl_bessel_jn(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_sf_bessel_Jn(f1, f2));
}

void psl_bessel_y0(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_Y0(f));
}

void psl_bessel_y1(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_Y1(f));
}

void psl_bessel_yn(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_sf_bessel_Yn(f1, f2));
}

void psl_bessel_i0(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_I0(f));
}

void psl_bessel_i1(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_bessel_I1(f));
}

void psl_bessel_in(t_psl *x, t_floatarg f1, t_floatarg f2) {
    outlet_float(x->out_f, gsl_sf_bessel_In(f1, f2));
}

void psl_clausen(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_clausen(f));
}

void psl_dawson(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_dawson(f));
}

void psl_debye_1(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_debye_1(f));
}

void psl_debye_2(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_debye_2(f));
}

void psl_debye_3(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_debye_3(f));
}

void psl_debye_4(t_psl *x, t_floatarg f) {
    outlet_float(x->out_f, gsl_sf_debye_4(f));
}

// function selection
//---------------------------------------------------------------------------

// set default function from symbol
void select_default_function(t_psl *x, t_symbol *s) {
    x->func_name = s;
    post("func %s selected", s->s_name);

    switch (hash(s->s_name)) {
        case ADD:
            x->nargs = 2;
            x->bfunc = &psl_add;
            break;
        case LOG1P:
            x->nargs = 1;
            x->ufunc = &psl_log1p;
            break;
        case EXPM1:
            x->nargs = 1;
            x->ufunc = &psl_expm1;
            break;
        case HYPOT:
            x->nargs = 2;
            x->bfunc = &psl_hypot;
            break;
        case HYPOT3:
            x->nargs = 3;
            x->tfunc = &psl_hypot3;
            break;
        case ACOSH:
            x->nargs = 1;
            x->ufunc = &psl_acosh;
            break;
        case ASINH:
            x->nargs = 1;
            x->ufunc = &psl_asinh;
            break;
        case ATANH:
            x->nargs = 1;
            x->ufunc = &psl_atanh;
            break;
        case LDEXP:
            x->nargs = 2;
            x->bfunc = &psl_ldexp;
            break;
        case POW_INT:
            x->nargs = 2;
            x->bfunc = &psl_pow_int;
            break;
        case POW_2:
            x->nargs = 1;
            x->ufunc = &psl_pow_2;
            break;
        case POW_3:
            x->nargs = 1;
            x->ufunc = &psl_pow_3;
            break;
        case POW_4:
            x->nargs = 1;
            x->ufunc = &psl_pow_4;
            break;
        case POW_5:
            x->nargs = 1;
            x->ufunc = &psl_pow_5;
            break;
        case POW_6:
            x->nargs = 1;
            x->ufunc = &psl_pow_6;
            break;
        case POW_7:
            x->nargs = 1;
            x->ufunc = &psl_pow_7;
            break;
        case POW_8:
            x->nargs = 1;
            x->ufunc = &psl_pow_8;
            break;
        case POW_9:
            x->nargs = 1;
            x->ufunc = &psl_pow_9;
            break;
        case RANDO:
            x->nargs = 2;
            x->bfunc = &psl_rando;
            break;
        case FCMP:
            x->nargs = 3;
            x->tfunc = &psl_fcmp;
            break;
        case AIRY_AI:
            x->nargs = 1;
            x->ufunc = &psl_airy_ai;
            break;
        case AIRY_BI:
            x->nargs = 1;
            x->ufunc = &psl_airy_bi;
            break;
        case BESSEL_J0:
            x->nargs = 1;
            x->ufunc = &psl_bessel_j0;
            break;
        case BESSEL_J1:
            x->nargs = 1;
            x->ufunc = &psl_bessel_j1;
            break;
        case BESSEL_JN:
            x->nargs = 2;
            x->bfunc = &psl_bessel_jn;
            break;
        case BESSEL_Y0:
            x->nargs = 1;
            x->ufunc = &psl_bessel_y0;
            break;
        case BESSEL_Y1:
            x->nargs = 1;
            x->ufunc = &psl_bessel_y1;
            break;
        case BESSEL_YN:
            x->nargs = 2;
            x->bfunc = &psl_bessel_yn;
            break;
        case BESSEL_I0:
            x->nargs = 1;
            x->ufunc = &psl_bessel_i0;
            break;
        case BESSEL_I1:
            x->nargs = 1;
            x->ufunc = &psl_bessel_i1;
            break;
        case BESSEL_IN:
            x->nargs = 2;
            x->bfunc = &psl_bessel_in;
            break;
        case CLAUSEN:
            x->nargs = 1;
            x->ufunc = &psl_clausen;
            break;
        case DAWSON:
            x->nargs = 1;
            x->ufunc = &psl_dawson;
            break;
        case DEBYE_1:
            x->nargs = 1;
            x->ufunc = &psl_debye_1;
            break;
        case DEBYE_2:
            x->nargs = 1;
            x->ufunc = &psl_debye_2;
            break;
        case DEBYE_3:
            x->nargs = 1;
            x->ufunc = &psl_debye_3;
            break;
        case DEBYE_4:
            x->nargs = 1;
            x->ufunc = &psl_debye_4;
            break;
        default:
            post("func selection failed, reverting to defaults");
            break;
   }
}

// psl-inlet funcs
// ---------------------------------------------------------------------------

static void psl_inlet_float(t_psl_inlet *x, float f)
{
    x->owner->arg_array[x->id+1] = f;
    // outlet_float(x->owner->out_f, x->id + f);
    post("x->owner->arg_array[x->id]: %.02f", x->owner->arg_array[x->id+1]);
    psl_bang(x->owner);
}

// psl class constructor
// ---------------------------------------------------------------------------

void *psl_new(t_symbol *s) {
    t_psl *x = (t_psl *)pd_new(psl_class);

    // initialize variables
    x->nargs = 0;
    x->inlets = 0;
    x->ufunc = NULL;
    x->bfunc = NULL;
    x->tfunc = NULL;

    select_default_function(x, s);
    // sets x->nargs to correct number

    // create inlets
    x->inlets = x->nargs - 1;
    x->ins = (t_psl_inlet *)getbytes(x->inlets * sizeof(*x->ins));
    x->arg_array = malloc(x->inlets * sizeof(float));

    for (int i=0; i < x->inlets; i++) {
        x->ins[i].x_pd = psl_inlet_class;
        x->ins[i].owner = x;
        x->ins[i].id = i;
        x->arg_array[i] = 0.0;
        inlet_new((t_object *)x, &(x->ins[i].x_pd), 0, 0);
    }

    // initialize outlets
    x->out_f = outlet_new(&x->x_obj, &s_float);

    return (void *)x;
}

// psl class destructor
// ---------------------------------------------------------------------------

// TODO: not sure if this is correct!
void psl_free(t_psl *x) {
    free(x->arg_array);
    freebytes(x->ins, x->inlets * sizeof(*x->ins));
    post("DONE");
}

// psl class setup
// ---------------------------------------------------------------------------

void psl_setup(void) {

    psl_inlet_class = class_new(gensym("psl-inlet"),
                                0, 0,
                                sizeof(t_psl_inlet),
                                CLASS_PD,
                                0);

    if (psl_inlet_class) {
        class_addfloat(psl_inlet_class, (t_method)psl_inlet_float);
    }

    psl_class = class_new(gensym("psl"),
                        (t_newmethod)psl_new,
                        (t_method)psl_free,  // destructor
                        sizeof(t_psl),
                        CLASS_DEFAULT,
                        A_DEFSYMBOL,
                        0);

    // typed methods
    class_addbang(psl_class, psl_bang);
    class_addfloat(psl_class, psl_float);
    class_addlist(psl_class, psl_list);
    class_addsymbol(psl_class, psl_symbol);

    // message methods

    // class-addmethods
    class_addmethod(psl_class, (t_method)psl_add,  gensym("add"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_log1p,  gensym("log1p"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_expm1,  gensym("expm1"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_hypot,  gensym("hypot"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_hypot3,  gensym("hypot3"), A_DEFFLOAT, A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_acosh,  gensym("acosh"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_asinh,  gensym("asinh"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_atanh,  gensym("atanh"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_ldexp,  gensym("ldexp"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_int,  gensym("pow_int"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_2,  gensym("pow_2"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_3,  gensym("pow_3"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_4,  gensym("pow_4"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_5,  gensym("pow_5"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_6,  gensym("pow_6"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_7,  gensym("pow_7"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_8,  gensym("pow_8"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_pow_9,  gensym("pow_9"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_rando,  gensym("rando"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_fcmp,  gensym("fcmp"), A_DEFFLOAT, A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_airy_ai,  gensym("airy_ai"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_airy_bi,  gensym("airy_bi"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_j0,  gensym("bessel_j0"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_j1,  gensym("bessel_j1"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_jn,  gensym("bessel_jn"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_y0,  gensym("bessel_y0"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_y1,  gensym("bessel_y1"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_yn,  gensym("bessel_yn"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_i0,  gensym("bessel_i0"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_i1,  gensym("bessel_i1"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_bessel_in,  gensym("bessel_in"), A_DEFFLOAT, A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_clausen,  gensym("clausen"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_dawson,  gensym("dawson"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_debye_1,  gensym("debye_1"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_debye_2,  gensym("debye_2"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_debye_3,  gensym("debye_3"), A_DEFFLOAT, 0);
    class_addmethod(psl_class, (t_method)psl_debye_4,  gensym("debye_4"), A_DEFFLOAT, 0);

    // create alias
    class_addcreator((t_newmethod)psl_new, gensym("gsl"), A_DEFSYMBOL, 0);

    // set name of default help file
    class_sethelpsymbol(psl_class, gensym("help-psl"));
}


/* monte/vegas.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.
 */

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

/* This is an implementation of the adaptive Monte-Carlo algorithm
   of G. P. Lepage, originally described in J. Comp. Phys. 27, 192(1978).
   The current version of the algorithm was described in the Cornell
   preprint CLNS-80/447 of March, 1980.

   This code follows most closely the c version by D.R.Yennie, coded
   in 1984.

   The input coordinates are x[j], with upper and lower limits xu[j]
   and xl[j].  The integration length in the j-th direction is
   delx[j].  Each coordinate x[j] is rescaled to a variable y[j] in
   the range 0 to 1.  The range is divided into bins with boundaries
   xi[i][j], where i=0 corresponds to y=0 and i=bins to y=1.  The grid
   is refined (ie, bins are adjusted) using d[i][j] which is some
   variation on the squared sum.  A third parameter used in defining
   the real coordinate using random numbers is called z.  It ranges
   from 0 to bins.  Its integer part gives the lower index of the bin
   into which a call is to be placed, and the remainder gives the
   location inside the bin.

   When stratified sampling is used the bins are grouped into boxes,
   and the algorithm allocates an equal number of function calls to
   each box.

   The variable alpha controls how "stiff" the rebinning algorithm is.
   alpha = 0 means never change the grid.  Alpha is typically set between
   1 and 2.

   */

/* configuration headers */
#include <config.h>

/* standard headers */
#include <math.h>
#include <stdio.h>

/* gsl headers */
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_monte_vegas.h>

/* lib-specific headers */
#define BINS_MAX 50		/* even integer, will be divided by two */

/* A separable grid with coordinates and values */
#define COORD(s,i,j) ((s)->xi[(i)*(s)->dim + (j)])
#define NEW_COORD(s,i) ((s)->xin[(i)])
#define VALUE(s,i,j) ((s)->d[(i)*(s)->dim + (j)])

/* predeclare functions */

typedef int coord;

static void init_grid (gsl_monte_vegas_state * s, double xl[], double xu[],
		size_t dim);
static void reset_grid_values (gsl_monte_vegas_state * s);
static void init_box_coord (gsl_monte_vegas_state * s, coord box[]);
static int change_box_coord (gsl_monte_vegas_state * s, coord box[]);
static void accumulate_distribution (gsl_monte_vegas_state * s, coord bin[],
                                     double y);
static void random_point (double x[], coord bin[], double *bin_vol,
                          const coord box[],
                          const double xl[], const double xu[],
                          gsl_monte_vegas_state * s, gsl_rng * r);
static void resize_grid (gsl_monte_vegas_state * s, unsigned int bins);
static void refine_grid (gsl_monte_vegas_state * s);

static void print_lim (gsl_monte_vegas_state * state,
                       double xl[], double xu[], unsigned long dim);
static void print_head (gsl_monte_vegas_state * state,
                        unsigned long num_dim, unsigned long calls,
                        unsigned int it_num,
                        unsigned int bins, unsigned int boxes);
static void print_res (gsl_monte_vegas_state * state,
                       unsigned int itr, double res, double err,
                       double cum_res, double cum_err,
                       double chi_sq);
static void print_dist (gsl_monte_vegas_state * state, unsigned long dim);
static void print_grid (gsl_monte_vegas_state * state, unsigned long dim);

int
gsl_monte_vegas_integrate (gsl_monte_function * f,
			   double xl[], double xu[],
			   size_t dim, size_t calls,
			   gsl_rng * r,
			   gsl_monte_vegas_state * state,
			   double *result, double *abserr)
{
  double cum_int, cum_sig;
  size_t i, k, it;

  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->stage == 0)
    {
      init_grid (state, xl, xu, dim);

      if (state->verbose >= 0)
	{
	  print_lim (state, xl, xu, dim);
	}
    }

  if (state->stage <= 1)
    {
      state->wtd_int_sum = 0;
      state->sum_wgts = 0;
      state->chi_sum = 0;
      state->it_num = 1;
      state->samples = 0;
    }

  if (state->stage <= 2)
    {
      unsigned int bins = state->bins_max;
      unsigned int boxes = 1;

      if (state->mode != GSL_VEGAS_MODE_IMPORTANCE_ONLY)
	{
	  /* shooting for 2 calls/box */

	  boxes = floor (pow (calls / 2.0, 1.0 / dim));
	  state->mode = GSL_VEGAS_MODE_IMPORTANCE;

	  if (2 * boxes >= state->bins_max)
	    {
	      /* if bins/box < 2 */
	      int box_per_bin = GSL_MAX (boxes / state->bins_max, 1);

	      bins = GSL_MIN(boxes / box_per_bin, state->bins_max);
	      boxes = box_per_bin * bins;

	      state->mode = GSL_VEGAS_MODE_STRATIFIED;
	    }
	}

      {
	double tot_boxes = pow ((double) boxes, (double) dim);
	state->calls_per_box = GSL_MAX (calls / tot_boxes, 2);
	calls = state->calls_per_box * tot_boxes;
      }

      /* total volume of x-space/(avg num of calls/bin) */
      state->jac = state->vol * pow ((double) bins, (double) dim) / calls;

      state->boxes = boxes;

      /* If the number of bins changes from the previous invocation, bins
         are expanded or contracted accordingly, while preserving bin
         density */

      if (bins != state->bins)
	{
	  resize_grid (state, bins);

	  if (state->verbose > 1)
	    {
	      print_grid (state, dim);
	    }
	}

      if (state->verbose >= 0)
	{
	  print_head (state,
		      dim, calls, state->it_num, state->bins, state->boxes);
	}
    }

  state->it_start = state->it_num;

  cum_int = 0.0;
  cum_sig = 0.0;

  state->chisq = 0.0;

  for (it = 0; it < state->iterations; it++)
    {
      double intgrl = 0.0, intgrl_sq = 0.0;
      double sig = 0.0;
      double wgt;
      size_t calls_per_box = state->calls_per_box;
      double jacbin = state->jac;
      double *x = state->x;
      coord *bin = state->bin;

      state->it_num = state->it_start + it;

      reset_grid_values (state);
      init_box_coord (state, state->box);

      do
	{
          double m = 0, q = 0;
	  double f_sq_sum = 0.0;

	  for (k = 0; k < calls_per_box; k++)
	    {
	      double fval, bin_vol;

	      random_point (x, bin, &bin_vol, state->box, xl, xu, state, r);

	      fval = jacbin * bin_vol * GSL_MONTE_FN_EVAL (f, x);

              /* recurrence for mean and variance */

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

	      if (state->mode != GSL_VEGAS_MODE_STRATIFIED)
		{
                  double f_sq = fval * fval;
		  accumulate_distribution (state, bin, f_sq);
		}
	    }

	  intgrl += m * calls_per_box;

	  f_sq_sum = q * calls_per_box ;

	  sig += f_sq_sum ;

	  if (state->mode == GSL_VEGAS_MODE_STRATIFIED)
	    {
	      accumulate_distribution (state, bin, f_sq_sum);
	    }
	}
      while (change_box_coord (state, state->box));

      /* Compute final results for this iteration   */

      sig = sig / (calls_per_box - 1.0)  ;

      if (sig > 0)
        {
          wgt = 1.0 / sig;
        }
      else if (state->sum_wgts > 0)
        {
          wgt = state->sum_wgts / state->samples;
        }
      else
        {
          wgt = 0.0;
        }

     intgrl_sq = intgrl * intgrl;

     state->result = intgrl;
     state->sigma  = sqrt(sig);

     if (wgt > 0.0)
       {
         state->samples++ ;
         state->sum_wgts += wgt;
         state->wtd_int_sum += intgrl * wgt;
         state->chi_sum += intgrl_sq * wgt;

         cum_int = state->wtd_int_sum / state->sum_wgts;
         cum_sig = sqrt (1 / state->sum_wgts);

         if (state->samples > 1)
           {
             state->chisq = (state->chi_sum - state->wtd_int_sum * cum_int) /
               (state->samples - 1.0);
           }
       }
     else
       {
         cum_int += (intgrl - cum_int) / (it + 1.0);
         cum_sig = 0.0;
       }

      if (state->verbose >= 0)
	{
	  print_res (state,
		     state->it_num, intgrl, sqrt (sig), cum_int, cum_sig,
		     state->chisq);
	  if (it + 1 == state->iterations && state->verbose > 0)
	    {
	      print_grid (state, dim);
	    }
	}

      if (state->verbose > 1)
	{
          print_dist (state, dim);
        }

      refine_grid (state);

      if (state->verbose > 1)
	{
	  print_grid (state, dim);
	}

    }

  /* By setting stage to 1 further calls will generate independent
     estimates based on the same grid, although it may be rebinned. */

  state->stage = 1;

  *result = cum_int;
  *abserr = cum_sig;

  return GSL_SUCCESS;
}

gsl_monte_vegas_state *
gsl_monte_vegas_alloc (size_t dim)
{
  gsl_monte_vegas_state *s =
    (gsl_monte_vegas_state *) malloc (sizeof (gsl_monte_vegas_state));

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

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

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

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

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

  s->xi = (double *) malloc ((BINS_MAX + 1) * dim * sizeof (double));

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

  s->xin = (double *) malloc ((BINS_MAX + 1) * sizeof (double));

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

  s->weight = (double *) malloc (BINS_MAX * sizeof (double));

  if (s->weight == 0)
    {
      free (s->xin);
      free (s->xi);
      free (s->d);
      free (s->delx);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for xin", GSL_ENOMEM, 0);
    }

  s->box = (coord *) malloc (dim * sizeof (coord));

  if (s->box == 0)
    {
      free (s->weight);
      free (s->xin);
      free (s->xi);
      free (s->d);
      free (s->delx);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for box", GSL_ENOMEM, 0);
    }

  s->bin = (coord *) malloc (dim * sizeof (coord));

  if (s->bin == 0)
    {
      free (s->box);
      free (s->weight);
      free (s->xin);
      free (s->xi);
      free (s->d);
      free (s->delx);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for bin", GSL_ENOMEM, 0);
    }

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

  if (s->x == 0)
    {
      free (s->bin);
      free (s->box);
      free (s->weight);
      free (s->xin);
      free (s->xi);
      free (s->d);
      free (s->delx);
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for x", GSL_ENOMEM, 0);
    }

  s->dim = dim;
  s->bins_max = BINS_MAX;

  gsl_monte_vegas_init (s);

  return s;
}

/* Set some default values and whatever */
int
gsl_monte_vegas_init (gsl_monte_vegas_state * state)
{
  state->stage = 0;
  state->alpha = 1.5;
  state->verbose = -1;
  state->iterations = 5;
  state->mode = GSL_VEGAS_MODE_IMPORTANCE;
  state->chisq = 0;
  state->bins = state->bins_max;
  state->ostream = stdout;

  return GSL_SUCCESS;
}

void
gsl_monte_vegas_free (gsl_monte_vegas_state * s)
{
  free (s->x);
  free (s->delx);
  free (s->d);
  free (s->xi);
  free (s->xin);
  free (s->weight);
  free (s->box);
  free (s->bin);
  free (s);
}

static void
init_box_coord (gsl_monte_vegas_state * s, coord box[])
{
  size_t i;

  size_t dim = s->dim;

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

/* change_box_coord steps through the box coord like
   {0,0}, {0, 1}, {0, 2}, {0, 3}, {1, 0}, {1, 1}, {1, 2}, ...
*/
static int
change_box_coord (gsl_monte_vegas_state * s, coord box[])
{
  int j = s->dim - 1;

  int ng = s->boxes;

  while (j >= 0)
    {
      box[j] = (box[j] + 1) % ng;

      if (box[j] != 0)
	{
	  return 1;
	}

      j--;
    }

  return 0;
}

static void
init_grid (gsl_monte_vegas_state * s, double xl[], double xu[], size_t dim)
{
  size_t j;

  double vol = 1.0;

  s->bins = 1;

  for (j = 0; j < dim; j++)
    {
      double dx = xu[j] - xl[j];
      s->delx[j] = dx;
      vol *= dx;

      COORD (s, 0, j) = 0.0;
      COORD (s, 1, j) = 1.0;
    }

  s->vol = vol;
}

static void
reset_grid_values (gsl_monte_vegas_state * s)
{
  size_t i, j;

  size_t dim = s->dim;
  size_t bins = s->bins;

  for (i = 0; i < bins; i++)
    {
      for (j = 0; j < dim; j++)
	{
	  VALUE (s, i, j) = 0.0;
	}
    }
}

static void
accumulate_distribution (gsl_monte_vegas_state * s, coord bin[], double y)
{
  size_t j;
  size_t dim = s->dim;

  for (j = 0; j < dim; j++)
    {
      int i = bin[j];
      VALUE (s, i, j) += y;
    }
}

static void
random_point (double x[], coord bin[], double *bin_vol,
	      const coord box[], const double xl[], const double xu[],
	      gsl_monte_vegas_state * s, gsl_rng * r)
{
  /* Use the random number generator r to return a random position x
     in a given box.  The value of bin gives the bin location of the
     random position (there may be several bins within a given box) */

  double vol = 1.0;

  size_t j;

  size_t dim = s->dim;
  size_t bins = s->bins;
  size_t boxes = s->boxes;

  DISCARD_POINTER(xu); /* prevent warning about unused parameter */

  for (j = 0; j < dim; ++j)
    {
      /* box[j] + ran gives the position in the box units, while z
         is the position in bin units.  */

      double z = ((box[j] + gsl_rng_uniform_pos (r)) / boxes) * bins;

      int k = z;

      double y, bin_width;

      bin[j] = k;

      if (k == 0)
	{
	  bin_width = COORD (s, 1, j);
	  y = z * bin_width;
	}
      else
	{
	  bin_width = COORD (s, k + 1, j) - COORD (s, k, j);
	  y = COORD (s, k, j) + (z - k) * bin_width;
	}

      x[j] = xl[j] + y * s->delx[j];

      vol *= bin_width;
    }

  *bin_vol = vol;
}

static void
resize_grid (gsl_monte_vegas_state * s, unsigned int bins)
{
  size_t j, k;
  size_t dim = s->dim;

  /* weight is ratio of bin sizes */

  double pts_per_bin = (double) s->bins / (double) bins;

  for (j = 0; j < dim; j++)
    {
      double xold;
      double xnew = 0;
      double dw = 0;
      int i = 1;

      for (k = 1; k <= s->bins; k++)
	{
	  dw += 1.0;
	  xold = xnew;
	  xnew = COORD (s, k, j);

	  for (; dw > pts_per_bin; i++)
	    {
	      dw -= pts_per_bin;
	      NEW_COORD (s, i) = xnew - (xnew - xold) * dw;
	    }
	}

      for (k = 1 ; k < bins; k++)
        {
          COORD(s, k, j) = NEW_COORD(s, k);
        }

      COORD (s, bins, j) = 1;
    }

  s->bins = bins;
}

static void
refine_grid (gsl_monte_vegas_state * s)
{
  size_t i, j, k;
  size_t dim = s->dim;
  size_t bins = s->bins;

  for (j = 0; j < dim; j++)
    {
      double grid_tot_j, tot_weight;
      double * weight = s->weight;

      double oldg = VALUE (s, 0, j);
      double newg = VALUE (s, 1, j);

      VALUE (s, 0, j) = (oldg + newg) / 2;
      grid_tot_j = VALUE (s, 0, j);

      /* This implements gs[i][j] = (gs[i-1][j]+gs[i][j]+gs[i+1][j])/3 */

      for (i = 1; i < bins - 1; i++)
	{
	  double rc = oldg + newg;
	  oldg = newg;
	  newg = VALUE (s, i + 1, j);
	  VALUE (s, i, j) = (rc + newg) / 3;
	  grid_tot_j += VALUE (s, i, j);
	}
      VALUE (s, bins - 1, j) = (newg + oldg) / 2;

      grid_tot_j += VALUE (s, bins - 1, j);

      tot_weight = 0;

      for (i = 0; i < bins; i++)
	{
	  weight[i] = 0;

	  if (VALUE (s, i, j) > 0)
	    {
	      oldg = grid_tot_j / VALUE (s, i, j);
	      /* damped change */
	      weight[i] = pow (((oldg - 1) / oldg / log (oldg)), s->alpha);
	    }

	  tot_weight += weight[i];

#ifdef DEBUG
          printf("weight[%d] = %g\n", i, weight[i]);
#endif
	}

      {
	double pts_per_bin = tot_weight / bins;

	double xold;
	double xnew = 0;
	double dw = 0;
	i = 1;

	for (k = 0; k < bins; k++)
	  {
	    dw += weight[k];
	    xold = xnew;
	    xnew = COORD (s, k + 1, j);

	    for (; dw > pts_per_bin; i++)
	      {
		dw -= pts_per_bin;
		NEW_COORD (s, i) = xnew - (xnew - xold) * dw / weight[k];
	      }
	  }

        for (k = 1 ; k < bins ; k++)
          {
            COORD(s, k, j) = NEW_COORD(s, k);
          }

	COORD (s, bins, j) = 1;
      }
    }
}

static void
print_lim (gsl_monte_vegas_state * state,
	   double xl[], double xu[], unsigned long dim)
{
  unsigned long j;

  fprintf (state->ostream, "The limits of integration are:\n");
  for (j = 0; j < dim; ++j)
    fprintf (state->ostream, "\nxl[%lu]=%f    xu[%lu]=%f", j, xl[j], j, xu[j]);
  fprintf (state->ostream, "\n");
  fflush (state->ostream);
}

static void
print_head (gsl_monte_vegas_state * state,
	    unsigned long num_dim, unsigned long calls,
	    unsigned int it_num, unsigned int bins, unsigned int boxes)
{
  fprintf (state->ostream,
	   "\nnum_dim=%lu, calls=%lu, it_num=%d, max_it_num=%d ",
	   num_dim, calls, it_num, state->iterations);
  fprintf (state->ostream,
	   "verb=%d, alph=%.2f,\nmode=%d, bins=%d, boxes=%d\n",
	   state->verbose, state->alpha, state->mode, bins, boxes);
  fprintf (state->ostream,
	   "\n       single.......iteration                   ");
  fprintf (state->ostream, "accumulated......results   \n");

  fprintf (state->ostream,
	   "iteration     integral    sigma             integral   ");
  fprintf (state->ostream, "      sigma     chi-sq/it\n\n");
  fflush (state->ostream);

}

static void
print_res (gsl_monte_vegas_state * state,
	   unsigned int itr,
           double res, double err,
           double cum_res, double cum_err,
	   double chi_sq)
{
  fprintf (state->ostream,
	   "%4d        %6.4e %10.2e          %6.4e      %8.2e  %10.2e\n",
	   itr, res, err, cum_res, cum_err, chi_sq);
  fflush (state->ostream);
}

static void
print_dist (gsl_monte_vegas_state * state, unsigned long dim)
{
  unsigned long i, j;
  int p = state->verbose;
  if (p < 1)
    return;

  for (j = 0; j < dim; ++j)
    {
      fprintf (state->ostream, "\n axis %lu \n", j);
      fprintf (state->ostream, "      x   g\n");
      for (i = 0; i < state->bins; i++)
	{
	  fprintf (state->ostream, "weight [%11.2e , %11.2e] = ",
                   COORD (state, i, j), COORD(state,i+1,j));
	  fprintf (state->ostream, " %11.2e\n", VALUE (state, i, j));

	}
      fprintf (state->ostream, "\n");
    }
  fprintf (state->ostream, "\n");
  fflush (state->ostream);

}

static void
print_grid (gsl_monte_vegas_state * state, unsigned long dim)
{
  unsigned long i, j;
  int p = state->verbose;
  if (p < 1)
    return;

  for (j = 0; j < dim; ++j)
    {
      fprintf (state->ostream, "\n axis %lu \n", j);
      fprintf (state->ostream, "      x   \n");
      for (i = 0; i <= state->bins; i++)
	{
	  fprintf (state->ostream, "%11.2e", COORD (state, i, j));
	  if (i % 5 == 4)
	    fprintf (state->ostream, "\n");
	}
      fprintf (state->ostream, "\n");
    }
  fprintf (state->ostream, "\n");
  fflush (state->ostream);

}


/**
 *
 * @file test_dotu.c
 *
 * @author Samuel  D. Relton
 * @author Pedro   V. Lara
 * @author Mawussi Zounon
 * @date 2016-06-15
 * @precisions normal z -> c
 *
 **/
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include<time.h>
#ifdef BBLAS_WITH_MKL
    #include <mkl_cblas.h>
    #include <mkl_lapacke.h>
#else
    #include <cblas.h>
    #include <lapacke.h>
#endif
#include "bblas_z.h"

#undef REAL
#define COMPLEX

int main(int argc, char *argv[])
{
  //Set parameters to initilize random value generation
  __time_t t;
  srand((unsigned) time(&t));
  int IONE     = 1;
  int ISEED[4] ={0,0,0,1};

  // Generation of batch_count value between 100 and 1000
  int batch_min = 100;
  int batch_max = 10000;
  int batch_count = rand() % (batch_max - batch_min + 1) + batch_min;

  // Generation of x and y vector sizes
  int * n = (int *) malloc(batch_count*sizeof(int));
  int n_max = 1000;
  int n_min = 10;
  for(int iter=0; iter < batch_count; iter++)
    n[iter] = rand() % (n_max - n_min + 1) + n_min;

  // common calling parameters
  int * incx = (int*) malloc(batch_count*sizeof(int));
  int * incy = (int*) malloc(batch_count*sizeof(int));
  int * info = (int *) malloc(batch_count*sizeof(int));
  enum BBLAS_OPTS batch_opts = BBLAS_VARIABLE;

  //Generation of x and y vectors  and the result vector
  // for using variable api
  BBLAS_Complex64_t ** x, ** y, *result;
  x = (BBLAS_Complex64_t **) malloc(batch_count*sizeof(BBLAS_Complex64_t*));
  y = (BBLAS_Complex64_t **) malloc(batch_count*sizeof(BBLAS_Complex64_t*));
  result = (BBLAS_Complex64_t *) malloc(batch_count*sizeof(BBLAS_Complex64_t));

  for(int iter=0; iter < batch_count; iter++){
    x[iter] = (BBLAS_Complex64_t*) malloc(n[iter]*sizeof(BBLAS_Complex64_t));
    y[iter] = (BBLAS_Complex64_t*) malloc(n[iter]*sizeof(BBLAS_Complex64_t));

#if defined(BBLAS_WITH_MKL)
    LAPACKE_zlarnv_work(IONE, ISEED, n[iter], (MKL_Complex16*) x[iter]);
    LAPACKE_zlarnv_work(IONE, ISEED, n[iter], (MKL_Complex16*) y[iter]);
#else
    LAPACKE_zlarnv_work(IONE, ISEED, n[iter], x[iter]);
    LAPACKE_zlarnv_work(IONE, ISEED, n[iter], y[iter]);
#endif
    // set values of incx and incy
    incx[iter] = 1;
    incy[iter] = 1;
  }

  //Calling variable api
  printf("Calling variable api: batchv_zdotu_sub \n");
  batchv_zdotu_sub(
		  (const int *) n,
		  (BBLAS_Complex64_t const * const *) x,
		  (const int *) incx,
		  (BBLAS_Complex64_t const * const *) y,
		  (const int *) incy,
		  result,
		  (const int) batch_count, info);

  //Calling tag api to solve variable problem
  printf("Calling tag api to solve variable problem: batch_zdotu_sub\n");

    batch_zdotu_sub(
		  (const int *) n,
		  (BBLAS_Complex64_t const * const *) x,
		  (const int *) incx,
		  (BBLAS_Complex64_t const * const *) y,
		  (const int *) incy,
		  result,
		  (const int) batch_count,
		  (const enum BBLAS_OPTS) batch_opts,
		  info);

    //Free x and y vectors
    printf("Free x and y vectors after variable case\n");

    for(int iter=0; iter < batch_count; iter++){
      free(x[iter]);
      free(y[iter]);
    }
    // free n incx and incy and info
    free(n);
    free(incx);
    free(incy);
    free(info);

    // Calling fixe api
    //Generation of x and y vectors, result will be overwritten
    int n_fixe = rand() % (n_max - n_min + 1) + n_min;
    int incx_fixe = 1;
    int incy_fixe = 1;
    int * info_fixe = (int*)malloc(sizeof(int));

    for(int iter=0; iter < batch_count; iter++){
      x[iter] = (BBLAS_Complex64_t*) malloc(n_fixe*sizeof(BBLAS_Complex64_t));
      y[iter] = (BBLAS_Complex64_t*) malloc(n_fixe*sizeof(BBLAS_Complex64_t));

#if defined(BBLAS_WITH_MKL)
      LAPACKE_zlarnv_work(IONE, ISEED, n_fixe, (MKL_Complex16*) x[iter]);
      LAPACKE_zlarnv_work(IONE, ISEED, n_fixe, (MKL_Complex16*) y[iter]);
#else
      LAPACKE_zlarnv_work(IONE, ISEED, n_fixe, x[iter]);
      LAPACKE_zlarnv_work(IONE, ISEED, n_fixe, y[iter]);
#endif
    }
  //Calling fixe api
    printf("Calling fixe api: batchf_zdotu_sub \n");
  batchf_zdotu_sub(
		  (const int ) n_fixe,
		  (BBLAS_Complex64_t const * const *) x,
		  (const int) incx_fixe,
		  (BBLAS_Complex64_t const * const *) y,
		  (const int) incy_fixe,
		  result,
		  (const int) batch_count, info_fixe);

  //Calling tag api to solve fixed batch  problem
  printf("Calling tag api to solve fixed batch  problem: batch_zdotu_sub \n");
  batch_opts = BBLAS_FIXED;

  batch_zdotu_sub(
		  (const int *) &n_fixe,
		  (BBLAS_Complex64_t const * const *) x,
		  (const int *) &incx_fixe,
		  (BBLAS_Complex64_t const * const *) y,
		  (const int *) &incy_fixe,
		  result,
		  (const int) batch_count,
		  (const enum BBLAS_OPTS) batch_opts,
		  info_fixe);
  //Free x and y vectors
  printf("Free memory after the call to fixed batch case\n");

  for(int iter=0; iter < batch_count; iter++){
    free(x[iter]);
    free(y[iter]);
  }

  //Creation of variable specific to group api
  int group_min = 1;
  int group_max = 10;
  int group_count = rand() % (group_max - group_min + 1) + group_min;
  int * group_size = (int *) malloc(group_count*sizeof(int));
  int tmp_size = batch_count/group_count;

  //Set value for group_size
  for(int iter=0; iter < group_count-1; iter++)
    group_size[iter] = tmp_size;

  //Set last value of group_size
  group_size[group_count-1] = batch_count - (tmp_size*(group_count-1));

  //Allocate memory for vectors

  int *n_group    = (int *) malloc(group_count*sizeof(int));
  int *incx_group = (int *) malloc(group_count*sizeof(int));
  int *incy_group = (int *) malloc(group_count*sizeof(int));
  int *info_group = (int *) malloc(group_count*sizeof(int));
  int offset = 0;
  //Set vector entries

  for(int group_iter = 0; group_iter < group_count ; group_iter++){
    n_group[group_iter] = rand() % (n_max - n_min + 1) + n_min;
    incx_group[group_iter] = 1;
    incy_group[group_iter] = 1;

    for (int iter = 0; iter < group_size[group_iter]; iter++){
      x[offset+iter] = (BBLAS_Complex64_t*) malloc(n_group[group_iter]*sizeof(BBLAS_Complex64_t));
      y[offset+iter] = (BBLAS_Complex64_t*) malloc(n_group[group_iter]*sizeof(BBLAS_Complex64_t));

#if defined(BBLAS_WITH_MKL)
      LAPACKE_zlarnv_work(IONE, ISEED, n_group[group_iter], (MKL_Complex16*) x[offset+iter]);
      LAPACKE_zlarnv_work(IONE, ISEED, n_group[group_iter], (MKL_Complex16*) y[offset+iter]);
#else
      LAPACKE_zlarnv_work(IONE, ISEED, n_group[group_iter], x[offset+iter]);
      LAPACKE_zlarnv_work(IONE, ISEED, n_group[group_iter], y[offset+iter]);
#endif
    }
    offset += group_size[group_iter];
  }

  //Calling group api
  printf("Calling group api:batchg_zdotu_sub\n");
   batchg_zdotu_sub(
		    (const int *)n_group,
		    (BBLAS_Complex64_t const * const *)x,
		    (const int *)incx_group,
		    (BBLAS_Complex64_t const * const *)y,
		    (const int *)incy_group,
		    result,
		    (const int)group_count,
		    (const int *) group_size,
		    info_group);

   //Free allocated memories
  for(int iter=0; iter < batch_count; iter++){
    free(x[iter]);
    free(y[iter]);
  }
  free(result);
  free(x);
  free(y);
  free(n_group);
  free(incx_group);
  free(incy_group);
  free(group_size);
  free(info_group);
  return 0;
}


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

/***************************************************************************//**
 *
 **/
void QUARK_CORE_cgemv(Quark *quark, Quark_Task_Flags *task_flags,
                      PLASMA_enum trans, int m, int n,
                      PLASMA_Complex32_t alpha, const PLASMA_Complex32_t *A, int lda,
                                                const PLASMA_Complex32_t *x, int incx,
                      PLASMA_Complex32_t beta,        PLASMA_Complex32_t *y, int incy)
{
    DAG_CORE_GEMV;
    QUARK_Insert_Task(quark, CORE_cgemv_quark, task_flags,
        sizeof(PLASMA_enum),             &trans,  VALUE,
        sizeof(int),                     &m,      VALUE,
        sizeof(int),                     &n,      VALUE,
        sizeof(PLASMA_Complex32_t),      &alpha,  VALUE,
        sizeof(PLASMA_Complex32_t)*m*n,  A,               INPUT,
        sizeof(int),                     &lda,    VALUE,
        sizeof(PLASMA_Complex32_t)*n,    x,               INPUT,
        sizeof(int),                     &incx,   VALUE,
        sizeof(PLASMA_Complex32_t),      &beta,   VALUE,
        sizeof(PLASMA_Complex32_t)*m,    y,               INOUT,
        sizeof(int),                     &incy,   VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_cgemv_quark = PCORE_cgemv_quark
#define CORE_cgemv_quark PCORE_cgemv_quark
#endif
void CORE_cgemv_quark(Quark *quark)
{
    PLASMA_enum trans;
    int m, n, lda, incx, incy;
    PLASMA_Complex32_t alpha, beta;
    const PLASMA_Complex32_t *A, *x;
    PLASMA_Complex32_t *y;

    quark_unpack_args_11( quark, trans, m, n, alpha, A, lda, x, incx, beta, y, incy );
    cblas_cgemv(
        CblasColMajor,
        (CBLAS_TRANSPOSE)trans,
        m, n,
        CBLAS_SADDR(alpha), A, lda,
                            x, incx,
        CBLAS_SADDR(beta),  y, incy);
}