/*****************************************************************************
*
* Rokko: Integrated Interface for libraries of eigenvalue decomposition
*
* Copyright (C) 2012-2020 Rokko Developers https://github.com/t-sakashita/rokko
*
* Distributed under the Boost Software License, Version 1.0. (See accompanying
* file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
*
*****************************************************************************/

#ifndef ROKKO_SCALAPACK_SCALAPACK_INTERFACE_H
#define ROKKO_SCALAPACK_SCALAPACK_INTERFACE_H

#include <rokko/config.h>
#include <rokko/mangling.h>
#include <lapacke.h>

#ifdef __cplusplus
extern "C" {
#endif

#define SCALAPACK_descinit ROKKO_GLOBAL(descinit,DESCINIT)
void SCALAPACK_descinit(int* desc, const int* m, const int* n, const int* mb, const int* nb,
                        const int* irsrc, const int* icsrc, const int* ictxt, const int* lld,
                        int* info);

#define SCALAPACK_indxg2p ROKKO_GLOBAL(indxg2p,INDXG2P)
int SCALAPACK_indxg2p(int* indxglob, int* nb, int* iproc, int* isrcproc, int* nprocs);

#define SCALAPACK_numroc ROKKO_GLOBAL(numroc,NUMROC)
int SCALAPACK_numroc(int* n, int* nb, int* iproc, int* isrcproc, int* nprocs);

#define SCALAPACK_pdelget ROKKO_GLOBAL(pdelget,PDELGET)
void SCALAPACK_pdelget(const char* scope, const char* top, double* alpha,
                       const double* A, const int* ia, const int* ja, const int* descA);

#define SCALAPACK_pdelset ROKKO_GLOBAL(pdelset,PDELSET)
void SCALAPACK_pdelset(double* A, const int* ia, const int* ja, const int* descA,
                       const double* alpha);

#define SCALAPACK_pdlamch ROKKO_GLOBAL(pdlamch,PDLAMCH)
double SCALAPACK_pdlamch(const int* icnt, const char* cmch);

#define SCALAPACK_pdlange ROKKO_GLOBAL(pdlange,PDLANGE)
double SCALAPACK_pdlange(const char* norm, int* m, int* n, const double* A,
                         const int* ia, const int* ja, const int* descA, double* work);

#define SCALAPACK_pdlaprnt ROKKO_GLOBAL(pdlaprnt,PDLAPRNT)
void SCALAPACK_pdlaprnt(const int* m, const int* n, const double* A, const int* ia, const int* ja,
                        const int* descA, const int* irprnt, const int* icprnt, const char* cmatnm,
                        const int* nout, double* work);

#define SCALAPACK_PSYEV_DECL(NAMES, NAMEL, TYPE, TYPE_REAL) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const char* jobz, const char* uplo, const int* n, \
                                 TYPE* A, const int* ia, const int* ja, const int* descA, \
                                 TYPE_REAL* w, TYPE* Z, const int* iz, const int* jz, const int* descZ, \
                                 TYPE* work, const int* lwork, int* info);

SCALAPACK_PSYEV_DECL(pssyev, PSSYEV, float, float);
SCALAPACK_PSYEV_DECL(pdsyev, PDSYEV, double, double);
SCALAPACK_PSYEV_DECL(pcheev, PCHEEV, lapack_complex_float, float);
SCALAPACK_PSYEV_DECL(pzheev, PZHEEV, lapack_complex_double, double);

#undef SCALAPACK_PSYEV_DECL

#define SCALAPACK_PSYEVD_DECL(NAMES, NAMEL, TYPE, TYPE_REAL) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const char* jobz, const char* uplo, const int* n, \
  TYPE* A, const int* ia, const int* ja, const int* descA, \
  TYPE_REAL* w, \
  TYPE* Z, const int* iz, const int* jz, const int* descZ, \
  TYPE* work, const int* lwork, int* iwork, const int* liwork, int* info);

SCALAPACK_PSYEVD_DECL(pssyevd, PSSYEVD, float, float);
SCALAPACK_PSYEVD_DECL(pdsyevd, PDSYEVD, double, double);
SCALAPACK_PSYEVD_DECL(pcheevd, PCHEEVD, lapack_complex_float, float);
SCALAPACK_PSYEVD_DECL(pzheevd, PZHEEVD, lapack_complex_double, double);

#undef SCALAPACK_PSYEVD_DECL

#define SCALAPACK_PSYEVX_DECL(NAMES, NAMEL, TYPE, TYPE_REAL) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const char* jobz, const char* range, const char* uplo, const int* n, \
  TYPE* A, const int* iA, const int* jA, const int* descA, \
  const TYPE_REAL* vl, const TYPE_REAL* vu, const int* il, const int* iu, \
  const TYPE_REAL* abstol, int* m, int* nZ, TYPE_REAL* w, const TYPE_REAL* orfac, \
  TYPE* Z, const int* iZ, const int* jZ, const int* descZ, \
  TYPE* work, const int* lwork, int* iwork, const int* liwork, \
  int* ifail, int* iclustr, TYPE_REAL* gap, int* info);

SCALAPACK_PSYEVX_DECL(pssyevx, PSSYEVX, float, float);
SCALAPACK_PSYEVX_DECL(pdsyevx, PDSYEVX, double, double);
SCALAPACK_PSYEVX_DECL(pcheevx, PCHEEVX, lapack_complex_float, float);
SCALAPACK_PSYEVX_DECL(pzheevx, PZHEEVX, lapack_complex_double, double);

#undef SCALAPACK_PSYEVX_DECL

#ifdef ROKKO_HAVE_SCALAPACK_PDSYEVR
#define SCALAPACK_PSYEVR_DECL(NAMES, NAMEL, TYPE, TYPE_REAL) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const char* jobz, const char* range, const char* uplo, const int* n, \
  TYPE* A, const int* iA, const int* jA, const int* descA, \
  const TYPE_REAL* vl, const TYPE_REAL* vu, const int* il, const int* iu, \
  int* m, int* nz, \
  TYPE_REAL* w, TYPE* Z, const int* iz, const int* jz, const int* descZ, \
  TYPE* work, const int* lwork, int* iwork, const int* liwork, int* info);

SCALAPACK_PSYEVR_DECL(pssyevr, PSSYEVR, float, float);
SCALAPACK_PSYEVR_DECL(pdsyevr, PDSYEVR, double, double);
SCALAPACK_PSYEVR_DECL(pcheevr, PCHEEVR, lapack_complex_float, float);
SCALAPACK_PSYEVR_DECL(pzheevr, PZHEEVR, lapack_complex_double, double);

#undef SCALAPACK_PSYEVR_DECL
#endif

#define SCALAPACK_pselget ROKKO_GLOBAL(pselget,PSELGET)
void SCALAPACK_pselget(const char* scope, const char* top, float* alpha,
                       const float* A, const int* ia, const int* ja, const int* descA);

#define SCALAPACK_pselset ROKKO_GLOBAL(pselset,PSELSET)
void SCALAPACK_pselset(float* A, const int* ia, const int* ja, const int* descA,
                       const float* alpha);

#define SCALAPACK_pslamch ROKKO_GLOBAL(pslamch,PSLAMCH)
float SCALAPACK_pslamch(const int* icnt, const char* cmch);

#define SCALAPACK_pslange ROKKO_GLOBAL(pslange,PSLANGE)
float SCALAPACK_pslange(const char* norm, int* m, int* n, const float* A,
                        const int* ia, const int* ja, const int* descA, float* work);

#define SCALAPACK_pslaprnt ROKKO_GLOBAL(pslaprnt,PSLAPRNT)
void SCALAPACK_pslaprnt(const int* m, const int* n, const float* A, const int* ia, const int* ja,
                        const int* descA, const int* irprnt, const int* icprnt, const char* cmatnm,
                        const int* nout, float* work);

#define SCALAPACK_PSTEBZ_DECL(NAMES, NAMEL, TYPE) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const int* ictxt, const char* range, const char* order, const int* n, \
                                 const TYPE* vl, const TYPE* vu, const int* il, const int* iu, \
                                 const TYPE* abstol, const TYPE* d, const TYPE* e, int* m, int* nsplit, \
                                 TYPE* w, int* iblock, int* isplit, \
                                 TYPE* work, const int* lwork, int* iwork, const int* liwork, int* info);

SCALAPACK_PSTEBZ_DECL(psstebz, PSSTEBZ, float);
SCALAPACK_PSTEBZ_DECL(pdstebz, PDSTEBZ, double);

#undef SCALAPACK_PSTEBZ_DECL

#define SCALAPACK_PSTEIN_DECL(NAMES, NAMEL, TYPE, TYPE_REAL) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const int* n, const TYPE_REAL* d, const TYPE_REAL* e, const int* m, \
                                 TYPE_REAL* w, const int* iblock, const int* isplit, const TYPE_REAL* orfac, \
                                 TYPE* Z, const int* iZ, const int* jZ, const int* descZ, \
                                 TYPE* work, const int* lwork, int* iwork, const int* liwork, \
                                 int* ifail, int* iclustr, TYPE_REAL* gap, int* info);

SCALAPACK_PSTEIN_DECL(psstein, PSSTEIN, float, float);
SCALAPACK_PSTEIN_DECL(pdstein, PDSTEIN, double, double);
SCALAPACK_PSTEIN_DECL(pcstein, PCSTEIN, lapack_complex_float, float);
SCALAPACK_PSTEIN_DECL(pzstein, PZSTEIN, lapack_complex_double, double);

