/*
 *  vbHmmGaussIntensity.c
 *  Model-specific core functions for VB-HMM-GAUSS.
 *
 *  Created by OKAMOTO Kenji, SAKO Yasushi and RIKEN
 *  Copyright 2011-2016
 *  Cellular Informatics Laboratory, Advance Science Institute, RIKEN, Japan.
 *  All rights reserved.
 *
 *  Ver. 1.0.0
 *  Last modified on 2016.02.08
 */

#include "vbHmmGaussIntensity.h"
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_psi.h>
#include <string.h>
#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_gaussInt(){
    commonFunctions funcs;
    funcs.newModelParameters    = newModelParameters_gaussInt;
    funcs.freeModelParameters   = freeModelParameters_gaussInt;
    funcs.newModelStats         = newModelStats_gaussInt;
    funcs.freeModelStats        = freeModelStats_gaussInt;
    funcs.initializeVbHmm       = initializeVbHmm_gaussInt;
    funcs.pTilde_z1             = pTilde_z1_gaussInt;
    funcs.pTilde_zn_zn1         = pTilde_zn_zn1_gaussInt;
    funcs.pTilde_xn_zn          = pTilde_xn_zn_gaussInt;
    funcs.calcStatsVars         = calcStatsVars_gaussInt;
    funcs.maximization          = maximization_gaussInt;
    funcs.varLowerBound         = varLowerBound_gaussInt;
    funcs.reorderParameters     = reorderParameters_gaussInt;
    funcs.outputResults         = outputResults_gaussInt;
    setFunctions( funcs );
}

void setGFunctions_gaussInt(){
    gCommonFunctions funcs;
    funcs.newModelParameters    = newModelParameters_gaussInt;
    funcs.freeModelParameters   = freeModelParameters_gaussInt;
    funcs.newModelStats         = newModelStats_gaussInt;
    funcs.freeModelStats        = freeModelStats_gaussInt;
    funcs.newModelStatsG        = newModelStatsG_gaussInt;
    funcs.freeModelStatsG       = freeModelStatsG_gaussInt;
    funcs.initializeVbHmmG      = initializeVbHmmG_gaussInt;
    funcs.pTilde_z1             = pTilde_z1_gaussInt;
    funcs.pTilde_zn_zn1         = pTilde_zn_zn1_gaussInt;
    funcs.pTilde_xn_zn          = pTilde_xn_zn_gaussInt;
    funcs.calcStatsVarsG        = calcStatsVarsG_gaussInt;
    funcs.maximizationG         = maximizationG_gaussInt;
    funcs.varLowerBoundG        = varLowerBoundG_gaussInt;
    funcs.reorderParametersG    = reorderParametersG_gaussInt;
    funcs.outputResultsG        = outputResultsG_gaussInt;
    setGFunctions( funcs );
    isGlobalAnalysis = 1;
}

void outputResults_gaussInt( xn, gv, iv, logFP )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
FILE *logFP;
{
    outputGaussIntResults( xn, gv, iv, logFP );
}

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

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

    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_gaussInt( p, xn, sNo )
void **p;
xnDataSet *xn;
int sNo;
{
    gaussIntParameters *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( gp );
    *p = NULL;
}

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

        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_gaussInt( s, xn, gv, iv )
void **s;
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    if( isGlobalAnalysis == 0 ){
        int sNo = gv->sNo;
        gaussIntStats *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_gaussInt( xns, gv, ivs)
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    int sNo = gv->sNo;
    gaussIntGlobalStats *gs = (gaussIntGlobalStats*)malloc( sizeof(gaussIntGlobalStats) );

    int i;
    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->NiR = (double *)malloc( sNo * sizeof(double) );
    gs->z1iR = (double *)malloc( sNo * sizeof(double) );

    return gs;
}

void freeModelStatsG_gaussInt( gs, xns, gv, ivs )
void **gs;
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    int sNo = gv->sNo;
    gaussIntGlobalStats *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_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    gaussIntData *d = xn->data;
    size_t dLen = xn->N;
    int sNo = gv->sNo;
    gaussIntParameters *p = gv->params;

    int i, j;
    double totalX = 0.0, precX, varX = 0.0;
    for( i = 0 ; i < dLen ; i++ ){
        totalX += d->v[i];
    }
    double meanX = totalX / (double)dLen;
    for( i = 0 ; i < dLen ; i++ ){
        varX += pow(d->v[i] - meanX, 2.0);
    }
    varX /= (double)(dLen - 1);
    precX = 1.0 / varX;

    // 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];
        }
    }

    // hyper parameter for p( mu(k), lm(k) )
    for( i = 0 ; i < sNo ; i++ ){
        p->uBt = 1.0;
        p->uMu = meanX * 2.0 / (double)sNo;
        p->uA  = 1.0;
        p->uB  = p->uA / precX ;
    }

    initialize_indVars_gaussInt( xn, gv, iv );

    calcStatsVars_gaussInt( xn, gv, iv );
    maximization_gaussInt( xn, gv, iv );

}

void initializeVbHmmG_gaussInt( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    gaussIntData *d;
    size_t dLen, totalN;
    int sNo = gv->sNo, rNo = xns->R;
    gaussIntParameters *p = gv->params;

    int i, j, r;
    double totalX, precX, varX, meanX;

    totalX = 0.0;
    totalN = 0;
    for( r = 0 ; r < rNo ; r++ ){
        d = xns->xn[r]->data;
        dLen = xns->xn[r]->N;
        for( i = 0 ; i < dLen ; i++ ){
            totalX += d->v[i];
        }
        totalN += dLen;
    }
    meanX = totalX / (double)totalN;
    varX = 0.0;
    for( r = 0 ; r < rNo ; r++ ){
        d = xns->xn[r]->data;
        dLen = xns->xn[r]->N;
        for( i = 0 ; i < dLen ; i++ ){
            varX += pow(d->v[i] - meanX, 2.0);
        }
    }
    varX /= (double)(totalN - 1);
    precX = 1.0 / varX;

    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];
        }
    }

    // hyper parameter for p( mu(k), lm(k) )
    for( i = 0 ; i < sNo ; i++ ){
        p->uBt = 1.0;
        p->uMu = meanX * 2.0 / (double)sNo;
        p->uA  = 1.0;
        p->uB  = p->uA / precX ;
    }

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

    calcStatsVarsG_gaussInt( xns, gv, ivs );
    maximizationG_gaussInt( xns, gv, ivs );
}

void initialize_indVars_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    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_gaussInt( 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 = (gaussIntData*)malloc( sizeof(gaussIntData) );
    gaussIntData *d = (gaussIntData*)xn->data;
    d->v = NULL;
    return xn;
}

void freeXnDataSet_gaussInt( xn )
xnDataSet **xn;
{
    gaussIntData *d = (gaussIntData*)(*xn)->data;
    free( d->v );
    free( (*xn)->data );
    free( (*xn)->name );
    free( *xn );
    *xn = NULL;
}

double pTilde_z1_gaussInt( i, params )
int i;
void *params;
{
    gaussIntParameters *p = (gaussIntParameters*)params;
    return exp( p->avgLnPi[i] );
}

double pTilde_zn_zn1_gaussInt( i, j, params )
int i, j;
void *params;
{
    gaussIntParameters *p = (gaussIntParameters*)params;
    return exp( p->avgLnA[i][j] );
}

double pTilde_xn_zn_gaussInt( xnWv, n, i, params )
xnDataSet *xnWv;
size_t n;
int i;
void *params;
{
    gaussIntParameters *p = (gaussIntParameters*)params;
    gaussIntData *xn = (gaussIntData*)xnWv->data;
    double val, di = (double)(i+1);
    val  = p->avgLnLm - log(2.0 * M_PI * di);
    val -= di/p->btMu + p->aLm * pow(xn->v[n] - di * p->mu0, 2.0) / di / p->bLm;
    return exp(val / 2.0);
}

void calcStatsVars_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    gaussIntData *d = (gaussIntData*)xn->data;
    gaussIntStats *s = (gaussIntStats*)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;

    s->N0 = (double)xn->N;
    s->N0i = 1e-10;
    s->Nx  = 1e-10;
    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];
            s->Nx += gmMat[n][i] * d->v[n];
            for( j = 0 ; j < sNo ; j++ ){
                Nii[i]    += xiMat[n][i][j];
                Nij[i][j] += xiMat[n][i][j];
            }
        }
        s->N0i += (double)(i+1) * Ni[i];
    }
}

void calcStatsVarsG_gaussInt( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    gaussIntData *d;
    gaussIntGlobalStats *gs = (gaussIntGlobalStats*)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;

    gs->N0R = 0.0;
    gs->N0iR = 1e-10;
    gs->NxR  = 1e-10;
    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++ ){
        d = (gaussIntData*)xns->xn[r]->data;
        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];
                gs->NxR += gmMat[n][i] * d->v[n];
                for( j = 0 ; j < sNo ; j++ ){
                    NiiR[i]    += xiMat[n][i][j];
                    NijR[i][j] += xiMat[n][i][j];
                }
            }
        }
        gs->N0R += (double)xns->xn[r]->N;
    }
    for( i = 0 ; i < sNo ; i++ ){
        gs->N0iR += (double)(i+1) * NiR[i];
    }
}

void maximization_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    gaussIntStats *s = (gaussIntStats*)iv->stats;
    gaussIntData *d = (gaussIntData*)xn->data;
    size_t dLen = xn->N;
    int sNo = gv->sNo;
    double **gmMat = iv->gmMat;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double uBt = p->uBt, uMu = p->uMu, uA = p->uA, uB = p->uB;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;
    double *Nii = s->Nii, **Nij = s->Nij, N0 = s->N0, N0i = s->N0i, Nx = s->Nx;
    int i, j, m;

    double bLm = 0.0, di;
    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] );
        }

        di = (double)(i+1);
        for( m = 0 ; m < dLen ; m++ ){
            bLm += gmMat[m][i] * d->v[m] * d->v[m] / di;
        }
    }
    bLm /= 2.0;

    p->btMu = uBt + N0i;
    p->mu0  = (uBt * uMu + Nx) / p->btMu;
    p->aLm  = uA + (N0 / 2.0);
    bLm += uB + (uBt * uMu * uMu / 2.0);
    bLm -= p->btMu * p->mu0 * p->mu0 / 2.0;
    p->bLm = bLm;

    p->avgMu    = p->mu0;
    p->avgLm    = p->aLm / p->bLm;
    p->avgLnLm  = gsl_sf_psi( p->aLm ) - log( p->bLm );
}

