/**
 * @copyright (c) 2017 King Abdullah University of Science and Technology (KAUST).
 *                     All rights reserved.
 **/
/**
 * @file time_zpotrf_tile.c
 *
 * This file shows how to generate tile low-rank (TLR) matrix and factorize it using Cholesky factorization.
 *
 * HiCMA is a software package provided by King Abdullah University of Science and Technology (KAUST)
 *
 * @version 0.1.1
 * @author Kadir Akbudak
 * @date 2018-11-08
 **/

/*
 * @copyright (c) 2009-2014 The University of Tennessee and The University
 *                          of Tennessee Research Foundation.
 *                          All rights reserved.
 * @copyright (c) 2012-2016 Inria. All rights reserved.
 * @copyright (c) 2012-2014 Bordeaux INP, CNRS (LaBRI UMR 5800), Inria, Univ. Bordeaux. All rights reserved.
 */

/**
 * The meaning of the descriptors:
 * - AUV: U and V, side by side
 * - AD : U*V
 * - A  : the original, non-approximated problem
 * - Ark: rank of U and V, each tile of the matrix is a single integer in fact a double.
 *
 **/

#include "morse.h"
#include "timing.h"
#include "hicma_constants.h"
#include "hicma_struct.h"
#include "hicma_z.h"
#include <stdio.h>
#include <time.h>
#include <sys/time.h>
//#include <mpi.h> //MPI_Wtime()

#include "starpu.h"
#ifdef MKL
#include <mkl.h>
//#pragma message("MKL is used")
#else
#include <cblas.h>
#ifdef LAPACKE_UTILS
#include <lapacke_utils.h>
#endif
#include <lapacke.h>
//#pragma message("MKL is NOT used")
#endif

#include "starsh-spatial.h"

#include <assert.h>
#include "hicma_z.h"
#include "auxcompute_z.h"
#include "auxdescutil.h"
#include "hicma.h"
#include <math.h>
#include <time.h>

#undef  CBLAS_SADDR
#define CBLAS_SADDR(_val) (_val)

// zgytlr uses starsh in MPI mode.
STARSH_blrf *mpiF;

int print_progress = 1;   // Print progress about the execution
char datebuf[128];
time_t timer;
struct tm* tm_info;
#define PROGRESS(str) \
    if(print_progress){ \
        int myrank = MORSE_My_Mpi_Rank();\
        time(&timer); \
        tm_info = localtime(&timer); \
        strftime(datebuf, 26, "%Y-%m-%d %H:%M:%S",tm_info); \
        fprintf(stderr, "%d:%s\t%d\t%s\t%s\n", myrank, datebuf, __LINE__, __func__, str);\
        fflush(stderr);\
    }
//#undef PROGRESS
//#define PROGRESS(str)

int store_only_diagonal_tiles = 0;
int global_check = 0;
int global_always_fixed_rank = 0;
int global_fixed_rank = 0;
int global_omit_computation = 1;
int num_mpi_ranks;
int run_potrf = 1;
int diag_nrows = 0;
int main_print_index = 0;
int print_index = 0;
int print_index_end = 0;
int main_print_mat = 0;
int print_mat = 0;
int use_scratch = 1; // Use scratch memory provided by starpu
int calc_rank_stat = 1;

void fwrite_array(int m, int n, int ld, double* arr, char* file){
        FILE* fp = fopen(file, "w");
        if(fp == NULL){
            fprintf(stderr, "File %s cannot be opened to write\n", file);
            exit(1);
        }
        int i, j;
        fprintf(fp, "%d %d\n", m, n);
        for(i = 0; i < m; i++){
            for(j = 0; j < n; j++){
                fprintf(fp, "%d\t", (int)arr[ld*j+i] );
            }
            fprintf(fp, "\n" );
        }
        fclose(fp);
}

double timediff(struct timeval begin, struct timeval end){
    double elapsed = (end.tv_sec - begin.tv_sec) +
        ((end.tv_usec - begin.tv_usec)/1000000.0);
    return elapsed;
}

    int