#undef SCALAPACK_PSTEIN_DECL

#define SCALAPACK_PSTEDC_DECL(NAMES, NAMEL, TYPE) \
void ROKKO_GLOBAL(NAMES, NAMEL) (const char* compz, const int* n, TYPE* d, TYPE* e, \
                                 TYPE* Q, const int* iq, const int* jq, const int* descQ, \
                                 TYPE* work, const int* lwork, int* iwork, const int* liwork, int* info);

SCALAPACK_PSTEDC_DECL(psstedc, PSSTEDC, float);
SCALAPACK_PSTEDC_DECL(pdstedc, PDSTEDC, double);

#undef SCALAPACK_PSTEDC_DECL

#ifdef __cplusplus
}
#endif

#endif // ROKKO_SCALAPACK_SCALAPACK_INTERFACE_H


/**
 *
 * @file qwrapper_chegst.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 Hatem Ltaief
 * @date 2010-11-15
 * @generated c Tue Jan  7 11:44:59 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

#undef REAL
#define COMPLEX

/***************************************************************************//**
 *
 **/
void QUARK_CORE_chegst(Quark *quark, Quark_Task_Flags *task_flags,
                       int itype, PLASMA_enum uplo, int n,
                       PLASMA_Complex32_t *A, int lda,
                       PLASMA_Complex32_t *B, int ldb,
                       PLASMA_sequence *sequence, PLASMA_request *request,
                       int iinfo)
{
    QUARK_Insert_Task(quark, CORE_chegst_quark, task_flags,
        sizeof(int),                        &itype,      VALUE,
        sizeof(PLASMA_enum),                &uplo,      VALUE,
        sizeof(int),                        &n,         VALUE,
        sizeof(PLASMA_Complex32_t)*lda*n,    A,             INOUT,
        sizeof(int),                        &lda,       VALUE,
#ifdef COMPLEX
        sizeof(PLASMA_Complex32_t)*ldb*n,    B,             INOUT,
#else
        sizeof(PLASMA_Complex32_t)*ldb*n,    B,             INPUT,
#endif
        sizeof(int),                        &ldb,       VALUE,
        sizeof(PLASMA_sequence*),           &sequence,  VALUE,
        sizeof(PLASMA_request*),            &request,   VALUE,
        sizeof(int),                        &iinfo,     VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_chegst_quark = PCORE_chegst_quark
#define CORE_chegst_quark PCORE_chegst_quark
#endif
void CORE_chegst_quark(Quark *quark)
{
    int itype;
    PLASMA_enum uplo;
    int n;
    PLASMA_Complex32_t *A;
    int lda;
    PLASMA_Complex32_t *B;
    int ldb;
    PLASMA_sequence *sequence;
    PLASMA_request *request;
    int iinfo;

    int info;

    quark_unpack_args_10(quark, itype, uplo, n, A, lda, B, ldb, sequence, request, iinfo);
    info = LAPACKE_chegst_work(
        LAPACK_COL_MAJOR,
        itype,
        lapack_const(uplo),
        n, A, lda, B, ldb);
    if (sequence->status == PLASMA_SUCCESS && info != 0)
      plasma_sequence_flush(quark, sequence, request, iinfo+info);
}


/*
 *  vbHmm_template.c
 *  Template for original model to be analyzed by VB-HMM.
 *
 *  Created by OKAMOTO Kenji and SAKO Yasushi
 *  Copyright 2011
 *  Cellular Informatics Laboratory, Advance Science Institute, RIKEN, Japan.
 *  All rights reserved.
 *
 *  Ver. 1.0.0
 *  Last modified on 2011.04.19
 */

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

// Special functions is probably necessary.
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_psi.h>

#include "vbHmm_template.h"

// For random number generation.
#include "rand.h"

#ifdef _OPENMP
#include "omp.h"
#endif

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

static int isGlobalAnalysis = 0;

void setFunctions__(){
    commonFunctions funcs;
    funcs.newModelParameters    = newModelParameters__;
    funcs.freeModelParameters   = freeModelParameters__;
    funcs.newModelStats         = newModelStats__;
    funcs.freeModelStats        = freeModelStats__;
    funcs.initializeVbHmm       = initializeVbHmm__;
    funcs.pTilde_z1             = pTilde_z1__;
    funcs.pTilde_zn_zn1         = pTilde_zn_zn1__;
    funcs.pTilde_xn_zn          = pTilde_xn_zn__;
    funcs.calcStatsVars         = calcStatsVars__;
    funcs.maximization          = maximization__;
    funcs.varLowerBound         = varLowerBound__;
    funcs.reorderParameters     = reorderParameters__;
    funcs.outputResults         = outputResults__;
    setFunctions( funcs );
}

void setGFunctions__(){
    gCommonFunctions funcs;
    funcs.newModelParameters    = newModelParameters__;
    funcs.freeModelParameters   = freeModelParameters__;
    funcs.newModelStats         = newModelStats__;
    funcs.freeModelStats        = freeModelStats__;
    funcs.newModelStatsG        = newModelStatsG__;
    funcs.freeModelStatsG       = freeModelStatsG__;
    funcs.initializeVbHmmG      = initializeVbHmmG__;
    funcs.pTilde_z1             = pTilde_z1__;
    funcs.pTilde_zn_zn1         = pTilde_zn_zn1__;
    funcs.pTilde_xn_zn          = pTilde_xn_zn__;
    funcs.calcStatsVarsG        = calcStatsVarsG__;
    funcs.maximizationG         = maximizationG__;
    funcs.varLowerBoundG        = varLowerBoundG__;
    funcs.reorderParametersG    = reorderParametersG__;
    funcs.outputResultsG        = outputResultsG__;
    setGFunctions( funcs );
    isGlobalAnalysis = 1;
}

// Redirect output function to that for model-specific data.
void outputResults__( xn, gv, iv, logFP )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
FILE *logFP;
{
    output__Results( xn, gv, iv, logFP );
}

void outputResultsG__( xns, gv, ivs, logFP )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
FILE *logFP;
{
    output__ResultsG( xns, gv, ivs, logFP );
}

void *newModelParameters__( xn, sNo )
xnDataSet *xn;
int sNo;
{
    int i;
    tempParameters *p = (void*)malloc( sizeof(tempParameters) );

    p->uPiArr = (double*)malloc( sNo * sizeof(double) );
    p->sumUPi = 0.0;
    p->uAMat = (double**)malloc( sNo * sizeof(double*) );
    for( i = 0 ; i < sNo ; i++ ){
        p->uAMat[i] = (double*)malloc( sNo * sizeof(double) );
    }
    p->sumUAArr = (double*)malloc( sNo * sizeof(double) );

    p->avgPi = (double *)malloc( sNo * sizeof(double) );
    p->avgLnPi = (double *)malloc( sNo * sizeof(double) );
    p->avgA = (double **)malloc( sNo * sizeof(double*) );
    p->avgLnA = (double **)malloc( sNo * sizeof(double*) );
    for( i = 0 ; i < sNo ; i++ ){
        p->avgA[i] = (double *)malloc( sNo * sizeof(double) );
        p->avgLnA[i] = (double *)malloc( sNo * sizeof(double) );
    }

    return p;
}

void freeModelParameters__( p, xn, sNo )
void **p;
xnDataSet *xn;
int sNo;
{
    tempParameters *gp = *p;
    int i;

    free( gp->uPiArr );
    for( i = 0 ; i < sNo ; i++ ){
        free( gp->uAMat[i] );
    }
    free( gp->uAMat );
    free( gp->sumUAArr );

    free( gp->avgPi );
    free( gp->avgLnPi );
    for( i = 0 ; i < sNo ; i++ ){
        free( gp->avgA[i] );
        free( gp->avgLnA[i] );
    }
    free( gp->avgA );
    free( gp->avgLnA );

    free( *p );
    *p = NULL;
}

void *newModelStats__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    if( isGlobalAnalysis == 0 ){
        int sNo = gv->sNo;
        tempStats *s = (tempStats*)malloc( sizeof(tempStats) );

        int i;
        s->Ni = (double *)malloc( sNo * sizeof(double) );
        s->Nij = (double **)malloc( sNo * sizeof(double*) );
        for( i = 0 ; i < sNo ; i++ )
        {   s->Nij[i] = (double *)malloc( sNo * sizeof(double) );   }
        s->Nii = (double *)malloc( sNo * sizeof(double) );

        return s;

    } else {

        return NULL;

    }
}

void freeModelStats__( s, xn, gv, iv )
void **s;
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    if( isGlobalAnalysis == 0 ){
        int sNo = gv->sNo;
        tempStats *gs = *s;
        int i;
        free( gs->Ni );
        for( i = 0 ; i < sNo ; i++ )
        {   free( gs->Nij[i] );   }
        free( gs->Nij );
        free( gs->Nii );

        free( gs );
        *s = NULL;
    }
}

void *newModelStatsG__( xns, gv, ivs)
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    int sNo = gv->sNo;
    tempGlobalStats *gs = (tempGlobalStats*)malloc( sizeof(tempGlobalStats) );

    int i;
    gs->NiR = (double *)malloc( sNo * sizeof(double) );
    gs->NijR = (double **)malloc( sNo * sizeof(double*) );
    for( i = 0 ; i < sNo ; i++ )
    {   gs->NijR[i] = (double *)malloc( sNo * sizeof(double) );   }
    gs->NiiR = (double *)malloc( sNo * sizeof(double) );
    gs->z1iR = (double *)malloc( sNo * sizeof(double) );

    return gs;
}