void maximizationG_gaussInt( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double uBt = p->uBt, uMu = p->uMu, uA = p->uA, uB = p->uB;
    double *avgPi = p->avgPi, *avgLnPi = p->avgLnPi, **avgA = p->avgA, **avgLnA = p->avgLnA;
    gaussIntGlobalStats *gs = (gaussIntGlobalStats*)ivs->stats;
    double *NiiR = gs->NiiR, **NijR = gs->NijR, N0R = gs->N0R, N0iR = gs->N0iR, NxR = gs->NxR;
    double *z1iR = gs->z1iR, dR = (double)(xns->R), di, bLm = 0.0;
    int sNo = gv->sNo, rNo = xns->R;
    int i, j, m, r;

    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] );
        }

        di = (double)(i+1);
        for( r = 0 ; r < rNo ; r++ ){
            size_t dLen = xns->xn[r]->N;
            gaussIntData *d = (gaussIntData*)xns->xn[r]->data;
            double **gmMat = ivs->indVars[r]->gmMat;
            for( m = 0 ; m < dLen ; m++ ){
                bLm += gmMat[m][i] * d->v[m] * d->v[m] / di;
            }
        }

    }
    bLm /= 2.0;

    p->btMu = uBt + N0iR;
    p->mu0  = (uBt * uMu + NxR) / p->btMu;
    p->aLm  = uA + N0R / 2.0;
    bLm += uB + uBt * uMu * uMu / 2.0;
    bLm -= p->btMu * p->mu0 * p->mu0 / 2.0;
    p->bLm = bLm;

    p->avgMu    = p->mu0;
    p->avgLm    = p->aLm / p->bLm;
    p->avgLnLm  = gsl_sf_psi( p->aLm ) - log( p->bLm );
}

double varLowerBound_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    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 uBt = p->uBt, uMu = p->uMu, uA = p->uA, uB = p->uB;
    double *avgLnPi = p->avgLnPi, **avgLnA = p->avgLnA;
    double avgLm = p->avgLm, avgLnLm = p->avgLnLm;
    double mu0 = p->mu0, btMu = p->btMu, aLm = p->aLm, bLm = p->bLm;
    gaussIntStats *s = (gaussIntStats*)iv->stats;
    double *Nii = s->Nii, **Nij = s->Nij;
    size_t n;
    int i, j;

    double lnpPi = gsl_sf_lngamma(sumUPi);
    double lnpA = 0.0;
    double lnpMuLm = log(uBt) / 2.0;
    lnpMuLm -= uBt * (1.0 / btMu + aLm * pow(mu0 - uMu, 2.0) / bLm ) / 2.0;
    lnpMuLm += - gsl_sf_lngamma(uA) + uA * log(uB);
    lnpMuLm += (uA - 0.5) * avgLnLm - uB * avgLm;

    double lnqPi = gsl_sf_lngamma(sumUPi + 1.0);
    double lnqA = 0.0;
    double lnqMuLm = (log(btMu) - 1.0) / 2.0 - gsl_sf_lngamma(aLm) + aLm * log(bLm);
    lnqMuLm += (aLm - 0.5) * avgLnLm - aLm;

    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 + lnpMuLm;
    val -= lnqPi + lnqA + lnqMuLm;
    val += lnpX;
    val += log(gsl_sf_fact(sNo));

    return val;
}

double varLowerBoundG_gaussInt( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    double *uPiArr = p->uPiArr, sumUPi = p->sumUPi;
    double **uAMat = p->uAMat, *sumUAArr = p->sumUAArr;
    double uBt = p->uBt, uMu = p->uMu, uA = p->uA, uB = p->uB;
    double *avgLnPi = p->avgLnPi, **avgLnA = p->avgLnA;
    double avgLm = p->avgLm, avgLnLm = p->avgLnLm;
    double mu0 = p->mu0, btMu = p->btMu, aLm = p->aLm, bLm = p->bLm;
    gaussIntGlobalStats *gs = (gaussIntGlobalStats*)ivs->stats;
    double *NiiR = gs->NiiR, **NijR = gs->NijR, *z1iR = gs->z1iR, dR = (double)xns->R;
    size_t n;
    int sNo = gv->sNo, rNo = xns->R;
    int i, j, r;

    double lnpPi = gsl_sf_lngamma(sumUPi);
    double lnpA = 0.0;
    double lnpMuLm = log(uBt) / 2.0;
    lnpMuLm -= uBt * (1.0 / btMu + aLm * pow(mu0 - uMu, 2.0) / bLm ) / 2.0;
    lnpMuLm += - gsl_sf_lngamma(uA) + uA * log(uB);
    lnpMuLm += (uA - 0.5) * avgLnLm - uB * avgLm;

    double lnqPi = gsl_sf_lngamma(sumUPi + dR);
    double lnqA = 0.0;
    double lnqMuLm = (log(btMu) - 1.0) / 2.0 - gsl_sf_lngamma(aLm) + aLm * log(bLm);
    lnqMuLm += (aLm - 0.5) * avgLnLm - aLm;

    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 + lnpMuLm;
    val -= lnqPi + lnqA + lnqMuLm;
    val += lnpX;
    val += log(gsl_sf_fact(sNo));

    return val;
}

void reorderParameters_gaussInt( xn, gv, iv )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
{
}

void reorderParametersG_gaussInt( xns, gv, ivs )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
{
}

void outputGaussIntResults( xn, gv, iv, logFP )
xnDataSet *xn;
globalVars *gv;
indVars *iv;
FILE *logFP;
{
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    int sNo = gv->sNo;

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

    fprintf(logFP, "   mean: ( %g ) \n", p->avgMu);

    fprintf(logFP, "   lambda: ( %g ) \n", p->avgLm);

    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, "mu, lambda, pi");
        for( i = 0 ; i < sNo ; i++ )
        {   fprintf(fp, ", A%dx", i);   }
        fprintf(fp, "\n");

        for( i = 0 ; i < sNo ; i++ ){
            fprintf(fp, "%g, %g, %g", (double)(i+1)*p->avgMu, (double)(i+1)*p->avgLm, 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 outputGaussIntResultsG( xns, gv, ivs, logFP )
xnDataBundle *xns;
globalVars *gv;
indVarBundle *ivs;
FILE *logFP;
{
    int sNo = gv->sNo, rNo = xns->R;
    gaussIntParameters *p = (gaussIntParameters*)gv->params;
    int i, j, r;

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

    fprintf(logFP, "   mean: ( %g ) \n", p->avgMu);

    fprintf(logFP, "   lambda: ( %g ) \n", p->avgLm);

    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, "mu, lambda, pi");
        for( i = 0 ; i < sNo ; i++ )
        {   fprintf(fp, ", A%dx", i);   }
        fprintf(fp, "\n");

        for( i = 0 ; i < sNo ; i++ ){
            fprintf(fp, "%g, %g, %g", (double)(i+1)*p->avgMu, (double)(i+1)*p->avgLm, 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);
    }

    sprintf( fn, "%s.maxS%03d", xns->xn[0]->name, sNo );
    int flag = 0;
    if( (fp = fopen( fn, "w")) != NULL ){
        n = 0;
        do{
            flag = 1;
            for( r = 0 ; r < rNo ; r++ ){
                xnDataSet *xn = xns->xn[r];
                indVars *iv = ivs->indVars[r];

                if( r > 0 ){
                    fprintf( fp, "," );
                }
                if( n < xn->N ){
                    fprintf( fp, "%d", iv->stateTraj[n] );
                }
                flag &= (n >= (xn->N - 1));
            }
            fprintf( fp, "\n" );
            n++;
        }while( !flag );
        fclose(fp);
    }
}

//


#include <gsl/gsl_math.h>
#include "gsl_cblas.h"
#include "cblas.h"

void
cblas_zhpmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
	     const int N, const void *alpha, const void *Ap, const void *X,
	     const int incX, const void *beta, void *Y, const int incY)
{
#define BASE double
#include "source_hpmv.h"
#undef BASE
}