RunTest(int *iparam, double *dparam, morse_time_t *t_, char* rankfile)
{
    // print progress info only on ROOT process
    if(MORSE_My_Mpi_Rank() != 0)
        print_progress = 0;
    PROGRESS("RunTest started");

    // this paramater enables storing only diagonal tiles in a tall and skinny matrix
    store_only_diagonal_tiles = 1;
    //chameleon/runtime/starpu/control/runtime_descriptor.c
    //MORSE_user_tag_size(31,26);
    //MORSE_user_tag_size(31,29);
    MORSE_user_tag_size(31,27);// When I added tile_to_lapack for descArk, I got not enough number of desc error

    // get parameters coming from command line
    PASTE_CODE_IPARAM_LOCALS( iparam );

    // set global variable so that p.. files can fill dense matrix
    global_check = check;
    // calculate total number of mpi processes (it is not used for now)
    num_mpi_ranks = P*Q;
    print_index = iparam[IPARAM_HICMA_PRINTINDEX];
    print_index_end = iparam[IPARAM_HICMA_PRINTINDEXEND];
    print_mat   = iparam[IPARAM_HICMA_PRINTMAT];
    int64_t _nb = iparam[IPARAM_NB];
    LDA = chameleon_max(M, iparam[IPARAM_LDA]);
    int hicma_maxrank  = iparam[IPARAM_HICMA_MAXRANK];
    global_always_fixed_rank = iparam[IPARAM_HICMA_ALWAYS_FIXED_RANK];

    int saveNB = NB;
    NB = MB;
    size_t ncols_AD;
    int saveP = P;
    int saveQ = Q;
    if (store_only_diagonal_tiles == 1) {
        ncols_AD = MB;
    } else {
        ncols_AD = M;
    }
    int saveN = N;
    N = ncols_AD;
    PASTE_CODE_ALLOCATE_MATRIX_TILE( descAD, 1, double, MorseRealDouble, LDA, M, N );
    N = saveN;
    P = saveP;
    Q = saveQ;
    PROGRESS("descAD is allocated");

    size_t ncols_Dense;
    size_t ld_Dense;
    int saveMB = MB;
    if(check == 0) {
        ncols_Dense = MT;
        MB = NB = 1;
        ld_Dense = MT;
    } else {
        ncols_Dense = M;
        ld_Dense = M;
    }
    /*descDense is full matrix if numerical accuracy will be checked.
     * Otherwise it is MB-by-MB matrix with 1-by-1 tiles */
    PASTE_CODE_ALLOCATE_MATRIX_TILE( descDense, 1, double, MorseRealDouble, ld_Dense, ncols_Dense, ncols_Dense );
    if(check == 0) {
        MB = saveMB;
    } else {
    }
    PROGRESS("descDense is allocated");
    NB = saveNB;

    int MTMB = MT * MB; // roundup number of rows/columns for AUV
    int nrows_AUV = MTMB;
    int ld_AUV = MTMB;
    // allocate descUV
    saveN = N;
    N = N * 2;
    saveNB = NB;
    NB = NB * 2;
    //printf("N:%d NB:%d\n", N, NB);
    PASTE_CODE_ALLOCATE_MATRIX_TILE( descAUV, 1, double, MorseRealDouble, ld_AUV, nrows_AUV, N );
    N = saveN;
    NB = saveNB;
    PROGRESS("descAUV is allocated");

    /* tile dimension of rank descriptor must be 1 */
    /* when LD for rk matrices is 1, program exits*/
    int bigMB = MB;
    int bigNB = NB;
    MB = NB = 1;
    PASTE_CODE_ALLOCATE_MATRIX_TILE( descArk, 1, double, MorseRealDouble, MT, MT, NT);
    PROGRESS("descA's are allocated");
    MB = bigMB;
    NB = bigNB;

    int diag_dense = 1;
    int fixedrank = iparam[IPARAM_RK]; //genargs->k
    double fixedacc = pow(10, -1.0*iparam[IPARAM_ACC]);

    char sym;
    if (run_potrf)
        sym = 'S';
    else
        sym = 'N';
    int probtype = iparam[IPARAM_HICMA_STARSH_PROB];
    int maxrank  = iparam[IPARAM_HICMA_STARSH_MAXRANK];
    //double ddecay = pow(10, -1.0*iparam[IPARAM_HICMA_STARSH_DECAY]);
    double ddecay = dparam[IPARAM_HICMA_STARSH_DECAY];

    int  initial_maxrank, final_maxrank;
    double initial_avgrank, final_avgrank;
    HICMA_problem_t hicma_problem;

    hicma_problem.ndim = 2;

    //BEGIN: rndtiled
    if(iparam[IPARAM_HICMA_STARSH_PROB] == HICMA_STARSH_PROB_RND) {
        hicma_problem.noise    = 1.0; //value added to diagonal
    }
    //END:   rndtiled

    //BEGIN: geostat
    //double theta[3] = {1, 0.1, 0.5}; //initially
    double theta[3] = {
        1.0, //sigma
        0.01, //beta
        10.0 //nu Aleks used 10.0 in his paper
    };
    if(iparam[IPARAM_HICMA_STARSH_PROB] == HICMA_STARSH_PROB_GEOSTAT) {
        hicma_problem.theta = theta;
        hicma_problem.noise = 0.0;
        hicma_problem.noise = 1.e-2;
        hicma_problem.kernel_type = STARSH_SPATIAL_MATERN2_SIMD;
    }
    //END: geostat

    //BEGIN: ss
    if(iparam[IPARAM_HICMA_STARSH_PROB] == HICMA_STARSH_PROB_SS) {
        //sigma=1.0 default value line 193 of stars-h/src/applications/spatial.c
        // Correlation length
        hicma_problem.beta  = 0.1;
        //If fixed rank is required set beta=1 and a sample case will be like this nb=25 maxrank=10 m=2500 So ranks will decrease.

        // Smoothing parameter for Matern kernel
        hicma_problem.nu    = 0.5;
        // Shift added to diagonal elements
        hicma_problem.noise = 1.e-4; //not enough for matrices larger than 600K
        hicma_problem.noise = 5.e-4; //works for 640K but does not work for 10M
        hicma_problem.noise = 1.e-2; //
    }
    //END: ss

    //BEGIN: edsin
    if(iparam[IPARAM_HICMA_STARSH_PROB] == HICMA_STARSH_PROB_EDSIN) {
        // Wave number, >= 0
        hicma_problem.wave_k = dparam[IPARAM_HICMA_STARSH_WAVE_K];
        hicma_problem.diag = M;
    //printf("%s %d: %g\n", __FILE__, __LINE__, hicma_problem.wave_k);
    }
    //END: edsin

    PROGRESS("generating coordinates started");
    struct timeval tvalBefore, tvalAfter;  // removed comma
    gettimeofday (&tvalBefore, NULL);
    HICMA_zgenerate_problem(probtype, sym, ddecay, M, MB, MT, NT, &hicma_problem);
    gettimeofday (&tvalAfter, NULL);
    if(MORSE_My_Mpi_Rank()==0){
        printf("Tproblem:%g\n",
                (tvalAfter.tv_sec - tvalBefore.tv_sec)
                 +(tvalAfter.tv_usec - tvalBefore.tv_usec)/1000000.0
              );
        fflush(stderr);
        fflush(stdout);
    }
    PROGRESS("generating coordinates ended");
    mpiF = hicma_problem.starsh_format; // This is assignment will be hidden from user in release

	// DO NOT enforce compression of diagonal tiles
	int compress_diag = 0;
    PROGRESS("nompi zgytlr starting");
    //descDense original problem
    gettimeofday (&tvalBefore, NULL);
    HICMA_zgytlr_Tile(MorseLower, descAUV, descAD, descArk, 0, maxrank, fixedacc, compress_diag, descDense);
    gettimeofday (&tvalAfter, NULL);
    if(MORSE_My_Mpi_Rank()==0){
        printf("Tcompress:%g\n",
                (tvalAfter.tv_sec - tvalBefore.tv_sec)
                 +(tvalAfter.tv_usec - tvalBefore.tv_usec)/1000000.0
                );
        fflush(stderr);
        fflush(stdout);
    }
    PROGRESS("nompi zgytlr finished");
    fflush(stderr);
    fflush(stdout);
    /*return 0; //TODO*/

    if(calc_rank_stat == 1) {
        PASTE_TILE_TO_LAPACK( descArk, Ark_initial, 1, double, MT, NT );
        if(MORSE_My_Mpi_Rank()==0){

            sprintf(rankfile, "%s-1", rankfile);
            fwrite_array(descArk->m, descArk->n, descArk->m, Ark_initial, rankfile);

            HICMA_stat_t hicma_statrk_initial;
            zget_stat(MorseLower, Ark_initial, MT, NT, MT,  &hicma_statrk_initial);
            printf("initial_ranks:");
            zprint_stat(hicma_statrk_initial);
            fflush(stderr);
            fflush(stdout);
        }
    }

    if (global_always_fixed_rank == 1) {
        fprintf(stderr, "%s %d Fixed rank: %d\n", __FILE__, __LINE__, global_fixed_rank);
    }

    if(0 && num_mpi_ranks == 1 && initial_maxrank > N){ //FIXME Enable for distributed mem
        fprintf(stderr,"%s %d %d\t|N:%d is less than actual maxrank:%d\n", __FILE__, __LINE__, MORSE_My_Mpi_Rank(), N, initial_maxrank);
        exit(1);
    }
    int set_diag = 0;

    /* Save A for check */
    PROGRESS("pasting original dense descAD into Adense and Adense2 started");
    // Adense: original dense problem.
    PASTE_TILE_TO_LAPACK( descDense, Adense, check, double, LDA, M );
    double one = 1.0, zero = 0.0, minusone = -1.0, diagVal = M;
    double* swork = NULL;
    //double* cp_L_Adense =  calloc(LDA*M, sizeof(double));
    if(check){
        swork  = calloc(2*M, sizeof(double));
        {size_t i, j;
            double* orgAdense = calloc(LDA*M, sizeof(double));
            for(j = 0; j < M; j++){
                for(i = 0; i < M; i++){
                    orgAdense[j*LDA+i] = Adense[j*LDA+i];
                }
            }
            int info = LAPACKE_dpotrf_work(
                    LAPACK_COL_MAJOR,
                    'L',
                    M, orgAdense, LDA);
            if(0 && info != 0){ //FIXME
                fprintf(stderr, "%s\t|%d\t|Error in LAPACK potrf. info:%d, This errors means "
                        "that the matrix generated is not positive definite\n", __FILE__, __LINE__, info);
            }
            for(j = 0; j < M; j++){
                for(i = 0; i < j; i++){
                    orgAdense[j*LDA+i] = zero;
                }
            }
            /*for(j = 0; j < M; j++) {                */
                /*for(i = 0; i < M; i++){*/
                    /*cp_L_Adense[j*LDA+i] = orgAdense[j*LDA+i];*/
                /*}*/
            /*}*/
            if(main_print_mat ){printf("L of Adense\n");printmat(orgAdense,M,M,LDA,MB, MB);}
            double normOrgAdense = 0.0;
            /*HICMA_znormest(M, M, orgAdense, &normOrgAdense, swork);*/
            /*printf("norm_L_OrgAdense:%e\n",normOrgAdense);*/
            free(orgAdense);
        }
    }
    PASTE_TILE_TO_LAPACK( descDense, Adense2, check, double, LDA, M );
    PROGRESS("pasting original dense descAD into Adense and Adense2 finished");
    PROGRESS("potrf started");
    START_TIMING();
    HICMA_zpotrf_Tile(MorseLower, descAUV, descAD, descArk, fixedrank, maxrank, fixedacc );
    STOP_TIMING();
    fflush(stderr);
    fflush(stdout);
    PROGRESS("potrf finished");
    if(check){
        HICMA_zuncompress(MorseLower, descAUV, descDense, descArk);
        HICMA_zdiag_vec2mat(descAD, descDense);
        PASTE_CODE_FREE_MATRIX( descAD ); //@KADIRLBL001
        descAD = descDense; // descAD was only diagonals.
        // After this line, descAD is dense matrix containing approximate L
        // So no need to adapt below code for descAD containg only diagonals.
    }
    if(calc_rank_stat == 1) {
        PASTE_TILE_TO_LAPACK( descArk, Ark_final, 1, double, MT, NT );
        if(MORSE_My_Mpi_Rank()==0){
            sprintf(rankfile, "%s-2", rankfile);
            fwrite_array(descArk->m, descArk->n, descArk->m, Ark_final, rankfile);
            HICMA_stat_t hicma_statrk_final;
            zget_stat(MorseLower, Ark_final, MT, NT, MT,  &hicma_statrk_final);
            printf("final_ranks:");
            zprint_stat(hicma_statrk_final);
            fflush(stderr);
            fflush(stdout);
        }
    }

    int check_dense = 0;
    int check_app = 1;
    if(check == 0){
        check_dense = check_app = 0;
    }
    if(check_app ) {
        PROGRESS("checking accuracy");
        if( MORSE_My_Mpi_Rank()==0){
#ifndef COMPLEX
            if(main_print_mat){printf("Adense2\n");printmat(Adense2,M,M,LDA,MB, MB);}
            double normA;
            {size_t i, j;
                for(j = 0; j < M; j++){
                    for(i = 0; i < j; i++){
                        Adense2[j*LDA+i] = zero;
                    }
                }
            }
            PROGRESS("normaA started");
            HICMA_znormest(M, M, Adense2, &normA, swork);
            // Ahicma: result of TLR potrf
            PASTE_TILE_TO_LAPACK( descAD, Ahicma, check, double, LDA, M );
            /*if(0){size_t i,j;*/
                /*for(j = 0; j < M; j++) {                */
                    /*for(i = 0; i < M; i++){*/
                        /*Ahicma[j*LDA+i] = cp_L_Adense[j*LDA+i];*/
                    /*}*/
                /*}*/
            /*}*/
            double normAhicma = 0.0;
            {size_t i, j;
                for(j = 0; j < M; j++){
                    for(i = 0; i < j; i++){
                        Ahicma[j*LDA+i] = zero;
                    }
                }
                double* orgAhicma = calloc(LDA*M, sizeof(double));
                for(j = 0; j < M; j++){
                    for(i = 0; i < M; i++){
                        orgAhicma[j*LDA+i] = Ahicma[j*LDA+i];
                    }
                }
                HICMA_znormest(M, M, orgAhicma, &normAhicma, swork);
                free(orgAhicma);
            }
            if(set_diag){size_t j; for(j = 0; j < M; j++){ Ahicma[j*LDA+j] = diagVal; } }
            if(main_print_mat){printf("Ahicma\n");printmat(Ahicma,M,M,LDA, MB, MB);}
            //LAPACKE_dpotrf(LAPACK_COL_MAJOR, 'L', M, Ahicma, LDA);
            // AhicmaT: transpose of Ahicma
            PROGRESS("copy descAd into AhicmaT started");
            PASTE_TILE_TO_LAPACK( descAD,  AhicmaT, check, double, LDA, M );

            {size_t i, j;
                for(j = 0; j < M; j++){
                    for(i = 0; i < j; i++){
                        Adense[j*LDA+i] = zero;
                    }
                }
            }

            if(main_print_mat){printf("Ahicma-upperzero\n");printmat(Ahicma,M,M,LDA, MB, MB);}
            PROGRESS("Transpose A started");
            LAPACKE_dge_trans(LAPACK_COL_MAJOR, M, M, Ahicma, LDA, AhicmaT, LDA);
            if(main_print_mat){printf("AhicmaT\n");printmat(AhicmaT,M,M,LDA, MB, MB);}
            PROGRESS("TRMM started");
            cblas_dtrmm (CblasColMajor, CblasLeft, CblasLower, CblasNoTrans, CblasNonUnit, M, M, one, Ahicma, LDA, AhicmaT, LDA);
            if(main_print_mat){printf("Ahicma*AhicmaT\n");printmat(AhicmaT,M,M,LDA, MB, MB);}
            //double tmpnorm;normest(M, M, AhicmaT, &tmpnorm, swork);printf("tmpnorm:%e\n",tmpnorm);
            {size_t i, j;
                for(j = 0; j < M; j++){
                    for(i = 0; i < j; i++){
                        AhicmaT[j*LDA+i] = zero;
                    }
                }
            }

            size_t nelm = M * M;
            if(main_print_mat)printf("nelm:%zu M:%d N:%d\n", nelm, M, N);
            PROGRESS("DAXPY started");
            cblas_daxpy(nelm, minusone, AhicmaT, 1, Adense, 1);
            if(main_print_mat){printf("Adense-(Ahicma*AhicmaT)\n");printmat(Adense,M,M,LDA, MB, MB);}

            double normDenseAppDiff;
            PROGRESS("Norm of difference started");
            HICMA_znormest(M, M, Adense, &normDenseAppDiff, swork);
            double accuracyDenseAppDiff = normDenseAppDiff/normA;
            //printf("normA:%.2e normDenseAppdiff:%.2e Accuracy: %.2e\n", normA, normDenseAppDiff,  accuracyDenseAppDiff);
            dparam[IPARAM_RES] = normDenseAppDiff;
            dparam[IPARAM_ANORM] = normA;
            dparam[IPARAM_XNORM] = normA;
            dparam[IPARAM_BNORM] = normAhicma;
#endif
        } else {
            PASTE_TILE_TO_LAPACK( descAD, Ahicma, check, double, LDA, M );
            PASTE_TILE_TO_LAPACK( descAD,  AhicmaT, check, double, LDA, M );
        }
        PROGRESS("checking accuracy is finished");
    }

    PASTE_CODE_FREE_MATRIX( descAUV );
    PROGRESS("descAUV is freed");
    if(check == 0) { // If there is no check, then descAD and descDense are different. Refer to @KADIRLBL001
        PASTE_CODE_FREE_MATRIX( descAD );
        PROGRESS("descAD is freed");
    }
    PASTE_CODE_FREE_MATRIX( descArk );
    PROGRESS("descArk is freed");
    PASTE_CODE_FREE_MATRIX( descDense );
    PROGRESS("descDense is freed");
    PROGRESS("freed descs");
    return 0;
}


/* PSICOV - Protein Sparse Inverse COVariance analysis program */

/* by David T. Jones August 2011 - Copyright (C) 2011 University College London */

/* Version 1.05 - Last Edit 13/2/12 */

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

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

#define FALSE 0
#define TRUE 1

#define SQR(x) ((x)*(x))
#define MAX(x,y) ((x)>(y)?(x):(y))
#define MIN(x,y) ((x)<(y)?(x):(y))

#define MAXSEQLEN 5000
#define MINSEQS 50
#define MINEFSEQS 100

extern glasso_(int *, double *, double *, int *, int *, int *, int *, double *, int *, double *, double *, int *, double *, int *);

/* Dump a rude message to standard error and exit */
void
                fail(char *errstr)
{
    fprintf(stderr, "\n*** %s\n\n", errstr);
    exit(-1);
}

/* Convert AA letter to numeric code (0-21) */
int
                aanum(int ch)
{
    const static int aacvs[] =
    {
	999, 0, 3, 4, 3, 6, 13, 7, 8, 9, 21, 11, 10, 12, 2,
	21, 14, 5, 1, 15, 16, 21, 19, 17, 21, 18, 6
    };

    return (isalpha(ch) ? aacvs[ch & 31] : 20);
}

/* Allocate matrix */
void           *allocmat(int rows, int columns, int size)
{
    int             i;
    void          **p, *rp;

    rp = malloc(rows * sizeof(void *) + sizeof(int));

    if (rp == NULL)
	fail("allocmat: malloc [] failed!");

    *((int *)rp) = rows;

    p = rp + sizeof(int);

    for (i = 0; i < rows; i++)
	if ((p[i] = calloc(columns, size)) == NULL)
	    fail("allocmat: malloc [][] failed!");

    return p;
}