void freeModelStatsG__( gs, xns, gv, ivs )
void **gs;
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    int sNo = gv->sNo;
    tempGlobalStats *ggs = *gs;
    int i;
    free( ggs->NiR );
    for( i = 0 ; i < sNo ; i++ )
    {   free( ggs->NijR[i] );   }
    free( ggs->NijR );
    free( ggs->NiiR );
    free( ggs->z1iR );

    free( *gs );
    *gs = NULL;
}

void initializeVbHmm__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // an example of hyperparameter initialization

    int sNo = gv->sNo;
    tempParameters *p = gv->params;

    int i, j;
    // hyper parameter for p( pi(i) )
    p->sumUPi = 0.0;
    for( i = 0 ; i < sNo ; i++ ){
        p->uPiArr[i] = 1.0;
        p->sumUPi += p->uPiArr[i];
    }

    // hyper parameter for p( A(i,j) )
    for( i = 0 ; i < sNo ; i++ ){
        p->sumUAArr[i] = 0.0;
        for( j = 0 ; j < sNo ; j++ ){
            if( j == i ){
                p->uAMat[i][j] = 5.0;
            } else {
                p->uAMat[i][j] = 1.0;
            }
            p->sumUAArr[i] += p->uAMat[i][j];
        }
    }

    initialize_indVars__( xn, gv, iv );

    calcStatsVars__( xn, gv, iv );
    maximization__( xn, gv, iv );
}

void initializeVbHmmG__( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    // an example of hyperparameter initialization

    int sNo = gv->sNo, rNo = xns->R;
    tempParameters *p = gv->params;

    int i, j, r;

    p->sumUPi = 0.0;
    for( i = 0 ; i < sNo ; i++ ){
        p->uPiArr[i] = 1.0;
        p->sumUPi += p->uPiArr[i];
    }

    for( i = 0 ; i < sNo ; i++ ){
        p->sumUAArr[i] = 0.0;
        for( j = 0 ; j < sNo ; j++ ){
            if( j == i ){
                p->uAMat[i][j] = 5.0;
            } else {
                p->uAMat[i][j] = 1.0;
            }
            p->sumUAArr[i] += p->uAMat[i][j];
        }
    }

    for( r = 0 ; r < rNo ; r++ ){
        initialize_indVars__( xns->xn[r], gv, ivs->indVars[r] );
    }

    calcStatsVarsG__( xns, gv, ivs );
    maximizationG__( xns, gv, ivs );
}

void initialize_indVars__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // an example of latent variable distribution

    size_t dLen = xn->N;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat;

    int i;
    size_t n;
    double sumPar;
    for( n = 0 ; n < dLen ; n++ ){
        sumPar = 0.0;
        for( i = 0 ; i < sNo ; i++ ){
            gmMat[n][i] = enoise(1.0) + 1.0;
            sumPar += gmMat[n][i];
        }
        for( i = 0 ; i < sNo ; i++ ){
            gmMat[n][i] /= sumPar;
        }
    }
}

xnDataSet *newXnDataSet__( filename )
const char *filename;
{
    xnDataSet *xn = (xnDataSet*)malloc( sizeof(xnDataSet) );
    xn->name = (char*)malloc( strlen(filename) + 2 );
    strncpy( xn->name, filename, strlen(filename)+1 );
    xn->data = (tempData*)malloc( sizeof(tempData) );
    tempData *d = (tempData*)xn->data;
    return xn;
}

void freeXnDataSet__( xn )
xnDataSet **xn;
{
    tempData *d = (tempData*)(*xn)->data;
    free( (*xn)->data );
    free( (*xn)->name );
    free( *xn );
    *xn = NULL;
}

double pTilde_z1__( i, params )
int i;
void *params;
{
    // Return the value for p(z_{1i}|pi_i) for given i.

    // for common HMM
    tempParameters *p = (tempParameters*)params;
    return exp( p->avgLnPi[i] );
}

double pTilde_zn_zn1__( i, j, params )
int i, j;
void *params;
{
    // Return the value for p(z_{nj}|z_{n-1,i},theta) for given i and j.

    // for common HMM
    tempParameters *p = (tempParameters*)params;
    return exp( p->avgLnA[i][j] );
}

double pTilde_xn_zn__( xnWv, n, i, params )
xnDataSet *xnWv;
size_t n;
int i;
void *params;
{
    // Return the value for p(x_{mi}|z_{ni},phi) for given i.

    // return emission probability for the model.
    tempParameters *p = (tempParameters*)params;
    return 0.0;
}

void calcStatsVars__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // Execute calculation of statistics, which may be necessary for M-step.

    // calculation of stats for common HMM
    tempStats *s = (tempStats*)iv->stats;
    size_t dLen = xn->N;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat, ***xiMat = iv->xiMat;
    double *Nii = s->Nii, **Nij = s->Nij, *Ni = s->Ni;
    size_t n;
    int i, j;

    for( i = 0 ; i < sNo ; i++ ){
        Ni[i]   = 1e-10;
        Nii[i]  = 1e-10;
        for( j = 0 ; j < sNo ; j++ ){
            Nij[i][j] = 1e-10;
        }

        for( n = 0 ; n < dLen ; n++ ){
            Ni[i]   += gmMat[n][i];
            for( j = 0 ; j < sNo ; j++ ){
                Nii[i]    += xiMat[n][i][j];
                Nij[i][j] += xiMat[n][i][j];
            }
        }
    }
}

void calcStatsVarsG__( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    // Execute calculation of statistics for global analysis, which may be necessary for M-step.

    // calculation of stats for global analysis of common HMM
    tempGlobalStats *gs = (tempGlobalStats*)ivs->stats;
    int sNo = gv->sNo, rNo = xns->R;
    double **gmMat, ***xiMat;
    double *NiiR = gs->NiiR, **NijR = gs->NijR, *NiR = gs->NiR, *z1iR = gs->z1iR;
    size_t dLen, n;
    int i, j, r;

    for( i = 0 ; i < sNo ; i++ ){
        NiR[i]   = 1e-10;
        NiiR[i]  = 1e-10;
        for( j = 0 ; j < sNo ; j++ ){
            NijR[i][j] = 1e-10;
        }
        z1iR[i] = 1e-10;
    }
    for( r = 0 ; r < rNo ; r++ ){
        dLen = xns->xn[r]->N;
        gmMat = ivs->indVars[r]->gmMat;
        xiMat = ivs->indVars[r]->xiMat;
        for( i = 0 ; i < sNo ; i++ ){
            z1iR[i] += gmMat[0][i];
            for( n = 0 ; n < dLen ; n++ ){
                NiR[i]   += gmMat[n][i];
                for( j = 0 ; j < sNo ; j++ ){
                    NiiR[i]  += xiMat[n][i][j];
                    NijR[i][j] += xiMat[n][i][j];
                }
            }
        }
    }
}

void maximization__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // Calculation of M-step, depending on the model.

    // calculation of M-step for common HMM
    tempParameters *p = (tempParameters*)gv->params;
    tempStats *s = (tempStats*)iv->stats;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;
    double *Nii = s->Nii, **Nij = s->Nij;
    int i, j;

    for( i = 0 ; i < sNo ; i++ ){
        avgPi[i] = ( uPiArr[i] + gmMat[0][i] ) / ( sumUPi + 1.0 );
        avgLnPi[i] = gsl_sf_psi( uPiArr[i] + gmMat[0][i] ) - gsl_sf_psi( sumUPi + 1.0 );

        for( j = 0 ; j < sNo ; j++ ){
            avgA[i][j] = ( uAMat[i][j] + Nij[i][j] ) / ( sumUAArr[i] + Nii[i] );
            avgLnA[i][j] = gsl_sf_psi( uAMat[i][j] + Nij[i][j] ) - gsl_sf_psi( sumUAArr[i] + Nii[i] );
        }
    }
}

void maximizationG__( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    // Calculation of M-step for global analysis, depending on the model.

    // calculation of stats for global analysis of common HMM
    tempParameters *p = (tempParameters*)gv->params;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;
    tempGlobalStats *gs = (tempGlobalStats*)ivs->stats;
    double *NiiR = gs->NiiR, **NijR = gs->NijR, *z1iR = gs->z1iR, dR = (double)(xns->R);
    int sNo = gv->sNo;
    int i, j;

    for( i = 0 ; i < sNo ; i++ ){
        avgPi[i] = ( uPiArr[i] + z1iR[i] ) / ( sumUPi + dR );
        avgLnPi[i] = gsl_sf_psi( uPiArr[i] + z1iR[i] ) - gsl_sf_psi( sumUPi + dR );

        for( j = 0 ; j < sNo ; j++ ){
            avgA[i][j] = ( uAMat[i][j] + NijR[i][j] ) / ( sumUAArr[i] + NiiR[i] );
            avgLnA[i][j] = gsl_sf_psi( uAMat[i][j] + NijR[i][j] ) - gsl_sf_psi( sumUAArr[i] + NiiR[i] );
        }
    }
}