#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_herk (void) {
const double flteps = 1e-4, dbleps = 1e-6;
  {
   int order = 101;
   int uplo = 121;
   int trans = 111;
   int N = 2;
   int K = 1;
   float alpha = 1.0f;
   float beta = 1.0f;
   float A[] = { 0.934f, 0.664f, 0.426f, 0.263f };
   int lda = 1;
   float C[] = { 0.251f, -0.97f, 0.76f, -0.349f, 0.152f, -0.899f, -0.17f, 0.707f };
   int ldc = 2;
   float C_expected[] = { 1.56425f, 0.0f, 1.33252f, -0.311778f, 0.152f, -0.899f, 0.080645f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1606) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1606) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int trans = 111;
   int N = 2;
   int K = 1;
   float alpha = 1.0f;
   float beta = 1.0f;
   float A[] = { 0.16f, 0.464f, -0.623f, 0.776f };
   int lda = 2;
   float C[] = { 0.771f, -0.449f, 0.776f, 0.112f, -0.134f, 0.317f, 0.547f, -0.551f };
   int ldc = 2;
   float C_expected[] = { 1.0119f, 0.0f, 0.776f, 0.112f, 0.126384f, -0.096232f, 1.5373f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1607) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1607) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 121;
   int trans = 113;
   int N = 2;
   int K = 1;
   float alpha = 0.1f;
   float beta = 1.0f;
   float A[] = { 0.787f, 0.057f, -0.49f, 0.47f };
   int lda = 2;
   float C[] = { -0.758f, 0.912f, 0.992f, -0.356f, 0.584f, 0.806f, 0.965f, 0.674f };
   int ldc = 2;
   float C_expected[] = { -0.695738f, 0.0f, 0.956116f, -0.316218f, 0.584f, 0.806f, 1.0111f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1608) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1608) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int trans = 113;
   int N = 2;
   int K = 1;
   float alpha = 0.1f;
   float beta = 1.0f;
   float A[] = { 0.961f, -0.384f, 0.165f, 0.395f };
   int lda = 1;
   float C[] = { -0.186f, 0.404f, -0.873f, 0.09f, -0.451f, -0.972f, -0.203f, -0.304f };
   int ldc = 2;
   float C_expected[] = { -0.0789023f, 0.0f, -0.873f, 0.09f, -0.450312f, -0.927704f, -0.184675f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1609) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1609) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int trans = 111;
   int N = 2;
   int K = 1;
   float alpha = 0.0f;
   float beta = -0.3f;
   float A[] = { 0.04f, 0.608f, 0.21f, -0.44f };
   int lda = 1;
   float C[] = { 0.285f, -0.943f, 0.581f, -0.56f, 0.112f, 0.529f, 0.16f, -0.913f };
   int ldc = 2;
   float C_expected[] = { -0.0855f, 0.0f, 0.581f, -0.56f, -0.0336f, -0.1587f, -0.048f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1610) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1610) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int trans = 111;
   int N = 2;
   int K = 1;
   float alpha = 0.0f;
   float beta = -0.3f;
   float A[] = { -0.984f, -0.398f, -0.379f, 0.919f };
   int lda = 2;
   float C[] = { -0.44f, -0.087f, 0.156f, -0.945f, -0.943f, -0.355f, 0.577f, 0.053f };
   int ldc = 2;
   float C_expected[] = { 0.132f, 0.0f, -0.0468f, 0.2835f, -0.943f, -0.355f, -0.1731f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1611) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1611) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int trans = 113;
   int N = 2;
   int K = 1;
   float alpha = 1.0f;
   float beta = -1.0f;
   float A[] = { 0.269f, -0.428f, -0.029f, 0.964f };
   int lda = 2;
   float C[] = { 0.473f, -0.932f, -0.689f, -0.072f, -0.952f, -0.862f, 0.001f, 0.282f };
   int ldc = 2;
   float C_expected[] = { -0.217455f, 0.0f, -0.689f, -0.072f, 0.531607f, 0.615096f, 0.929137f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1612) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1612) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int trans = 113;
   int N = 2;
   int K = 1;
   float alpha = 1.0f;
   float beta = -1.0f;
   float A[] = { -0.303f, -0.037f, -0.411f, -0.243f };
   int lda = 1;
   float C[] = { 0.652f, -0.227f, -0.849f, 0.87f, -0.051f, -0.535f, 0.418f, -0.681f };
   int ldc = 2;
   float C_expected[] = { -0.558822f, 0.0f, 0.982524f, -0.928422f, -0.051f, -0.535f, -0.19003f, 0.0f };
   cblas_cherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], flteps, "cherk(case 1613) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], flteps, "cherk(case 1613) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 121;
   int trans = 111;
   int N = 2;
   int K = 1;
   double alpha = 0.1;
   double beta = 1;
   double A[] = { -0.384, -0.851, 0.518, 0.492 };
   int lda = 1;
   double C[] = { -0.117, -0.194, -0.915, 0.069, 0.445, 0.089, 0.213, -0.889 };
   int ldc = 2;
   double C_expected[] = { -0.0298343, 0.0, -0.9767604, 0.043811, 0.445, 0.089, 0.2640388, 0.0 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1614) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1614) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int trans = 111;
   int N = 2;
   int K = 1;
   double alpha = 0.1;
   double beta = 1;
   double A[] = { 0.13, 0.236, 0.788, 0.629 };
   int lda = 2;
   double C[] = { 0.021, -0.376, -0.804, 0.689, -0.912, 0.21, -0.581, 0.406 };
   int ldc = 2;
   double C_expected[] = { 0.0282596, 0.0, -0.804, 0.689, -0.8869116, 0.2204198, -0.4793415, 0.0 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1615) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1615) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 121;
   int trans = 113;
   int N = 2;
   int K = 1;
   double alpha = 0;
   double beta = 1;
   double A[] = { 0.593, 0.846, -0.144, 0.128 };
   int lda = 2;
   double C[] = { 0.02, 0.313, 0.222, 0.301, 0.412, -0.645, -0.411, -0.02 };
   int ldc = 2;
   double C_expected[] = { 0.02, 0.313, 0.222, 0.301, 0.412, -0.645, -0.411, -0.02 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1616) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1616) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int trans = 113;
   int N = 2;
   int K = 1;
   double alpha = 0;
   double beta = 1;
   double A[] = { 0.857, 0.994, -0.933, 0.069 };
   int lda = 1;
   double C[] = { 0.253, -0.521, 0.937, -0.73, 0.24, 0.177, -0.27, -0.225 };
   int ldc = 2;
   double C_expected[] = { 0.253, -0.521, 0.937, -0.73, 0.24, 0.177, -0.27, -0.225 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1617) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1617) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int trans = 111;
   int N = 2;
   int K = 1;
   double alpha = 0;
   double beta = 1;
   double A[] = { -0.343, -0.433, -0.381, -0.087 };
   int lda = 1;
   double C[] = { -0.695, 0.911, 0.719, -0.074, -0.621, -0.256, 0.216, -0.889 };
   int ldc = 2;
   double C_expected[] = { -0.695, 0.911, 0.719, -0.074, -0.621, -0.256, 0.216, -0.889 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1618) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1618) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int trans = 111;
   int N = 2;
   int K = 1;
   double alpha = 0;
   double beta = 1;
   double A[] = { -0.887, 0.557, -0.43, 0.912 };
   int lda = 2;
   double C[] = { -0.083, 0.219, 0.417, 0.817, -0.294, -0.683, -0.633, 0.831 };
   int ldc = 2;
   double C_expected[] = { -0.083, 0.219, 0.417, 0.817, -0.294, -0.683, -0.633, 0.831 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1619) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1619) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int trans = 113;
   int N = 2;
   int K = 1;
   double alpha = -0.3;
   double beta = -1;
   double A[] = { -0.531, 0.187, -0.777, -0.329 };
   int lda = 2;
   double C[] = { -0.173, 0.833, 0.155, -0.52, -0.99, 0.28, 0.455, 0.481 };
   int ldc = 2;
   double C_expected[] = { 0.077921, 0.0, 0.155, -0.52, 0.8846808, -0.1840006, -0.668591, 0.0 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1620) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1620) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int trans = 113;
   int N = 2;
   int K = 1;
   double alpha = -0.3;
   double beta = -1;
   double A[] = { -0.287, 0.068, 0.917, -0.449 };
   int lda = 1;
   double C[] = { -0.248, -0.608, -0.124, -0.718, -0.037, -0.115, 0.998, -0.551 };
   int ldc = 2;
   double C_expected[] = { 0.2219021, 0.0, 0.2121133, 0.7379521, -0.037, -0.115, -1.310747, 0.0 };
   cblas_zherk(order, uplo, trans, N, K, alpha, A, lda, beta, C, ldc);
   {
     int i;
     for (i = 0; i < 4; i++) {
       gsl_test_rel(C[2*i], C_expected[2*i], dbleps, "zherk(case 1621) real");
       gsl_test_rel(C[2*i+1], C_expected[2*i+1], dbleps, "zherk(case 1621) imag");
     };
   };
  };

}


#include <stdlib.h>
#include <gsl/gsl_math.h>
#include <gsl/matrix/gsl_matrix.h>

#define BASE_DOUBLE
#include <gsl/templates_on.h>
#include <gsl/matrix/minmax_source.c>
#include <gsl/templates_off.h>
#undef BASE_DOUBLE


/**
 *
 * @file qwrapper_dtrtri.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 Julien Langou
 * @author Henricus Bouwmeester
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @generated d Tue Jan  7 11:44:56 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_dtrtri(Quark *quark, Quark_Task_Flags *task_flags,
                       PLASMA_enum uplo, PLASMA_enum diag,
                       int n, int nb,
                       double *A, int lda,
                       PLASMA_sequence *sequence, PLASMA_request *request,
                       int iinfo)
{
    QUARK_Insert_Task(
        quark, CORE_dtrtri_quark, task_flags,
        sizeof(PLASMA_enum),                &uplo,      VALUE,
        sizeof(PLASMA_enum),                &diag,      VALUE,
        sizeof(int),                        &n,         VALUE,
        sizeof(double)*nb*nb,    A,                 INOUT,
        sizeof(int),                        &lda,       VALUE,
        sizeof(PLASMA_sequence*),           &sequence,  VALUE,
        sizeof(PLASMA_request*),            &request,   VALUE,
        sizeof(int),                        &iinfo,     VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_dtrtri_quark = PCORE_dtrtri_quark
#define CORE_dtrtri_quark PCORE_dtrtri_quark
#endif
void CORE_dtrtri_quark(Quark *quark)
{
    PLASMA_enum uplo;
    PLASMA_enum diag;
    int N;
    double *A;
    int LDA;
    PLASMA_sequence *sequence;
    PLASMA_request *request;
    int iinfo;

    int info;

    quark_unpack_args_8(quark, uplo, diag, N, A, LDA, sequence, request, iinfo);
    info = LAPACKE_dtrtri_work(
        LAPACK_COL_MAJOR,
        lapack_const(uplo), lapack_const(diag),
        N, A, LDA);
    if ((sequence->status == PLASMA_SUCCESS) && (info > 0))
        plasma_sequence_flush(quark, sequence, request, iinfo + info);
}


/*! \file allvars.h
 *  \brief declares global variables.
 *
 *  This file declares all global variables. Further variables should be added here, and declared as
 *  'extern'. The actual existence of these variables is provided by the file 'allvars.c'. To produce
 *  'allvars.c' from 'allvars.h', do the following:
 *
 *     - Erase all #define's, typedef's, and enum's
 *     - add #include "allvars.h", delete the #ifndef ALLVARS_H conditional
 *     - delete all keywords 'extern'
 *     - delete all struct definitions enclosed in {...}, e.g.
 *        "extern struct global_data_all_processes {....} All;"
 *        becomes "struct global_data_all_processes All;"
 */

#ifndef ALLVARS_H
#define ALLVARS_H

#include <stdio.h>
#include <gsl/gsl_rng.h>
#include "tags.h"

#define  GADGETVERSION   "2.0"   /*!< code version string */

#define  TIMEBASE        (1<<28) /*!< The simulated timespan is mapped onto the integer interval [0,TIMESPAN],
                                  *   where TIMESPAN needs to be a power of 2. Note that (1<<28) corresponds to 2^29
                                  */

#define  MAXTOPNODES     200000   /*!< Maximum number of nodes in the top-level tree used for domain decomposition */

typedef  long long  peanokey;    /*!< defines the variable type used for Peano-Hilbert keys */

#define  BITS_PER_DIMENSION 18	 /*!< Bits per dimension available for Peano-Hilbert order.
				      Note: If peanokey is defined as type int, the allowed maximum is 10.
				      If 64-bit integers are used, the maximum is 21 */

#define  PEANOCELLS (((peanokey)1)<<(3*BITS_PER_DIMENSION))  /*!< The number of different Peano-Hilbert cells */