/* Free matrix */
void
                freemat(void *rp)
{
    int             rows;
    void **p = rp;

    rows = *((int *)(rp - sizeof(int)));

    while (rows--)
	free(p[rows]);

    free(rp - sizeof(int));
}

/* Allocate vector */
void           *allocvec(int columns, int size)
{
    void          *p;

    p = calloc(columns, size);

    if (p == NULL)
	fail("allocvec: calloc failed!");

    return p;
}

struct sc_entry
{
    float sc;
    int i, j;
} *sclist;

/* Sort descending */
int cmpfn(const void *a, const void *b)
{
    if (((struct sc_entry *)a)->sc == ((struct sc_entry *)b)->sc)
	return 0;

    if (((struct sc_entry *)a)->sc < ((struct sc_entry *)b)->sc)
	return 1;

    return -1;
}

int             main(int argc, char **argv)
{
    int             a, b, i, j, k, seqlen, nids, s, nseqs, ncon, opt, ndim, approxflg=0, initflg=0, debugflg=0, diagpenflg=1, apcflg=1, maxit=10000, npair, nnzero, niter, jerr, shrinkflg=1, rawscflg = 1, pseudoc = 1, minseqsep = 5;
    unsigned int *wtcount;
    double thresh=1e-4, del, sum, score, (**pab)[21][21], **pa, wtsum, pc, **pcmat, *pcsum, pcmean, rhodefault = -1.0, lambda, smean, fnzero, lastfnzero, trialrho, rfact, r2, targfnzero = 0.0, scsum, scsumsq, mean, sd, zscore, ppv;
    float *weight, idthresh = -1.0, maxgapf = 0.9;
    char            buf[4096], seq[MAXSEQLEN], *blockfn = NULL, **aln;
    FILE *ifp;

    while ((opt = getopt(argc, argv, "alnpr:b:i:t:c:g:d:j:")) >= 0)
	switch (opt)
	{
	case 'a':
	    approxflg = 1;
	    break;
	case 'n':
	    shrinkflg = 0;
	    break;
	case 'p':
	    rawscflg = 0;
	    break;
	case 'l':
	    apcflg = 0;
	    break;
	case 'r':
	    rhodefault = atof(optarg);
	    break;
	case 'd':
	    targfnzero = atof(optarg);
	    break;
	case 't':
	    thresh = atof(optarg);
	    break;
	case 'i':
	    idthresh = 1.0 - atof(optarg)/100.0;
	    break;
	case 'c':
	    pseudoc = atoi(optarg);
	    break;
	case 'j':
	    minseqsep = atoi(optarg);
	    break;
	case 'b':
	    blockfn = strdup(optarg);
	    break;
	case 'g':
	    maxgapf = atof(optarg);
	    break;
	case '?':
	    exit(-1);
	}

    if (optind >= argc)
	fail("Usage: psicov [options] alnfile\n\nOptions:\n-a\t: use approximate Lasso algorithm\n-n\t: don't pre-shrink the sample covariance matrix\n-p\t: output PPV estimates rather than raw scores\n-l\t: don't apply APC to Lasso output\n-r nnn\t: set initial rho parameter\n-d nnn\t: set target precision matrix sparsity (default 0 = not specified)\n-t nnn\t: set Lasso convergence threshold (default 1e-4)\n-i nnn\t: select BLOSUM weighting with given identity threshold (default selects threshold automatically)\n-c nnn\t: set pseudocount value (default 1)\n-j nnn\t: set minimum sequence separation (default 5)\n-g nnn\t: maximum fraction of gaps (default 0.9)\n-b file\t: read rho parameter file\n");

    ifp = fopen(argv[optind], "r");
    if (!ifp)
	fail("Unable to open alignment file!");

    for (nseqs=0;; nseqs++)
	if (!fgets(seq, MAXSEQLEN, ifp))
	    break;

    aln = allocvec(nseqs, sizeof(char *));

    weight = allocvec(nseqs, sizeof(float));

    wtcount = allocvec(nseqs, sizeof(unsigned int));

    rewind(ifp);

    if (!fgets(seq, MAXSEQLEN, ifp))
	fail("Bad alignment file!");

    seqlen = strlen(seq)-1;

    if (nseqs < MINSEQS)
	fail("Alignment too small - not enough homologous sequences to proceed (or change MINSEQS at your own risk!)");

    if (!(aln[0] = malloc(seqlen)))
	fail("Out of memory!");

    for (j=0; j<seqlen; j++)
	aln[0][j] = aanum(seq[j]);

    for (i=1; i<nseqs; i++)
    {
	if (!fgets(seq, MAXSEQLEN, ifp))
	    break;

	if (seqlen != strlen(seq)-1)
	    fail("Length mismatch in alignment file!");

	if (!(aln[i] = malloc(seqlen)))
	    fail("Out of memory!");

	for (j=0; j<seqlen; j++)
	    aln[i][j] = aanum(seq[j]);
    }

    /* Calculate sequence weights */

    if (idthresh < 0.0)
    {
	double meanfracid = 0.0;

	for (i=0; i<nseqs; i++)
	    for (j=i+1; j<nseqs; j++)
	    {
		int nids;
		float fracid;

		for (nids=k=0; k<seqlen; k++)
		    if (aln[i][k] == aln[j][k])
			nids++;

		fracid = (float)nids / seqlen;

		meanfracid += fracid;
	    }

	meanfracid /= 0.5 * nseqs * (nseqs - 1.0);

	idthresh = 0.38 * 0.32 / meanfracid;
    }

    for (i=0; i<nseqs; i++)
	for (j=i+1; j<nseqs; j++)
	{
	    int nthresh = seqlen * idthresh;

	    for (k=0; nthresh > 0 && k<seqlen; k++)
		if (aln[i][k] != aln[j][k])
		    nthresh--;

	    if (nthresh > 0)
	    {
		wtcount[i]++;
		wtcount[j]++;
	    }
	}

    for (wtsum=i=0; i<nseqs; i++)
	wtsum += (weight[i] = 1.0 / (1 + wtcount[i]));

    if (wtsum < MINEFSEQS)
	puts("\n*** WARNING - not enough sequence variation - or change MINEFSEQS at your own risk! ***\n");

    pa = allocmat(seqlen, 21, sizeof(double));
    pab = allocmat(seqlen, seqlen, 21*21*sizeof(double));

    /* Calculate singlet frequencies with pseudocount */
    for (i=0; i<seqlen; i++)
    {
	for (a=0; a<21; a++)
	    pa[i][a] = pseudoc;

	for (k=0; k<nseqs; k++)
	{
	    a = aln[k][i];
	    if (a < 21)
		pa[i][a] += weight[k];
	}

	for (a=0; a<21; a++)
	    pa[i][a] /= pseudoc * 21.0 + wtsum;
    }

    /* Calculate pair frequencies with pseudocount */
    for (i=0; i<seqlen; i++)
    {
	for (j=i+1; j<seqlen; j++)
	{
	    for (a=0; a<21; a++)
		for (b=0; b<21; b++)
		    pab[i][j][a][b] = pseudoc / 21.0;

	    for (k=0; k<nseqs; k++)
	    {
		a = aln[k][i];
		b = aln[k][j];
		if (a < 21 && b < 21)
		    pab[i][j][a][b] += weight[k];
	    }

	    for (a=0; a<21; a++)
		for (b=0; b<21; b++)
		{
		    pab[i][j][a][b] /= pseudoc * 21.0 + wtsum;
		    pab[j][i][b][a] = pab[i][j][a][b];

//		    printf("%d/%d %d/%d %f %f %f %f\n", i+1, a, j+1, b, pab[i][j][a][b], pa[i][a] , pa[j][b], pab[i][j][a][b] - pa[i][a] * pa[j][b]);
		}
	}
    }

    for (i=0; i<seqlen; i++)
	for (a=0; a<21; a++)
	    for (b=0; b<21; b++)
		pab[i][i][a][b] = (a == b) ? pa[i][a] : 0.0;

    gsl_matrix *cmat, *rho, *ww, *wwi, *tempmat;

    ndim = seqlen * 21;

    cmat = gsl_matrix_calloc(ndim, ndim);

    /* Form the covariance matrix */
    for (i=0; i<seqlen; i++)
	for (j=0; j<seqlen; j++)
	    for (a=0; a<21; a++)
		for (b=0; b<21; b++)
		    if (i != j)
			gsl_matrix_set(cmat, i*21+a, j*21+b, pab[i][j][a][b] - pa[i][a] * pa[j][b]);
		    else if (a == b)
			gsl_matrix_set(cmat, i*21+a, j*21+b, pab[i][j][a][b] - pa[i][a] * pa[j][b]);

    freemat(pab);

    /* Shrink sample covariance matrix towards shrinkage target F = Diag(1,1,1,...,1) * smean */

    if (shrinkflg)
    {
	for (smean=i=0; i<ndim; i++)
	    smean += gsl_matrix_get(cmat, i, i);

	smean /= (float)ndim;
	lambda = 0.1;

//	smean = 1;

	tempmat = gsl_matrix_calloc(ndim, ndim);

	gsl_set_error_handler_off();

	for (;;)
	{
	    gsl_matrix_memcpy(tempmat, cmat);

	    /* Test if positive definite using Cholesky decomposition */
	    if (!gsl_linalg_cholesky_decomp(tempmat))
		break;

	    for (i=0; i<seqlen; i++)
		for (j=0; j<seqlen; j++)
		    for (a=0; a<21; a++)
			for (b=0; b<21; b++)
			    if (i != j)
				gsl_matrix_set(cmat, i*21+a, j*21+b, (1.0 - lambda) * gsl_matrix_get(cmat, i*21+a, j*21+b));
			    else if (a == b)
				gsl_matrix_set(cmat, i*21+a, j*21+b, smean * lambda + (1.0 - lambda) * gsl_matrix_get(cmat, i*21+a, j*21+b));
	}

	gsl_matrix_free(tempmat);
    }

    rho = gsl_matrix_alloc(ndim, ndim);
    ww = gsl_matrix_alloc(ndim, ndim);
    wwi = gsl_matrix_alloc(ndim, ndim);

    lastfnzero=0.0;

    /* Guess at a reasonable starting rho value if undefined */
    if (rhodefault < 0.0)
	trialrho = MAX(0.001, 1.0 / wtsum);
    else
	trialrho = rhodefault;

    rfact = 0.0;

    for (;;)
    {
	if (trialrho <= 0.0 || trialrho >= 1.0)
	    fail("Sorry - failed to find suitable value for rho (0 < rho < 1)!");

	gsl_matrix_set_all(rho, trialrho);

	for (i=0; i<seqlen; i++)
	    for (j=0; j<seqlen; j++)
		for (a=0; a<21; a++)
		    for (b=0; b<21; b++)
			if ((a != b && i == j) || pa[i][20] > maxgapf || pa[j][20] > maxgapf)
			    gsl_matrix_set(rho, i*21+a, j*21+b, 1e9);

	/* Mask out regions if block-out list provided */
	if (blockfn != NULL)
	{
	    ifp = fopen(blockfn, "r");

	    for (;;)
	    {
		if (fscanf(ifp, "%d %d %lf", &i, &j, &score) != 3)
		    break;

		for (a=0; a<21; a++)
		    for (b=0; b<21; b++)
		    {
			gsl_matrix_set(rho, (i-1)*21+a, (j-1)*21+b, score);
			gsl_matrix_set(rho, (j-1)*21+b, (i-1)*21+a, score);
		    }
	    }

	    fclose(ifp);
	}

	/* All matrices are symmetric so no need to transpose before/after calling Fortran code */

	glasso_(&ndim, cmat->data, rho->data, &approxflg, &initflg, &debugflg, &diagpenflg, &thresh, &maxit, ww->data, wwi->data, &niter, &del, &jerr);

	if (targfnzero <= 0.0)
	    break;

	for (npair=nnzero=i=0; i<ndim; i++)
	    for (j=i+1; j<ndim; j++,npair++)
		if (gsl_matrix_get(wwi, i, j) != 0.0)
		    nnzero++;

	fnzero = (double) nnzero / npair;

//      printf("rho=%f fnzero = %f\n", trialrho, fnzero);

	/* Stop iterating if we have achieved the target sparsity level */
	if (fabs(fnzero - targfnzero)/targfnzero < 0.01)
	    break;

	if (fnzero == 0.0)
	{
	    /* As we have guessed far too high, halve rho and try again */
	    trialrho *= 0.5;
	    continue;
	}

	if (lastfnzero > 0.0 && fnzero != lastfnzero)
	{
//	    printf("fnzero=%f lastfnzero=%f trialrho=%f oldtrialrho=%f\n", fnzero, lastfnzero, trialrho, trialrho/rfact);

	    rfact = pow(rfact, log(targfnzero / fnzero) / log(fnzero / lastfnzero));

//	    printf("New rfact = %f\n", rfact);
	}

	lastfnzero = fnzero;

	/* Make a small trial step in the appropriate direction */

	if (rfact == 0.0)
	    rfact = (fnzero < targfnzero) ? 0.9 : 1.1;

	trialrho *= rfact;
    }

    gsl_matrix_free(rho);
    gsl_matrix_free(ww);

    /* Calculate background corrected scores using average product correction */

    pcmat = allocmat(seqlen, seqlen, sizeof(double));
    pcsum = allocvec(seqlen, sizeof(double));

    pcmean = 0.0;

    for (i=0; i<seqlen; i++)
	for (j=i+1; j<seqlen; j++)
	{
	    for (pc=a=0; a<20; a++)
		for (b=0; b<20; b++)
		    pc += fabs(gsl_matrix_get(wwi, i*21+a, j*21+b));

	    pcmat[i][j] = pcmat[j][i] = pc;
	    pcsum[i] += pc;
	    pcsum[j] += pc;

	    pcmean += pc;
	}

    pcmean /= seqlen * (seqlen - 1) * 0.5;

    /* Build final list of predicted contacts */

    sclist = allocvec(seqlen * (seqlen - 1) / 2, sizeof(struct sc_entry));

    for (scsum=scsumsq=ncon=i=0; i<seqlen; i++)
	for (j=i+minseqsep; j<seqlen; j++)
	    if (pcmat[i][j] > 0.0)
	    {
		/* Calculate APC score */
		if (apcflg)
		    sclist[ncon].sc = pcmat[i][j] - pcsum[i] * pcsum[j] / SQR(seqlen - 1.0) / pcmean;
		else
		    sclist[ncon].sc = pcmat[i][j];
		scsum += sclist[ncon].sc;
		scsumsq += SQR(sclist[ncon].sc);
		sclist[ncon].i = i;
		sclist[ncon++].j = j;
	    }

    qsort(sclist, ncon, sizeof(struct sc_entry), cmpfn);

    mean = scsum / ncon;
    sd = sqrt(scsumsq / ncon - SQR(mean));

    /* Print output in CASP RR format with optional PPV estimated from final Z-score */
    if (rawscflg)
	for (i=0; i<ncon; i++)
	    printf("%d %d 0 8 %f\n", sclist[i].i+1, sclist[i].j+1, sclist[i].sc);
    else
	for (i=0; i<ncon; i++)
	{
	    zscore = (sclist[i].sc - mean) / sd;
	    ppv = 0.904 / (1.0 + 16.61 * exp(-0.8105 * zscore));
	    printf("%d %d 0 8 %f\n", sclist[i].i+1, sclist[i].j+1, ppv);
	}

    return 0;
}