double varLowerBound__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // Calculation of lower bound, depending on the model.

    // calculation of lower bound of common HMM
    tempParameters *p = (tempParameters*)gv->params;
    tempStats *s = (tempStats*)iv->stats;
    size_t dLen = xn->N;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat, *cn = iv->cn;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double *avgLnPi = p->avgLnPi, **avgLnA = p->avgLnA;
    double *Nii = s->Nii, **Nij = s->Nij;
    size_t n;
    int i, j;

    double lnpPi = gsl_sf_lngamma(sumUPi);
    double lnpA = 0.0;
    double lnpPhi = 0.0;            // ln p(phi) for model-specific parameters
    double lnqPi = gsl_sf_lngamma(sumUPi + 1.0);
    double lnqA = 0.0;
    double lnqPhi = 0.0;            // ln q(phi) for model-specific parameters
    for( i = 0 ; i < sNo ; i++ ){
        lnpPi += (uPiArr[i]-1.0) * avgLnPi[i] - gsl_sf_lngamma(uPiArr[i]);

        lnqPi += (uPiArr[i]+gmMat[0][i]-1.0) * (gsl_sf_psi(uPiArr[i]+gmMat[0][i]) - gsl_sf_psi(sumUPi+1.0));
        lnqPi -= gsl_sf_lngamma(uPiArr[i] + gmMat[0][i]);

        lnpA += gsl_sf_lngamma(sumUAArr[i]);
        lnqA += gsl_sf_lngamma(sumUAArr[i] + Nii[i]);
        for( j = 0 ; j < sNo ; j++ ){
            lnpA += (uAMat[i][j]-1.0)*avgLnA[i][j] - gsl_sf_lngamma(uAMat[i][j]);

            lnqA += (uAMat[i][j] + Nij[i][j] - 1.0) * (gsl_sf_psi(uAMat[i][j]+Nij[i][j]) - gsl_sf_psi(sumUAArr[i]+Nii[i]));
            lnqA -= gsl_sf_lngamma( uAMat[i][j] + Nij[i][j] );
        }
    }

    double lnpX = 0.0;
    for( n = 0 ; n < dLen ; n++ ){
        lnpX += log( cn[n] );
    }

    double val;
    val  = lnpPi + lnpA + lnpPhi;
    val -= lnqPi + lnqA + lnqPhi;
    val += lnpX;
    val += log(gsl_sf_fact(sNo));

    return val;
}

double varLowerBoundG__( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    // Calculation of lower bound for global analysis, depending on the model.

    // calculation of lower bound for global analysis of common HMM
    int sNo = gv->sNo, rNo = xns->R;
    tempParameters *p = (tempParameters*)gv->params;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double *avgLnPi = p->avgLnPi, **avgLnA = p->avgLnA;
    tempGlobalStats *gs = (tempGlobalStats*)ivs->stats;
    double *NiiR = gs->NiiR, **NijR = gs->NijR, *z1iR = gs->z1iR, dR = (double)xns->R;
    size_t n;
    int i, j, r;

    double lnpPi = gsl_sf_lngamma(sumUPi);
    double lnpA = 0.0;
    double lnpPhi = 0.0;            // ln p(phi) for model-specific parameters
    double lnqPi = gsl_sf_lngamma(sumUPi + dR);
    double lnqA = 0.0;
    double lnqPhi = 0.0;            // ln q(phi) for model-specific parameters
    for( i = 0 ; i < sNo ; i++ ){
        lnpPi += (uPiArr[i]-1.0) * avgLnPi[i] - gsl_sf_lngamma(uPiArr[i]);

        lnqPi += (uPiArr[i]+z1iR[i]-1.0) * (gsl_sf_psi(uPiArr[i]+z1iR[i]) - gsl_sf_psi(sumUPi+dR));
        lnqPi -= gsl_sf_lngamma(uPiArr[i] + z1iR[i]);

        lnpA += gsl_sf_lngamma(sumUAArr[i]);
        lnqA += gsl_sf_lngamma(sumUAArr[i] + NiiR[i]);
        for( j = 0 ; j < sNo ; j++ ){
            lnpA += (uAMat[i][j]-1.0)*avgLnA[i][j] - gsl_sf_lngamma(uAMat[i][j]);

            lnqA += (uAMat[i][j] + NijR[i][j] - 1.0) * (gsl_sf_psi(uAMat[i][j]+NijR[i][j]) - gsl_sf_psi(sumUAArr[i]+NiiR[i]));
            lnqA -= gsl_sf_lngamma( uAMat[i][j] + NijR[i][j] );
        }
    }

    double lnpX = 0.0;
    for( r = 0 ; r < rNo ; r++ ){
        size_t dLen = xns->xn[r]->N;
        for( n = 0 ; n < dLen ; n++ ){
            lnpX += log( ivs->indVars[r]->cn[n] );
        }
    }

    double val;
    val  = lnpPi + lnpA + lnpPhi;
    val -= lnqPi + lnqA + lnqPhi;
    val += lnpX;
    val += log(gsl_sf_fact(sNo));

    return val;
}

void reorderParameters__( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    // Reorder states in the final result, for example, in the order of intensity.

    // an example for common HMM.
    tempParameters *p = (tempParameters*)gv->params;
    tempStats *s = (tempStats*)iv->stats;
    size_t dLen = xn->N;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat, ***xiMat = iv->xiMat;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;
    double *Ni = s->Ni;
    size_t n;
    int i, j;

    int *index = (int*)malloc( sNo * sizeof(int) );
    double *store = (double*)malloc( sNo * sizeof(double) );
    double **s2D = (double**)malloc( sNo * sizeof(double*) );
    for( i = 0 ; i < sNo ; i++ )
    {   s2D[i] = (double*)malloc( MAX(sNo,2) * sizeof(double) );   }

    // index indicates order of avgPi values (0=biggest avgMu -- sNo=smallest avgMu).
    for( i = 0 ; i < sNo ; i++ ){
        index[i] = sNo - 1;
        for( j = 0 ; j < sNo ; j++ ){
            if( j != i ){
                if( avgPi[i] < avgPi[j] ){
                    index[i]--;
                } else if( avgPi[i] == avgPi[j] ){
                    if( j > i )
                    {   index[i]--;   }
                }
            }
        }
    }

    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = avgPi[i];   }
    for( i = 0 ; i < sNo ; i++ ){   avgPi[i] = store[i];   }

    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = avgLnPi[i];   }
    for( i = 0 ; i < sNo ; i++ ){   avgLnPi[i] = store[i];   }

    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = avgA[i][j];   }
    }
    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   avgA[i][j] = s2D[i][j];   }
    }

    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = avgLnA[i][j];   }
    }
    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   avgLnA[i][j] = s2D[i][j];   }
    }

    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = Ni[i];   }
    for( i = 0 ; i < sNo ; i++ ){   Ni[i] = store[i];   }

    for( n = 0 ; n < dLen ; n++ ){
        for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = gmMat[n][i];   }
        for( i = 0 ; i < sNo ; i++ ){   gmMat[n][i] = store[i];   }
    }

    for( n = 0 ; n < dLen ; n++ ){
        for( j = 0 ; j < sNo ; j++ ){
            for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = xiMat[n][i][j];   }
        }
        for( j = 0 ; j < sNo ; j++ ){
            for( i = 0 ; i < sNo ; i++ ){   xiMat[n][i][j] = s2D[i][j];   }
        }
    }

    for( i = 0 ; i < sNo ; i++ ){   free( s2D[i] );   }
    free( s2D );
    free( store );
    free( index );
}

void reorderParametersG__( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    // Reorder states in the final result, for example, in the order of intensity.

    // an example for global analysis of common HMM.
    size_t dLen;
    int sNo = gv->sNo, rNo = xns->R;
    tempParameters *p = (tempParameters*)gv->params;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;

    size_t n;
    int i, j, r;

    int *index = (int*)malloc( sNo * sizeof(int) );
    double *store = (double*)malloc( sNo * sizeof(double) );
    double **s2D = (double**)malloc( sNo * sizeof(double*) );
    for( i = 0 ; i < sNo ; i++ )
    {   s2D[i] = (double*)malloc( MAX(sNo,2) * sizeof(double) );   }

    // index indicates order of avgPi values (0=biggest avgMu -- sNo=smallest avgMu).
    for( i = 0 ; i < sNo ; i++ ){
        index[i] = sNo - 1;
        for( j = 0 ; j < sNo ; j++ ){
            if( j != i ){
                if( avgPi[i] < avgPi[j] ){
                    index[i]--;
                } else if( avgPi[i] == avgPi[j] ){
                    if( j > i )
                    {   index[i]--;   }
                }
            }
        }
    }

    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = avgPi[i];   }
    for( i = 0 ; i < sNo ; i++ ){   avgPi[i] = store[i];   }

    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = avgLnPi[i];   }
    for( i = 0 ; i < sNo ; i++ ){   avgLnPi[i] = store[i];   }

    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = avgA[i][j];   }
    }
    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   avgA[i][j] = s2D[i][j];   }
    }

    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = avgLnA[i][j];   }
    }
    for( j = 0 ; j < sNo ; j++ ){
        for( i = 0 ; i < sNo ; i++ ){   avgLnA[i][j] = s2D[i][j];   }
    }

    double *NiR = ((tempGlobalStats*)ivs->stats)->NiR;
    for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = NiR[i];   }
    for( i = 0 ; i < sNo ; i++ ){   NiR[i] = store[i];   }

    for( r = 0 ; r < rNo ; r++ ){
        double **gmMat = ivs->indVars[r]->gmMat;
        dLen = xns->xn[r]->N;
        for( n = 0 ; n < dLen ; n++ ){
            for( i = 0 ; i < sNo ; i++ ){   store[index[i]] = gmMat[n][i];   }
            for( i = 0 ; i < sNo ; i++ ){   gmMat[n][i] = store[i];   }
        }
    }

    for( r = 0 ; r < rNo ; r++ ){
        double ***xiMat = ivs->indVars[r]->xiMat;
        dLen = xns->xn[r]->N;
        for( n = 0 ; n < dLen ; n++ ){
            for( j = 0 ; j < sNo ; j++ ){
                for( i = 0 ; i < sNo ; i++ ){   s2D[index[i]][index[j]] = xiMat[n][i][j];   }
            }
            for( j = 0 ; j < sNo ; j++ ){
                for( i = 0 ; i < sNo ; i++ ){   xiMat[n][i][j] = s2D[i][j];   }
            }
        }
    }

    for( i = 0 ; i < sNo ; i++ ){   free( s2D[i] );   }
    free( s2D );
    free( store );
    free( index );
}