#define  RNDTABLE         3000   /*!< gives the length of a table with random numbers, refreshed at every timestep.
				      This is used to allow application of random numbers to a specific particle
				      in a way that is independent of the number of processors used. */
#define  MAX_REAL_NUMBER  1e37
#define  MIN_REAL_NUMBER  1e-37

#define  MAXLEN_FILENAME  4096    /*!< Maximum number of characters for filenames (including the full path) */

#ifdef   ISOTHERM_EQS
#define  GAMMA         (1.0)     /*!< index for isothermal gas */
#else
#define  GAMMA         (5.0/3)   /*!< adiabatic index of simulated gas */
#endif

#define  GAMMA_MINUS1  (GAMMA-1)

#define  HYDROGEN_MASSFRAC 0.76  /*!< mass fraction of hydrogen, relevant only for radiative cooling */

/* Some physical constants in cgs units */

#define  GRAVITY           6.672e-8   /*!< Gravitational constant (in cgs units) */
#define  SOLAR_MASS        1.989e33
#define  SOLAR_LUM         3.826e33
#define  RAD_CONST         7.565e-15
#define  AVOGADRO          6.0222e23
#define  BOLTZMANN         1.3806e-16
#define  GAS_CONST         8.31425e7
#define  C                 2.9979e10
#define  PLANCK            6.6262e-27
#define  CM_PER_MPC        3.085678e24
#define  PROTONMASS        1.6726e-24
#define  ELECTRONMASS      9.10953e-28
#define  THOMPSON          6.65245e-25
#define  ELECTRONCHARGE    4.8032e-10
#define  HUBBLE            3.2407789e-18	/* in h/sec */

/* Some conversion factors */

#define  SEC_PER_MEGAYEAR  3.155e13
#define  SEC_PER_YEAR      3.155e7

#ifndef ASMTH
#define ASMTH 1.25  /*!< ASMTH gives the scale of the short-range/long-range force split in units of FFT-mesh cells */
#endif

#ifndef RCUT
#define RCUT  4.5   /*!< RCUT gives the maximum distance (in units of the scale used for the force split) out to
                         which short-range forces are evaluated in the short-range tree walk. */
#endif

#define MAX_NGB             20000  /*!< defines maximum length of neighbour list */

#define MAXLEN_OUTPUTLIST   500	   /*!< maxmimum number of entries in list of snapshot output times */

#define DRIFT_TABLE_LENGTH  1000   /*!< length of the lookup table used to hold the drift and kick factors */

#define MAXITER             150    /*!< maxmimum number of steps for SPH neighbour iteration */

#ifdef DOUBLEPRECISION             /*!< If defined, the variable type FLOAT is set to "double", otherwise to FLOAT */
#define FLOAT double
#else
#define FLOAT float
#endif

#ifndef  TWODIMS
#define  NUMDIMS 3                                      /*!< For 3D-normalized kernel */
#define  KERNEL_COEFF_1  2.546479089470                 /*!< Coefficients for SPH spline kernel and its derivative */
#define  KERNEL_COEFF_2  15.278874536822
#define  KERNEL_COEFF_3  45.836623610466
#define  KERNEL_COEFF_4  30.557749073644
#define  KERNEL_COEFF_5  5.092958178941
#define  KERNEL_COEFF_6  (-15.278874536822)
#define  NORM_COEFF      4.188790204786                 /*!< Coefficient for kernel normalization. Note:  4.0/3 * PI = 4.188790204786 */
#else
#define  NUMDIMS 2                                      /*!< For 2D-normalized kernel */
#define  KERNEL_COEFF_1  (5.0/7*2.546479089470)         /*!< Coefficients for SPH spline kernel and its derivative */
#define  KERNEL_COEFF_2  (5.0/7*15.278874536822)
#define  KERNEL_COEFF_3  (5.0/7*45.836623610466)
#define  KERNEL_COEFF_4  (5.0/7*30.557749073644)
#define  KERNEL_COEFF_5  (5.0/7*5.092958178941)
#define  KERNEL_COEFF_6  (5.0/7*(-15.278874536822))
#define  NORM_COEFF      M_PI                           /*!< Coefficient for kernel normalization. */
#endif

extern int ThisTask;		/*!< the rank of the local processor */
extern int NTask;               /*!< number of processors */
extern int PTask;	        /*!< smallest integer such that NTask <= 2^PTask */

extern int NumPart;		/*!< number of particles on the LOCAL processor */
extern int N_gas;		/*!< number of gas particles on the LOCAL processor  */
extern long long Ntype[6];      /*!< total number of particles of each type */
extern int NtypeLocal[6];       /*!< local number of particles of each type */

extern int NumForceUpdate;      /*!< number of active particles on local processor in current timestep  */
extern int NumSphUpdate;        /*!< number of active SPH particles on local processor in current timestep  */

extern double CPUThisRun;	/*!< Sums the CPU time for the process (current submission only) */

extern int RestartFlag;         /*!< taken from command line used to start code. 0 is normal start-up from
                                     initial conditions, 1 is resuming a run from a set of restart files, while 2
                                     marks a restart from a snapshot file. */

extern char *Exportflag;        /*!< Buffer used for flagging whether a particle needs to be exported to another process */

extern int  *Ngblist;           /*!< Buffer to hold indices of neighbours retrieved by the neighbour search routines */

extern int TreeReconstructFlag; /*!< Signals that a new tree needs to be constructed */

extern int Flag_FullStep;       /*!< This flag signals that the current step involves all particles */

extern int ZeroTimestepEncountered;  /*!< Flag used by AMUSE. When a particle is assigned a timestep of zero, an
                                     exception is raised instead of forcing the application to exit. */

extern gsl_rng *random_generator; /*!< the employed random number generator of the GSL library */

extern double RndTable[RNDTABLE]; /*!< Hold a table with random numbers, refreshed every timestep */

extern double DomainCorner[3];    /*!< gives the lower left corner of simulation volume */
extern double DomainCenter[3];    /*!< gives the center of simulation volume */
extern double DomainLen;          /*!< gives the (maximum) side-length of simulation volume */
extern double DomainFac;          /*!< factor used for converting particle coordinates to a Peano-Hilbert mesh covering the simulation volume */
extern int    DomainMyStart;      /*!< first domain mesh cell that resides on the local processor */
extern int    DomainMyLast;       /*!< last domain mesh cell that resides on the local processor */
extern int    *DomainStartList;   /*!< a table that lists the first domain mesh cell for all processors */
extern int    *DomainEndList;     /*!< a table that lists the last domain mesh cell for all processors */
extern double *DomainWork;        /*!< a table that gives the total "work" due to the particles stored by each processor */
extern int    *DomainCount;       /*!< a table that gives the total number of particles held by each processor */
extern int    *DomainCountSph;    /*!< a table that gives the total number of SPH particles held by each processor */

extern int    *DomainTask;        /*!< this table gives for each leaf of the top-level tree the processor it was assigned to */
extern int    *DomainNodeIndex;   /*!< this table gives for each leaf of the top-level tree the corresponding node of the gravitational tree */
extern FLOAT  *DomainTreeNodeLen; /*!< this table gives for each leaf of the top-level tree the side-length of the corresponding node of the gravitational tree */
extern FLOAT  *DomainHmax;        /*!< this table gives for each leaf of the top-level tree the maximum SPH smoothing length among the particles of the corresponding node of the gravitational tree */

extern struct DomainNODE
{
  FLOAT s[3];                     /*!< center-of-mass coordinates */
  FLOAT vs[3];                    /*!< center-of-mass velocities */
  FLOAT mass;                     /*!< mass of node */
#ifdef UNEQUALSOFTENINGS
#ifndef ADAPTIVE_GRAVSOFT_FORGAS
  int   bitflags;                 /*!< this bit-field encodes the particle type with the largest softening among the particles of the nodes, and whether there are particles with different softening in the node */
#else
  FLOAT maxsoft;                  /*!< hold the maximum gravitational softening of particles in the
                                       node if the ADAPTIVE_GRAVSOFT_FORGAS option is selected */
#endif
#endif
}
 *DomainMoment;                   /*!< this table stores for each node of the top-level tree corresponding node data from the gravitational tree */

extern peanokey *DomainKeyBuf;    /*!< this points to a buffer used during the exchange of particle data */

extern peanokey *Key;             /*!< a table used for storing Peano-Hilbert keys for particles */
extern peanokey *KeySorted;       /*!< holds a sorted table of Peano-Hilbert keys for all particles, used to construct top-level tree */

extern int NTopnodes;             /*!< total number of nodes in top-level tree */
extern int NTopleaves;            /*!< number of leaves in top-level tree. Each leaf can be assigned to a different processor */

extern struct topnode_data
{
  int Daughter;                   /*!< index of first daughter cell (out of 8) of top-level node */
  int Pstart;                     /*!< for the present top-level node, this gives the index of the first node in the concatenated list of topnodes collected from all processors */
  int Blocks;                     /*!< for the present top-level node, this gives the number of corresponding nodes in the concatenated list of topnodes collected from all processors */
  int Leaf;                       /*!< if the node is a leaf, this gives its number when all leaves are traversed in Peano-Hilbert order */
  peanokey Size;                  /*!< number of Peano-Hilbert mesh-cells represented by top-level node */
  peanokey StartKey;              /*!< first Peano-Hilbert key in top-level node */
  long long Count;                /*!< counts the number of particles in this top-level node */
}
 *TopNodes;                       /*!< points to the root node of the top-level tree */

extern double TimeOfLastTreeConstruction; /*!< holds what it says, only used in connection with FORCETEST */

/* variables for input/output, usually only used on process 0 */

extern char ParameterFile[MAXLEN_FILENAME];  /*!< file name of parameterfile used for starting the simulation */

extern FILE *FdInfo;       /*!< file handle for info.txt log-file. */
extern FILE *FdEnergy;     /*!< file handle for energy.txt log-file. */
extern FILE *FdTimings;    /*!< file handle for timings.txt log-file. */
extern FILE *FdCPU;        /*!< file handle for cpu.txt log-file. */

#ifdef FORCETEST
extern FILE *FdForceTest;  /*!< file handle for forcetest.txt log-file. */
#endif

extern double DriftTable[DRIFT_TABLE_LENGTH];      /*!< table for the cosmological drift factors */
extern double GravKickTable[DRIFT_TABLE_LENGTH];   /*!< table for the cosmological kick factor for gravitational forces */
extern double HydroKickTable[DRIFT_TABLE_LENGTH];  /*!< table for the cosmological kick factor for hydrodynmical forces */