/**
 *
 * @file core_cpltmg.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Ichitaro Yamazaki
 * @author Julien Herrmann
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @generated c Tue Jan  7 11:44:47 2014
 *
 **/

#include <math.h>
#include <lapacke.h>
#include "common.h"

#define pi (3.1415926535897932384626433832795028841971693992)

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex32_t
 *
 *  CORE_cpltmg initialize a tile of a random matrix from the MatLab
 *  gallery configured with the default parameters, and a few other
 *  specific matrices.
 *
 *******************************************************************************
 *
 * @param[in] mtxtype
 *          Possible types are: PlasmaMatrixRandom, PlasmaMatrixHadamard,
 *          PlasmaMatrixParter, PlasmaMatrixRis, PlasmaMatrixKms,
 *          PlasmaMatrixMoler, PlasmaMatrixCompan, PlasmaMatrixRiemann,
 *          PlasmaMatrixLehmer, PlasmaMatrixMinij, PlasmaMatrixDorr,
 *          PlasmaMatrixDemmel, PlasmaMatrixInvhess, PlasmaMatrixCauchy,
 *          PlasmaMatrixHilb, PlasmaMatrixLotkin, PlasmaMatrixOrthog,
 *          PlasmaMatrixWilkinson, PlasmaMatrixFoster, PlasmaMatrixWright,
 *          PlasmaMatrixLangou
 *          (See further in the code for more details)
 *
 * @param[in] M
 *         The number of rows of the tile A. M >= 0.
 *
 * @param[in] N
 *         The number of columns of the tile A. N >= 0.
 *
 * @param[in,out] A
 *         On entry, the M-by-N tile to be initialized.
 *         On exit, the tile initialized in the mtxtype format.
 *
 * @param[in] LDA
 *         The leading dimension of the tile A. LDA >= max(1,M).
 *
 * @param[in] gM
 *         The global number of rows of the full matrix, A is belonging to. gM >= (m0+M).
 *
 * @param[in] gN
 *         The global number of columns of the full matrix, A is belonging to. gN >= (n0+gN).
 *
 * @param[in] m0
 *         The index of the first row of tile A in the full matrix. m0 >= 0.
 *
 * @param[in] n0
 *         The index of the first column of tile A in the full matrix. n0 >= 0.
 *
 * @param[in] seed
 *         The seed used for random generation. Must be the same for
 *         all tiles initialized with this routine.
 *
 *******************************************************************************
 *
 * @return
 *         \retval PLASMA_SUCCESS successful exit
 *         \retval <0 if INFO = -k, the k-th argument had an illegal value
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_cpltmg = PCORE_cpltmg
#define CORE_cpltmg PCORE_cpltmg
#define CORE_cplrnt  PCORE_cplrnt
void
CORE_cplrnt( int M, int N, PLASMA_Complex32_t *A, int LDA,
             int gM, int m0, int n0,
             unsigned long long int seed );