void output__Results( xn, gv, iv, logFP )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
FILE *logFP;
{
    // Output the final result (after reordering) in any format, e.g. stdout, stderr or files.

    // an example for common HMM parameters.
    tempParameters *p = (tempParameters*)gv->params;
    int sNo = gv->sNo;

    int i, j;
    fprintf(logFP, "  results: K = %d \n", sNo);

    fprintf(logFP, "   pi: ( %g", p->avgPi[0]);
    for( i = 1 ; i < sNo ; i++ ){
        fprintf(logFP, ", %g", p->avgPi[i]);
    }
    fprintf(logFP, " ) \n");

    fprintf(logFP, "   A_matrix: [");
    for( i = 0 ; i < sNo ; i++ ){
        fprintf(logFP, " ( %g", p->avgA[i][0]);
        for( j = 1 ; j < sNo ; j++ )
        {   fprintf(logFP, ", %g", p->avgA[i][j]);   }
        fprintf(logFP, ")");
    }
    fprintf(logFP, " ] \n\n");

    char fn[256];
    FILE *fp;
    size_t n;

    sprintf( fn, "%s.param%03d", xn->name, sNo );
    if( (fp = fopen( fn, "w")) != NULL ){
        fprintf(fp, "pi");
        for( i = 0 ; i < sNo ; i++ )
        {   fprintf(fp, ", A%dx", i);   }
        fprintf(fp, "\n");

        for( i = 0 ; i < sNo ; i++ ){
            fprintf(fp, "%g", p->avgPi[i]);
            for( j = 0 ; j < sNo ; j++ )
            {   fprintf(fp, ", %g", p->avgA[j][i]);   }
            fprintf(fp, "\n");
        }
        fclose(fp);
    }

    sprintf( fn, "%s.Lq%03d", xn->name, sNo );
    if( (fp = fopen( fn, "w")) != NULL ){
        for( n = 0 ; n < gv->iteration ; n++ ){
            fprintf( fp, "%24.20e\n", gv->LqArr[n] );
        }
        fclose(fp);
    }

    sprintf( fn, "%s.maxS%03d", xn->name, sNo );
    if( (fp = fopen( fn, "w")) != NULL ){
        for( n = 0 ; n < xn->N ; n++ ){
            fprintf( fp, "%d\n", iv->stateTraj[n] );
        }
        fclose(fp);
    }

}

void output__ResultsG( xns, gv, ivs, logFP )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
FILE *logFP;
{
    // Output the final result (after reordering) in any format, e.g. stdout, stderr or files.

    // an example for parameters of global analysis of common HMM.
    int sNo = gv->sNo, rNo = xns->R;
    tempParameters *p = (tempParameters*)gv->params;
    int i, j, r;

    fprintf(logFP, "  results: K = %d \n", sNo);

    fprintf(logFP, "   pi: ( %g", p->avgPi[0]);
    for( i = 1 ; i < sNo ; i++ ){
        fprintf(logFP, ", %g", p->avgPi[i]);
    }
    fprintf(logFP, " ) \n");

    fprintf(logFP, "   A_matrix: [");
    for( i = 0 ; i < sNo ; i++ ){
        fprintf(logFP, " ( %g", p->avgA[i][0]);
        for( j = 1 ; j < sNo ; j++ )
        {   fprintf(logFP, ", %g", p->avgA[i][j]);   }
        fprintf(logFP, ")");
    }
    fprintf(logFP, " ] \n\n");

    char fn[256];
    FILE *fp;
    size_t n;

    sprintf( fn, "%s.param%03d", xns->xn[0]->name, sNo );
    if( (fp = fopen( fn, "w")) != NULL ){
        fprintf(fp, "pi");
        for( i = 0 ; i < sNo ; i++ )
        {   fprintf(fp, ", A%dx", i);   }
        fprintf(fp, "\n");

        for( i = 0 ; i < sNo ; i++ ){
            fprintf(fp, "%g", p->avgPi[i]);
            for( j = 0 ; j < sNo ; j++ )
            {   fprintf(fp, ", %g", p->avgA[j][i]);   }
            fprintf(fp, "\n");
        }
        fclose(fp);
    }

    sprintf( fn, "%s.Lq%03d", xns->xn[0]->name, sNo );
    if( (fp = fopen( fn, "w")) != NULL ){
        for( n = 0 ; n < gv->iteration ; n++ ){
            fprintf( fp, "%24.20e\n", gv->LqArr[n] );
        }
        fclose(fp);
    }

    for( r = 0 ; r < rNo ; r++ ){
        xnDataSet *xn = xns->xn[r];
        indVars *iv = ivs->indVars[r];

        sprintf( fn, "%s.maxS%03d", xn->name, sNo );
        if( (fp = fopen( fn, "w")) != NULL ){
            for( n = 0 ; n < xn->N ; n++ ){
                fprintf( fp, "%d\n", iv->stateTraj[n] );
            }
            fclose(fp);
        }
    }
}

//


/*
 *  libDefs.h
 *  This file and its associated source file contain any functions and
 *   statements (within the actual program) that need to be modified
 *   when adding a new library. This includes any work done on complex
 *   numbers, FFT planning and execution, and would also contain the
 *   definition of the appropriate MPI type to represent the complex
 *   number, except that I decided to assume they were all just two
 *   MPI_DOUBLEs. (Bit compatability can be verified.)
 *
 * Defining HAS_AUTO in compilation is an instruction to use the parallel
 *  version of the library as well.
 *
 * We use the less eye-friendly version of the C complex number type
 *  to avoid namespace collisions -- complex is equivalent to _Complex.
 *
 *  Created by Ian Kirker on 14/04/2008.
 *
 */

#ifndef HEADER_LIBDEFS
#define HEADER_LIBDEFS

#include <complex.h>
#include <mpi.h>

#ifndef FFT_fftw2
#ifndef FFT_fftw3
#ifndef FFT_mkl
#ifndef FFT_essl
#ifndef FFT_acml
#define FFT_fftw3 /* Default to make test building easier. */
#endif
#endif
#endif
#endif
#endif

/* Include FFT library of choice */
#ifdef FFT_fftw2
	#ifdef FFTW_TYPE_SPECIFIED
		#include <dfftw.h>
		#ifdef HAS_AUTO
			#include <dfftw_mpi.h>
		#endif
	#else
		#include <fftw.h>
		#ifdef HAS_AUTO
			#include <fftw_mpi.h>
		#endif
	#endif

	#define FFT_NAME "fftw2"
	#define FFT_fftw2_LIBKEY
	typedef fftw_complex complexType;
	typedef fftw_plan oneDplanType;
	typedef fftwnd_plan twoDplanType;
	#ifdef HAS_AUTO
		typedef fftwnd_mpi_plan parallelPlanType;
	#endif
#endif

#ifdef FFT_fftw3
	#include <fftw3.h>
	#define FFT_NAME "fftw3"
	#define FFT_fftw3_LIBKEY 1

	typedef fftw_complex complexType;
	typedef fftw_plan planType;
	#ifdef HAS_AUTO
		typedef fftw_plan parallelPlanType;
	#endif
#endif

#ifdef FFT_essl
	#include <essl.h>
	#define FFT_NAME "essl"
	#define FFT_essl_LIBKEY 2

	typedef dcmplx complexType;
	typedef double planType[20000];

	#ifdef HAS_AUTO
		#include <pessl.h>
		#include <Cblacs.h>
		/* This refers to the BLACS handle you get back from the grid init calls. */
		typedef int parallelPlanType;
	#endif
#endif

#ifdef FFT_acml
	#include <acml.h>
	#define FFT_NAME "acml"
	#define FFT_acml_LIBKEY 3
	typedef doublecomplex complexType;

	/* In ACML, the closest you can get to making a plan is to run
	 * a transform and have it save the data in the array it uses as a buffer,
	 * so we alloc some space later but say that the planType is a pointer now.
	 */
	typedef complexType *planType;
#endif

#ifdef FFT_mkl
	#include <mkl_dfti.h>
	#define FFT_NAME "mkl"
	#define FFT_mkl_LIBKEY 4
	typedef _Complex double complexType;
	typedef DFTI_DESCRIPTOR_HANDLE planType;
	#ifdef HAS_AUTO
		typedef DFTI_DESCRIPTOR_DM_HANDLE parallelPlanType;
	#endif