extern void *CommBuffer;   /*!< points to communication buffer, which is used in the domain decomposition, the
                                parallel tree-force computation, the SPH routines, etc. */

/*! This structure contains data which is the SAME for all tasks (mostly code parameters read from the
 * parameter file).  Holding this data in a structure is convenient for writing/reading the restart file, and
 * it allows the introduction of new global variables in a simple way. The only thing to do is to introduce
 * them into this structure.
 */
extern struct global_data_all_processes
{
  long long TotNumPart;		/*!< total particle numbers (global value) */
  long long TotN_gas;		/*!< total gas particle number (global value) */

  int MaxPart;			/*!< This gives the maxmimum number of particles that can be stored on one processor. */
  int MaxPartSph;		/*!< This gives the maxmimum number of SPH particles that can be stored on one processor. */

  double BoxSize;               /*!< Boxsize in case periodic boundary conditions are used */

  int ICFormat;			/*!< selects different versions of IC file-format */

  int SnapFormat;		/*!< selects different versions of snapshot file-formats */

  int NumFilesPerSnapshot;      /*!< number of files in multi-file snapshot dumps */
  int NumFilesWrittenInParallel;/*!< maximum number of files that may be written simultaneously when
                                     writing/reading restart-files, or when writing snapshot files */

  int BufferSize;		/*!< size of communication buffer in MB */
  int BunchSizeForce;		/*!< number of particles fitting into the buffer in the parallel tree-force algorithm  */
  int BunchSizeDensity;         /*!< number of particles fitting into the communication buffer in the density computation */
  int BunchSizeHydro;           /*!< number of particles fitting into the communication buffer in the SPH hydrodynamical force computation */
  int BunchSizeDomain;          /*!< number of particles fitting into the communication buffer in the domain decomposition */

  double PartAllocFactor;	/*!< in order to maintain work-load balance, the particle load will usually
				     NOT be balanced.  Each processor allocates memory for PartAllocFactor times
				     the average number of particles to allow for that */

  double TreeAllocFactor;	/*!< Each processor allocates a number of nodes which is TreeAllocFactor times
				     the maximum(!) number of particles.  Note: A typical local tree for N
				     particles needs usually about ~0.65*N nodes. */

  /* some SPH parameters */

  double DesNumNgb;             /*!< Desired number of SPH neighbours */
  double MaxNumNgbDeviation;    /*!< Maximum allowed deviation neighbour number */

  double ArtBulkViscConst;      /*!< Sets the parameter \f$\alpha\f$ of the artificial viscosity */
  double ArtBulkViscBeta;      /*!< Sets the parameter \f$\beta\f$ of the artificial viscosity */
  double InitGasTemp;		/*!< may be used to set the temperature in the IC's */
  double MinGasTemp;		/*!< may be used to set a floor for the gas temperature */
  double MinEgySpec;            /*!< the minimum allowed temperature expressed as energy per unit mass */

  /* some force counters  */

  long long TotNumOfForces;	             /*!< counts total number of force computations  */
  long long NumForcesSinceLastDomainDecomp;  /*!< count particle updates since last domain decomposition */

  /* system of units  */

  double G;                        /*!< Gravity-constant in internal units */
  double UnitTime_in_s;   	   /*!< factor to convert internal time unit to seconds/h */
  double UnitMass_in_g;            /*!< factor to convert internal mass unit to grams/h */
  double UnitVelocity_in_cm_per_s; /*!< factor to convert intqernal velocity unit to cm/sec */
  double UnitLength_in_cm;         /*!< factor to convert internal length unit to cm/h */
  double UnitPressure_in_cgs;      /*!< factor to convert internal pressure unit to cgs units (little 'h' still around!) */
  double UnitDensity_in_cgs;       /*!< factor to convert internal length unit to g/cm^3*h^2 */
  double UnitCoolingRate_in_cgs;   /*!< factor to convert internal cooling rate to cgs units */
  double UnitEnergy_in_cgs;        /*!< factor to convert internal energy to cgs units */
  double UnitTime_in_Megayears;    /*!< factor to convert internal time to megayears/h */
  double GravityConstantInternal;  /*!< If set to zero in the parameterfile, the internal value of the
                                        gravitational constant is set to the Newtonian value based on the system of
                                        units specified. Otherwise the value provided is taken as internal gravity constant G. */

  /* Cosmological parameters */

  double Hubble;       /*!< Hubble-constant in internal units */
  double Omega0;       /*!< matter density in units of the critical density (at z=0)*/
  double OmegaLambda;  /*!< vaccum energy density relative to crictical density (at z=0) */
  double OmegaBaryon;  /*!< baryon density in units of the critical density (at z=0)*/
  double HubbleParam;  /*!< little `h', i.e. Hubble constant in units of 100 km/s/Mpc.  Only needed to get absolute physical values for cooling physics */

  /* Code options */

  int ComovingIntegrationOn;	/*!< flags that comoving integration is enabled */
  int PeriodicBoundariesOn;     /*!< flags that periodic boundaries are enabled */
  int ResubmitOn;               /*!< flags that automatic resubmission of job to queue system is enabled */
  int TypeOfOpeningCriterion;   /*!< determines tree cell-opening criterion: 0 for Barnes-Hut, 1 for relative criterion */
  int TypeOfTimestepCriterion;  /*!< gives type of timestep criterion (only 0 supported right now - unlike gadget-1.1) */
  int OutputListOn;             /*!< flags that output times are listed in a specified file */

  /* Parameters determining output frequency */

  int SnapshotFileCount;        /*!< number of snapshot that is written next */
  double TimeBetSnapshot;       /*!< simulation time interval between snapshot files */
  double TimeOfFirstSnapshot;   /*!< simulation time of first snapshot files */
  double CpuTimeBetRestartFile; /*!< cpu-time between regularly generated restart files */
  double TimeLastRestartFile;   /*!< cpu-time when last restart-file was written */
  double TimeBetStatistics;     /*!< simulation time interval between computations of energy statistics */
  double TimeLastStatistics;    /*!< simulation time when the energy statistics was computed the last time */
  int NumCurrentTiStep;         /*!< counts the number of system steps taken up to this point */

  /* Current time of the simulation, global step, and end of simulation */

  double Time;                  /*!< current time of the simulation */
  double TimeBegin;             /*!< time of initial conditions of the simulation */
  double TimeStep;              /*!< difference between current times of previous and current timestep */
  double TimeMax;	        /*!< marks the point of time until the simulation is to be evolved */

  /* variables for organizing discrete timeline */

  double Timebase_interval;     /*!< factor to convert from floating point time interval to integer timeline */
  int Ti_Current;               /*!< current time on integer timeline */
  int Ti_nextoutput;            /*!< next output time on integer timeline */
#ifdef FLEXSTEPS
  int PresentMinStep;           /*!< If FLEXSTEPS is used, particle timesteps are chosen as multiples of the present minimum timestep. */
  int PresentMaxStep;		/*!< If FLEXSTEPS is used, this is the maximum timestep in timeline units, rounded down to the next power 2 division */
#endif
#ifdef PMGRID
  int PM_Ti_endstep;            /*!< begin of present long-range timestep */
  int PM_Ti_begstep;            /*!< end of present long-range timestep */
#endif

  /* Placement of PM grids */

#ifdef PMGRID
  double Asmth[2];              /*!< Gives the scale of the long-range/short-range split (in mesh-cells), both for the coarse and the high-res mesh */
  double Rcut[2];               /*!< Gives the maximum radius for which the short-range force is evaluated with the tree (in mesh-cells), both for the coarse and the high-res mesh */
  double Corner[2][3];          /*!< lower left corner of coarse and high-res PM-mesh */
  double UpperCorner[2][3];     /*!< upper right corner of coarse and high-res PM-mesh */
  double Xmintot[2][3];         /*!< minimum particle coordinates both for coarse and high-res PM-mesh */
  double Xmaxtot[2][3];         /*!< maximum particle coordinates both for coarse and high-res PM-mesh */
  double TotalMeshSize[2];      /*!< total extension of coarse and high-res PM-mesh */
#endif

  /* Variables that keep track of cumulative CPU consumption */

  double TimeLimitCPU;          /*!< CPU time limit as defined in parameterfile */
  double CPU_TreeConstruction;  /*!< time spent for constructing the gravitational tree */
  double CPU_TreeWalk;          /*!< actual time spent for pure tree-walks */
  double CPU_Gravity;           /*!< cumulative time used for gravity computation (tree-algorithm only) */
  double CPU_Potential;         /*!< time used for computing gravitational potentials */
  double CPU_Domain;            /*!< cumulative time spent for domain decomposition */
  double CPU_Snapshot;          /*!< time used for writing snapshot files */
  double CPU_Total;             /*!< cumulative time spent for domain decomposition */
  double CPU_CommSum;           /*!< accumulated time used for communication, and for collecting partial results, in tree-gravity */
  double CPU_Imbalance;         /*!< cumulative time lost accross all processors as work-load imbalance in gravitational tree */
  double CPU_HydCompWalk;       /*!< time used for actual SPH computations, including neighbour search */
  double CPU_HydCommSumm;       /*!< cumulative time used for communication in SPH, and for collecting partial results */
  double CPU_HydImbalance;      /*!< cumulative time lost due to work-load imbalance in SPH */
  double CPU_Hydro;             /*!< cumulative time spent for SPH related computations */
  double CPU_EnsureNgb;         /*!< time needed to iterate on correct neighbour numbers */
  double CPU_Predict;           /*!< cumulative time to drift the system forward in time, including dynamic tree updates */
  double CPU_TimeLine;          /*!< time used for determining new timesteps, and for organizing the timestepping, including kicks of active particles */
  double CPU_PM;                /*!< time used for long-range gravitational force */
  double CPU_Peano;             /*!< time required to establish Peano-Hilbert order */

  /* tree code opening criterion */

  double ErrTolTheta;		/*!< BH tree opening angle */
  double ErrTolForceAcc;	/*!< parameter for relative opening criterion in tree walk */

  /* adjusts accuracy of time-integration */

  double ErrTolIntAccuracy;	/*!< accuracy tolerance parameter \f$ \eta \f$ for timestep criterion. The
                                     timestep is \f$ \Delta t = \sqrt{\frac{2 \eta eps}{a}} \f$ */

  double MinSizeTimestep;       /*!< minimum allowed timestep. Normally, the simulation terminates if the
                                     timestep determined by the timestep criteria falls below this limit. */
  double MaxSizeTimestep;       /*!< maximum allowed timestep */

  double MaxRMSDisplacementFac; /*!< this determines a global timestep criterion for cosmological simulations
                                     in comoving coordinates.  To this end, the code computes the rms velocity
                                     of all particles, and limits the timestep such that the rms displacement
                                     is a fraction of the mean particle separation (determined from the
                                     particle mass and the cosmological parameters). This parameter specifies
                                     this fraction. */

  double CourantFac;		/*!< SPH-Courant factor */

  int BunchSizeTime;		/*!< number of particles fitting into the communication buffer in the timestep communication */

  /* frequency of tree reconstruction/domain decomposition */

  double TreeDomainUpdateFrequency; /*!< controls frequency of domain decompositions  */

  /* Gravitational and hydrodynamical softening lengths (given in terms of an `equivalent' Plummer softening length).
   * Five groups of particles are supported 0="gas", 1="halo", 2="disk", 3="bulge", 4="stars", 5="bndry"
   */

  double MinGasHsmlFractional;  /*!< minimum allowed SPH smoothing length in units of SPH gravitational softening length */
  double MinGasHsml;            /*!< minimum allowed SPH smoothing length */

  double SofteningGas;          /*!< comoving gravitational softening lengths for type 0 */
  double SofteningHalo;         /*!< comoving gravitational softening lengths for type 1 */
  double SofteningDisk;         /*!< comoving gravitational softening lengths for type 2 */
  double SofteningBulge;        /*!< comoving gravitational softening lengths for type 3 */
  double SofteningStars;        /*!< comoving gravitational softening lengths for type 4 */
  double SofteningBndry;        /*!< comoving gravitational softening lengths for type 5 */

  double SofteningGasMaxPhys;   /*!< maximum physical softening length for type 0 */
  double SofteningHaloMaxPhys;  /*!< maximum physical softening length for type 1 */
  double SofteningDiskMaxPhys;  /*!< maximum physical softening length for type 2 */
  double SofteningBulgeMaxPhys; /*!< maximum physical softening length for type 3 */
  double SofteningStarsMaxPhys; /*!< maximum physical softening length for type 4 */
  double SofteningBndryMaxPhys; /*!< maximum physical softening length for type 5 */

  double SofteningTable[6];     /*!< current (comoving) gravitational softening lengths for each particle type */
  double ForceSoftening[6];     /*!< the same, but multiplied by a factor 2.8 - at that scale the force is Newtonian */

  double MassTable[6];          /*!< Table with particle masses for particle types with equal mass.
                                     If particle masses are all equal for one type, the corresponding entry in MassTable
                                     is set to this value, allowing the size of the snapshot files to be reduced. */

  /* some filenames */

  char InitCondFile[MAXLEN_FILENAME];          /*!< filename of initial conditions */
  char OutputDir[MAXLEN_FILENAME];             /*!< output directory of the code */
  char SnapshotFileBase[MAXLEN_FILENAME];      /*!< basename to construct the names of snapshotf files */
  char EnergyFile[MAXLEN_FILENAME];            /*!< name of file with energy statistics */
  char CpuFile[MAXLEN_FILENAME];               /*!< name of file with cpu-time statistics */
  char InfoFile[MAXLEN_FILENAME];              /*!< name of log-file with a list of the timesteps taken */
  char TimingsFile[MAXLEN_FILENAME];           /*!< name of file with performance metrics of gravitational tree algorithm */
  char RestartFile[MAXLEN_FILENAME];           /*!< basename of restart-files */
  char ResubmitCommand[MAXLEN_FILENAME];       /*!< name of script-file that will be executed for automatic restart */
  char OutputListFilename[MAXLEN_FILENAME];    /*!< name of file with list of desired output times */

  double OutputListTimes[MAXLEN_OUTPUTLIST];   /*!< table with desired output times */
  int OutputListLength;                        /*!< number of output times stored in the table of desired output times */

}
 All;                                          /*!< a container variable for global variables that are equal on all processors */