#endif
int CORE_cpltmg( PLASMA_enum mtxtype,
                  int M, int N, PLASMA_Complex32_t *A, int LDA,
                  int gM, int gN, int m0, int n0,
                  unsigned long long int seed )
{
    int i, j;

    /* Check input arguments */
    if (M < 0) {
        coreblas_error(2, "Illegal value of M");
        return -3;
    }
    if (N < 0) {
        coreblas_error(3, "Illegal value of N");
        return -3;
    }
    if ((LDA < max(1,M)) && (M > 0)) {
        coreblas_error(5, "Illegal value of LDA");
        return -5;
    }
    if (m0 < 0) {
        coreblas_error(8, "Illegal value of m0");
        return -8;
    }
    if (n0 < 0) {
        coreblas_error(9, "Illegal value of n0");
        return -9;
    }
    if (gM < m0+M) {
        coreblas_error(6, "Illegal value of gM");
        return -6;
    }
    if (gN < n0+N) {
        coreblas_error(7, "Illegal value of gN");
        return -7;
    }

    /* Quick return */
    if ((M == 0) || (N == 0))
        return PLASMA_SUCCESS;

    switch( mtxtype ) {
    case PlasmaMatrixRandom:
    {
        CORE_cplrnt( M, N, A, LDA, gM, m0, n0, seed );
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/hadamard.html
     *
     * Initialize the tile A to create the Hadamard matrix of order gN.
     *
     * Hadamard matrices are matrices of 1's and -1's whose columns are orthogonal,
     *
     *   H'*H = gN*I
     *
     *   where [gN gN]=size(H) and I = eye(gN,gN) ,.
     *
     *  They have applications in several different areas, including
     *  combinatorics, signal processing, and numerical analysis.
     *
     *  An n-by-n Hadamard matrix with n > 2 exists only if rem(n,4) =
     *  0. This function handles only the cases where n is a power of
     *  2.
     */
    case PlasmaMatrixHadamard:
    {
        int tmp, nbone;

        /* Extra parameters check */
        if (gM != gN) {
            coreblas_error(6, "Illegal value of gM (Matrix must be square)");
            return -6;
        }

        tmp = gM;
        while ( tmp > 1 ) {
            if( tmp % 2 != 0 ) {
                coreblas_error(6, "Illegal value of gM (Matrix dimension must be a power of 2)");
                return -6;
            }
            tmp /= 2;
        }

        for (j=0; j<N; j++) {
            for (i=0; i<M; i++) {
                tmp = ((m0 + i) & (n0 + j));
                nbone = 0;
                while ( tmp != 0 )
                {
                    nbone += ( tmp & 1 );
                    tmp >>= 1;
                }
                A[j*LDA+i] = (PLASMA_Complex32_t)(1. - 2. * ( nbone % 2 ));
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000116
     *
     * Toeplitz matrix with singular values near pi.
     * Returns the tile A, such that the elment of the matrix are 1/(i-j+0.5).
     *
     * C is a Cauchy matrix and a Toeplitz matrix. Most of the
     * singular values of C are very close to pi.
     *
     */
    case PlasmaMatrixParter:
    {
        PLASMA_Complex32_t tmp;

        if (gM != gN) {
            coreblas_error(6, "Illegal value of gM (Matrix must be square for Parter)");
            return -6;
        }

        tmp = (PLASMA_Complex32_t)( .5 + m0 - n0 );
        for (j=0; j<N; j++) {
            for (i=0; i<M; i++) {
                A[j*LDA+i] = (PLASMA_Complex32_t)1. / (PLASMA_Complex32_t)( tmp + i - j );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000243
     *
     * Symmetric Hankel matrix
     * Returns a symmetric gN-by-gN Hankel matrix with elements.
     *
     *     A(i,j) = 0.5/(n-i-j+1.5)
     *
     * The eigenvalues of A cluster around π/2 and –π/2. This matrix
     * was invented by F.N. Ris.
     *
     */
     case PlasmaMatrixRis:
    {
        PLASMA_Complex32_t tmp;

        if (gM != gN) {
            coreblas_error(6, "Illegal value of gM (Matrix must be square for RIS)");
            return -6;
        }

        tmp = (PLASMA_Complex32_t)( gM - m0 - n0 - 0.5 );
        for (j=0; j<N; j++) {
            for (i=0; i<M; i++) {
                A[j*LDA+i] = (PLASMA_Complex32_t).5 / (PLASMA_Complex32_t)( tmp - i - j );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000026
     *
     * Kac-Murdock-Szego Toeplitz matrix
     *
     * Returns the n-by-n Kac-Murdock-Szego Toeplitz matrix such that
     * A(i,j) = rho^(abs(i-j)), for real rho.
     *
     * For complex rho, the same formula holds except that elements
     * below the diagonal are conjfugated. rho defaults to 0.5.
     *
     * The KMS matrix A has these properties:
     *     - An LDL' factorization with L inv(gallery('triw',n,-rho,1))',
     *       and D(i,i) (1-abs(rho)^2)*eye(n), except D(1,1) = 1.
     *     - Positive definite if and only if 0 < abs(rho) < 1.
     *     - The inverse inv(A) is tridiagonal.Symmetric Hankel matrix
     *
     * In this function, rho is set to 0.5 and cannot be changed.
     */
    case PlasmaMatrixKms:
    {
        PLASMA_Complex32_t rho;

        if (gM != gN) {
            coreblas_error(6, "Illegal value of gM (Matrix must be square for KMS)");
            return -6;
        }

        rho = .5;
        for (j=0; j<N; j++) {
            for (i=0; i<M; i++) {
                A[j*LDA+i] = (PLASMA_Complex32_t)( cpowf( rho, fabs( (float)( m0 + i - n0 - j ) ) ) );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000074
     *
     * Symmetric positive definite matrix
     *
     * Returns the symmetric positive definite n-by-n matrix U'*U,
     * where U = gallery('triw',n,alpha).
     *
     * For the default alpha = -1, A(i,j) = min(i,j)-2, and A(i,i) =
     * i. One of the eigenvalues of A is small.
     *
     */
    case PlasmaMatrixMoler:
    {
        int ii, jj;
        for (j=0,jj=n0; j<N; j++,jj++) {
            for (i=0,ii=m0; i<M; i++,ii++) {
                if ( ii == jj ) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( ii + 1. );
                } else {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( min( ii, jj ) - 1. );
                }
            }
        }
    }
    break;

    /*
     *  See http://www.mathworks.fr/fr/help/matlab/ref/compan.html
     *
     *  Companion matrix
     *
     *  A = compan(u) returns the corresponding companion matrix whose first row is
     *  -u(2:n)/u(1), where u is a vector of polynomial coefficients. The
     *  eigenvalues of compan(u) are the roots of the polynomial.
     *
     */
    case PlasmaMatrixCompan:
    {
        int jj;

        LAPACKE_claset_work(LAPACK_COL_MAJOR, 'A', M, N, 0., 0., A, LDA);

        /* First row */
        if ( m0 == 0 ) {
            PLASMA_Complex32_t v0;
            /* Get V0 */
            CORE_cplrnt( 1, 1, &v0, 1, 1, 1, 0, seed );
            v0 = 1. / v0 ;

            /* Initialize random vector */
            CORE_cplrnt( 1, N, A, LDA, 1, 1, n0, seed );
            cblas_cscal( N, CBLAS_SADDR(v0), A, LDA);

            /* Restore A(0,0) */
            if ( n0 == 0 )
                A[0] = 0.;
        }

        /* Sub diagonal*/
        for (j=0,jj=n0; j<N; j++,jj++)
        {
            i = jj + 1 - m0;
            if ( ( i > 0 ) && (i < M) )
            {
                A[j*LDA+i] = 1.;
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000232
     *
     * Matrix associated with the Riemann hypothesis
     *
     * Returns an n-by-n matrix for which the Riemann hypothesis is
     * true if and only if for every eps > 0.
     *
     * The Riemann matrix is defined by:
     *
     *    A = B(2:n+1,2:n+1)
     *
     *    where B(i,j) = i-1 if i divides j, and B(i,j) = -1 otherwise.
     *
     * The Riemann matrix has these properties:
     *     - Each eigenvalue e(i) satisfies abs(e(i)) <= m-1/m, where m = n+1.
     *     - i <= e(i) <= i+1 with at most m-sqrt(m) exceptions.
     *     - All integers in the interval (m/3, m/2] are eigenvalues.
     *
     */
    case PlasmaMatrixRiemann:
    {
        int ii, jj;
        for (j=0,jj=n0+2; j<N; j++,jj++) {
            for (i=0,ii=m0+2; i<M; i++,ii++) {
                if ( jj%ii == 0 ) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( ii - 1. );
                } else {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( -1. );
                }
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000049
     *
     * Symmetric positive definite matrix
     *
     * Returns the symmetric positive definite n-by-n matrix such that
     * A(i,j) = i/j for j >= i.
     *
     * The Lehmer matrix A has these properties:
     *     - A is totally nonnegative.
     *     - The inverse inv(A) is tridiagonal and explicitly known.
     *     - The order n <= cond(A) <= 4*n*n.Matrix associated with the
     *       Riemann hypothesis
     *
     */
     case PlasmaMatrixLehmer:
    {
        int ii, jj;
        for (j=0,jj=n0+1; j<N; j++,jj++) {
            for (i=0,ii=m0+1; i<M; i++,ii++) {
                if ( jj >= ii ) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( ii ) / (PLASMA_Complex32_t)( jj );
                } else {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( jj ) / (PLASMA_Complex32_t)( ii );
                }
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000066
     *
     * Symmetric positive definite matrix
     *
     * Returns the n-by-n symmetric positive definite matrix with
     * A(i,j) = min(i,j).
     *
     * The minij matrix has these properties:
     *     - The inverse inv(A) is tridiagonal and equal to -1 times the
     *       second difference matrix, except its (n,n) element is 1.
     *     - Givens' matrix, 2*A-ones(size(A)), has tridiagonal inverse
     *       and eigenvalues 0.5*sec((2*r-1)*pi/(4*n))^2, where r=1:n.
     *     - (n+1)*ones(size(A))-A has elements that are max(i,j) and a
     *       tridiagonal inverse.
     *
     */
    case PlasmaMatrixMinij:
    {
        int ii, jj;
        for (j=0,jj=n0+1; j<N; j++,jj++) {
            for (i=0,ii=m0+1; i<M; i++,ii++) {
                A[j*LDA+i] = (PLASMA_Complex32_t) min( ii, jj );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-999936
     *
     * Diagonally dominant, ill-conditioned, tridiagonal matrix
     *
     * Returns the n-by-n matrix, row diagonally dominant, tridiagonal
     * matrix that is ill-conditioned for small nonnegative values of
     * theta. The default value of theta is 0.01. The Dorr matrix
     * itself is the same as gallery('tridiag',c,d,e).
     *
     */
    case PlasmaMatrixDorr:
    {
        PLASMA_Complex32_t theta = 0.01;
        PLASMA_Complex32_t h     = 1. / ( gN + 1. );
        PLASMA_Complex32_t term  = theta / ( h * h );
        int jj;
        int half = (gN+1) / 2;

        LAPACKE_claset_work(LAPACK_COL_MAJOR, 'A', M, N, 0., 0., A, LDA);

        /* First half */
        for (j=0, jj=n0; (j<N) && (jj<half); j++, jj++) {
            i = jj - m0;
            if ( ( i < -1 ) || (i > M) )
                continue;

            /* Over the diagonal */
            if (i > 0)
                A[j*LDA + i-1] = - term - (0.5 - jj*h)/h;

            /* Diagonal */
            if ( i >= M )
                return PLASMA_SUCCESS;

            if ( i >=0 )
                A[j*LDA + i] = 2. * term + (0.5 - (jj+1) * h) / h;

            /* Below the diagonal */
            if (i+1 < M) {
                if (jj+1 == half)
                    A[j*LDA + i+1] = - term + (0.5 - (jj+2)*h)/h;
                else
                    A[j*LDA + i+1] = - term;
            }
        }

        /* Second half */
        for (; j<N; j++,jj++) {
            i = jj - m0;
            if ( ( i < -1 ) || (i > M))
                continue;

            if (i > 0) {
                if (jj == half)
                    A[j*LDA + i-1] = - term - (0.5 - jj*h)/h;
                else
                    A[j*LDA + i-1] = - term;
            }

            if ((i >=0) && (i < M))
                A[j*LDA + i] = 2. * term - (0.5 - (jj+1)*h)/h;

            if (i+1 < M)
                A[j*LDA + i+1] = - term + (0.5 - (jj+2)*h)/h;
        }
    }
    break;

    /*
     * See [1] J. Demmel, Applied Numerical Linear Algebra, SIAM,
     *         Philadelphia, 1997
     *
     * Returns a matrix defined by:
     *    A = D * ( I + 1e-7* rand(n)), where D = diag(10^{14*(0:n-1)/n})
     *
     */
    case PlasmaMatrixDemmel:
    {
        PLASMA_Complex32_t dii;
        int ii, jj;

        /* Randomize the matrix */
        CORE_cplrnt( M, N, A, LDA, gM, m0, n0, seed );

        for (j=0,jj=n0; j<N; j++,jj++) {
            for (i=0,ii=m0; i<M; i++,ii++) {
                dii = cpowf( 10. , 14. * ii / gM );
                A[j*LDA+i] *= dii * ( (jj == ii) ? 1. : 1.e-7 );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000000
     *
     * Inverse of an upper Hessenberg matrix
     *
     * A = gallery('invhess',x,y), where x is a length n vector and y
     * is a length n-1 vector, returns the matrix whose lower triangle
     * agrees with that of ones(n,1)*x' and whose strict upper
     * triangle agrees with that of [1 y]*ones(1,n).
     *
     * The matrix is nonsingular if x(1) ~= 0 and x(i+1) ~= y(i) for
     * all i, and its inverse is an upper Hessenberg matrix. Argument
     * y defaults to -x(1:n-1).
     *
     * If x is a scalar, invhess(x) is the same as invhess(1:x).
     *
     * Here: gallery('invhess', gM)
     */
    case PlasmaMatrixInvhess:
    {
        int ii, jj;
        for (j=0,jj=n0+1; j<N; j++,jj++) {
            for (i=0,ii=m0+1; i<M; i++,ii++) {
                if ( jj <= ii ) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( jj );
                } else {
                    A[j*LDA+i] = (PLASMA_Complex32_t)( -ii );
                }
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1019317
     *
     * Cauchy matrix
     *
     * Returns an n-by-n matrix C such that, C(i,j) = 1/(i + j).
     *
     */
    case PlasmaMatrixCauchy:
    {
        int ii, jj;
        for (j=0,jj=n0+1; j<N; j++,jj++) {
            for (i=0,ii=m0+1; i<M; i++,ii++) {
                A[j*LDA+i] = (PLASMA_Complex32_t)( 1. ) / (PLASMA_Complex32_t)( ii+jj );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/hilb.html
     *
     * Hilbert Matrix
     *
     * The Hilbert matrix is a notable example of a poorly conditioned
     * matrix. The elements of the Hilbert matrices are:
     *   H(i,j) = 1/(i * + j – 1).
     *
     */
    case PlasmaMatrixHilb:
    {
        PLASMA_Complex32_t tmp = (PLASMA_Complex32_t)( m0 + n0 + 1. );
        for (j=0; j<N; j++) {
            for (i=0; i<M; i++) {
                A[j*LDA+i] = (PLASMA_Complex32_t)1. / (PLASMA_Complex32_t)( tmp + i + j );
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000062
     *
     * Lotkin matrix
     *
     * Returns the Hilbert matrix with its first row altered to all
     * ones. The Lotkin matrix A is nonsymmetric, ill-conditioned, and
     * has many negative eigenvalues of small magnitude. Its inverse
     * has integer entries and is known explicitly.
     *
     */
    case PlasmaMatrixLotkin:
    {
        PLASMA_Complex32_t tmp = (PLASMA_Complex32_t)( m0 + n0 + 1. );
        if (m0 == 0) {
            for (j=0; j<N; j++) {
                A[j*LDA] = (PLASMA_Complex32_t)1.;
                for (i=1; i<M; i++) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)1. / (PLASMA_Complex32_t)( tmp + i + j );
                }
            }
        } else {
            for (j=0; j<N; j++) {
                for (i=0; i<M; i++) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)1. / (PLASMA_Complex32_t)( tmp + i + j );
                }
            }
        }
    }
    break;

    /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/gallery.html#f84-1000083
     *
     * Orthogonal and nearly orthogonal matrices
     *
     * Returns the matrix Q of order n, such that:
     *    Q(i,j) = sqrt(2/(n+1)) * sin(i*j*pi/(n+1))
     *
     * Symmetric eigenvector matrix for second difference matrix.
     *
     */
    case PlasmaMatrixOrthog: /* Default: k=1 */
    {
        PLASMA_Complex32_t sqrtn = (PLASMA_Complex32_t) sqrt( 2. / (gN+1.) );
        float scale = pi / (float)(gN+1.);

        int ii, jj;
        for (j=0,jj=n0+1; j<N; j++,jj++) {
            for (i=0,ii=m0+1; i<M; i++,ii++) {
                A[j*LDA+i] = sqrtn * (PLASMA_Complex32_t) sin( (float)ii * (float)jj * scale );
            }
        }
    }
    break;

     /*
     * See http://www.mathworks.fr/fr/help/matlab/ref/wilkinson.html
     *
     * Wilkinson's eigenvalue test matrix
     *
     * Returns one of J. H. Wilkinson's eigenvalue test matrices. It
     * is a symmetric, tridiagonal matrix with pairs of nearly, but
     * not exactly, equal eigenvalues.
     *
     */
   case PlasmaMatrixWilkinson:
    {
        if (gM != gN) {
            coreblas_error(6, "Illegal value of gM (Matrix must be square for Wilkinson)");
            return -6;
        }

        int ii, jj;
        for (j=0,jj=n0; j<N; j++,jj++) {
            for (i=0,ii=m0; i<M; i++,ii++) {
                if (ii == jj) {
                    PLASMA_Complex32_t tmp = (PLASMA_Complex32_t)(( (gN - 1 - ii) < ii ) ? gN - 1 - ii : ii );
                     A[j*LDA+i] = (PLASMA_Complex32_t)(gN - 2. * tmp - 1.) / 2.;
                }
                else if ( (ii == jj+1) || (ii == jj-1) ) {
                     A[j*LDA+i] = (PLASMA_Complex32_t)1.;
                }
                else {
                     A[j*LDA+i] = (PLASMA_Complex32_t)0.;
                }
           }
       }
    }
    break;

    /*
     * See [1] L. V. Foster, Gaussian Elimination with Partial
     *         Pivoting Can Fail in Practice, SIAM J. Matrix
     *         Anal. Appl., 15 (1994), pp. 1354-1362.
     *
     *     [2] L. V. Foster, The growth factor and efficiency of
     *         Gaussian elimination with rook pivoting,
     *         J. Comput. Appl. Math., 86 (1997), pp. 177-194
     *
     * A pathological case for LU with gaussian elimination.
     *
     */
    case PlasmaMatrixFoster: /* Default: k=h=c=1 */
    {
        float k=1., h=1., c=1.;

        int ii, jj;
        for (j=0,jj=n0; j<N; j++,jj++) {
            for (i=0,ii=m0; i<M; i++,ii++) {

                if (ii == jj) {
                    if (jj == 0)
                        A[j*LDA+i] = (PLASMA_Complex32_t)1.;
                    else if (jj == gN-1)
                        A[j*LDA+i] = (PLASMA_Complex32_t)(1. - (1. / c) - (k*h)/2. );
                    else
                        A[j*LDA+i] = (PLASMA_Complex32_t)(1. - (k*h)/2. );
                }
                else if (jj == 0) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-k*h/2.);
                }
                else if (jj == gN-1) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-1./c);
                }
                else if (ii > jj) {
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-k*h);
                }
                else {
                    A[j*LDA+i] = (PLASMA_Complex32_t)0.;
                }
            }
        }
    }
    break;

    /*
     * See [3] S. J. Wright, A collection of problems for which
     *         Gaussian elimination with partial pivoting is unstable,
     *         SIAM J. SCI. STATIST. COMPUT., 14 (1993), pp. 231-238.
     *
     * A pathological case for LU with gaussian elimination.
     *
     */
    /*
     * Default: h=0.01, M=[-10 -19, 19 30]. Then,
     *   exp(h*M)=[0.9048 0.8270, 1.2092 1.3499]
     */
    case PlasmaMatrixWright:
    {
        int ii, jj;
        for (j=0,jj=n0; j<N; j++,jj++) {
            for (i=0,ii=m0; i<M; i++,ii++) {

                if (ii == jj)
                    A[j*LDA+i] = (PLASMA_Complex32_t)1.;
                else if ((ii == jj + 2) && (jj % 2 == 0))
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-0.9048);
                else if ((ii == jj + 3) && (jj % 2 == 0))
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-1.2092);
                else if ((ii == jj + 2) && (jj % 2 == 1))
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-0.8270);
                else if ((ii == jj + 3) && (jj % 2 == 1))
                    A[j*LDA+i] = (PLASMA_Complex32_t)(-1.3499);
                else if ((jj == gM-2) && (ii == 0))
                    A[j*LDA+i] = (PLASMA_Complex32_t)1.;
                else if ((jj == gM-1) && (ii == 1))
                    A[j*LDA+i] = (PLASMA_Complex32_t)1.;
                else
                    A[j*LDA+i] = (PLASMA_Complex32_t)0.;
            }
        }
    }
    break;

    /*
     * Generates a pathological case for LU with gaussian elimination.
     *
     * Returns a random matrix on which, the columns from N/4 to N/2
     * are scaled down by eps.
     * These matrices fails on LU with partial pivoting, but Hybrid
     * LU-QR algorithms manage to recover the scaled down columns.
     *
     */
    case PlasmaMatrixLangou:
    {
        PLASMA_Complex32_t eps = (PLASMA_Complex32_t) LAPACKE_slamch_work( 'e' );
        int ii, jj, mm, minMN;
        int firstcol, lastcol;

         /* Create random tile */
         CORE_cplrnt( M, N, A, LDA, gM, m0, n0, seed );

         /* Scale down the columns gN/4 to gN/2 below the diagonal */
         minMN = min( gM, gN );
         firstcol = minMN / 4;
         lastcol  = minMN / 2;

         if ( (m0 >= n0) && ((n0+N) >= firstcol ) && (n0 < lastcol) ) {

             jj = max( n0, firstcol );
             j = jj - n0;

             for (; j<N && jj < lastcol; j++,jj++) {

                 ii = max( m0, jj );
                 i  = ii - m0;
                 mm = M - i;
                 cblas_cscal( mm, CBLAS_SADDR(eps), A + j*LDA + i, 1);
             }
         }
    }
    break;

    default:
        coreblas_error(1, "Illegal value of mtxtype");
        return -1;
    }

    return PLASMA_SUCCESS;
}


#ifndef CONSTITUTIVE_DF_H
#define CONSTITUTIVE_DF_H

#include <algorithm>
#include <numeric>
#include "SIMD_BDB_Integrator.h"

#ifdef HAS_MKL
#include <mkl.h>
#else
#include <cblas.h>
#endif

inline void GetTotalTraction_(Real *TotalTraction, const Real *CauchyStressTensor, int ndim) {
    if (ndim==3) {
        TotalTraction[0] = CauchyStressTensor[0];
        TotalTraction[1] = CauchyStressTensor[4];
        TotalTraction[2] = CauchyStressTensor[8];
        TotalTraction[3] = CauchyStressTensor[1];
        TotalTraction[4] = CauchyStressTensor[2];
        TotalTraction[5] = CauchyStressTensor[5];
    }
    else if (ndim == 2) {
        TotalTraction[0] = CauchyStressTensor[0];
        TotalTraction[1] = CauchyStressTensor[3];
        TotalTraction[2] = CauchyStressTensor[1];
    }
}

inline void FillConstitutiveB_(Real *B, const Real* SpatialGradient,
                     int ndim, int nvar, int rows, int cols) {
    int i = 0;

    if (ndim == 3) {

        for (; i<rows; ++i) {

            // Store in registers
            const Real a0 = SpatialGradient[i*ndim];
            const Real a1 = SpatialGradient[i*ndim+1];
            const Real a2 = SpatialGradient[i*ndim+2];

            // MECHANICAL TERMS
            B[i*cols*nvar]              = a0;
            B[i*cols*nvar+cols+1]       = a1;
            B[i*cols*nvar+2*(cols+1)]   = a2;

            B[i*cols*nvar+cols+5]       = a2;
            B[i*cols*nvar+2*cols+5]     = a1;

            B[i*cols*nvar+4]            = a2;
            B[i*cols*nvar+2*cols+4]     = a0;

            B[i*cols*nvar+3]            = a1;
            B[i*cols*nvar+cols+3]       = a0;
        }
    }

    else if (ndim == 2) {

        for (; i<rows; ++i) {

            // Store in registers
            const Real a0 = SpatialGradient[i*ndim];
            const Real a1 = SpatialGradient[i*ndim+1];

            // MECHANICAL TERMS
            B[i*cols*nvar]              = a0;
            B[i*cols*nvar+cols+1]       = a1;

            B[i*cols*nvar+2]            = a1;
            B[i*cols*nvar+cols+2]       = a0;
        }
    }
}

inline void _ConstitutiveStiffnessIntegrandDF_Filler_(
    Real *stiffness,
    Real *traction,
    const Real* SpatialGradient,
    const Real* CauchyStressTensor,
    const Real* H_Voigt,
    const Real* detJ,
    int ngauss,
    int noderpelem,
    int ndim,
    int nvar,
    int H_VoigtSize,
    int requires_geometry_update) {

    int local_size = nvar*noderpelem;

    Real *t;
    if (ndim==3) { t = allocate<Real>(6);}
    else if (ndim==2) { t =  allocate<Real>(3);}

    Real *B = allocate<Real>(H_VoigtSize*local_size);
    Real *HBT = allocate<Real>(H_VoigtSize*local_size);
    Real *BDB_1 = allocate<Real>(local_size*local_size);

    std::fill(B,B+H_VoigtSize*local_size,0.);

    for (int igauss = 0; igauss < ngauss; ++igauss) {

        FillConstitutiveB_(B,&SpatialGradient[igauss*ndim*noderpelem],ndim,nvar,noderpelem,H_VoigtSize);
        // if (ndim == 3) {
            cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
                H_VoigtSize, local_size, H_VoigtSize, 1.0, &H_Voigt[igauss*H_VoigtSize*H_VoigtSize], H_VoigtSize, B, H_VoigtSize, 0.0, HBT, local_size);

            cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                local_size, local_size, H_VoigtSize, 1.0, B, H_VoigtSize, HBT, local_size, 0.0, BDB_1, local_size);
        // }
        // else
        // {
        //     _SIMD_BDB_Integrator_DF_2D_(
        //         HBT,
        //         BDB_1,
        //         &SpatialGradient[igauss*ndim*noderpelem],
        //         &H_Voigt[igauss*H_VoigtSize*H_VoigtSize],
        //         noderpelem
        //         );
        // }

        // Multiply stiffness with detJ
        const Real detJ_igauss = detJ[igauss];
        for (int i=0; i<local_size*local_size; ++i) {
            stiffness[i] += BDB_1[i]*detJ_igauss;
        }

        if (requires_geometry_update==1) {
            // Compute tractions
            GetTotalTraction_(t, &CauchyStressTensor[igauss*ndim*ndim], ndim);

            // Multiply B with traction - for loop is okay
            for (int i=0; i<local_size; ++i) {
                Real tmp = 0;
                for (int j=0; j<H_VoigtSize; ++j) {
                    tmp += B[i*H_VoigtSize+j]*t[j];
                }
                // local_traction[i] = tmp;
                traction[i] += tmp*detJ_igauss;
            }
        }
    }

    deallocate(t);
    deallocate(B);
    deallocate(HBT);
    deallocate(BDB_1);
}

#endif


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

/* Author:  G. Jungman */

#include <config.h>
#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_gamma.h"
#include "gsl_sf_coupling.h"

#include "error.h"

inline
static
int locMax3(const int a, const int b, const int c)
{
  int d = GSL_MAX(a, b);
  return GSL_MAX(d, c);
}

inline
static
int locMin3(const int a, const int b, const int c)
{
  int d = GSL_MIN(a, b);
  return GSL_MIN(d, c);
}

inline
static
int locMin5(const int a, const int b, const int c, const int d, const int e)
{
  int f = GSL_MIN(a, b);
  int g = GSL_MIN(c, d);
  int h = GSL_MIN(f, g);
  return GSL_MIN(e, h);
}

/* See: [Thompson, Atlas for Computing Mathematical Functions] */

static
int
delta(int ta, int tb, int tc, gsl_sf_result * d)
{
  gsl_sf_result f1, f2, f3, f4;
  int status = 0;
  status += gsl_sf_fact_e((ta + tb - tc)/2, &f1);
  status += gsl_sf_fact_e((ta + tc - tb)/2, &f2);
  status += gsl_sf_fact_e((tb + tc - ta)/2, &f3);
  status += gsl_sf_fact_e((ta + tb + tc)/2 + 1, &f4);
  if(status != 0) {
    OVERFLOW_ERROR(d);
  }
  d->val = f1.val * f2.val * f3.val / f4.val;
  d->err = 4.0 * GSL_DBL_EPSILON * fabs(d->val);
  return GSL_SUCCESS;
}

static
int
triangle_selection_fails(int two_ja, int two_jb, int two_jc)
{
  return ((two_jb < abs(two_ja - two_jc)) || (two_jb > two_ja + two_jc));
}

static
int
m_selection_fails(int two_ja, int two_jb, int two_jc,
                  int two_ma, int two_mb, int two_mc)
{
  return (   abs(two_ma) > two_ja
          || abs(two_mb) > two_jb
	  || abs(two_mc) > two_jc
	  || GSL_IS_ODD(two_ja + two_ma)
	  || GSL_IS_ODD(two_jb + two_mb)
	  || GSL_IS_ODD(two_jc + two_mc)
          || (two_ma + two_mb + two_mc) != 0
	  );
}

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

int
gsl_sf_coupling_3j_e(int two_ja, int two_jb, int two_jc,
                        int two_ma, int two_mb, int two_mc,
			gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(two_ja < 0 || two_jb < 0 || two_jc < 0) {
    DOMAIN_ERROR(result);
  }
  else if(   triangle_selection_fails(two_ja, two_jb, two_jc)
          || m_selection_fails(two_ja, two_jb, two_jc, two_ma, two_mb, two_mc)
     ) {
    result->val = 0.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else {
    gsl_sf_result n1_a, n1_b, n3_a, n3_b;
    gsl_sf_result d1_a, d1_b, d2_a, d2_b, d3_a, d3_b;
    gsl_sf_result n1, n2, n3;
    gsl_sf_result d1, d2, d3;
    double norm;
    double sign = (GSL_IS_ODD((two_ja - two_jb - two_mc)/2) ? -1.0 : 1.0);
    int tk, tkmin, tkmax;
    double sum_pos = 0.0;
    double sum_neg = 0.0;
    double phase;
    int status = 0;
    status += gsl_sf_fact_e((two_jc + two_ja - two_jb)/2, &n1_a);
    status += gsl_sf_fact_e((two_jc - two_ja + two_jb)/2, &n1_b);
    status += gsl_sf_fact_e((two_ja + two_jb - two_jc)/2, &n2);
    status += gsl_sf_fact_e((two_jc - two_mc)/2, &n3_a);
    status += gsl_sf_fact_e((two_jc + two_mc)/2, &n3_b);
    status += gsl_sf_fact_e((two_ja + two_jb + two_jc)/2 + 1, &d1);
    status += gsl_sf_fact_e((two_ja - two_ma)/2, &d2_a);
    status += gsl_sf_fact_e((two_ja + two_ma)/2, &d2_b);
    status += gsl_sf_fact_e((two_jb - two_mb)/2, &d3_a);
    status += gsl_sf_fact_e((two_jb + two_mb)/2, &d3_b);

    if(status != 0) {
      OVERFLOW_ERROR(result);
    }

    n1.val = n1_a.val * n1_b.val;
    n3.val = n3_a.val * n3_b.val;
    d2.val = d2_a.val * d2_b.val;
    d3.val = d3_a.val * d3_b.val;

    norm = sign * sqrt(n1.val*n2.val*n3.val)/sqrt(d1.val*d2.val*d3.val);

    tkmin = GSL_MAX(0, two_jb - two_ja - two_mc);
    tkmax = GSL_MIN(two_jc - two_ja + two_jb, two_jc - two_mc);

    phase = GSL_IS_ODD((tkmin + two_jb + two_mb)/2) ? -1.0 : 1.0;

    for(tk=tkmin; tk<=tkmax; tk += 2) {
      double term;

      status = 0;
      status += gsl_sf_fact_e((two_jb + two_jc + two_ma - tk)/2, &n1);
      status += gsl_sf_fact_e((two_ja - two_ma + tk)/2, &n2);
      status += gsl_sf_fact_e(tk/2, &d1_a);
      status += gsl_sf_fact_e((two_jc - two_ja + two_jb - tk)/2, &d1_b);
      status += gsl_sf_fact_e((two_jc - two_mc - tk)/2, &d2);
      status += gsl_sf_fact_e((two_ja - two_jb + two_mc + tk)/2, &d3);

      if(status != 0) {
        OVERFLOW_ERROR(result);
      }

      d1.val = d1_a.val * d1_b.val;

      term = phase * n1.val * n2.val / (d1.val * d2.val * d3.val);
      phase = -phase;

      if(norm*term >= 0.0) {
        sum_pos += norm*term;
      }
      else {
        sum_neg -= norm*term;
      }
    }

    result->val  = sum_pos - sum_neg;
    result->err  = 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
    result->err += 2.0 * GSL_DBL_EPSILON * (tkmax - tkmin) * fabs(result->val);

    return GSL_SUCCESS;
  }
}

int
gsl_sf_coupling_6j_e(int two_ja, int two_jb, int two_jc,
                        int two_jd, int two_je, int two_jf,
			gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(   two_ja < 0 || two_jb < 0 || two_jc < 0
     || two_jd < 0 || two_je < 0 || two_je < 0
     ) {
    DOMAIN_ERROR(result);
  }
  else if(   triangle_selection_fails(two_ja, two_jb, two_je)
          || triangle_selection_fails(two_ja, two_jc, two_jf)
          || triangle_selection_fails(two_jb, two_jd, two_jf)
          || triangle_selection_fails(two_jc, two_jd, two_je)
     ) {
    result->val = 0.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else {
    gsl_sf_result n1;
    gsl_sf_result d1, d2, d3, d4, d5, d6;
    double norm;
    int tk, tkmin, tkmax;
    double phase;
    double sum_pos = 0.0;
    double sum_neg = 0.0;
    double sumsq_err = 0.0;
    int status = 0;
    status += delta(two_ja, two_jb, two_je, &d1);
    status += delta(two_ja, two_jc, two_jf, &d2);
    status += delta(two_jb, two_jd, two_jf, &d3);
    status += delta(two_jc, two_jd, two_je, &d4);
    if(status != GSL_SUCCESS) {
      OVERFLOW_ERROR(result);
    }
    norm = sqrt(d1.val) * sqrt(d2.val) * sqrt(d3.val) * sqrt(d4.val);

    tkmin = locMax3(0,
                   two_ja + two_jd - two_je - two_jf,
                   two_jb + two_jc - two_je - two_jf);

    tkmax = locMin5(two_ja + two_jb + two_jc + two_jd + 2,
                    two_ja + two_jb - two_je,
		    two_jc + two_jd - two_je,
		    two_ja + two_jc - two_jf,
		    two_jb + two_jd - two_jf);

    phase = GSL_IS_ODD((two_ja + two_jb + two_jc + two_jd + tkmin)/2)
            ? -1.0
	    :  1.0;

    for(tk=tkmin; tk<=tkmax; tk += 2) {
      double term;
      double term_err;
      gsl_sf_result den_1, den_2;
      gsl_sf_result d1_a, d1_b;
      status = 0;

      status += gsl_sf_fact_e((two_ja + two_jb + two_jc + two_jd - tk)/2 + 1, &n1);
      status += gsl_sf_fact_e(tk/2, &d1_a);
      status += gsl_sf_fact_e((two_je + two_jf - two_ja - two_jd + tk)/2, &d1_b);
      status += gsl_sf_fact_e((two_je + two_jf - two_jb - two_jc + tk)/2, &d2);
      status += gsl_sf_fact_e((two_ja + two_jb - two_je - tk)/2, &d3);
      status += gsl_sf_fact_e((two_jc + two_jd - two_je - tk)/2, &d4);
      status += gsl_sf_fact_e((two_ja + two_jc - two_jf - tk)/2, &d5);
      status += gsl_sf_fact_e((two_jb + two_jd - two_jf - tk)/2, &d6);

      if(status != GSL_SUCCESS) {
        OVERFLOW_ERROR(result);
      }

      d1.val = d1_a.val * d1_b.val;
      d1.err = d1_a.err * fabs(d1_b.val) + fabs(d1_a.val) * d1_b.err;

      den_1.val  = d1.val*d2.val*d3.val;
      den_1.err  = d1.err * fabs(d2.val*d3.val);
      den_1.err += d2.err * fabs(d1.val*d3.val);
      den_1.err += d3.err * fabs(d1.val*d2.val);

      den_2.val  = d4.val*d5.val*d6.val;
      den_2.err  = d4.err * fabs(d5.val*d6.val);
      den_2.err += d5.err * fabs(d4.val*d6.val);
      den_2.err += d6.err * fabs(d4.val*d5.val);

      term  = phase * n1.val / den_1.val / den_2.val;
      phase = -phase;
      term_err  = n1.err / fabs(den_1.val) / fabs(den_2.val);
      term_err += fabs(term / den_1.val) * den_1.err;
      term_err += fabs(term / den_2.val) * den_2.err;

      if(term >= 0.0) {
        sum_pos += norm*term;
      }
      else {
        sum_neg -= norm*term;
      }

      sumsq_err += norm*norm * term_err*term_err;
    }

    result->val  = sum_pos - sum_neg;
    result->err  = 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
    result->err += sqrt(sumsq_err / (0.5*(tkmax-tkmin)+1.0));
    result->err += 2.0 * GSL_DBL_EPSILON * (tkmax - tkmin + 2.0) * fabs(result->val);

    return GSL_SUCCESS;
  }
}

int
gsl_sf_coupling_9j_e(int two_ja, int two_jb, int two_jc,
                        int two_jd, int two_je, int two_jf,
			int two_jg, int two_jh, int two_ji,
			gsl_sf_result * result)
{
  /* CHECK_POINTER(result) */

  if(   two_ja < 0 || two_jb < 0 || two_jc < 0
     || two_jd < 0 || two_je < 0 || two_jf < 0
     || two_jg < 0 || two_jh < 0 || two_ji < 0
     ) {
    DOMAIN_ERROR(result);
  }
  else if(   triangle_selection_fails(two_ja, two_jb, two_jc)
          || triangle_selection_fails(two_jd, two_je, two_jf)
          || triangle_selection_fails(two_jg, two_jh, two_ji)
          || triangle_selection_fails(two_ja, two_jd, two_jg)
          || triangle_selection_fails(two_jb, two_je, two_jh)
          || triangle_selection_fails(two_jc, two_jf, two_ji)
     ) {
    result->val = 0.0;
    result->err = 0.0;
    return GSL_SUCCESS;
  }
  else {
    int tk;
    int tkmin = locMax3(abs(two_ja-two_ji), abs(two_jh-two_jd), abs(two_jb-two_jf));
    int tkmax = locMin3(two_ja + two_ji, two_jh + two_jd, two_jb + two_jf);
    double sum_pos = 0.0;
    double sum_neg = 0.0;
    double sumsq_err = 0.0;
    double phase;
    for(tk=tkmin; tk<=tkmax; tk += 2) {
      gsl_sf_result s1, s2, s3;
      double term;
      double term_err;
      int status = 0;
      status += gsl_sf_coupling_6j_e(two_ja, two_ji, two_jd,  two_jh, tk, two_jg,  &s1);
      status += gsl_sf_coupling_6j_e(two_jb, two_jf, two_jh,  two_jd, tk, two_je,  &s2);
      status += gsl_sf_coupling_6j_e(two_ja, two_ji, two_jb,  two_jf, tk, two_jc,  &s3);
      if(status != GSL_SUCCESS) {
        OVERFLOW_ERROR(result);
      }
      term = s1.val * s2.val * s3.val;
      term_err  = s1.err * fabs(s2.val*s3.val);
      term_err += s2.err * fabs(s1.val*s3.val);
      term_err += s3.err * fabs(s1.val*s2.val);

      if(term >= 0.0) {
        sum_pos += (tk + 1) * term;
      }
      else {
        sum_neg -= (tk + 1) * term;
      }

      sumsq_err += ((tk+1) * term_err) * ((tk+1) * term_err);
    }

    phase = GSL_IS_ODD(tkmin) ? -1.0 : 1.0;

    result->val  = phase * (sum_pos - sum_neg);
    result->err  = 2.0 * GSL_DBL_EPSILON * (sum_pos + sum_neg);
    result->err += sqrt(sumsq_err / (0.5*(tkmax-tkmin)+1.0));
    result->err += 2.0 * GSL_DBL_EPSILON * (tkmax-tkmin + 2.0) * fabs(result->val);

    return GSL_SUCCESS;
  }
}

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

#include "eval.h"

double gsl_sf_coupling_3j(int two_ja, int two_jb, int two_jc,
                          int two_ma, int two_mb, int two_mc)
{
  EVAL_RESULT(gsl_sf_coupling_3j_e(two_ja, two_jb, two_jc,
                                   two_ma, two_mb, two_mc,
                                   &result));
}

double gsl_sf_coupling_6j(int two_ja, int two_jb, int two_jc,
                          int two_jd, int two_je, int two_jf)
{
  EVAL_RESULT(gsl_sf_coupling_6j_e(two_ja, two_jb, two_jc,
                                   two_jd, two_je, two_jf,
                                   &result));
}

double gsl_sf_coupling_9j(int two_ja, int two_jb, int two_jc,
                          int two_jd, int two_je, int two_jf,
                          int two_jg, int two_jh, int two_ji)
{
  EVAL_RESULT(gsl_sf_coupling_9j_e(two_ja, two_jb, two_jc,
                                   two_jd, two_je, two_jf,
                                   two_jg, two_jh, two_ji,
                                   &result));
}


#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_math.h>
#include "gsl_cblas.h"

#include "tests.h"

void
test_amax (void) {
  {
   int N = 1;
   float X[] = { -0.388f };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_isamax(N, X, incX);
   gsl_test_int(k, expected, "samax(case 52)");
  };

  {
   int N = 1;
   double X[] = { 0.247 };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_idamax(N, X, incX);
   gsl_test_int(k, expected, "damax(case 53)");
  };

  {
   int N = 1;
   float X[] = { 0.704f, 0.665f };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_icamax(N, X, incX);
   gsl_test_int(k, expected, "camax(case 54)");
  };

  {
   int N = 1;
   double X[] = { -0.599, -0.758 };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_izamax(N, X, incX);
   gsl_test_int(k, expected, "zamax(case 55)");
  };

  {
   int N = 2;
   float X[] = { 0.909f, 0.037f };
   int incX = 1;
   int expected = 0;
   int k;
   k = cblas_isamax(N, X, incX);
   gsl_test_int(k, expected, "samax(case 56)");
  };

  {
   int N = 2;
   double X[] = { 0.271, -0.426 };
   int incX = 1;
   int expected = 1;
   int k;
   k = cblas_idamax(N, X, incX);
   gsl_test_int(k, expected, "damax(case 57)");
  };

  {
   int N = 2;
   float X[] = { -0.648f, 0.317f, 0.62f, 0.392f };
   int incX = 1;
   int expected = 1;
   int k;
   k = cblas_icamax(N, X, incX);
   gsl_test_int(k, expected, "camax(case 58)");
  };

  {
   int N = 2;
   double X[] = { -0.789, 0.352, 0.562, 0.697 };
   int incX = 1;
   int expected = 1;
   int k;
   k = cblas_izamax(N, X, incX);
   gsl_test_int(k, expected, "zamax(case 59)");
  };

  {
   int N = 2;
   float X[] = { 0.487f, 0.918f };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_isamax(N, X, incX);
   gsl_test_int(k, expected, "samax(case 60)");
  };

  {
   int N = 2;
   double X[] = { 0.537, 0.826 };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_idamax(N, X, incX);
   gsl_test_int(k, expected, "damax(case 61)");
  };

  {
   int N = 2;
   float X[] = { 0.993f, 0.172f, -0.825f, 0.873f };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_icamax(N, X, incX);
   gsl_test_int(k, expected, "camax(case 62)");
  };

  {
   int N = 2;
   double X[] = { 0.913, -0.436, -0.134, 0.129 };
   int incX = -1;
   int expected = 0;
   int k;
   k = cblas_izamax(N, X, incX);
   gsl_test_int(k, expected, "zamax(case 63)");
  };

}


/***************************************************************************
 *   Copyright (C) 2008 by Regis Behmo,,,   *
 *   regis.behmo@ecp.fr   *
 *                                                                         *
 *   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.                                   *
 ***************************************************************************/

#ifndef _MPLSH_FIT_TUNE_H_INCLUDED_
#define _MPLSH_FIT_TUNE_H_INCLUDED_

#include <lshkit.h>
#include <lshkit/matrix.h>
#include <lshkit/tune.h>

#include <cstdlib>
#include <gsl/gsl_multifit.h>
#include <boost/program_options.hpp>
#include <boost/progress.hpp>

bool is_good_value (double v);
bool constraint (const lshkit::tune::Input &x);

double mplsh_tune(const double& param_M, const double& param_G,
                  const double& param_a_M, const double& param_b_M, const double& param_c_M,
                  const double& param_a_G, const double& param_b_G, const double& param_c_G,
                  int N, int K, int L, int T, int& M, float& W, float R );

template<class DATA, class METRIC>
void mplsh_fit( const DATA& data, const METRIC& metric, int NN, double& param_M, double& param_G,
                double& param_a_M, double& param_b_M, double& param_c_M,
                double& param_a_G, double& param_b_G, double& param_c_G )
{
	// Parameters
	unsigned N, P, Q, K, F;
	N = 0;// # points
	P = 50000;// number of pairs to sample
	Q = 1000;// number of queries to sample
	K = NN;// search for K nearest neighbors
	F = 10;// divide the sample to F folds

	std::vector<unsigned> idx(data.getSize());
	for (unsigned i = 0; i < idx.size(); ++i) idx[i] = i;
	random_shuffle(idx.begin(), idx.end());

	if (N > 0 && N < data.getSize()) idx.resize(N);

	lshkit::DefaultRng rng;
	rng.seed(0);//plant the same seed, always
	boost::variate_generator<lshkit::DefaultRng &, lshkit::UniformUnsigned> gen(rng, lshkit::UniformUnsigned(0, idx.size()-1));

	double gM = 0.0;
	double gG = 0.0;
	{
		// sample P pairs of points
		for (unsigned k = 0; k < P; ++k)
		{
			double dist, logdist;
			for (;;)
			{
				unsigned i = gen();
				unsigned j = gen();
				if (i == j) continue;
				dist = metric( data[idx[i]], data[idx[j]] );
				logdist = log(dist);
				if (is_good_value(logdist)) break;
			}
			gM += dist;
			gG += logdist;
		}
		gM /= P;
		gG /= P;
		gG = exp(gG);
	}

  // TODO check that
	// Custom
	Q = (idx.size() > 1000)? 1000 : idx.size();// Added

	// TODO check that
  // Supprime
  //if (Q > idx.size()) Q = idx.size();
  //if (K > idx.size() - Q) K = idx.size() - Q;

	/* sample query */
	std::vector<unsigned> qry(Q);

	lshkit::SampleQueries(&qry, idx.size(), rng);

	/* do the queries */
	std::vector<lshkit::Topk<unsigned> > topks(Q);
	for (unsigned i = 0; i < Q; ++i) topks[i].reset(K);

	/* ... */
	gsl_matrix *X = gsl_matrix_alloc(F * K, 3);
	gsl_vector *yM = gsl_vector_alloc(F * K);
	gsl_vector *yG = gsl_vector_alloc(F * K);
	gsl_vector *pM = gsl_vector_alloc(3);
	gsl_vector *pG = gsl_vector_alloc(3);
	gsl_matrix *cov = gsl_matrix_alloc(3,3);

	std::vector<double> M(K);
	std::vector<double> G(K);

	boost::progress_display progress(F, std::cerr);
	unsigned m = 0;
	for (unsigned l = 0; l < F; l++)
	{
		// Scan
		for (unsigned i = l; i< idx.size(); i += F)
		{
			for (unsigned j = 0; j < Q; j++)
			{
				int id = qry[j];
				if (i != id)
				{
					float d = metric( data[idx[id]], data[idx[i]] );
					if (is_good_value(log(double(d)))) topks[j] << lshkit::Topk<unsigned>::Element(i, d);
				}
			}
		}

		std::fill(M.begin(), M.end(), 0.0);
		std::fill(G.begin(), G.end(), 0.0);

		for (unsigned i = 0; i < Q; i++)
		{
			for (unsigned k = 0; k < K; k++)
			{
				M[k] += topks[i][k].dist;
				G[k] += log(topks[i][k].dist);
			}
		}

		for (unsigned k = 0; k < K; k++)
		{
			M[k] = log(M[k]/Q);
			G[k] /= Q;
			gsl_matrix_set(X, m, 0, 1.0);
			gsl_matrix_set(X, m, 1, log(double(data.getSize() * (l + 1)) / double(F)));
			gsl_matrix_set(X, m, 2, log(double(k + 1)));
			gsl_vector_set(yM, m, M[k]);
			gsl_vector_set(yG, m, G[k]);
			++m;
		}
        ++progress;
	}

	gsl_multifit_linear_workspace *work = gsl_multifit_linear_alloc(F * K, 3);

	double chisq;

	gsl_multifit_linear(X, yM, pM, cov, &chisq, work);
	gsl_multifit_linear(X, yG, pG, cov, &chisq, work);

	param_M = gM;
	param_G = gG;
	param_a_M = gsl_vector_get(pM, 0);
	param_b_M = gsl_vector_get(pM, 1);
	param_c_M = gsl_vector_get(pM, 2);
	param_a_G = gsl_vector_get(pG, 0);
	param_b_G = gsl_vector_get(pG, 1);
	param_c_G = gsl_vector_get(pG, 2);

	gsl_matrix_free(X);
	gsl_matrix_free(cov);
	gsl_vector_free(pM);
	gsl_vector_free(pG);
	gsl_vector_free(yM);
	gsl_vector_free(yG);
}

template<class DATA, class METRIC>
double mplsh_fit_tune( const DATA& data, const METRIC& metric, const int& L, const int& T, int& M, float& W, float R = 0.8, int K = 1 )
{

	/** ***************************/
	/** ********** FIT  ***********/
	/** ***************************/
  std::cout << "Fitting..." << std::endl;
	double param_M, param_G, param_a_M, param_b_M, param_c_M, param_a_G, param_b_G, param_c_G;
	mplsh_fit( data, metric, K, param_M, param_G, param_a_M, param_b_M, param_c_M, param_a_G, param_b_G, param_c_G );

  std::cout << param_M << "    " << param_G << std::endl;
  std::cout << param_a_M << "    " << param_b_M << "    " << param_c_M << std::endl;
  std::cout << param_a_G << "    " << param_b_G << "    " << param_c_G << std::endl;

	/** ***************************/
	/** ********** TUNE ***********/
	/** ***************************/
  std::cout << "Tuning..." << std::endl;
	double cost = mplsh_tune(param_M, param_G, param_a_M, param_b_M, param_c_M, param_a_G, param_b_G, param_c_G,
                    data.getSize(), K, L, T, M, W, R );
  std::cout << "L = " << L;
  std::cout << "    " << "T = " << T;
  std::cout << "    " << "M = " << M;
  std::cout << "    " << "W = " << W;
  std::cout << "    " << "R = " << R;
  std::cout << "    " << "M = " << M;
  std::cout << std::endl;

  return cost;
}

#endif