#endif

void prepareFFTs(complexType *data, int decomp, int use2DFFT, int extent, int domainSize[2], MPI_Comm commColumn);
void performFFTset(complexType *data, complexType *buffer, int extent, int domainSize[2]);
void perform2DFFT(complexType *data, complexType *buffer, int extent, int domainSize[2]);
void performAutomatic3DFFT(complexType *data, complexType *buffer, int extent, int domainSize[2]);
void cleanUpFFTs(int decomp);
int libraryHasAutomaticDecomposition();

void printLib();
void complexSwap(complexType *, complexType *);
void complexSet(complexType *z, double real, double imag);
void complexAssign( complexType *z, complexType w );
double complexAbsNorm(complexType z, complexType w);
_Complex double complexNative( complexType z );

#endif


/* specfunc/bessel_I0.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 <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_bessel.h"

#include "error.h"

#include "chebyshev.h"
#include "cheb_eval.c"

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

/* based on SLATEC besi0 */

/* chebyshev expansions

 series for bi0        on the interval  0.	    to  9.00000d+00
					with weighted error   2.46e-18
					 log weighted error  17.61
			       significant figures required  17.90
				    decimal places required  18.15

 series for ai0        on the interval  1.25000d-01 to  3.33333d-01
					with weighted error   7.87e-17
					 log weighted error  16.10
			       significant figures required  14.69
				    decimal places required  16.76

 series for ai02       on the interval  0.	    to  1.25000d-01
					with weighted error   3.79e-17
					 log weighted error  16.42
			       significant figures required  14.86
				    decimal places required  17.09
*/

static double bi0_data[12] = {
  -.07660547252839144951,
  1.92733795399380827000,
   .22826445869203013390,
   .01304891466707290428,
   .00043442709008164874,
   .00000942265768600193,
   .00000014340062895106,
   .00000000161384906966,
   .00000000001396650044,
   .00000000000009579451,
   .00000000000000053339,
   .00000000000000000245
};
static cheb_series bi0_cs = {
  bi0_data,
  11,
  -1, 1,
  11
};

static double ai0_data[21] = {
   .07575994494023796,
   .00759138081082334,
   .00041531313389237,
   .00001070076463439,
  -.00000790117997921,
  -.00000078261435014,
   .00000027838499429,
   .00000000825247260,
  -.00000001204463945,
   .00000000155964859,
   .00000000022925563,
  -.00000000011916228,
   .00000000001757854,
   .00000000000112822,
  -.00000000000114684,
   .00000000000027155,
  -.00000000000002415,
  -.00000000000000608,
   .00000000000000314,
  -.00000000000000071,
   .00000000000000007
};
static cheb_series ai0_cs = {
  ai0_data,
  20,
  -1, 1,
  13
};

static double ai02_data[22] = {
   .05449041101410882,
   .00336911647825569,
   .00006889758346918,
   .00000289137052082,
   .00000020489185893,
   .00000002266668991,
   .00000000339623203,
   .00000000049406022,
   .00000000001188914,
  -.00000000003149915,
  -.00000000001321580,
  -.00000000000179419,
   .00000000000071801,
   .00000000000038529,
   .00000000000001539,
  -.00000000000004151,
  -.00000000000000954,
   .00000000000000382,
   .00000000000000176,
  -.00000000000000034,
  -.00000000000000027,
   .00000000000000003
};
static cheb_series ai02_cs = {
  ai02_data,
  21,
  -1, 1,
  11
};

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