/*! This structure holds all the information that is
 * stored for each particle of the simulation.
 */
extern struct particle_data
{
  FLOAT Pos[3];			/*!< particle position at its current time */
  FLOAT Mass;			/*!< particle mass */
  FLOAT Vel[3];			/*!< particle velocity at its current time */
  FLOAT GravAccel[3];		/*!< particle acceleration due to gravity */
#ifdef PMGRID
  FLOAT GravPM[3];		/*!< particle acceleration due to long-range PM gravity force*/
#endif
#ifdef FORCETEST
  FLOAT GravAccelDirect[3];	/*!< particle acceleration when computed with direct summation */
#endif
  FLOAT Potential;		/*!< gravitational potential */
  FLOAT OldAcc;			/*!< magnitude of old gravitational force. Used in relative opening criterion */
#ifndef LONGIDS
  unsigned int ID;		/*!< particle identifier */
#else
  unsigned long long ID;        /*!< particle identifier */
#endif

  int Type;		        /*!< flags particle type.  0=gas, 1=halo, 2=disk, 3=bulge, 4=stars, 5=bndry */
  int Ti_endstep;               /*!< marks start of current timestep of particle on integer timeline */
  int Ti_begstep;               /*!< marks end of current timestep of particle on integer timeline */
#ifdef TIMESTEP_LIMITER
  int Ti_sizestep;
#endif
#ifdef FLEXSTEPS
  int FlexStepGrp;		/*!< a random 'offset' on the timeline to create a smooth groouping of particles */
#endif
  float GravCost;		/*!< weight factor used for balancing the work-load */
#ifdef PSEUDOSYMMETRIC
  float AphysOld;               /*!< magnitude of acceleration in last timestep. Used to make a first order
                                     prediction of the change of acceleration expected in the future, thereby
                                     allowing to guess whether a decrease/increase of the timestep should occur
                                     in the timestep that is started. */
#endif
}
 *P,              /*!< holds particle data on local processor */
 *DomainPartBuf;  /*!< buffer for particle data used in domain decomposition */

/* the following struture holds data that is stored for each SPH particle in addition to the collisionless
 * variables.
 */
extern struct sph_particle_data
{
  FLOAT Entropy;                /*!< current value of entropy (actually entropic function) of particle */
  FLOAT Density;		/*!< current baryonic mass density of particle */
  FLOAT Hsml;			/*!< current smoothing length */
  FLOAT Left;                   /*!< lower bound in iterative smoothing length search */
  FLOAT Right;                  /*!< upper bound in iterative smoothing length search */
  FLOAT NumNgb;                 /*!< weighted number of neighbours found */
  FLOAT Pressure;		/*!< current pressure */
  FLOAT DtEntropy;              /*!< rate of change of entropy */
  FLOAT HydroAccel[3];		/*!< acceleration due to hydrodynamical force */
  FLOAT VelPred[3];		/*!< predicted SPH particle velocity at the current time */
  FLOAT DivVel;			/*!< local velocity divergence */
  FLOAT CurlVel;		/*!< local velocity curl */
  FLOAT Rot[3];		        /*!< local velocity curl */
  FLOAT DhsmlDensityFactor;     /*!< correction factor needed in the equation of motion of the conservative entropy formulation of SPH */
  FLOAT MaxSignalVel;           /*!< maximum "signal velocity" occuring for this particle */
#ifdef TIMESTEP_UPDATE
  int   FeedbackFlag;
  FLOAT FeedAccel[3];  /*!< acceleration due to feedback force */
#endif
#ifdef MORRIS97VISC
  FLOAT Alpha;		        /*!< viscosity coefficient */
  FLOAT DAlphaDt;       		/*!< time rate of change of viscosity coefficient */
#endif
}
 *SphP,                        	/*!< holds SPH particle data on local processor */
 *DomainSphBuf;                 /*!< buffer for SPH particle data in domain decomposition */

/*  Variables for Tree
 */

extern int MaxNodes;		/*!< maximum allowed number of internal nodes */
extern int Numnodestree;	/*!< number of (internal) nodes in each tree */

extern struct NODE
{
  FLOAT len;			/*!< sidelength of treenode */
  FLOAT center[3];		/*!< geometrical center of node */
#ifdef ADAPTIVE_GRAVSOFT_FORGAS
  FLOAT maxsoft;                /*!< hold the maximum gravitational softening of particles in the
                                     node if the ADAPTIVE_GRAVSOFT_FORGAS option is selected */
#endif
  union
  {
    int suns[8];		/*!< temporary pointers to daughter nodes */
    struct
    {
      FLOAT s[3];               /*!< center of mass of node */
      FLOAT mass;               /*!< mass of node */
      int bitflags;             /*!< a bit-field with various information on the node */
      int sibling;              /*!< this gives the next node in the walk in case the current node can be used */
      int nextnode;             /*!< this gives the next node in case the current node needs to be opened */
      int father;               /*!< this gives the parent node of each node (or -1 if we have the root node) */
    }
    d;
  }
  u;
}
 *Nodes_base,                   /*!< points to the actual memory allocted for the nodes */
 *Nodes;                        /*!< this is a pointer used to access the nodes which is shifted such that Nodes[All.MaxPart]
 				     gives the first allocated node */

extern int *Nextnode;	        /*!< gives next node in tree walk */
extern int *Father;	        /*!< gives parent node in tree    */

extern struct extNODE           /*!< this structure holds additional tree-node information which is not needed in the actual gravity computation */
{
  FLOAT hmax;			/*!< maximum SPH smoothing length in node. Only used for gas particles */
  FLOAT vs[3];			/*!< center-of-mass velocity */
}
 *Extnodes_base,                /*!< points to the actual memory allocted for the extended node information */
 *Extnodes;                     /*!< provides shifted access to extended node information, parallel to Nodes/Nodes_base */

/*! Header for the standard file format.
 */