int gsl_sf_bessel_I0_scaled_e(const double x, gsl_sf_result * result)
{
  double y = fabs(x);

  /* CHECK_POINTER(result) */

  if(y < 2.0 * GSL_SQRT_DBL_EPSILON) {
    result->val = 1.0 - y;
    result->err = 0.5*y*y;
    return GSL_SUCCESS;
  }
  else if(y <= 3.0) {
    const double ey = exp(-y);
    gsl_sf_result c;
    cheb_eval_e(&bi0_cs, y*y/4.5-1.0, &c);
    result->val = ey * (2.75 + c.val);
    result->err = GSL_DBL_EPSILON * fabs(result->val) + ey * c.err;
    return GSL_SUCCESS;
  }
  else if(y <= 8.0) {
    const double sy = sqrt(y);
    gsl_sf_result c;
    cheb_eval_e(&ai0_cs, (48.0/y-11.0)/5.0, &c);
    result->val  = (0.375 + c.val) / sy;
    result->err  = 2.0 * GSL_DBL_EPSILON * (0.375 + fabs(c.val)) / sy;
    result->err += c.err / sy;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    const double sy = sqrt(y);
    gsl_sf_result c;
    cheb_eval_e(&ai02_cs, 16.0/y-1.0, &c);
    result->val = (0.375 + c.val) / sy;
    result->err  = 2.0 * GSL_DBL_EPSILON * (0.375 + fabs(c.val)) / sy;
    result->err += c.err / sy;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
}

int gsl_sf_bessel_I0_e(const double x, gsl_sf_result * result)
{
  double y = fabs(x);

  /* CHECK_POINTER(result) */

  if(y < 2.0 * GSL_SQRT_DBL_EPSILON) {
    result->val = 1.0;
    result->err = 0.5*y*y;
    return GSL_SUCCESS;
  }
  else if(y <= 3.0) {
    gsl_sf_result c;
    cheb_eval_e(&bi0_cs, y*y/4.5-1.0, &c);
    result->val  = 2.75 + c.val;
    result->err  = GSL_DBL_EPSILON * (2.75 + fabs(c.val));
    result->err += c.err;
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else if(y < GSL_LOG_DBL_MAX - 1.0) {
    const double ey = exp(y);
    gsl_sf_result b_scaled;
    gsl_sf_bessel_I0_scaled_e(x, &b_scaled);
    result->val  = ey * b_scaled.val;
    result->err  = ey * b_scaled.err + y*GSL_DBL_EPSILON*fabs(result->val);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    OVERFLOW_ERROR(result);
  }
}

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

#include "eval.h"

double gsl_sf_bessel_I0_scaled(const double x)
{
  EVAL_RESULT(gsl_sf_bessel_I0_scaled_e(x, &result); )
}

double gsl_sf_bessel_I0(const double x)
{
  EVAL_RESULT(gsl_sf_bessel_I0_e(x, &result); )
}


#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <gbpLib.h>
#include <gbpRNG.h>
#include <gbpMCMC.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_fit.h>
#include <gsl/gsl_interp.h>

void init_MCMC(MCMC_info * MCMC,
               const char *problem_name,
               void *      params,
               int (*f)(double *, MCMC_info *, double **),
               int     n_P,
               double *P_init,
               char ** P_names,
               double *P_limit_min,
               double *P_limit_max,
               int     n_arrays,
               ...) {
    int     i_P;
    int     i_array;
    int     i;
    FILE *  ft, *ft_restart;
    char    test_dir[256], test_restart[256];
    va_list vargs;
    va_start(vargs, n_arrays);

    SID_log("Initializing MCMC structure...", SID_LOG_OPEN);

    // Set defaults to bare minimums
    MCMC->n_avg                 = 100;
    MCMC->n_iterations_burn     = 4;
    MCMC->n_iterations          = 8;
    MCMC->n_thin                = 1;
    MCMC->coverage_size         = 100;
    MCMC->flag_autocor_on       = GBP_FALSE;
    MCMC->flag_integrate_on     = GBP_FALSE;
    MCMC->flag_analysis_on      = GBP_TRUE;
    MCMC->first_map_call        = GBP_TRUE;
    MCMC->first_link_call       = GBP_TRUE;
    MCMC->flag_init_chain       = GBP_TRUE;
    MCMC->first_chain_call      = GBP_TRUE;
    MCMC->first_parameter_call  = GBP_TRUE;
    MCMC->first_likelihood_call = GBP_TRUE;
    MCMC->ln_likelihood_last    = 0.;
    MCMC->ln_likelihood_new     = 0.;
    MCMC->ln_likelihood_chain   = 0.;
    MCMC->P_init                = NULL;
    MCMC->P_new                 = NULL;
    MCMC->P_last                = NULL;
    MCMC->P_chain               = NULL;
    MCMC->P_limit_min           = NULL;
    MCMC->P_limit_max           = NULL;
    MCMC->P_min                 = NULL;
    MCMC->P_max                 = NULL;
    MCMC->P_avg                 = NULL;
    MCMC->dP_avg                = NULL;
    MCMC->P_best                = NULL;
    MCMC->P_peak                = NULL;
    MCMC->P_lo_68               = NULL;
    MCMC->P_hi_68               = NULL;
    MCMC->P_lo_95               = NULL;
    MCMC->P_hi_95               = NULL;
    MCMC->n_M                   = NULL;
    MCMC->M_new                 = NULL;
    MCMC->M_last                = NULL;
    MCMC->DS                    = NULL;
    MCMC->last                  = NULL;
    MCMC->V                     = NULL;
    MCMC->m                     = NULL;
    MCMC->b                     = NULL;
    MCMC->RNG                   = NULL;
    MCMC->params                = NULL;
    MCMC->temperature           = 1.0;
    MCMC->n_DS                  = 0;
    MCMC->n_M_total             = 0;
    MCMC->n_fail                = 0;
    MCMC->n_success             = 0;
    MCMC->n_propositions        = 0;
    MCMC->n_map_calls           = 0;

    // Process the passed arguments
    MCMC->map_P_to_M                 = f;
    MCMC->compute_MCMC_ln_likelihood = compute_MCMC_ln_likelihood_default;
    MCMC->params                     = params;
    MCMC->n_P                        = n_P;
    sprintf(MCMC->problem_name, "%s", problem_name);
    MCMC->P_names       = (char **)SID_malloc(sizeof(char *) * MCMC->n_P);
    MCMC->P_name_length = 0;
    for(i_P = 0; i_P < n_P; i_P++) {
        MCMC->P_names[i_P] = (char *)SID_malloc(sizeof(char) * MCMC_NAME_SIZE);
        sprintf(MCMC->P_names[i_P], "%s", P_names[i_P]);
        MCMC->P_name_length = GBP_MAX((size_t)(MCMC->P_name_length), strlen(MCMC->P_names[i_P]));
    }
    sprintf(MCMC->P_name_format, "%%-%ds", MCMC->P_name_length);

    // Initialize the MCMC mode and set things associated with it
    set_MCMC_mode(MCMC, MCMC_MODE_DEFAULT); // MCMC->my_chain is set here

    // Set parameter arrays and limits
    MCMC->P_init      = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    MCMC->P_new       = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    MCMC->P_last      = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    MCMC->P_chain     = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    MCMC->P_limit_min = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    MCMC->P_limit_max = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
    if(P_limit_min == NULL) {
        for(i_P = 0; i_P < n_P; i_P++)
            MCMC->P_limit_min[i_P] = -DBL_MAX * 1e-3;
    } else {
        for(i_P = 0; i_P < n_P; i_P++)
            MCMC->P_limit_min[i_P] = P_limit_min[i_P];
    }
    if(P_limit_max == NULL) {
        for(i_P = 0; i_P < n_P; i_P++)
            MCMC->P_limit_max[i_P] = DBL_MAX * 1e-3;
    } else {
        for(i_P = 0; i_P < n_P; i_P++)
            MCMC->P_limit_max[i_P] = P_limit_max[i_P];
    }

    // Set parameter initial values
    memcpy(MCMC->P_init, P_init, (size_t)MCMC->n_P * sizeof(double));
    memcpy(MCMC->P_new, P_init, (size_t)MCMC->n_P * sizeof(double));
    memcpy(MCMC->P_last, P_init, (size_t)MCMC->n_P * sizeof(double));
    memcpy(MCMC->P_chain, P_init, (size_t)MCMC->n_P * sizeof(double));

    // Set arrays
    MCMC->n_arrays = n_arrays;
    if(n_arrays > 0) {
        MCMC->array      = (double **)SID_malloc(sizeof(double *) * MCMC->n_arrays);
        MCMC->array_name = (char **)SID_malloc(sizeof(char *) * MCMC->n_arrays);
        for(i_array = 0; i_array < n_arrays; i_array++) {
            MCMC->array[i_array]      = (double *)SID_malloc(sizeof(double) * MCMC->n_P);
            MCMC->array_name[i_array] = (char *)SID_malloc(sizeof(char) * MCMC_NAME_SIZE);
            memcpy(MCMC->array[i_array], (double *)va_arg(vargs, double *), (size_t)(MCMC->n_P) * sizeof(double));
            sprintf(MCMC->array_name[i_array], "%s", (char *)va_arg(vargs, char *));
        }
    } else
        MCMC->array = NULL;

    // Set autotune defaults (if needed)
    if(SID_CHECK_BITFIELD_SWITCH(MCMC->mode, MCMC_MODE_AUTOTUNE))
        set_MCMC_autotune(MCMC, -1., -1., -1., -1, -1, -1, -1); // Negatives mean use defaults (set in gbpMCMC.h)

    // Initialize Communicator
    SID_Comm_init(&(MCMC->comm));
    SID_Comm_split(SID_COMM_WORLD, MCMC->my_chain, SID.My_rank, MCMC->comm);

    // Set the base output directory
    if(MCMC->my_chain == SID.My_rank) {
        // Generate directory and stop filenames
        sprintf(test_dir, "./%s_MCMC/", SID.My_binary);
        sprintf(test_restart, "./%s_MCMC/stop", SID.My_binary);

        // analyze_MCMC() needs to know what the filename root is.  We also need to strip trailing '/'s.
        strcpy(MCMC->filename_output_root, test_dir);
        int i_char;
        int flag_continue;
        for(i_char = strlen(MCMC->filename_output_root) - 1, flag_continue = GBP_TRUE; i_char >= 0 && flag_continue; i_char--) {
            if(MCMC->filename_output_root[i_char] != '/')
                flag_continue = GBP_FALSE;
            else
                MCMC->filename_output_root[i_char] = '\0';
        }

        i = 0;
        // Try to open them ...
        ft         = fopen(test_dir, "r");
        ft_restart = fopen(test_restart, "r");
        // If the directory exists & there is no stop file in it then...
        if((ft != NULL) && (ft_restart == NULL)) {
            // Increment the directory suffix until we don't find a directory,
            // whilst always ensuring we don't come across a stop file (which indicates
            // the previous run was stopped prematurely and we want restart the run).
            do {
                fclose(ft);
                i++;
                sprintf(test_dir, "./%s_MCMC.%d/", SID.My_binary, i);
                ft = fopen(test_dir, "r");
                sprintf(test_restart, "./%s_MCMC.%d/stop", SID.My_binary, i);
                ft_restart = fopen(test_restart, "r");
            } while((ft != NULL) && (ft_restart == NULL));
        }
        // Finally, if we did find a stop file then close it and remove it.
        if(ft_restart != NULL) {
            fclose(ft_restart);
            remove(test_restart);
        }
        // Copy the directory name we settled on to the MCMC structure
        strcpy(MCMC->filename_output_dir, test_dir);
        SID_log("ouput_dir set to: %s", SID_LOG_COMMENT, MCMC->filename_output_dir);
    }
    // Broadcast the output directory to all the other cores.
    SID_Bcast(MCMC->filename_output_dir, SID_MAX_FILENAME_LENGTH, SID_CHAR, MCMC->my_chain, MCMC->comm);

    // Initilize the random number generator
    MCMC->RNG = (RNG_info *)SID_malloc(sizeof(RNG_info));
    init_seed_from_clock(&(MCMC->seed));
    SID_Bcast(&(MCMC->seed), 1, SID_INT, SID_MASTER_RANK, MCMC->comm);
    init_RNG(&(MCMC->seed), MCMC->RNG, RNG_DEFAULT);

    SID_log("Done.", SID_LOG_CLOSE);

    va_end(vargs);
}


/*
Project Name : OpenMEEG

© INRIA and ENPC (contributors: Geoffray ADDE, Maureen CLERC, Alexandre
GRAMFORT, Renaud KERIVEN, Jan KYBIC, Perrine LANDREAU, Théodore PAPADOPOULO,
Emmanuel OLIVI
Maureen.Clerc.AT.sophia.inria.fr, keriven.AT.certis.enpc.fr,
kybic.AT.fel.cvut.cz, papadop.AT.sophia.inria.fr)

The OpenMEEG software is a C++ package for solving the forward/inverse
problems of electroencephalography and magnetoencephalography.

This software is governed by the CeCILL-B license under French law and
abiding by the rules of distribution of free software.  You can  use,
modify and/ or redistribute the software under the terms of the CeCILL-B
license as circulated by CEA, CNRS and INRIA at the following URL
"http://www.cecill.info".

As a counterpart to the access to the source code and  rights to copy,
modify and redistribute granted by the license, users are provided only
with a limited warranty  and the software's authors,  the holders of the
economic rights,  and the successive licensors  have only  limited
liability.

In this respect, the user's attention is drawn to the risks associated
with loading,  using,  modifying and/or developing or reproducing the
software by the user in light of its specific status of free software,
that may mean  that it is complicated to manipulate,  and  that  also
therefore means  that it is reserved for developers  and  experienced
professionals having in-depth computer knowledge. Users are therefore
encouraged to load and test the software's suitability as regards their
requirements in conditions enabling the security of their systems and/or
data to be ensured and,  more generally, to use and operate it in the
same conditions as regards security.

The fact that you are presently reading this means that you have had
knowledge of the CeCILL-B license and that you accept its terms.
*/

#pragma once

//  cmake configuration.
#include <OpenMEEGConfigure.h>
#include <DLLDefinesOpenMEEGMaths.h>

#ifdef USE_MATIO
#include "matio.h"
#endif

#if !defined(USE_MKL)
    #if defined (WIN32) || !defined(USE_ATLAS)
        #define FC_GLOBAL(x,X) x ## _
    #else
        #include <FC.h>
    #endif
#endif

//#define inline __forceinline
//#define inline __attribute__((always_inline))
//#define inline __attribute__((weak)) inline

#if WIN32
    #pragma inline_recursion (on)
    #pragma inline_depth (255)
    #pragma warning( disable : 4530)    //MSVC standard library can't be inlined
    #pragma warning( disable : 4996)    //MSVC warning C4996: declared deprecated
#endif

#ifdef USE_ATLAS
#ifdef __APPLE__
    extern "C" {
        #include <cblas.h>
        #include <clapack.h>
    }
    #define BLAS(x,X) cblas_ ## x
    #define LAPACK(x,X) x ## _
    // #define LAPACK(x,X) FC_GLOBAL(x,X)
#else
    extern "C" {
        #include <cblas.h>
        #include <clapack.h>
    }
    #define BLAS(x,X) cblas_ ## x
    #define LAPACK(x,X) clapack_ ## x
#endif
#endif

#ifdef USE_MKL
// Hack to avoid the MKL declarations of Lapack Functions which do not use the power of C++ references
    #define _MKL_LAPACK_H_
    #include <mkl.h>
    #define BLAS(x,X) cblas_ ## x
    #define LAPACK(x,X) x
    #define FC_GLOBAL(x,X) x
#endif

#ifdef USE_ACML
    #include <acml.h>
    //  Those macros are not used yet
    #define BLAS(x,X) x
    #define LAPACK(x,X) FC_GLOBAL(x,X)
    extern "C" void vrda_sin (int n, double *t, double *p);
    extern "C" void vrda_cos (int n, double *t, double *p);
    extern "C" void vrda_exp (int n, double *t, double *p);
    extern "C" void vrda_log (int n, double *t, double *p);
#endif

#if defined(HAVE_BLAS) && !defined(USE_ATLAS) && !defined(USE_ACML)

#ifndef USE_MKL
    #define CblasColMajor
    #define CblasTrans 'T'
    #define CblasNoTrans 'N'
    #define CblasRight 'R'
    #define CblasLeft 'L'
    #define CblasUpper 'U'
    #define BLAS(x,X) FC_GLOBAL(x,X)
    #define LAPACK(x,X) FC_GLOBAL(x,X)

    extern "C" {
        void BLAS(dcopy,DCOPY)(const int&,const double*,const int&,double*,const int&);
        void BLAS(daxpy,DAXPY)(const int&,const double&,const double*,const int&,double*,const int&);
        double BLAS(ddot,DDOT)(const int&,const double*,const int&,const double*,const int&);
        double BLAS(dnrm2,DNRM2)(const int&,const double*,const int&);
        void BLAS(dscal,DSCAL)(const int&,const double&,double*,const int&);
        void BLAS(dger,DGER)(const int&,const int&,const double&,const double*,const int&,const double*,const int&,double*,const int&);
        void BLAS(dspmv,DSPMV)(const char&,const int&,const double&,const double*,const double*,const int&,const double&,double*,const int&);
        void BLAS(dtpmv,DTPMV)(const char&,const char&,const char&,const int&,const double*,double*,const int&);
        void BLAS(dsymm,DSYMM)(const char&,const char&,const int&,const int&,const double&,const double*,const int&,const double*,const int&, const double&,double*,const int&);
        void BLAS(dgemm,DGEMM)(const char&,const char&,const int&,const int&,const int&,const double&,const double*,const int&,const double*,const int&,const double&,double*,const int&);
        void BLAS(dtrmm,DTRMM)(const char&,const char&,const char&,const char&,const int&,const int&,const double&,const double*,const int&,const double*,const int&);
        void BLAS(dgemv,DGEMV)(const char&,const int&,const int&,const double&,const double*,const int&,const double*,const int&,const double&,double*,const int&);
    }
#endif

    extern "C" {
        void LAPACK(dgetrf,DGETRF)(const int&,const int&,double*,const int&,int*,int&);
        void LAPACK(dgetri,DGETRI)(const int&,double*,const int&,int*,double*,const int&,int&);
    }

#endif

#if defined(HAVE_LAPACK)
    extern "C" {
        void FC_GLOBAL(dgesdd,DGESDD)(const char&,const int&,const int&,double*,const int&,double*,double*,const int&,double*,const int&,double*,const int&,int*,int&);
        void FC_GLOBAL(dpotf2,DPOTF2)(const char&,const int&,double*,const int&,int&);
        double FC_GLOBAL(dlange,DLANGE)(const char&,const int&,const int&,const double*,const int&,double*);
        void FC_GLOBAL(dsptrf,DSPTRF)(const char&,const int&,double*,int*,int&);
        void FC_GLOBAL(dtptri,DTPTRI)(const char&,const char&,const int&,double*,int&,int&);
        void FC_GLOBAL(dsptri,DSPTRI)(const char&,const int&,double*,int*,double*,int&);
        void FC_GLOBAL(dpptrf,DPPTRF)(const char&,const int&,double*,int&);
        void FC_GLOBAL(dpptri,DPPTRI)(const char&,const int&,double*,int&);
        void FC_GLOBAL(dspevd,DSPEVD)(const char&,const char&,const int&,double*,double*,double*,const int&,double*,const int&,int*,const int&,int&);
        void FC_GLOBAL(dsptrs,DSPTRS)(const char&,const int&,const int&,double*,int*,double*,const int&,int&);
    }
#endif

#define DGESDD FC_GLOBAL(dgesdd,DGESDD)
#define DPOTF2 FC_GLOBAL(dpotf2,DPOTF2)
#define DLANGE FC_GLOBAL(dlange,DLANGE)

#define DSPTRF FC_GLOBAL(dsptrf,DSPTRF)
#define DTPTRI FC_GLOBAL(dtptri,DTPTRI)
#define DPPTRF FC_GLOBAL(dpptrf,DPPTRF)
#define DPPTRI FC_GLOBAL(dpptri,DPPTRI)
#define DSPEVD FC_GLOBAL(dspevd,DSPEVD)
#define DSPTRS FC_GLOBAL(dsptrs,DSPTRS)

#if defined(USE_ATLAS) || defined(USE_MKL)
    #define DGER(X1,X2,X3,X4,X5,X6,X7,X8,X9) BLAS(dger,DGER)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9)
    #define DSPMV(X1,X2,X3,X4,X5,X6,X7,X8,X9) BLAS(dspmv,DSPMV)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9)
    #define DTPMV(X1,X2,X3,X4,X5,X6,X7) BLAS(dtpmv,DTPMV)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7)
    #define DSYMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) BLAS(dsymm,DSYMM)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12)
    #define DGEMV(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11) BLAS(dgemv,DGEMV)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11)
    #define DGEMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) BLAS(dgemm,DGEMM)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13)
    #define DTRMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11) BLAS(dtrmm,DTRMM)(CblasColMajor,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11)
    #if defined(USE_ATLAS)
        #ifdef __APPLE__
            #define DGETRF(X1,X2,X3,X4,X5,X6) LAPACK(dgetrf,DGETRF)(&X1,&X2,X3,&X4,X5,&X6)
            // #define DGETRF(X1,X2,X3,X4,X5,X6) LAPACK(dgetrf,DGETRF)(CblasColMajor,X1,X2,X3,X4,X5)
            #define DGETRI(X1,X2,X3,X4,X5,X6,X7) LAPACK(dgetri,DGETRI)(&X1,X2,&X3,X4,X5,&X6,&X7)
            // #define DGETRI(X1,X2,X3,X4,X5,X6,X7) LAPACK(dgetri,DGETRI)(CblasColMajor,X1,X2,X3,X4)
        #else
            #define DGETRF(X1,X2,X3,X4,X5) LAPACK(dgetrf,DGETRF)(CblasColMajor,X1,X2,X3,X4,X5)
            #define DGETRI(X1,X2,X3,X4)    LAPACK(dgetri,DGETRI)(CblasColMajor,X1,X2,X3,X4)
        #endif
    #else
        #define DGETRF(X1,X2,X3,X4,X5,X6) LAPACK(dgetrf,DGETRF)(X1,X2,X3,X4,X5,X6)
        #define DGETRI(X1,X2,X3,X4,X5,X6,X7) LAPACK(dgetri,DGETRI)(X1,X2,X3,X4,X5,X6,X7)
    #endif
    #define DSPTRI(X1,X2,X3,X4,X5,X6) FC_GLOBAL(dsptri,DSPTRI)(X1,X2,X3,X4,X5,X6)
#else
    #define DGER(X1,X2,X3,X4,X5,X6,X7,X8,X9) BLAS(dger,DGER)(X1,X2,X3,X4,X5,X6,X7,X8,X9)
    #define DSPMV(X1,X2,X3,X4,X5,X6,X7,X8,X9) BLAS(dspmv,DSPMV)(X1,X2,X3,X4,X5,X6,X7,X8,X9)
    #define DTPMV(X1,X2,X3,X4,X5,X6,X7) BLAS(dtpmv,DTPMV)(X1,X2,X3,X4,X5,X6,X7)
    #define DSYMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12) BLAS(dsymm,DSYMM)(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12)
    #define DGEMV(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11) BLAS(dgemv,DGEMV)(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11)
    #define DGEMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13) BLAS(dgemm,DGEMM)(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13)
    #define DTRMM(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11) BLAS(dtrmm,DTRMM)(X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11)
    #define DGETRF LAPACK(dgetrf,DGETRF)
    #if defined(USE_ACML)
        #define DGETRI(X1,X2,X3,X4,X5,X6,X7) LAPACK(dgetri,DGETRI)(X1,X2,X3,X4,X7)
        #define DSPTRI(X1,X2,X3,X4,X5,X6) LAPACK(dsptri,DSPTRI)(X1,X2,X3,X4,X6)
    #else
        #define DGETRI(X1,X2,X3,X4,X5,X6,X7) LAPACK(dgetri,DGETRI)(X1,X2,X3,X4,X5,X6,X7)
        #define DSPTRI(X1,X2,X3,X4,X5,X6) LAPACK(dsptri,DSPTRI)(X1,X2,X3,X4,X5,X6)
    #endif
#endif