extern struct io_header
{
  int npart[6];                        /*!< number of particles of each type in this file */
  double mass[6];                      /*!< mass of particles of each type. If 0, then the masses are explicitly
                                            stored in the mass-block of the snapshot file, otherwise they are omitted */
  double time;                         /*!< time of snapshot file */
  double redshift;                     /*!< redshift of snapshot file */
  int flag_sfr;                        /*!< flags whether the simulation was including star formation */
  int flag_feedback;                   /*!< flags whether feedback was included (obsolete) */
  unsigned int npartTotal[6];          /*!< total number of particles of each type in this snapshot. This can be
                                            different from npart if one is dealing with a multi-file snapshot. */
  int flag_cooling;                    /*!< flags whether cooling was included  */
  int num_files;                       /*!< number of files in multi-file snapshot */
  double BoxSize;                      /*!< box-size of simulation in case periodic boundaries were used */
  double Omega0;                       /*!< matter density in units of critical density */
  double OmegaLambda;                  /*!< cosmological constant parameter */
  double HubbleParam;                  /*!< Hubble parameter in units of 100 km/sec/Mpc */
  int flag_stellarage;                 /*!< flags whether the file contains formation times of star particles */
  int flag_metals;                     /*!< flags whether the file contains metallicity values for gas and star particles */
  unsigned int npartTotalHighWord[6];  /*!< High word of the total number of particles of each type */
  int  flag_entropy_instead_u;         /*!< flags that IC-file contains entropy instead of u */
  char fill[60];	               /*!< fills to 256 Bytes */
}
 header;                               /*!< holds header for snapshot files */

#define IO_NBLOCKS 11   /*!< total number of defined information blocks for snapshot files.
                             Must be equal to the number of entries in "enum iofields" */

enum iofields           /*!< this enumeration lists the defined output blocks in snapshot files. Not all of them need to be present. */
{
  IO_POS,
  IO_VEL,
  IO_ID,
  IO_MASS,
  IO_U,
  IO_RHO,
  IO_HSML,
  IO_POT,
  IO_ACCEL,
  IO_DTENTR,
  IO_TSTP,
};

extern char Tab_IO_Labels[IO_NBLOCKS][4];   /*<! This table holds four-byte character tags used for fileformat 2 */

/* global state of system, used for global statistics
 */
extern struct state_of_system
{
  double Mass;
  double EnergyKin;
  double EnergyPot;
  double EnergyInt;
  double EnergyTot;
  double Momentum[4];
  double AngMomentum[4];
  double CenterOfMass[4];
  double MassComp[6];
  double EnergyKinComp[6];
  double EnergyPotComp[6];
  double EnergyIntComp[6];
  double EnergyTotComp[6];
  double MomentumComp[6][4];
  double AngMomentumComp[6][4];
  double CenterOfMassComp[6][4];
}
 SysState;                       /*<! Structure for storing some global statistics about the simulation. */

/* Various structures for communication
 */
extern struct gravdata_in
{
  union
  {
    FLOAT Pos[3];
    FLOAT Acc[3];
    FLOAT Potential;
  }
  u;
#ifdef UNEQUALSOFTENINGS
  int Type;
#ifdef ADAPTIVE_GRAVSOFT_FORGAS
  FLOAT Soft;
#endif
#endif
  union
  {
    FLOAT OldAcc;
    int Ninteractions;
  }
  w;
}
 *GravDataIn,                   /*!< holds particle data to be exported to other processors */
 *GravDataGet,                  /*!< holds particle data imported from other processors */
 *GravDataResult,               /*!< holds the partial results computed for imported particles. Note: We use GravDataResult = GravDataGet, such that the result replaces the imported data */
 *GravDataOut;                  /*!< holds partial results received from other processors. This will overwrite the GravDataIn array */

extern struct gravdata_index
{
  int Task;
  int Index;
  int SortIndex;
}
 *GravDataIndexTable;           /*!< the particles to be exported are grouped by task-number. This table allows the results to be disentangled again and to be assigned to the correct particle */

extern struct densdata_in
{
  FLOAT Pos[3];
  FLOAT Vel[3];
  FLOAT Hsml;
  int Index;
  int Task;
}
 *DensDataIn,                   /*!< holds particle data for SPH density computation to be exported to other processors */
 *DensDataGet;                  /*!< holds imported particle data for SPH density computation */

extern struct densdata_out
{
  FLOAT Rho;
  FLOAT Div, Rot[3];
  FLOAT DhsmlDensity;
  FLOAT Ngb;
}
 *DensDataResult,               /*!< stores the locally computed SPH density results for imported particles */
 *DensDataPartialResult;        /*!< imported partial SPH density results from other processors */

extern struct hydrodata_in
{
  FLOAT Pos[3];
  FLOAT Vel[3];
  FLOAT Hsml;
  FLOAT Mass;
  FLOAT Density;
  FLOAT Pressure;
  FLOAT F1;
  FLOAT DhsmlDensityFactor;
  int   Timestep;
  int   Task;
  int   Index;
#ifdef MORRIS97VISC
  FLOAT Alpha;
#endif
}
 *HydroDataIn,                  /*!< holds particle data for SPH hydro-force computation to be exported to other processors */
 *HydroDataGet;                 /*!< holds imported particle data for SPH hydro-force computation */

extern struct hydrodata_out
{
  FLOAT Acc[3];
  FLOAT DtEntropy;
  FLOAT MaxSignalVel;
}
 *HydroDataResult,              /*!< stores the locally computed SPH hydro results for imported particles */
 *HydroDataPartialResult;       /*!< imported partial SPH hydro-force results from other processors */

#ifdef TIMESTEP_LIMITER
  extern struct timedata_in
  {
    FLOAT  Pos[3];
    FLOAT  Hsml;
    int    Size;
    int    Begin;
    int    Index;
    int    Task;
  }
  *TimeDataIn,
  *TimeDataGet;
#endif

#ifndef NOMPI
#ifdef MPI_VERSION
    extern MPI_Comm GADGET_WORLD;
#endif
#endif

#endif


/*
* -----------------------------------------------------------------
*  Partially Stirred Reaction Library --- pasr_lib.h
*  Version: 1.6180
*  Date: Nov 16, 2010
* -----------------------------------------------------------------
*  Programmer: Americo Barbosa da Cunha Junior
*              americo.cunhajr@gmail.com
* -----------------------------------------------------------------
*  Copyright (c) 2010 by Americo Barbosa da Cunha Junior
*
*  This program is free software: you can redistribute it and/or
*  modify it under the terms of the GNU General Public License as
*  published by the Free Software Foundation, either version 3 of
*  the License, or (at your option) any later version.
*
*  This program is distributed in the hope that it will be useful,
*  but WITHOUT ANY WARRANTY; without even the implied warranty of
*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
*  GNU General Public License for more details.
*
*  A copy of the GNU General Public License is available in
*  LICENSE.txt or http://www.gnu.org/licenses/.
* -----------------------------------------------------------------
*  This is the header file for the PaSR model.
* -----------------------------------------------------------------
*/

#ifndef __PaSR_LIB_H__
#define __PaSR_LIB_H__

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

/*
* ------------------------------------------------------------
*  Types: struct pasr, pasr_wrk
* ------------------------------------------------------------
* This structure contains fields of PaSR model.
*
* last update: Nov 5, 2009
* ------------------------------------------------------------
*/

typedef struct pasr
{
    int *pasr_idx;         /* particles index vector */
    gsl_vector **pasr_ps;  /* particle system        */
} pasr_wrk;
/*------------------------------------------------------------*/

/*
*------------------------------------------------------------
* function prototypes
*------------------------------------------------------------
*/

void pasr_title();

int pasr_input(unsigned long int *seed,unsigned int *Np,unsigned int *K,
			double *t0,double *delta_t,double *tau_res,
				double *tau_mix,double *Tmax,double *Tmin);

pasr_wrk *pasr_alloc();

int pasr_init(int Np,int Neq,pasr_wrk *pasr);

void pasr_free(int Np,void **pasr_bl);

int pasr_set_all(int Np,gsl_vector *phi,pasr_wrk *pasr);

int pasr_Nexc(int Np,double delta_t,double tau_res);

void pasr_meanvar(int Np,int k,gsl_vector **ps,double *mean,double *var);

void pasr_iem(int Np,int Neq,double delta_t,double tau_mix,
			    double phi_m,int *idx,gsl_vector **ps);

void pmsr_iops(int Np,int Nexc,int Npair,gsl_rng *r,
				    gsl_vector *phi,pmsr_wrk *pmsr);

#endif /* __PaSR_LIB_H__ */


#pragma once

#ifndef _NOGSL
#include <gsl/gsl_vector.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_blas.h>
#else
#include "FakeGSL.h"
#endif

#include <vector>

#include <fstream>
#include <iostream>
#include "BasicError.h"
//#define _NOSNOPT 1
#ifndef _NOSNOPT
#include "Snopt.h"
#else
#include "CustomSolver.h"
#endif

using namespace std;
typedef int (* MAX_SOLVER_DF_TYPE)(integer*, doublereal*, integer*, doublereal*, integer*, doublereal*, char*, integer*);

class MaxSolver {
	integer n; integer neF; integer lenG;

	integer *iGfun;
	integer *jGvar;
	doublereal* G;

	doublereal *x;
	doublereal *xlow;
	doublereal *xupp;

	doublereal *F;
	doublereal *Flow;
	doublereal *Fupp;

	gsl_vector* result;
	double objectiveVal;

	MAX_SOLVER_DF_TYPE df;
	char* workspace;

	doublereal obj;
	doublereal* grad;
	doublereal* oldx;

	doublereal stepSize = 0.1;

	int maxSteps = 5000;

public:
	MaxSolver(integer n_, integer neF_): n(n_), neF(neF_){
		lenG = n*neF;
		iGfun = new integer[lenG];
		jGvar = new integer[lenG];
		G = new doublereal[lenG];

		grad = new doublereal[n];

		x = new doublereal[n];
		xlow = new doublereal[n];
		xupp = new doublereal[n];

		F = new doublereal[neF];
		Flow = new doublereal[neF];
		Fupp = new doublereal[neF];

		oldx = new doublereal[n];
		result = gsl_vector_alloc(n);
	}

	~MaxSolver() {
		delete []iGfun; delete []jGvar;
		delete []x; delete []xlow; delete []xupp;
		delete []F; delete []Flow; delete []Fupp;
	}

	void init(char* workspace, integer nef_, MAX_SOLVER_DF_TYPE _df, doublereal *xlow_, doublereal *xupp_, doublereal *Flow_, doublereal *Fupp_);

	bool optimize(const gsl_vector* initState, const gsl_vector* initDir, bool suppressPrint = false);

	gsl_vector* getResults() {
		return result;
	}

	double getObjectiveVal() {
		return objectiveVal;
	}

	bool inLimits();

};


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

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

/* This is an implementation of M. Luescher's second generation
   version of the RANLUX generator.

   Thanks to Martin Luescher for providing information on this
   generator.

 */

static unsigned long int ranlxs_get (void *vstate);
static inline double ranlxs_get_double (void *vstate);
static void ranlxs_set_lux (void *state, unsigned long int s, unsigned int luxury);
static void ranlxs0_set (void *state, unsigned long int s);
static void ranlxs1_set (void *state, unsigned long int s);
static void ranlxs2_set (void *state, unsigned long int s);

static const int next[12] = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 0};
static const int snext[24] = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
                              14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 0};

static const double sbase = 16777216.0;		/* 2^24 */
static const double sone_bit = 1.0 / 16777216.0;	/* 1/2^24 */
static const double one_bit = 1.0 / 281474976710656.0;	/* 1/2^48 */

static const double shift = 268435456.0;	/* 2^28 */

#define RANLUX_STEP(x1,x2,i1,i2,i3)      \
          x1=xdbl[i1] - xdbl[i2];        \
          if (x2 < 0)                    \
          {                              \
            x1-=one_bit;                 \
            x2+=1;                       \
          }                              \
          xdbl[i3]=x2

typedef struct
  {
    double xdbl[12], ydbl[12];  /* doubles first so they are 8-byte aligned */
    double carry;
    float xflt[24];
    unsigned int ir;
    unsigned int jr;
    unsigned int is;
    unsigned int is_old;
    unsigned int pr;
  }
ranlxs_state_t;

static void increment_state (ranlxs_state_t * state);

static void
increment_state (ranlxs_state_t * state)
{
  int k, kmax, m;
  double x, y1, y2, y3;

  float *xflt = state->xflt;
  double *xdbl = state->xdbl;
  double *ydbl = state->ydbl;
  double carry = state->carry;
  unsigned int ir = state->ir;
  unsigned int jr = state->jr;

  for (k = 0; ir > 0; ++k)
    {
      y1 = xdbl[jr] - xdbl[ir];
      y2 = y1 - carry;
      if (y2 < 0)
	{
	  carry = one_bit;
	  y2 += 1;
	}
      else
	{
	  carry = 0;
	}
      xdbl[ir] = y2;
      ir = next[ir];
      jr = next[jr];
    }

  kmax = state->pr - 12;

  for (; k <= kmax; k += 12)
    {
      y1 = xdbl[7] - xdbl[0];
      y1 -= carry;

      RANLUX_STEP (y2, y1, 8, 1, 0);
      RANLUX_STEP (y3, y2, 9, 2, 1);
      RANLUX_STEP (y1, y3, 10, 3, 2);
      RANLUX_STEP (y2, y1, 11, 4, 3);
      RANLUX_STEP (y3, y2, 0, 5, 4);
      RANLUX_STEP (y1, y3, 1, 6, 5);
      RANLUX_STEP (y2, y1, 2, 7, 6);
      RANLUX_STEP (y3, y2, 3, 8, 7);
      RANLUX_STEP (y1, y3, 4, 9, 8);
      RANLUX_STEP (y2, y1, 5, 10, 9);
      RANLUX_STEP (y3, y2, 6, 11, 10);

      if (y3 < 0)
	{
	  carry = one_bit;
	  y3 += 1;
	}
      else
	{
	  carry = 0;
	}
      xdbl[11] = y3;
    }

  kmax = state->pr;

  for (; k < kmax; ++k)
    {
      y1 = xdbl[jr] - xdbl[ir];
      y2 = y1 - carry;
      if (y2 < 0)
	{
	  carry = one_bit;
	  y2 += 1;
	}
      else
	{
	  carry = 0;
	}
      xdbl[ir] = y2;
      ydbl[ir] = y2 + shift;
      ir = next[ir];
      jr = next[jr];
    }

  ydbl[ir] = xdbl[ir] + shift;

  for (k = next[ir]; k > 0;)
    {
      ydbl[k] = xdbl[k] + shift;
      k = next[k];
    }

  for (k = 0, m = 0; k < 12; ++k)
    {
      x = xdbl[k];
      y2 = ydbl[k] - shift;
      if (y2 > x)
	y2 -= sone_bit;
      y1 = (x - y2) * sbase;

      xflt[m++] = (float) y1;
      xflt[m++] = (float) y2;
    }

  state->ir = ir;
  state->is = 2 * ir;
  state->is_old = 2 * ir;
  state->jr = jr;
  state->carry = carry;
}

static inline double
ranlxs_get_double (void *vstate)
{
  ranlxs_state_t *state = (ranlxs_state_t *) vstate;

  const unsigned int is = snext[state->is];

  state->is = is;

  if (is == state->is_old)
    increment_state (state);

  return state->xflt[state->is];
}

static unsigned long int
ranlxs_get (void *vstate)
{
  return ranlxs_get_double (vstate) * 16777216.0;	/* 2^24 */
}

static void
ranlxs_set_lux (void *vstate, unsigned long int s, unsigned int luxury)
{
  ranlxs_state_t *state = (ranlxs_state_t *) vstate;

  int ibit, jbit, i, k, m, xbit[31];
  double x, y;

  long int seed;

  if (s == 0)
    s = 1;			/* default seed is 1 */

  seed = s;

  i = seed & 0xFFFFFFFFUL;

  for (k = 0; k < 31; ++k)
    {
      xbit[k] = i % 2;
      i /= 2;
    }

  ibit = 0;
  jbit = 18;

  for (k = 0; k < 12; ++k)
    {
      x = 0;

      for (m = 1; m <= 48; ++m)
	{
	  y = (double) xbit[ibit];
	  x += x + y;
	  xbit[ibit] = (xbit[ibit] + xbit[jbit]) % 2;
	  ibit = (ibit + 1) % 31;
	  jbit = (jbit + 1) % 31;
	}
      state->xdbl[k] = one_bit * x;
    }

  state->carry = 0;
  state->ir = 0;
  state->jr = 7;
  state->is = 23;
  state->is_old = 0;
  state->pr = luxury;
}

static void
ranlxs0_set (void *vstate, unsigned long int s)
{
  ranlxs_set_lux (vstate, s, 109);
}

void
ranlxs1_set (void *vstate, unsigned long int s)
{
  ranlxs_set_lux (vstate, s, 202);
}

static void
ranlxs2_set (void *vstate, unsigned long int s)
{
  ranlxs_set_lux (vstate, s, 397);
}

static const gsl_rng_type ranlxs0_type =
{"ranlxs0",			/* name */
 0x00ffffffUL,			/* RAND_MAX */
 0,				/* RAND_MIN */
 sizeof (ranlxs_state_t),
 &ranlxs0_set,
 &ranlxs_get,
 &ranlxs_get_double};

static const gsl_rng_type ranlxs1_type =
{"ranlxs1",			/* name */
 0x00ffffffUL,			/* RAND_MAX */
 0,				/* RAND_MIN */
 sizeof (ranlxs_state_t),
 &ranlxs1_set,
 &ranlxs_get,
 &ranlxs_get_double};

static const gsl_rng_type ranlxs2_type =
{"ranlxs2",			/* name */
 0x00ffffffUL,			/* RAND_MAX */
 0,				/* RAND_MIN */
 sizeof (ranlxs_state_t),
 &ranlxs2_set,
 &ranlxs_get,
 &ranlxs_get_double};

const gsl_rng_type *gsl_rng_ranlxs0 = &ranlxs0_type;
const gsl_rng_type *gsl_rng_ranlxs1 = &ranlxs1_type;
const gsl_rng_type *gsl_rng_ranlxs2 = &ranlxs2_type;


#include <linux/types.h>
#include <linux/types.h>
#include <stdio.h>
#include <gsl/gsl_rng.h>
#include <math.h>

#include "sweeny_dc.h"
#include "timeseries.h"
#include "extract_args.h"

#define BUF_LEN 512
char fn[BUF_LEN];
char verbose = 0;

#define TS_FILE_D  "../time_series/dc/simulation_l%u_q%.4f_b%.4f_c%.4f_s%u.hdf5"
char impl_title[] = "Dynamic Connectivity implementation";
__u32 DX;
__u32 seed;
__u32 cutoff;
__u32 steps;
double beta;
double coupling;
double q;
double rnd_num;

__u32 *num_bonds, *num_cluster, *size_giant;
__u64 *sec_cs_moment,*four_cs_moment;

int main(int argc, char **argv) {

    if(!extractArgs(argc, argv,impl_title))
      return EXIT_FAILURE;
    snprintf(fn,BUF_LEN,TS_FILE_D,DX,q,beta,coupling,seed);
    if(!init_observables())
        return EXIT_FAILURE;
    if(!init_sweeny_dc(q,DX,beta,coupling,cutoff,steps,seed,num_bonds,num_cluster,size_giant,
                sec_cs_moment,four_cs_moment))
        return EXIT_FAILURE;
    if(!simulate_sweeny_dc())
        return EXIT_FAILURE;
    destroy_sweeny_dc();
    save_timeseries();
    destroy_observables();
    return EXIT_SUCCESS;

}


/*! \file ExtremaRootFinding.h
 *  \brief header file for finding roots and extrema of a function
    \todo not implemented yet
 */

#ifndef MINMAXROOT_H
#define MINMAXROOT_H

#include <cmath>
#include <iostream>
#include <gsl/gsl_math.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_cdf.h>
#include <Precision.h>
#include <Function.h>
#include <Matrix.h>
#include <GMatrix.h>
#include <Interpolate.h>

using namespace std;
namespace Math
{
    //// Brent bracket search for extrema
    //Double_t Brent();
}

#endif


/**
 *
 * @file qwrapper_spotrf.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
 * @author Mathieu Faverge
 * @author Jakub Kurzak
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:44:56 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_slauum(Quark *quark, Quark_Task_Flags *task_flags,
                       PLASMA_enum uplo, int n, int nb,
                       float *A, int lda)
{
    DAG_CORE_LAUUM;
    QUARK_Insert_Task(quark, CORE_slauum_quark, task_flags,
        sizeof(PLASMA_enum),                &uplo,  VALUE,
        sizeof(int),                        &n,     VALUE,
        sizeof(float)*nb*nb,    A,             INOUT,
        sizeof(int),                        &lda,   VALUE,
        0);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_slauum_quark = PCORE_slauum_quark
#define CORE_slauum_quark PCORE_slauum_quark
#endif
void CORE_slauum_quark(Quark *quark)
{
    PLASMA_enum uplo;
    int N;
    float *A;
    int LDA;

    quark_unpack_args_4(quark, uplo, N, A, LDA);
    LAPACKE_slauum_work(LAPACK_COL_MAJOR, lapack_const(uplo), N, A, LDA);
}