/**
 *
 * @file core_sgetrf_rectil.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Hatem Ltaief
 * @author Mathieu Faverge
 * @author Piotr Luszczek
 * @date 2009-11-15
 *
 * @generated s Tue Jan  7 11:44:48 2014
 *
 **/

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

#define A(m, n) BLKADDR(A, float, m, n)

void
CORE_sgetrf_rectil_init(void);

static inline void
CORE_sgetrf_rectil_rec(const PLASMA_desc A, int *IPIV, int *info,
                       float *pivot,
                       int thidx,  int thcnt,
                       int column, int width,
                       int ft,     int lt);
static inline void
CORE_sgetrf_rectil_update(const PLASMA_desc A, int *IPIV,
                          int column, int n1,     int n2,
                          int thidx,  int thcnt,
                          int ft,     int lt);

/***************************************************************************//**
 *
 * @ingroup CORE_float
 *
 *  CORE_sgetrf_rectil computes a LU factorization of a general M-by-N
 *  matrix A stored in CCRB layout using partial pivoting with row
 *  interchanges.
 *
 *  The factorization has the form
 *
 *    A = P * L * U
 *
 *  where P is a permutation matrix, L is lower triangular with unit
 *  diagonal elements (lower trapezoidal if m > n), and U is upper
 *  triangular (upper trapezoidal if m < n).
 *
 *  This is the recursive version of the algorithm applied on tile layout.
 *
 *  WARNINGS:
 *     - The function CORE_sgetrf_rectil_init has to be called prior
 *     to any call to this function.
 *     - You cannot call this kernel on different matrices at the same
 *     time.
 *     - The matrix A cannot be more than one tile wide.
 *     - The number of threads calling this function has to be excatly
 *     the number defined by info[2] with each one of them a different
 *     index between 0 included and info[2] excluded.
 *
 *******************************************************************************
 *
 *  @param[in,out] A
 *          PLASMA descriptor of the matrix A to be factorized.
 *          On entry, the M-by-N matrix to be factorized.
 *          On exit, the factors L and U from the factorization
 *          A = P*L*U; the unit diagonal elements of L are not stored.
 *
 *  @param[out] IPIV
 *          The pivot indices; for 0 <= i < min(M,N) stored in Fortran
 *          mode (starting at 1), row i of the matrix was interchanged
 *          with row IPIV(i).
 *          On exit, each value IPIV[i] for 0 <= i < min(M,N) is
 *          increased by A.i, which means A.i < IPIV[i] <= A.i+M.
 *
 *  @param[in,out] info
 *          Array of 3 integers.
 *          - info[0], see returned value
 *          - info[1], is the thread index 0 <= info[0] < info[2]
 *          - info[2], on entry is the number of threads trying to
 *                     participate to the factorization,
 *                     on exit is the real number of threads used to
 *                     perform the factorization.
 *    Info[2] threads, and exactly info[2], have to call this function
 *    to avoid dead lock.
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval -k, the k-th argument had an illegal value
 *          \retval k if U(k,k) is exactly zero. The factorization
 *                  has been completed, but the factor U is exactly
 *                  singular, and division by zero will occur if it is used
 *                  to solve a system of equations.
 *
 */
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_sgetrf_rectil = PCORE_sgetrf_rectil
#define CORE_sgetrf_rectil PCORE_sgetrf_rectil
#endif
int CORE_sgetrf_rectil(const PLASMA_desc A, int *IPIV, int *info)
{
    int ft, lt;
    int thidx = info[1];
    int thcnt = min( info[2], A.mt );
    int minMN = min( A.m, A.n );
    float pivot;

    info[0] = 0;
    info[2] = thcnt;

    if ( A.nt > 1 ) {
        coreblas_error(1, "Illegal value of A.nt");
        info[0] = -1;
        return -1;
    }

    if ( thidx >= thcnt )
      return 0;

    int q = A.mt / thcnt;
    int r = A.mt % thcnt;

    if (thidx < r) {
        q++;
        ft = thidx * q;
        lt = ft + q;
    } else {
        ft = r * (q + 1) + (thidx - r) * q;
        lt = ft + q;
        lt = min( lt, A.mt );
    }

    CORE_sgetrf_rectil_rec( A, IPIV, info, &pivot,
                            thidx, thcnt, 0, minMN, ft, lt);

    if ( A.n > minMN ) {
        CORE_sgetrf_rectil_update( A, IPIV,
                                   0, minMN, A.n-minMN,
                                   thidx, thcnt,
                                   ft, lt);
    }

    return info[0];
}

/*******************************************************************
 *   Additional routines
 */
#define AMAX1BUF_SIZE (48 << 1)

/* 48 threads should be enough for everybody */
static volatile float CORE_samax1buf[AMAX1BUF_SIZE];
static float sfmin;

void
CORE_sgetrf_rectil_init(void)
{
    int i;
    for (i = 0; i < AMAX1BUF_SIZE; ++i) CORE_samax1buf[i] = -1.0;
    sfmin =  LAPACKE_slamch_work('S');
}

static void
CORE_samax1_thread(float localamx,
                   int thidx, int thcnt, int *thwinner,
                   float *diagvalue,
                   float *globalamx,
                   int pividx, int *ipiv)
{
    if (thidx == 0) {
        int i, j = 0;
        float curval = localamx, tmp;
        float curamx = fabsf(localamx);

        /* make sure everybody filled in their value */
        for (i = 1; i < thcnt; ++i) {
            while (CORE_samax1buf[i << 1] == -1.0) { /* wait for thread i to store its value */
            }
        }

        /* better not fuse the loop above and below to make sure data is sync'd */

        for (i = 1; i < thcnt; ++i) {
            tmp = CORE_samax1buf[ (i << 1) + 1];
            if (fabsf(tmp) > curamx) {
                curamx = fabsf(tmp);
                curval = tmp;
                j = i;
            }
        }

        if (0 == j)
            ipiv[0] = pividx;

        /* make sure everybody knows the amax value */
        for (i = 1; i < thcnt; ++i)
            CORE_samax1buf[ (i << 1) + 1] = curval;

        CORE_samax1buf[0] = -j - 2.0; /* set the index of the winning thread */
        CORE_samax1buf[1] = *diagvalue; /* set the index of the winning thread */

        *thwinner = j;
        *globalamx = curval;

        for (i = 1; i < thcnt; ++i)
            CORE_samax1buf[i << 1] = -3.0;

        /* make sure everybody read the max value */
        for (i = 1; i < thcnt; ++i) {
            while (CORE_samax1buf[i << 1] != -1.0) {
            }
        }

        CORE_samax1buf[0] = -1.0;
    } else {
        CORE_samax1buf[(thidx << 1) + 1] = localamx;
        CORE_samax1buf[thidx << 1] = -2.0;  /* announce to thread 0 that local amax was stored */
        while (CORE_samax1buf[0] == -1.0) { /* wait for thread 0 to finish calculating the global amax */
        }
        while (CORE_samax1buf[thidx << 1] != -3.0) { /* wait for thread 0 to store amax */
        }
        *thwinner  = -CORE_samax1buf[0] - 2.0;
        *diagvalue = CORE_samax1buf[1];
        *globalamx = CORE_samax1buf[(thidx << 1) + 1]; /* read the amax from the location adjacent to the one in the above loop */
        CORE_samax1buf[thidx << 1] = -1.0;  /* signal thread 0 that this thread is done reading */

        if (thidx == *thwinner)
            ipiv[0] = pividx;

        while (CORE_samax1buf[0] != -1.0) { /* wait for thread 0 to finish */
        }
    }
}

static void
CORE_sbarrier_thread(int thidx,
                     int thcnt)
{
    int idum1, idum2;
    float ddum1 = 0.;
    float ddum2 = 0.;
    /* it's probably faster to implement a dedicated barrier */
    CORE_samax1_thread( 1.0, thidx, thcnt, &idum1, &ddum1, &ddum2, 0, &idum2 );
}

static inline void
CORE_sgetrf_rectil_update(const PLASMA_desc A, int *IPIV,
                          int column, int n1,     int n2,
                          int thidx,  int thcnt,
                          int ft,     int lt)
{
    int ld, lm, tmpM;
    int ip, j, it, i, ldft;
    float zone  = 1.0;
    float mzone = -1.0;
    float *Atop, *Atop2, *U, *L;
    int offset = A.i;

    ldft = BLKLDD(A, 0);
    Atop  = A(0, 0) + column * ldft;
    Atop2 = Atop    + n1     * ldft;

    if (thidx == 0)
    {
        /* Swap to the right */
        int *lipiv = IPIV+column;
        int idxMax = column+n1;
        for (j = column; j < idxMax; ++j, ++lipiv) {
            ip = (*lipiv) - offset - 1;
            if ( ip != j )
            {
                it = ip / A.mb;
                i  = ip % A.mb;
                ld = BLKLDD(A, it);
                cblas_sswap(n2, Atop2                     + j, ldft,
                            A(it, 0) + (column+n1)*ld + i, ld   );
            }
        }

        /* Trsm on the upper part */
        U = Atop2 + column;
        cblas_strsm( CblasColMajor, CblasLeft, CblasLower,
                     CblasNoTrans, CblasUnit,
                     n1, n2, (zone),
                     Atop  + column, ldft,
                     U,              ldft );

        /* Signal to other threads that they can start update */
        CORE_sbarrier_thread( thidx, thcnt );

        /* First tile */
        L = Atop + column + n1;
        tmpM = min(ldft, A.m) - column - n1;

        /* Apply the GEMM */
        cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                     tmpM, n2, n1,
                     (mzone), L,      ldft,
                     U,      ldft,
                     (zone),  U + n1, ldft );

    }
    else
    {
        ld = BLKLDD( A, ft );
        L  = A( ft, 0 ) + column * ld;
        lm = ft == A.mt-1 ? A.m - ft * A.mb : A.mb;

        U = Atop2 + column;

        /* Wait for pivoting and triangular solve to be finished
         * before to really start the update */
        CORE_sbarrier_thread( thidx, thcnt );

        /* First tile */
        /* Apply the GEMM */
        cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                     lm, n2, n1,
                     (mzone), L,         ld,
                                         U,         ldft,
                     (zone),  L + n1*ld, ld );
    }

    /* Update the other blocks */
    for( it = ft+1; it < lt; it++)
    {
        ld = BLKLDD( A, it );
        L  = A( it, 0 ) + column * ld;
        lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;

        /* Apply the GEMM */
        cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                     lm, n2, n1,
                     (mzone), L,          ld,
                                         U,          ldft,
                     (zone),  L + n1*ld,  ld );
    }
}

static void
CORE_sgetrf_rectil_rec(const PLASMA_desc A, int *IPIV, int *info,
                       float *pivot,
                       int thidx,  int thcnt,
                       int column, int width,
                       int ft,     int lt)
{
    int ld, jp, n1, n2, lm, tmpM, piv_sf;
    int ip, j, it, i, ldft;
    int max_i, max_it, thwin;
    float zone  = 1.0;
    float mzone = -1.0;
    float tmp1;
    float tmp2 = 0.;
    float pivval;
    float *Atop, *Atop2, *U, *L;
    float             abstmp1;
    int offset = A.i;

    ldft = BLKLDD(A, 0);
    Atop = A(0, 0) + column * ldft;

    if ( width > 1 ) {
        /* Assumption: N = min( M, N ); */
        n1 = width / 2;
        n2 = width - n1;

        Atop2 = Atop + n1 * ldft;

        CORE_sgetrf_rectil_rec( A, IPIV, info, pivot,
                                thidx, thcnt, column, n1, ft, lt );

        if ( *info != 0 )
            return;

        if (thidx == 0)
        {
            /* Swap to the right */
            int *lipiv = IPIV+column;
            int idxMax = column+n1;
            for (j = column; j < idxMax; ++j, ++lipiv) {
                ip = (*lipiv) - offset - 1;
                if ( ip != j )
                {
                    it = ip / A.mb;
                    i  = ip % A.mb;
                    ld = BLKLDD(A, it);
                    cblas_sswap(n2, Atop2                     + j, ldft,
                                    A(it, 0) + (column+n1)*ld + i, ld   );
                }
            }
            /* Trsm on the upper part */
            U = Atop2 + column;
            cblas_strsm( CblasColMajor, CblasLeft, CblasLower,
                         CblasNoTrans, CblasUnit,
                         n1, n2, (zone),
                         Atop  + column, ldft,
                         U,              ldft );

            /* SIgnal to other threads that they can start update */
            CORE_sbarrier_thread( thidx, thcnt );
            pivval = *pivot;
            if ( pivval == 0.0 ) {
                *info = column+n1;
                return;
            } else {
                if ( fabsf(pivval) >= sfmin ) {
                    piv_sf = 1;
                    pivval = 1.0 / pivval;
                } else {
                    piv_sf = 0;
                }
            }

            /* First tile */
            {
                L = Atop + column + n1;
                tmpM = min(ldft, A.m) - column - n1;

                /* Scale last column of L */
                if ( piv_sf ) {
                    cblas_sscal( tmpM, (pivval), L+(n1-1)*ldft, 1 );
                } else {
                    int i;
                    Atop2 = L+(n1-1)*ldft;
                    for( i=0; i < tmpM; i++, Atop2++)
                        *Atop2 = *Atop2 / pivval;
                }

                /* Apply the GEMM */
                cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                             tmpM, n2, n1,
                             (mzone), L,      ldft,
                                                 U,      ldft,
                             (zone),  U + n1, ldft );

                /* Search Max in first column of U+n1 */
                tmp2    = U[n1];
                max_it  = ft;
                max_i   = cblas_isamax( tmpM, U+n1, 1 ) + n1;
                tmp1    = U[max_i];
                abstmp1 = fabsf(tmp1);
                max_i   += column;
            }
        }
        else
        {
            pivval = *pivot;
            if ( pivval == 0.0 ) {
                *info = column+n1;
                return;
            } else {
                if ( fabsf(pivval) >= sfmin ) {
                    piv_sf = 1;
                    pivval = 1.0 / pivval;
                } else {
                    piv_sf = 0;
                }
            }

            ld = BLKLDD( A, ft );
            L  = A( ft, 0 ) + column * ld;
            lm = ft == A.mt-1 ? A.m - ft * A.mb : A.mb;

            U = Atop2 + column;

            /* First tile */
            /* Scale last column of L */
            if ( piv_sf ) {
                cblas_sscal( lm, (pivval), L+(n1-1)*ld, 1 );
            } else {
                int i;
                Atop2 = L+(n1-1)*ld;
                for( i=0; i < lm; i++, Atop2++)
                    *Atop2 = *Atop2 / pivval;
            }

            /* Wait for pivoting and triangular solve to be finished
             * before to really start the update */
            CORE_sbarrier_thread( thidx, thcnt );

            /* Apply the GEMM */
            cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                         lm, n2, n1,
                         (mzone), L,         ld,
                                             U,         ldft,
                         (zone),  L + n1*ld, ld );

            /* Search Max in first column of L+n1*ld */
            max_it  = ft;
            max_i   = cblas_isamax( lm, L+n1*ld, 1 );
            tmp1    = L[n1*ld+max_i];
            abstmp1 = fabsf(tmp1);
        }

        /* Update the other blocks */
        for( it = ft+1; it < lt; it++)
        {
            ld = BLKLDD( A, it );
            L  = A( it, 0 ) + column * ld;
            lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;

            /* Scale last column of L */
            if ( piv_sf ) {
                cblas_sscal( lm, (pivval), L+(n1-1)*ld, 1 );
            } else {
                int i;
                Atop2 = L+(n1-1)*ld;
                for( i=0; i < lm; i++, Atop2++)
                    *Atop2 = *Atop2 / pivval;
            }

            /* Apply the GEMM */
            cblas_sgemm( CblasColMajor, CblasNoTrans, CblasNoTrans,
                         lm, n2, n1,
                         (mzone), L,          ld,
                                             U,          ldft,
                         (zone),  L + n1*ld,  ld );

            /* Search the max on the first column of L+n1*ld */
            jp = cblas_isamax( lm, L+n1*ld, 1 );
            if ( fabsf( L[n1*ld+jp] ) > abstmp1 ) {
                tmp1 = L[n1*ld+jp];
                abstmp1 = fabsf(tmp1);
                max_i  = jp;
                max_it = it;
            }
        }

        jp = offset + max_it*A.mb + max_i;
        CORE_samax1_thread( tmp1, thidx, thcnt, &thwin,
                            &tmp2, pivot, jp + 1, IPIV + column + n1 );

        if ( thidx == 0 ) {
            U[n1] = *pivot; /* all threads have the pivot element: no need for synchronization */
        }
        if (thwin == thidx) { /* the thread that owns the best pivot */
            if ( jp-offset != column+n1 ) /* if there is a need to exchange the pivot */
            {
                ld = BLKLDD(A, max_it);
                Atop2 = A( max_it, 0 ) + (column + n1 )* ld + max_i;
                *Atop2 = tmp2;
            }
        }

        CORE_sgetrf_rectil_rec( A, IPIV, info, pivot,
                                thidx, thcnt, column+n1, n2, ft, lt );
        if ( *info != 0 )
            return;

        if ( thidx == 0 )
        {
            /* Swap to the left */
            int *lipiv = IPIV+column+n1;
            int idxMax = column+width;
            for (j = column+n1; j < idxMax; ++j, ++lipiv) {
                ip = (*lipiv) - offset - 1;
                if ( ip != j )
                {
                    it = ip / A.mb;
                    i  = ip % A.mb;
                    ld = BLKLDD(A, it);
                    cblas_sswap(n1, Atop + j,                 ldft,
                                    A(it, 0) + column*ld + i, ld  );
                }
            }
        }

    } else if ( width == 1 ) {

        /* Search maximum for column 0 */
        if ( column == 0 )
        {
            if ( thidx == 0 )
              tmp2 = Atop[column];

            /* First tmp1 */
            ld = BLKLDD(A, ft);
            Atop2   = A( ft, 0 );
            lm      = ft == A.mt-1 ? A.m - ft * A.mb : A.mb;
            max_it  = ft;
            max_i   = cblas_isamax( lm, Atop2, 1 );
            tmp1    = Atop2[max_i];
            abstmp1 = fabsf(tmp1);

            /* Update */
            for( it = ft+1; it < lt; it++)
            {
                Atop2= A( it, 0 );
                lm   = it == A.mt-1 ? A.m - it * A.mb : A.mb;
                jp   = cblas_isamax( lm, Atop2, 1 );
                if (  fabsf(Atop2[jp]) > abstmp1 ) {
                    tmp1 = Atop2[jp];
                    abstmp1 = fabsf(tmp1);
                    max_i  = jp;
                    max_it = it;
                }
            }

            jp = offset + max_it*A.mb + max_i;
            CORE_samax1_thread( tmp1, thidx, thcnt, &thwin,
                                &tmp2, pivot, jp + 1, IPIV + column );

            if ( thidx == 0 ) {
                Atop[0] = *pivot; /* all threads have the pivot element: no need for synchronization */
            }
            if (thwin == thidx) { /* the thread that owns the best pivot */
                if ( jp-offset != 0 ) /* if there is a need to exchange the pivot */
                {
                    Atop2 = A( max_it, 0 ) + max_i;
                    *Atop2 = tmp2;
                }
            }
        }

        CORE_sbarrier_thread( thidx, thcnt );

        /* If it is the last column, we just scale */
        if ( column == (min(A.m, A.n))-1 ) {

            pivval = *pivot;
            if ( pivval != 0.0 ) {
                if ( thidx == 0 ) {
                    if ( fabsf(pivval) >= sfmin ) {
                        pivval = 1.0 / pivval;

                        /*
                         * We guess than we never enter the function with m == A.mt-1
                         * because it means that there is only one thread
                         */
                        lm = ft == A.mt-1 ? A.m - ft * A.mb : A.mb;
                        cblas_sscal( lm - column - 1, (pivval), Atop+column+1, 1 );

                        for( it = ft+1; it < lt; it++)
                        {
                            ld = BLKLDD(A, it);
                            Atop2 = A( it, 0 ) + column * ld;
                            lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;
                            cblas_sscal( lm, (pivval), Atop2, 1 );
                        }
                    } else {
                        /*
                         * We guess than we never enter the function with m == A.mt-1
                         * because it means that there is only one thread
                         */
                        int i;
                        Atop2 = Atop + column + 1;
                        lm = ft == A.mt-1 ? A.m - ft * A.mb : A.mb;

                        for( i=0; i < lm-column-1; i++, Atop2++)
                            *Atop2 = *Atop2 / pivval;

                        for( it = ft+1; it < lt; it++)
                            {
                                ld = BLKLDD(A, it);
                                Atop2 = A( it, 0 ) + column * ld;
                                lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;

                                for( i=0; i < lm; i++, Atop2++)
                                    *Atop2 = *Atop2 / pivval;
                            }
                    }
                }
                else
                {
                    if ( fabsf(pivval) >= sfmin ) {
                        pivval = 1.0 / pivval;

                        for( it = ft; it < lt; it++)
                        {
                            ld = BLKLDD(A, it);
                            Atop2 = A( it, 0 ) + column * ld;
                            lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;
                            cblas_sscal( lm, (pivval), Atop2, 1 );
                        }
                    } else {
                        /*
                         * We guess than we never enter the function with m == A.mt-1
                         * because it means that there is only one thread
                         */
                        int i;
                        for( it = ft; it < lt; it++)
                        {
                            ld = BLKLDD(A, it);
                            Atop2 = A( it, 0 ) + column * ld;
                            lm = it == A.mt-1 ? A.m - it * A.mb : A.mb;

                            for( i=0; i < lm; i++, Atop2++)
                                *Atop2 = *Atop2 / pivval;
                        }
                    }
                }
            }
            else {
                *info = column + 1;
                return;
            }
        }
    }
}


/*
 * BRAINS
 * (B)LR (R)everberation-mapping (A)nalysis (I)n AGNs with (N)ested (S)ampling
 * Yan-Rong Li, liyanrong@ihep.ac.cn
 * Thu, Aug 4, 2016
 */

/*!
 *  \file allvars.h
 *  \brief header file of allvars.c.
 */

#ifndef _ALLVARS_H
#define _ALLVARS_H

#include <stdio.h>
#include <stdlib.h>
#include <float.h>
#include <mpi.h>

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

/*! \def GRAVITY
 *  \brief Gravitational constant.

 *  \def SOLAR_MASS
 *  \brief Solar mass.

 *  \def C
 *  \brief speed of light.

 *  \def SEC_PER_YEAR
 *  \brief seconds per year.

 *  \def CM_PER_LD
 *  \brief light day in centimeter.

 *  \def PI
 *  \brief Pi.

 *  \def BRAINS_MAX_STR_LENGTH
 *  \brief maximum string length.
 */
#define GRAVITY       6.672e-8
#define SOLAR_MASS    1.989e33
#define C             2.9979e10
#define SEC_PER_YEAR  3.155e7
#define CM_PER_LD    (C*8.64e4)
#define CM_PER_PC    (3.08567758e+18)
#define CM_PER_MPC   (3.08567758e+24)

#define PI            M_PI
#define BRAINS_MAX_STR_LENGTH  (256)

#define EPS (DBL_MIN)  /* epsilon of the machine as in Matlab */

/* for PARDICT */
#define MAXTAGS 300
#define DOUBLE 1
#define STRING 2
#define INT 3

enum PRIOR_TYPE {GAUSSIAN=1, UNIFORM=2};

/* variables for MPICH */
extern int thistask, totaltask, namelen;
extern int roottask;
extern char proc_name[MPI_MAX_PROCESSOR_NAME];

/*! \struct PARSET
 *  \brief the configuration parameters.
 */
typedef struct
{
  char param_file[BRAINS_MAX_STR_LENGTH];
  char continuum_file[BRAINS_MAX_STR_LENGTH],
       line_file[BRAINS_MAX_STR_LENGTH],
       line2d_file[BRAINS_MAX_STR_LENGTH],
       pcon_out_file[BRAINS_MAX_STR_LENGTH],
       pline_out_file[BRAINS_MAX_STR_LENGTH],
       pline2d_out_file[BRAINS_MAX_STR_LENGTH],
       pline2d_data_out_file[BRAINS_MAX_STR_LENGTH],
       cloud_out_file[BRAINS_MAX_STR_LENGTH],
       tran_out_file[BRAINS_MAX_STR_LENGTH],
       tran2d_out_file[BRAINS_MAX_STR_LENGTH],
       tran2d_data_out_file[BRAINS_MAX_STR_LENGTH];

  char file_dir[BRAINS_MAX_STR_LENGTH];

  int flag_dim;

  int flag_trend, flag_trend_diff;

  int n_con_recon, n_line_recon, n_vel_recon;

  int n_tau;
  double rcloud_max, time_back;

  int flag_blrmodel;

  int n_cloud_per_task, n_vel_per_cloud;

  int flag_save_clouds;

  int flag_InstRes;
  double InstRes, InstRes_err;
  char file_instres[BRAINS_MAX_STR_LENGTH];

  int num_particles;

  char str_par_fix[BRAINS_MAX_STR_LENGTH], str_par_fix_val[BRAINS_MAX_STR_LENGTH];

  int flag_narrowline;
  double flux_narrowline, width_narrowline, shift_narrowline;
  double flux_narrowline_err, width_narrowline_err, shift_narrowline_err;

  int flag_linecenter;
  double linecenter_err;

  int flag_postprc;
  int flag_restart;
  int flag_sample_info;
  int flag_temp;
  int flag_exam_prior;
  int flag_rng_seed, rng_seed;
  int flag_fixvar;
  int flag_nonlinear;

  int flag_force_update;
  int flag_force_run;

  int flag_con_sys_err, flag_line_sys_err;

  double temperature;

  int flag_help, flag_end;
  int flag_para_name;

  double redshift;
  double linecenter;
#ifdef SA
  char sa_file[BRAINS_MAX_STR_LENGTH];
  int flag_sa_blrmodel, flag_sa_par_mutual;
  double sa_linecenter;
  double sa_InstRes;
  char sa_str_par_fix[BRAINS_MAX_STR_LENGTH], sa_str_par_fix_val[BRAINS_MAX_STR_LENGTH];
  int n_sa_vel_recon, n_sa_base_recon;
#endif
}PARSET;
extern PARSET parset;

typedef struct
{
  int id;
  void *addr;
  char tag[50];
  int isset;
}PARDICT;
extern PARDICT *pardict;
extern int num_pardict;

extern double VelUnit, C_Unit;

extern int n_con_data, n_line_data, n_vel_data, n_vel_data_incr, n_vel_data_ext, n_con_max;
extern double *Tcon_data, *Fcon_data,  *Fcerrs_data;
extern double *Tline_data, *Fline_data, *Flerrs_data;
extern double *Vline_data, *Fline2d_data, *Flerrs2d_data, *Wline_data;
extern double *Vline_data_ext, *Wline_data_ext;
extern double con_scale, line_scale;

extern double con_error_mean, line_error_mean, line_error_mean_sq;

extern char dnest_options_file[BRAINS_MAX_STR_LENGTH];

extern int which_parameter_update, which_particle_update;  // which parameter and particle to be updated
extern int which_level_update;
extern double *limits;  // external from dnest

/* continuum reconstruction */
extern int nq;
extern double *Tcon, *Fcon, *Fcerrs, *Fcon_rm;
extern double Tcon_min, Tcon_max;
extern double *PSmat, *USmat, *PSmat_data;
extern double *PCmat_data, *IPCmat_data, *PQmat, *PEmat1, *PEmat2;
extern double *workspace, *workspace_uv;
extern double *var_param, *var_param_std;
extern double logz_con;
extern double *Larr_data, *Larr_rec;
extern double *pow_Tcon_data;

extern double Tspan_data, Tspan_data_con, Tcad_data, Tmed_data;

/* line reconstruction */
extern double *Fline_at_data;
extern double *Tline, *Fline, *Flerrs;
extern double Tline_min, Tline_max;
extern double logz_line;

/* line 2d reconstruction */
extern double *Fline2d_at_data;
extern double *Fline2d, *Flerrs2d;
extern double logz_line2d;

extern int BLRmodel_size;
extern int *par_fix, npar_fix;
extern double *par_fix_val;

extern int num_params_blr_tot;
extern int num_params, num_params_blr, num_params_blr_model, num_params_var, num_params_difftrend, num_params_nlr, num_params_res;
extern int num_params_drw, num_params_trend, num_params_resp;
extern int num_params_linecenter;

extern double **blr_range_model, **par_range_model;
extern int *par_prior_model;  /* prior type for model parameters */
extern double **par_prior_gaussian; /* center and std of Gaussian priors */
extern double var_range_model[15][2];
extern double nlr_range_model[3][2];
extern int nlr_prior_model[3];
extern double mass_range[2];
extern double sys_err_line_range[2]; /* range for systematic error of line */
extern double resp_range[2][2];
extern int idx_resp, idx_difftrend, idx_linecenter;

extern double *instres_epoch, *instres_err_epoch;

/* transfer function / velocity-delay map */
extern double *TransTau, *TransV, *TransW, *Trans1D, *Trans2D_at_veldata, *Trans2D;
extern double rcloud_min_set, rcloud_max_set, time_back_set;

extern double **Fcon_rm_particles, **Fcon_rm_particles_perturb;
extern double *prob_con_particles, *prob_con_particles_perturb;

extern int force_update;
extern double **TransTau_particles, **TransTau_particles_perturb;
extern double **Trans1D_particles, **Trans1D_particles_perturb;
extern double **Trans2D_at_veldata_particles, **Trans2D_at_veldata_particles_perturb;
extern double **Fline_at_data_particles, **Fline_at_data_particles_perturb;

extern double *clouds_tau, *clouds_weight, *clouds_vel;

extern FILE *fcloud_out;
extern int icr_cloud_save;

/* GSL */
extern const gsl_rng_type * gsl_T;
extern gsl_rng * gsl_r;

extern gsl_interp_accel *gsl_acc;
extern gsl_interp  *gsl_linear;

#ifdef SA
extern double PhaseFactor;

extern int num_params_rm;
extern int num_params_sa, num_params_sa_blr_model, num_params_sa_extpar, num_params_sa_blr;
extern int n_epoch_sa_data, n_vel_sa_data, n_base_sa_data;
extern double *vel_sa_data, *base_sa_data, *Fline_sa_data, *Flerrs_sa_data, *phase_sa_data, *pherrs_sa_data;
extern double *wave_sa_data;

extern double sa_flux_norm;

extern double *phase_sa, *Fline_sa, *base_sa, *vel_sa, *wave_sa;

extern double *clouds_alpha, *clouds_beta;

extern double **sa_extpar_range, **sa_blr_range_model;

extern int SABLRmodel_size;

extern int *idx_sa_par_mutual, *idx_rm_par_mutual;

extern double *prob_sa_particles, *prob_sa_particles_perturb;

extern double sa_phase_error_mean, sa_line_error_mean;

extern double *workspace_phase;
#endif
#endif


#include <string.h>
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_integration.h>

#include <fastpm/libfastpm.h>
#include <fastpm/logging.h>

#define LENGTH_FERMI_DIRAC_TABLE 4000 //sets the length of the table on which CDF
                                      //will be evaluated
#define MAX_FERMI_DIRAC          20.0 //Upper limit of F-D distribution in units of
                                      // p/T

#define NEXT(n, i)  (((n) + (i)/(n)) >> 1) // Needed for Healpix routine

//needed for healpix
unsigned int isqrt(int number) {
    unsigned int n  = 1;
    unsigned int n1 = NEXT(n, number);

    while(abs(n1 - n) > 1) {
        n  = n1;
        n1 = NEXT(n, number);
    }
    while(n1*n1 > number)
        n1--;
    return n1;
}

//Converts from pixel number to unit vector (needed for healpix)
void pix2vec (int pix, double *vec, int n_side)
{
    double z, phi;
    int nside_ = n_side;
    long ncap_=nside_*(nside_-1)*2;
    long npix_=12*nside_*nside_;
    double fact2_  = 4./npix_;
    if (pix<ncap_) /* North Polar cap */
    {
        int iring = (int)(0.5*(1+isqrt(1+2*pix))); /* counted from North pole */
        int iphi  = (pix+1) - 2*iring*(iring-1);

        z = 1.0 - (iring*iring)*fact2_;
        phi = (iphi-0.5) * 0.5*M_PI/iring;
    }
    else if (pix<(npix_-ncap_)) /* Equatorial region */
    {
        double fact1_  = (nside_<<1)*fact2_;
        int ip  = pix - ncap_;
        int iring = ip/(4*nside_) + nside_; /* counted from North pole */
        int iphi  = ip%(4*nside_) + 1;
        /* 1 if iring+nside is odd, 1/2 otherwise */
        double fodd = ((iring+nside_)&1) ? 1 : 0.5;

        int nl2 = 2*nside_;
        z = (nl2-iring)*fact1_;
        phi = (iphi-fodd) * M_PI/nl2;
    }
    else /* South Polar cap */
    {
        int ip = npix_ - pix;
        int iring = (int)(0.5*(1+isqrt(2*ip-1))); /* counted from South pole */
        int iphi  = 4*iring + 1 - (ip - 2*iring*(iring-1));

        z = -1.0 + (iring*iring)*fact2_;
        phi = (iphi-0.5) * 0.5*M_PI/iring;
    }

    double v[3];
    v[0] = sin(acos(z))*cos(phi);
    v[1] = sin(acos(z))*sin(phi);
    v[2] = z;

    /* rotate the vector to break degeneracy with grid axes */
    vec[0] = 0.5*v[0] -0.5*v[1] +0.70710678*v[2];
    vec[1] = 0.85355339*v[0] +0.14644661*v[1] -0.5*v[2];
    vec[2] = 0.14644661*v[0] +0.85355339*v[1] +0.5*v[2];
}

/* make params struct for functions we will integrate with gsl */
typedef struct kernel_params {
    double m[3];
    int n;
} kernel_params;

double fermi_dirac_kernel_vol_1(double x)
{
    /* Functional form of FD distribution for 1 particle
       over the full volume (i.e. no *x^2) */
    return 1. / (exp(x) + 1);
}

double fermi_dirac_kernel_vol(double x, void * p)
{
    /* FD kernel in the case of multiple particles
       over the full volume (i.e. no *x^2) */
    struct kernel_params * params = (struct kernel_params *)p;

    double result = fermi_dirac_kernel_vol_1(x);
    // only loop from i=1. i=0 term has been included in result already (r=1)
    for(int i = 1; i < params->n; i ++) {
        double r = params->m[i] / params->m[0];
        result += (r*r*r*r) * fermi_dirac_kernel_vol_1(x * r);
    }
    return result;
}

/* now define the 1D kernel and moments */
double fermi_dirac_kernel(double x, void * p)
{
    return x*x * fermi_dirac_kernel_vol(x, p);
}

/* Samples the low velocity end more effectively */
double low_vel_kernel(double x, void * p)
{
    return x * fermi_dirac_kernel_vol(x, p);
}

/* Needed for calculatin the velocity dispersion */
double fermi_dirac_dispersion(double x, void * p)
{
     return x*x*x*x * fermi_dirac_kernel_vol(x, p);
}

void
divide_fd(double *vel_table, double *mass,
          kernel_params * params,
          int n_shells,
          int lvk)
{
    double fermi_dirac_vel_ncdm[LENGTH_FERMI_DIRAC_TABLE];
    double fermi_dirac_cdf_ncdm[LENGTH_FERMI_DIRAC_TABLE]; //stores CDF

    int i,j;
    double v_bin,u,bin_average,bin_mass;
    double vel_edges[n_shells];
    double result,error;
    gsl_integration_workspace * w
        = gsl_integration_workspace_alloc (1000);

    gsl_function F,G,H;
    if(lvk)
        F.function = &low_vel_kernel;
    else
        F.function = &fermi_dirac_kernel;
    G.function = &fermi_dirac_kernel;
    H.function = &fermi_dirac_dispersion;

    F.params = (void*) params;
    G.params = (void*) params;
    H.params = (void*) params;

    // Initialize the CDF table
    for(i = 0; i < LENGTH_FERMI_DIRAC_TABLE; i++){
        fermi_dirac_vel_ncdm[i] = MAX_FERMI_DIRAC * i / (LENGTH_FERMI_DIRAC_TABLE - 1.0);
        gsl_integration_qags (&F, 0, fermi_dirac_vel_ncdm[i], 0,1e-7 , 1000,
			  w, &result, &error);
        fermi_dirac_cdf_ncdm[i] = result;
    }

    //Normalize to 1
    for(i = 0; i < LENGTH_FERMI_DIRAC_TABLE; i++)
        fermi_dirac_cdf_ncdm[i] /= fermi_dirac_cdf_ncdm[LENGTH_FERMI_DIRAC_TABLE - 1];

    //Define the edges of the velocity bins (lower edge held to 0)
    for(i=0;i<n_shells;i++){
        v_bin = (i+1)/(n_shells*1.0);
        j=0;
        while(j < LENGTH_FERMI_DIRAC_TABLE - 2)
            if(v_bin > fermi_dirac_cdf_ncdm[j + 1])
                j++;
            else
                break;

        u = (v_bin - fermi_dirac_cdf_ncdm[j]) / (fermi_dirac_cdf_ncdm[j + 1] - fermi_dirac_cdf_ncdm[j]);

        vel_edges[i] = fermi_dirac_vel_ncdm[j] * (1 - u) + fermi_dirac_vel_ncdm[j + 1] * u;
    }

    //Get the bin velocities and bin masses
    double total_mass;
    gsl_integration_qags (&G, 0, fermi_dirac_vel_ncdm[LENGTH_FERMI_DIRAC_TABLE-1], 0, 1e-7, 1000,
			  w, &result, &error);
    total_mass = result;
    for(i=0;i<n_shells;i++){
        //Special case for lowest bin - left edge has to be zero
        if (i==0){
            gsl_integration_qags (&H, 0,vel_edges[i], 0, 1e-7, 1000,
			  w, &result, &error);
            bin_average = result;
            gsl_integration_qags (&G, 0, vel_edges[i], 0, 1e-7, 1000,
			  w, &result, &error);
            bin_average /= result;

            bin_mass = result/total_mass;
        }
        else{
            gsl_integration_qags (&H, vel_edges[i-1], vel_edges[i], 0, 1e-7, 1000,
			  w, &result, &error);
            bin_average = result;
            gsl_integration_qags (&G, vel_edges[i-1], vel_edges[i], 0, 1e-7, 1000,
			  w, &result, &error);
            bin_average /= result;

            bin_mass = result/total_mass;
        }
        vel_table[i] = sqrt(bin_average);
        mass[i] = bin_mass;
    }

}

void divide_sphere_healpix(double *vec_table, int n_side)  //so is the direction totally fixed? could we rotate the divisions relative to north pole (i.e. relative to the box)?
{
    int i,k;
    double v_sq[3];
    for(k=0;k<3;k++)
        v_sq[k] = 0.;

    // Get unit vectors for all pixels
    for(i=0;i<12*n_side*n_side;i++){
        pix2vec(i,&vec_table[i*3],n_side);
        for(k=0;k<3;k++)
            v_sq[k] += vec_table[i*3+k]*vec_table[i*3+k];
    }
    // Isotropize the velocity dispersion - important for low n_side    [should we remove this if for high n_side???]
    for(k=0;k<3;k++){
        v_sq[k] /= 12*n_side*n_side;
        v_sq[k] /= 1./3.; // Set each direction to have 1/3 of total dispersion
    }
    for(i=0;i<12*n_side*n_side;i++)
        for(k=0;k<3;k++)
            vec_table[i*3+k] /= sqrt(v_sq[k]);
}

void divide_sphere_fibonacci(double *vec_table, int n_side)
{
    int n_fibonacci = n_side;
    double lat, lon;
    int i, j;
    //int N_tot = 2 * n_fibonacci + 1;

    for (i=-n_fibonacci;i<n_fibonacci+1;i++){
        lat = asin(2.0*i/(2.0*n_fibonacci+1));
        lon = 2.0*M_PI*i*2.0/(1.0+sqrt(5.0));
        j = i + n_fibonacci;
        vec_table[j*3+0] = cos(lat)*cos(lon);
        vec_table[j*3+1] = cos(lat)*sin(lon);
        vec_table[j*3+2] = sin(lat);
    }
}

void divide_sphere(FastPMncdmSphereScheme ncdm_sphere_scheme,
                   double *vec_table, int n_side)
{
    switch (ncdm_sphere_scheme){
        case FASTPM_NCDM_SPHERE_HEALPIX:
            divide_sphere_healpix(vec_table, n_side);
        break;
        case FASTPM_NCDM_SPHERE_FIBONACCI:
            divide_sphere_fibonacci(vec_table, n_side);
        break;
        default:
            fastpm_raise(-1, "Wrong ncdm sphere scheme.\n");
    }
}

static void _fastpm_ncdm_init_fill(FastPMncdmInitData* nid);

//create and fill the table
FastPMncdmInitData*
fastpm_ncdm_init_create(
    double BoxSize,
    FastPMCosmology * c,
    double z,
    int n_shells,
    int n_side,
    int lvk,
    FastPMncdmSphereScheme ncdm_sphere_scheme)
{
    FastPMncdmInitData* nid = malloc(sizeof(nid[0]));

    nid->BoxSize = BoxSize;
    nid->m_ncdm_sum = 0;
    for(int i = 0; i < c->N_ncdm; i ++) {
        nid->m_ncdm[i] = c->m_ncdm[i];
        nid->m_ncdm_sum += c->m_ncdm[i];
    }
    nid->n_ncdm = c->N_ncdm;
    nid->Omega_ncdm = c->Omega_ncdm;
    nid->z = z;
    fastpm_info("ncdm reference redshift = %g\n", z);
    nid->n_shells = n_shells;
    nid->n_side = n_side;
    nid->lvk = lvk;
    nid->ncdm_sphere_scheme = ncdm_sphere_scheme;

    /* this is the total number of velocity vectors produced */
    switch (ncdm_sphere_scheme){
        case FASTPM_NCDM_SPHERE_HEALPIX:
            nid->n_sphere = 12 * n_side * n_side;
        break;
        case FASTPM_NCDM_SPHERE_FIBONACCI:
            nid->n_sphere = 2 * n_side + 1;
        break;
        default:
            fastpm_raise(-1, "Wrong ncdm sphere scheme.\n");
    }

    nid->n_split = n_shells * nid->n_sphere;

    /* recall vel is a pointer to a 3 element array
    so lets make into multidim array of dim (n_split x 3) */
    //for now store all (3) neutrinos in the same nid table.
    nid->vel = calloc(nid->n_split, sizeof(double[3]));
    nid->mass = calloc(nid->n_split, sizeof(double));   //a 1d array to store all the masses

    _fastpm_ncdm_init_fill(nid);

    return nid;
}

//free the table
void
fastpm_ncdm_init_free(FastPMncdmInitData* nid)
{
    free(nid->vel);
    free(nid->mass);
    free(nid);
}

//append the table
static void
_fastpm_ncdm_init_fill(FastPMncdmInitData* nid)
{
    int n_ncdm = nid->n_ncdm;
    int n_shells = nid->n_shells;
    int n_side = nid->n_side;
    int n_sphere = nid->n_sphere;
    int lvk = nid->lvk;

    double *vel_table, *vec_table, *masstab;
    vel_table = malloc(sizeof(double)*n_shells);
    /* masstab is the distribution integrated per shell, sums to 1 */
    masstab = calloc(n_shells,sizeof(double));
    vec_table = malloc(sizeof(double)*n_sphere*3);

    /* define the kernel params for dividing fd */
    kernel_params* params = malloc(sizeof(params[0]));
    for(int i = 0; i < n_ncdm; i ++) {
        params->m[i] = nid->m_ncdm[i];
    }
    params->n = n_ncdm;

    divide_fd(vel_table, masstab, params, n_shells, lvk);
    divide_sphere(nid->ncdm_sphere_scheme, vec_table, n_side);

    /* velocity_conversion_factor converts the dimless exponent
       in the FD distribution to velocity in FastPM units:
       conjugate momentum (a^2 xdot, where x is comoving dist).
       kTc = 50.3 eV/c^2 km/s */
    double m0 = nid->m_ncdm[0];
    double velocity_conversion_factor = 50.3 / m0 / HubbleConstant;

    int i, j, d;
    int s = 0;                          //row num  (s for split index)
    for(i = 0; i < n_sphere; i ++){
        for(j = 0; j < n_shells; j ++){
            /* define mass st sum over split gives 1 */
            nid->mass[s] = masstab[j] / n_sphere;
            for(d = 0; d < 3; d ++){
                nid->vel[s][d] = vel_table[j] * vec_table[i*3 + d] * velocity_conversion_factor;
            }
            s++;
        }
    }
    free(vel_table);
    free(masstab);
    free(vec_table);
}

void
fastpm_split_ncdm(FastPMncdmInitData * nid,
                  FastPMStore * src,
                  FastPMStore * dest,
                  MPI_Comm comm)
{
    /*
    Takes store src and splits according to the ncdm
    init data, and uses this to populate an dest store.
    src is fully populated after calling the setup_lpt
    func, but dest has only been init'd.
    */

    dest->np = src->np * nid->n_split;    // FIXME: ? Is proc imbalance an issue that needs to be accounted for?
    if(dest->np > dest->np_upper) {
        fastpm_raise(-1, "exceeding limit on the number limit of particles for the ncdm species \n");
    }

    size_t np_total = fastpm_store_get_np_total(src, comm);     //np_total is num of UNsplit ncdms

    /* avg mass of UNsplit ncdm site */
    double M0 = nid->Omega_ncdm * FASTPM_CRITICAL_DENSITY * pow(nid->BoxSize, 3) / np_total;
    double Mestate = M0 / nid->n_ncdm;
    fastpm_info("average mass of a ncdm particle is %g\n", Mestate);

    /* copy and amend meta-data */
    memmove(&dest->meta, &src->meta, sizeof(src->meta));

    dest->meta.M0 = 0.; /* will have a mass per particle */

    /* Compute the factor used to displace ncdm so that the expanded spheres almost touch.
       This assumes the largest speed particle is in the final entry of vel table */
    int n_shells = nid->n_shells;
    int n_sphere = nid->n_sphere;
    double vthm_max = 0;
    for (int d = 0; d < 3; d ++)
        vthm_max += nid->vel[n_sphere*n_shells-1][d]*nid->vel[n_sphere*n_shells-1][d];
    vthm_max = sqrt(vthm_max);
    double disp_factor = 0.5 * nid->BoxSize / nid->n_ncdm / vthm_max * (n_shells - 1) / n_shells;

    ptrdiff_t i, s, d;
    ptrdiff_t r = 0;    //row index of dest
    int c;
    double vthm;
    for(i = 0; i < src->np; i ++) {    //loop thru each src particle
        for(s = 0; s < nid->n_split; s ++) {  //loop thru split velocities
            /* copy all cols el by el */
            for(c = 0; c < 32; c ++) {
                if (!dest->columns[c] || !src->columns[c]) continue;

                size_t elsize = dest->_column_info[c].elsize;
                memcpy(dest->columns[c] + r * elsize,
                       src->columns[c] + i * elsize,
                       elsize);
            }

            /* give id, mass and add thm vel */
            dest->id[r] = s * src->meta._q_size + src->id[i];
            dest->mass[r] = nid->mass[s] * M0;    // ensures sum over split gives M0

            for(d = 0; d < 3; d ++){
                vthm = nid->vel[s][d];
                dest->v[r][d] = vthm;
                dest->x[r][d] += vthm * disp_factor;
                if (dest->q) dest->q[r][d] += vthm * disp_factor;
            }
            r ++;
        }
    }
}


#include <slepcmfn.h>
#include "cs.h"
#include <gsl/gsl_rng.h>
//for use in programs like im_clam
typedef struct clam_lik_params{
	int snpNumber, maxSampleSize,nstates,n1,n2,nParams;
	gsl_vector *sampleSizeVector,*rates, *stateVec, *resVec ;
	gsl_vector *paramVector,*paramCIUpper,*paramCILower, *mlParams;
	//For straight MLE the paramVector takes the form [N2,NA,m1,m2,t]
	gsl_matrix *log_afs, *transMat,*expAFS, *expAFS2, *invMatGSL, *invMatGSLA, *obsData;
	afsStateSpace *stateSpace ,*reducedStateSpace;
	gsl_rng *rng;
	struct site *data;
	double *cs_work,*new,*topA,*resultTmp,**invMat,*b,*res, *st, *top;
	int *dim1, *dim2, *moveA, *move, *dim1A, *dim2A; //these pointers ease the construction of sparse matrices
	int nnz, nnzA;
	double maxLik;
	int *map, *reverseMap; //these provide mapping of between state spaces of two phases
	int optimized;
	int rank;
	int Na,fEvals;
	double *expoArray;
	double meanTreeLength;
	cs_di *spMat, *eye, *eyeAnc, *triplet, *tmpMat, *tmpMat2;

	Vec  x_0, x, u,bP, u2, bP2, v, y, v_seq, *x2, ancStateVec, ancResVec;
	Vec xInv,bInv;
	Mat            ident,C, C2, C_transpose, D, D_copy, F, denseIdent, denseMat1, denseMat2, denseMat3;
	VecScatter	ctx;
	MFN                mfn;
	PetscInt        iStart,iEnd;
      /* linear solver context */
	PC             pc;           /* preconditioner context */

}clam_lik_params;


#ifndef _GDRDGEMM_H
#define _GDRDGEMM_H

#ifndef MKL
#include <cblas.h>
#else
#include <mkl_cblas.h>
#endif

#define NMAT 2048
void gdr_check_and_restart(double a[][NMAT],
			   double b[][NMAT],
			   double c[][NMAT]);

void gdrblas_dgemm
(
#ifndef MKL
   const enum CBLAS_ORDER             ORDER,
   const enum CBLAS_TRANSPOSE             TRANSA,
   const enum CBLAS_TRANSPOSE             TRANSB,
#else
   const CBLAS_ORDER             ORDER,
   const CBLAS_TRANSPOSE             TRANSA,
   const CBLAS_TRANSPOSE             TRANSB,
#endif
   const int                        M,
   const int                        N,
   const int                        K,
   const double                     ALPHA,
   const double *                   A,
   const int                        LDA,
   const double *                   B,
   const int                        LDB,
   const double                     BETA,
   double *                         C,
   const int                        LDC
   );

void mygdrdgemm(int m,
		int n,
		int k,
		double alpha,
		double * a,
		int na,
		double * b,
		int nb,
		double beta,
		double * c,
		int nc);

#endif


#include <petsc.h>
#include <petsc/private/fortranimpl.h>
#include <omp.h>
//#include <papi.h>
/*
  Global Variables
*/
double  gradTime; // Gradient calculation time
double  fluxTime; // Flux evaluation timing
int     nThreads; // Number of threads at each MPI process
int     rank;     // MPI process ID
int     size;     // MPI number of running processes

#ifdef HW_COUNTER
int       eventset; // PAPI counter context
long long handler;  // PAPI counter return value
#endif

/*
  FORTRAN routine definitions
*/
#if defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define f77name(ucase,lcase,lcbar) lcbar
#elif defined(PETSC_HAVE_FORTRAN_CAPS)
#define f77name(ucase,lcase,lcbar) ucase
#else
#define f77name(ucase,lcase,lcbar) lcase
#endif
/*
  Node coordinates in a 3D mesh
*/
struct COORD
{
  double *x;  // X component
  double *y;  // Y component
  double *z;  // Z component
};
/*
  Normal to faces and length
*/
struct NORMAL
{
  double  *len;         // Length
  struct  COORD coord;  // X, Y, and Z components
};
/*
  Weights for calculating the gradients using least square
*/
struct WEIGHT
{
  double *r11;  // w11
  double *r12;  // r12r11
  double *r13;  // r13r11
  double *r22;  // w22
  double *r23;  // r23r22
  double *r33;  // w33
  double *r44;  // rmess
};
/*
  MeTiS partitioning using for OpenMP
*/
struct THREAD
{
  int     nedge;          // Number edge for all threads with replication
  int     *partitions;    // MeTiS nodes partitioning
  int     *nedgeLoc;      // Number of edges local for each thread
  int     *eptr;          // Edge pointers
  struct  NORMAL  normal; // Normal to faces and length
};
/*
  A boundary's elements
*/
struct BOUNDELM
{
  int     nnode;        // Number of nodes
  int     nfacet;       // Number of facets
  int     *f2nt;        // Facet to tetrahedron indices
  int     *inode;       // nodes pointers
  struct  COORD normal; // Normal to faces
};
/*
  Boundaries
*/
struct BOUND
{
  int     nsbound;            // Number of solid boundaries
  int     nvbound;            // Number of viscous boundaries
  int     nfbound;            // Number of free boundaries
  struct  BOUNDELM solid;     // Solid boundary elements
  struct  BOUNDELM viscs;     // Viscous boundary elements
  struct  BOUNDELM ffild;     // Free boundary elements
};
/*
  Grid information
*/
typedef struct grid_t
{
  int     nnodes;           // Number of mesh nodes
  int     nedge;            // Number of mesh edges
  int     *eptr;            // Edge pointers array
  struct  NORMAL  normal;   // Normal to faces and length
  struct  COORD   coord;    // Node Coordinates
  struct  THREAD  thread;   // MeTiS subdomain partitioning elements
  struct  BOUND   bound;    // Boundaries elements
  struct  WEIGHT  weight;   // Least square weights
  double  *area;            // Area of control volumes
  double  *cdt;             // Pseudo-time step for each cell
} GRID;
/*
  PETSc data structures
*/
typedef struct gridPETSc_t
{
  Vec   qnode;        // Global distributed solution vector
  Vec   qnodeLoc;     // Local sequential solution vector
  Vec   res;          // Residual vector
  Vec   grad;         // Gradient vector
  Mat   A;            // Left hand side matrix
} GRIDPETSc;
/*
  Time step context
*/
typedef struct tstepctx_t
{
  /*
    A vector state at which to evaluate residual (x) at every
    time step (hold the old x vector before proceeding to the
    next SNES time step)
  */
  Vec     qnode;
  /*
    A vector to put residual (function value) (f) used at every
    time step calculation
  */
  Vec     res;
  /*
    Courant–Friedrichs–Lewy stability restriction condition
  */
  double  CFL;
  double  CFLInit;
  double  CFLMax;
  /*
    2-norm of function at current iterate
  */
  double  fnorm;
  double  fnormInit;
  double  fnormRatio;
  /*
    A flag to indicate that the formFunction is called to compute the
    pseudo time step
  */
  int     isPseudoTimeStep;
  /*
    Time step counting variable: time step loop iterator (i)
  */
  int     iTimeStep;
  /*
    Maximum time steps for the nonlinear solve
  */
  int     maxTimeSteps;
  /*
    A flag for local or global time step
  */
  int     isLocal;
} TstepCtx;
/*
  Encapsulate the grid data structure information and time step
  data structure information
*/
typedef struct appctx_t
{
  GRID        *grid;        // Pointer to grid info
  GRIDPETSc   *gridPETSc;   // PETSc data structure context
  TstepCtx    *tsCtx;       // Pointer to time stepping context
  PetscBool   isPreLoading; // Preloading flag (single time step)
} AppCtx;


/* ################################################################################## */
/* ###                                                                            ### */
/* ###                                 sigvel.c                                   ### */
/* ###                                                                            ### */
/* ###   Original: hydra.c (public version of Gadget 2)                           ### */
/* ###   Author: Volker Springel                                                  ### */
/* ###                                                                            ### */
/* ###   Modified: February 2011                                                  ### */
/* ###   Author: Fabrice Durier                                                   ### */
/* ###                                                                            ### */
/* ################################################################################## */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#ifndef NOMPI
#include <mpi.h>
#endif
#include <gsl/gsl_math.h>
#include "allvars.h"
#include "proto.h"

/*! \file sigvel.c
 *  Re-Computation of SPH acceleration and maximum signal velocity
 *  for 'feedback' particles only.
 *
 *  This file is a modified version of hydra.c, where the SPH forces are
 *  computed, and where the rate of change of entropy due to the shock heating
 *  (via artificial viscosity) is computed.
 */

#ifdef TIMESTEP_UPDATE

static double hubble_a, atime, hubble_a2, fac_mu, fac_vsic_fix, a3inv, fac_egy;

#ifdef PERIODIC
static double boxSize, boxHalf;

#ifdef LONG_X
static double boxSize_X, boxHalf_X;
#else
#define boxSize_X boxSize
#define boxHalf_X boxHalf
#endif
#ifdef LONG_Y
static double boxSize_Y, boxHalf_Y;
#else
#define boxSize_Y boxSize
#define boxHalf_Y boxHalf
#endif
#ifdef LONG_Z
static double boxSize_Z, boxHalf_Z;
#else
#define boxSize_Z boxSize
#define boxHalf_Z boxHalf
#endif
#endif

/*! This function is the driver routine for the update of the calculation
 *  of hydrodynamical force due to the feedback impact
 *  from either SNe or BHs on active gas particles.
 */
void get_sigvel(void)
{
  long long ntot, ntotleft;
  int i, j, k, n, ngrp, maxfill, source, ndone;
  int *nbuffer, *noffset, *nsend_local, *nsend, *numlist, *ndonelist;
  int level, sendTask, recvTask, nexport, place;
  double soundspeed_i;
  double tstart, tend, sumt, sumcomm;
  double timecomp = 0, timecommsumm = 0, timeimbalance = 0, sumimbalance;
#ifndef NOMPI
  MPI_Status status;
#endif

#ifdef PERIODIC
  boxSize = All.BoxSize;
  boxHalf = 0.5 * All.BoxSize;
#ifdef LONG_X
  boxHalf_X = boxHalf * LONG_X;
  boxSize_X = boxSize * LONG_X;
#endif
#ifdef LONG_Y
  boxHalf_Y = boxHalf * LONG_Y;
  boxSize_Y = boxSize * LONG_Y;
#endif
#ifdef LONG_Z
  boxHalf_Z = boxHalf * LONG_Z;
  boxSize_Z = boxSize * LONG_Z;
#endif
#endif

  if(All.ComovingIntegrationOn)
    {
      /* Factors for comoving integration of hydro */
      hubble_a = All.Omega0 / (All.Time * All.Time * All.Time)
        + (1 - All.Omega0 - All.OmegaLambda) / (All.Time * All.Time) + All.OmegaLambda;

      hubble_a = All.Hubble * sqrt(hubble_a);
      hubble_a2 = All.Time * All.Time * hubble_a;

      fac_mu = pow(All.Time, 3 * (GAMMA - 1) / 2) / All.Time;

      fac_egy = pow(All.Time, 3 * (GAMMA - 1));

      fac_vsic_fix = hubble_a * pow(All.Time, 3 * GAMMA_MINUS1);

      a3inv = 1 / (All.Time * All.Time * All.Time);
      atime = All.Time;
    }
  else
    hubble_a = hubble_a2 = atime = fac_mu = fac_vsic_fix = a3inv = fac_egy = 1.0;

  /* `NumSphUpdate' gives the number of feedback particles on this processor that want a force update */
  for(n = 0, NumSphUpdate = 0; n < N_gas; n++)
    {
      if(P[n].Ti_endstep == All.Ti_Current && SphP[n].FeedbackFlag > 1)
	NumSphUpdate++;
    }

  numlist = malloc(NTask * sizeof(int) * NTask);

#ifndef NOMPI
  MPI_Allgather(&NumSphUpdate, 1, MPI_INT, numlist, 1, MPI_INT, GADGET_WORLD);
#else
    numlist[0] = NumSphUpdate;
#endif
  for(i = 0, ntot = 0; i < NTask; i++)
    ntot += numlist[i];
  free(numlist);

  if(ThisTask == 0 && ntot)
    printf("\t --->  Number of feedback particles = %ld \n\n", ntot);

  noffset = malloc(sizeof(int) * NTask);	/* offsets of bunches in common list */
  nbuffer = malloc(sizeof(int) * NTask);
  nsend_local = malloc(sizeof(int) * NTask);
  nsend = malloc(sizeof(int) * NTask * NTask);
  ndonelist = malloc(sizeof(int) * NTask);

  i = 0;			/* first particle for this task */
  ntotleft = ntot;		/* particles left for all tasks together */

  while(ntotleft > 0)
    {
      for(j = 0; j < NTask; j++)
	nsend_local[j] = 0;

      /* do local particles and prepare export list */
      tstart = second();
      for(nexport = 0, ndone = 0; i < N_gas && nexport < All.BunchSizeHydro - NTask; i++)
	if(P[i].Ti_endstep == All.Ti_Current && SphP[i].FeedbackFlag > 1)
	  {
	    ndone++;

	    for(j = 0; j < NTask; j++)
	      Exportflag[j] = 0;

	    get_sigvel_evaluate(i, 0);

	    for(j = 0; j < NTask; j++)
	      {
		if(Exportflag[j])
		  {
		    for(k = 0; k < 3; k++)
		      {
			HydroDataIn[nexport].Pos[k] = P[i].Pos[k];
			HydroDataIn[nexport].Vel[k] = SphP[i].VelPred[k];
		      }
                    HydroDataIn[nexport].Hsml = SphP[i].Hsml;
                    HydroDataIn[nexport].Mass = P[i].Mass;
                    HydroDataIn[nexport].DhsmlDensityFactor = SphP[i].DhsmlDensityFactor;
                    HydroDataIn[nexport].Density = SphP[i].Density;
                    HydroDataIn[nexport].Pressure = SphP[i].Pressure;
                    HydroDataIn[nexport].Timestep = P[i].Ti_endstep - P[i].Ti_begstep;

                    /* calculation of F1 */
                    soundspeed_i = sqrt(GAMMA * SphP[i].Pressure / SphP[i].Density);
                    HydroDataIn[nexport].F1 = fabs(SphP[i].DivVel) /
		      (fabs(SphP[i].DivVel) + SphP[i].CurlVel +
                       0.0001 * soundspeed_i / SphP[i].Hsml / fac_mu);

		    HydroDataIn[nexport].Index = i;
		    HydroDataIn[nexport].Task = j;
		    nexport++;
		    nsend_local[j]++;
		  }
	      }
	  }
      tend = second();
      timecomp += timediff(tstart, tend);

      qsort(HydroDataIn, nexport, sizeof(struct hydrodata_in), hydro_compare_key);

      for(j = 1, noffset[0] = 0; j < NTask; j++)
	noffset[j] = noffset[j - 1] + nsend_local[j - 1];

      tstart = second();
#ifndef NOMPI
      MPI_Allgather(nsend_local, NTask, MPI_INT, nsend, NTask, MPI_INT, GADGET_WORLD);
#else
    nsend[0] = nsend_local[0];
#endif
      tend = second();
      timeimbalance += timediff(tstart, tend);

      /* now do the particles that need to be exported */

      for(level = 1; level < (1 << PTask); level++)
	{
	  tstart = second();
	  for(j = 0; j < NTask; j++)
	    nbuffer[j] = 0;
	  for(ngrp = level; ngrp < (1 << PTask); ngrp++)
	    {
	      maxfill = 0;
	      for(j = 0; j < NTask; j++)
		{
		  if((j ^ ngrp) < NTask)
		    if(maxfill < nbuffer[j] + nsend[(j ^ ngrp) * NTask + j])
		      maxfill = nbuffer[j] + nsend[(j ^ ngrp) * NTask + j];
		}
	      if(maxfill >= All.BunchSizeHydro)
		break;

	      sendTask = ThisTask;
	      recvTask = ThisTask ^ ngrp;
#ifndef NOMPI
	      if(recvTask < NTask)
		{
		  if(nsend[ThisTask * NTask + recvTask] > 0 || nsend[recvTask * NTask + ThisTask] > 0)
		    {
		      /* get the particles */
		      MPI_Sendrecv(&HydroDataIn[noffset[recvTask]],
				   nsend_local[recvTask] * sizeof(struct hydrodata_in), MPI_BYTE,
				   recvTask, TAG_HYDRO_A,
				   &HydroDataGet[nbuffer[ThisTask]],
				   nsend[recvTask * NTask + ThisTask] * sizeof(struct hydrodata_in), MPI_BYTE,
				   recvTask, TAG_HYDRO_A, GADGET_WORLD, &status);
		    }
		}
#endif
	      for(j = 0; j < NTask; j++)
		if((j ^ ngrp) < NTask)
		  nbuffer[j] += nsend[(j ^ ngrp) * NTask + j];
	    }
	  tend = second();
	  timecommsumm += timediff(tstart, tend);

	  /* now do the imported particles */
	  tstart = second();
	  for(j = 0; j < nbuffer[ThisTask]; j++)
	    get_sigvel_evaluate(j, 1);
	  tend = second();
	  timecomp += timediff(tstart, tend);

	  /* do a block to measure imbalance */
	  tstart = second();
#ifndef NOMPI
	      MPI_Barrier(GADGET_WORLD);
#endif
	  tend = second();
	  timeimbalance += timediff(tstart, tend);

	  /* get the result */
	  tstart = second();
	  for(j = 0; j < NTask; j++)
	    nbuffer[j] = 0;
	  for(ngrp = level; ngrp < (1 << PTask); ngrp++)
	    {
	      maxfill = 0;
	      for(j = 0; j < NTask; j++)
		{
		  if((j ^ ngrp) < NTask)
		    if(maxfill < nbuffer[j] + nsend[(j ^ ngrp) * NTask + j])
		      maxfill = nbuffer[j] + nsend[(j ^ ngrp) * NTask + j];
		}
	      if(maxfill >= All.BunchSizeHydro)
		break;

	      sendTask = ThisTask;
	      recvTask = ThisTask ^ ngrp;

#ifndef NOMPI
	      if(recvTask < NTask)
		{
		  if(nsend[ThisTask * NTask + recvTask] > 0 || nsend[recvTask * NTask + ThisTask] > 0)
		    {
		      /* send the results */
		      MPI_Sendrecv(&HydroDataResult[nbuffer[ThisTask]],
				   nsend[recvTask * NTask + ThisTask] * sizeof(struct hydrodata_out),
				   MPI_BYTE, recvTask, TAG_HYDRO_B,
				   &HydroDataPartialResult[noffset[recvTask]],
				   nsend_local[recvTask] * sizeof(struct hydrodata_out),
				   MPI_BYTE, recvTask, TAG_HYDRO_B, GADGET_WORLD, &status);

		      /* add the result to the particles */
		      for(j = 0; j < nsend_local[recvTask]; j++)
			{
			  source = j + noffset[recvTask];
			  place = HydroDataIn[source].Index;

			  for(k = 0; k < 3; k++)
			    SphP[place].FeedAccel[k] += HydroDataPartialResult[source].Acc[k];

			  if(SphP[place].MaxSignalVel < HydroDataPartialResult[source].MaxSignalVel)
			    SphP[place].MaxSignalVel = HydroDataPartialResult[source].MaxSignalVel;
			}
		    }
		}
#endif
	      for(j = 0; j < NTask; j++)
		if((j ^ ngrp) < NTask)
		  nbuffer[j] += nsend[(j ^ ngrp) * NTask + j];
	    }
	  tend = second();
	  timecommsumm += timediff(tstart, tend);

	  level = ngrp - 1;
	}

#ifndef NOMPI
      MPI_Allgather(&ndone, 1, MPI_INT, ndonelist, 1, MPI_INT, GADGET_WORLD);
#else
    ndonelist[0] = ndone;
#endif
      for(j = 0; j < NTask; j++)
	ntotleft -= ndonelist[j];
    }

  free(ndonelist);
  free(nsend);
  free(nsend_local);
  free(nbuffer);
  free(noffset);

  /* collect some timing information */
#ifndef NOMPI
  MPI_Reduce(&timecomp, &sumt, 1, MPI_DOUBLE, MPI_SUM, 0, GADGET_WORLD);
  MPI_Reduce(&timecommsumm, &sumcomm, 1, MPI_DOUBLE, MPI_SUM, 0, GADGET_WORLD);
  MPI_Reduce(&timeimbalance, &sumimbalance, 1, MPI_DOUBLE, MPI_SUM, 0, GADGET_WORLD);
#else
    sumt = timecomp;
    sumcomm = timecommsumm;
    sumimbalance = timeimbalance;
#endif
  if(ThisTask == 0)
    {
      All.CPU_HydCompWalk += sumt / NTask;
      All.CPU_HydCommSumm += sumcomm / NTask;
      All.CPU_HydImbalance += sumimbalance / NTask;
    }
}

/*! This function is the 'core' of the SPH force update. A target
 *  particle is specified which may either be local, or reside in the
 *  communication buffer.
 *  Note that only the acceleration due to feedback and the change
 *  of signal velocity are updated, not the actual variation of Entropy rate.
 */
void get_sigvel_evaluate(int target, int mode)
{
  int j, k, n, timestep, startnode, numngb;
  FLOAT *pos, *vel;
  FLOAT mass, h_i, dhsmlDensityFactor, rho, pressure, f1, f2;
  double acc[3], dtEntropy, maxSignalVel;
  double dx, dy, dz, dvx, dvy, dvz;
  double h_i2, hinv, hinv4;
  double p_over_rho2_i, p_over_rho2_j, soundspeed_i, soundspeed_j;
  double hfc, dwk_i, vdotr, vdotr2, visc, mu_ij, rho_ij, vsig;
  double h_j, dwk_j, r, r2, u, hfc_visc;

#ifndef NOVISCOSITYLIMITER
  double dt;
#endif

  if(mode == 0)
    {
      pos = P[target].Pos;
      vel = SphP[target].VelPred;
      h_i = SphP[target].Hsml;
      mass = P[target].Mass;
      dhsmlDensityFactor = SphP[target].DhsmlDensityFactor;
      rho = SphP[target].Density;
      pressure = SphP[target].Pressure;
      timestep = P[target].Ti_endstep - P[target].Ti_begstep;
      soundspeed_i = sqrt(GAMMA * pressure / rho);
      f1 = fabs(SphP[target].DivVel) /
        (fabs(SphP[target].DivVel) + SphP[target].CurlVel +
         0.0001 * soundspeed_i / SphP[target].Hsml / fac_mu);
    }
  else
    {
      pos = HydroDataGet[target].Pos;
      vel = HydroDataGet[target].Vel;
      h_i = HydroDataGet[target].Hsml;
      mass = HydroDataGet[target].Mass;
      dhsmlDensityFactor = HydroDataGet[target].DhsmlDensityFactor;
      rho = HydroDataGet[target].Density;
      pressure = HydroDataGet[target].Pressure;
      timestep = HydroDataGet[target].Timestep;
      soundspeed_i = sqrt(GAMMA * pressure / rho);
      f1 = HydroDataGet[target].F1;
    }

  /* initialize variables before SPH loop is started */
  acc[0] = acc[1] = acc[2] = dtEntropy = 0;
  maxSignalVel = 0;

  p_over_rho2_i = pressure / (rho * rho) * dhsmlDensityFactor;
  h_i2 = h_i * h_i;

  /* Now start the actual SPH computation for this particle */
  startnode = All.MaxPart;
  do
    {
      numngb = ngb_treefind_pairs(&pos[0], h_i, &startnode);

      for(n = 0; n < numngb; n++)
	{
	  j = Ngblist[n];

	  dx = pos[0] - P[j].Pos[0];
	  dy = pos[1] - P[j].Pos[1];
	  dz = pos[2] - P[j].Pos[2];

#ifdef PERIODIC			/*  find the closest image in the given box size  */
	  if(dx > boxHalf_X)
	    dx -= boxSize_X;
	  if(dx < -boxHalf_X)
	    dx += boxSize_X;
	  if(dy > boxHalf_Y)
	    dy -= boxSize_Y;
	  if(dy < -boxHalf_Y)
	    dy += boxSize_Y;
	  if(dz > boxHalf_Z)
	    dz -= boxSize_Z;
	  if(dz < -boxHalf_Z)
	    dz += boxSize_Z;
#endif
	  r2 = dx * dx + dy * dy + dz * dz;
	  h_j = SphP[j].Hsml;
	  if(r2 < h_i2 || r2 < h_j * h_j)
	    {
	      r = sqrt(r2);
	      if(r > 0)
		{
		  p_over_rho2_j = SphP[j].Pressure / (SphP[j].Density * SphP[j].Density);
		  soundspeed_j = sqrt(GAMMA * p_over_rho2_j * SphP[j].Density);
		  dvx = vel[0] - SphP[j].VelPred[0];
		  dvy = vel[1] - SphP[j].VelPred[1];
		  dvz = vel[2] - SphP[j].VelPred[2];
		  vdotr = dx * dvx + dy * dvy + dz * dvz;

		  if(All.ComovingIntegrationOn)
		    vdotr2 = vdotr + hubble_a2 * r2;
		  else
		    vdotr2 = vdotr;

                  if(r2 < h_i2)
                    {
                      hinv = 1.0 / h_i;
#ifndef  TWODIMS
                      hinv4 = hinv * hinv * hinv * hinv;
#else
                      hinv4 = hinv * hinv * hinv / boxSize_Z;
#endif
                      u = r * hinv;
                      if(u < 0.5)
                        dwk_i = hinv4 * u * (KERNEL_COEFF_3 * u - KERNEL_COEFF_4);
                      else
                        dwk_i = hinv4 * KERNEL_COEFF_6 * (1.0 - u) * (1.0 - u);
                    }
                  else
                    {
                      dwk_i = 0;
                    }

                  if(r2 < h_j * h_j)
                    {
                      hinv = 1.0 / h_j;
#ifndef  TWODIMS
                      hinv4 = hinv * hinv * hinv * hinv;
#else
                      hinv4 = hinv * hinv * hinv / boxSize_Z;
#endif
                      u = r * hinv;
                      if(u < 0.5)
                        dwk_j = hinv4 * u * (KERNEL_COEFF_3 * u - KERNEL_COEFF_4);
                      else
                        dwk_j = hinv4 * KERNEL_COEFF_6 * (1.0 - u) * (1.0 - u);
                    }
                  else
                    {
                      dwk_j = 0;
                    }

                  if(soundspeed_i + soundspeed_j > maxSignalVel)
                    maxSignalVel = soundspeed_i + soundspeed_j;

                  if(vdotr2 < 0)        /* ... artificial viscosity */
                    {
                      mu_ij = fac_mu * vdotr2 / r;      /* note: this is negative! */

                      vsig = soundspeed_i + soundspeed_j - 3 * mu_ij;

                      if(vsig > maxSignalVel)
                        maxSignalVel = vsig;

		      if(P[j].Ti_endstep == All.Ti_Current)
			if(vsig > SphP[j].MaxSignalVel)
			  SphP[j].MaxSignalVel = vsig;

                      rho_ij = 0.5 * (rho + SphP[j].Density);
                      f2 =
                        fabs(SphP[j].DivVel) / (fabs(SphP[j].DivVel) + SphP[j].CurlVel +
                                                0.0001 * soundspeed_j / fac_mu / SphP[j].Hsml);

                      visc = 0.25 * All.ArtBulkViscConst * vsig * (-mu_ij) / rho_ij * (f1 + f2);

                      /* .... end artificial viscosity evaluation */
#ifndef NOVISCOSITYLIMITER
                      /* make sure that viscous acceleration is not too large */
                      dt = imax(timestep, (P[j].Ti_endstep - P[j].Ti_begstep)) * All.Timebase_interval;
                      if(dt > 0 && (dwk_i + dwk_j) < 0)
                        {
                          visc = dmin(visc, 0.5 * fac_vsic_fix * vdotr2 /
                                      (0.5 * (mass + P[j].Mass) * (dwk_i + dwk_j) * r * dt));
                        }
#endif
                    }
                  else
                    visc = 0;

                  p_over_rho2_j *= SphP[j].DhsmlDensityFactor;

                  hfc_visc = 0.5 * P[j].Mass * visc * (dwk_i + dwk_j) / r;

                  hfc = hfc_visc + P[j].Mass * (p_over_rho2_i * dwk_i + p_over_rho2_j * dwk_j) / r;

                  acc[0] -= hfc * dx;
                  acc[1] -= hfc * dy;
                  acc[2] -= hfc * dz;

		  if(P[j].Ti_endstep == All.Ti_Current)
		    {
		      if(SphP[j].FeedbackFlag == 0)
			SphP[j].FeedbackFlag = 1;

		      if(maxSignalVel > SphP[j].MaxSignalVel)
			SphP[j].MaxSignalVel = maxSignalVel;

		      SphP[j].FeedAccel[0] -= hfc * dx;
		      SphP[j].FeedAccel[1] -= hfc * dy;
		      SphP[j].FeedAccel[2] -= hfc * dz;
		    }

		}
	    }
	}
      fflush(stdout);
    }
  while(startnode >= 0);

  /* Now collect the result at the right place */
  if(mode == 0)
    {
      SphP[target].MaxSignalVel = maxSignalVel;

      for(k = 0; k < 3; k++)
        SphP[target].FeedAccel[k] = acc[k];
    }
  else
    {
      HydroDataResult[target].MaxSignalVel = maxSignalVel;

      for(k = 0; k < 3; k++)
        HydroDataResult[target].Acc[k] = acc[k];
    }
}

#endif


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <float.h>
#include <omp.h>
#include <math.h>
#include "parmt_config.h"
#ifdef PARMT_USE_INTEL
#include <mkl_cblas.h>
#else
#include <cblas.h>
#endif
#include "parmt_mtsearch.h"
#include "parmt_utils.h"
#include "compearth.h"
#include "iscl/array/array.h"
#include "iscl/memory/memory.h"

#ifndef MAX
#define MAX(x,y) (((x) > (y)) ? (x) : (y))
#endif
#ifndef MIN
#define MIN(x,y) (((x) < (y)) ? (x) : (y))
#endif

static int getNpMax(const int iobs, const struct parmtData_struct data,
                    const struct localMT_struct mtloc);
/*
static int setDataOnG(const int iobs, const int iloc, const int npmax,
                       const struct parmtData_struct data,
                       double *__restrict__ G);
*/
int parmt_computeL1StationMagnitude64f(const int ldm, const int nmt,
                                       const int npts, const int blockSize,
                                       const double *__restrict__ Gxx,
                                       const double *__restrict__ Gyy,
                                       const double *__restrict__ Gzz,
                                       const double *__restrict__ Gxy,
                                       const double *__restrict__ Gxz,
                                       const double *__restrict__ Gyz,
                                       const double *__restrict__ mts,
                                       const double *__restrict__ d,
                                       double *__restrict__ mags);

int parmt_locSearchL164f(const MPI_Comm locComm,
                         const int iobs, const int blockSize,
                         const int nlags, const bool lwantLags,
                         const bool lrescale,
                         struct localMT_struct mtloc,
                         struct parmtData_struct *data,
                         const double *__restrict__ CeInv,
                         double *__restrict__ phi,
                         double *__restrict__ var,
                         int *__restrict__ lags)
{
    const char *fcnm = "parmt_locSearchL164f\0";
    double *G, *d, *phiLoc, *phiWork, *varLoc, *varWork, xrescaleNum;
    int *lagLoc, *lagWork, ierr, iloc, jndx, jloc, k,
        myloc, npmax, nlocProcs, npts;
    const int master = 0;
    ierr = 0;
    myloc =-1;
    if (mtloc.myid == master)
    {
        MPI_Comm_rank(locComm, &myloc);
        MPI_Comm_size(locComm, &nlocProcs);
    }
    MPI_Bcast(&myloc,     1, MPI_INT, master, mtloc.comm);
    MPI_Bcast(&nlocProcs, 1, MPI_INT, master, mtloc.comm);
    if (iobs < 0 || iobs >= data->nobs)
    {
        printf("%s: Invalid observation number %d\n", fcnm, iobs);
        return -1;
    }
    if (mtloc.ldm <= 6)
    {
        printf("%s: Error leading dimension must be at least 6\n", fcnm);
        return -1;
    }
    if (mtloc.mts == NULL || phi == NULL)
    {
        if (mtloc.mts == NULL)
        {
            fprintf(stderr, "%s: Error mts is NULL\n", __func__);
        }
        if (phi == NULL){fprintf(stderr, "%s: Error phi is NULL\n", __func__);}
        return -1;
    }
    npmax = getNpMax(iobs, *data, mtloc);
    if (npmax < 1)
    {
        printf("%s: No data points\n", fcnm);
        return -1;
    }
    // Set space and copy data
    lagLoc = NULL;
    lagWork = NULL;
    varWork = NULL;
    phiWork = NULL;
    G = memory_calloc64f(6*npmax);
    d = memory_calloc64f(npmax);
    varLoc = array_set64f(npmax, DBL_MAX, &ierr);
    phiLoc = memory_calloc64f(mtloc.nmt);
    if (nlocProcs > 1)
    {
        if (mtloc.myid == master)
        {
            phiWork = memory_calloc64f(data->nlocs*mtloc.nmtAll);
            varWork = memory_calloc64f(npmax);
            if (lwantLags)
            {
                lagWork = memory_calloc32i(data->nlocs*mtloc.nmtAll);
            }
        }
        else
        {
            phiWork = memory_calloc64f(1);
            varWork = memory_calloc64f(1);
            lagWork = memory_calloc32i(1);
        }
    }
    else
    {
        phiWork = phi;
        varWork = var;
        lagWork = lags;
    }
    if (lwantLags)
    {
        lagLoc = memory_calloc32i(mtloc.nmt);
    }
    else
    {
        lagLoc = memory_calloc32i(1);
    }
    npts = data->data[iobs].npts;
    cblas_dcopy(npts, data->data[iobs].data, 1, d, 1);
    for (jloc=0; jloc<data->nlocs; jloc=jloc+nlocProcs)
    {
        iloc = jloc + myloc;
        if (iloc >= data->nlocs){goto NEXT_LOCATION;}
        k = iobs*data->nlocs + iloc;
        // Get the Green's functions onto the matrix G
        ierr = parmt_utils_setDataOnG(iobs, iloc, npmax, *data, G);
        if (ierr != 0)
        {
            printf("%s: Error setting Greens functions\n", fcnm);
            return -1;
        }
        // Tally the objective function
        ierr = parmt_mtSearchL164f(mtloc.ldm, mtloc.nmt,
                                   npts, blockSize,
                                   nlags, lwantLags,
                                   lrescale,
                                   &G[0*npmax], &G[1*npmax], &G[2*npmax],
                                   &G[3*npmax], &G[4*npmax], &G[5*npmax],
                                   CeInv, mtloc.mts, d,
                                   phiLoc, varLoc, lagLoc);
        if (ierr != 0)
        {
            printf("%s: Error calling XC64f search %d %d\n",
                   fcnm, myloc, mtloc.myid);
            return -1;
        }
        // Get the results on the master
        jndx = 0;
        if (mtloc.myid == master){jndx = iloc*mtloc.nmtAll;}
        if (mtloc.commSize == 1)
        {
            array_copy64f_work(mtloc.nmt, phiLoc, &phiWork[jndx]);
            if (lwantLags)
            {
                array_copy32i_work(mtloc.nmt, lagLoc, &lagWork[jndx]);
            }
        }
        else
        {
            MPI_Gatherv(phiLoc, mtloc.nmt, MPI_DOUBLE,
                        &phiWork[jndx], mtloc.nmtProc, mtloc.offset,
                        MPI_DOUBLE, master, mtloc.comm);
            if (lwantLags)
            {
                MPI_Gatherv(lagLoc, mtloc.nmt, MPI_INT,
                            &lagWork[jndx], mtloc.nmtProc, mtloc.offset,
                            MPI_INT, master, mtloc.comm);
            }
        }
NEXT_LOCATION:;
    }
    // Reduce the variance onto varWork
    MPI_Reduce(varLoc, varWork, npts, MPI_DOUBLE, MPI_MIN,
               master, mtloc.comm);
    // Have the location masters reduce their result onto the master
    if (mtloc.myid == master)
    {
        if (nlocProcs > 1)
        {
            MPI_Reduce(phiWork, phi, data->nlocs*mtloc.nmtAll,
                       MPI_DOUBLE, MPI_SUM, master, locComm);
            MPI_Reduce(varWork, var, npts,
                       MPI_DOUBLE, MPI_MIN, master, locComm);
            if (lwantLags)
            {
                MPI_Reduce(lagWork, lags, data->nlocs*mtloc.nmtAll,
                           MPI_INT, MPI_SUM, master, locComm);
            }
        }
    }
    cblas_dscal(npts, 1.0/(double) mtloc.nmtAll, varLoc, 1);
    // Free memory
    memory_free32i(&lagLoc);
    memory_free64f(&phiLoc);
    memory_free64f(&varLoc);
    memory_free64f(&d);
    memory_free64f(&G);
    if (nlocProcs > 1)
    {
        memory_free64f(&phiWork);
        memory_free64f(&varWork);
        memory_free32i(&lagWork);
    }
    phiWork = NULL;
    lagWork = NULL;
    // Block until everyone is done
    if (mtloc.myid == master){MPI_Barrier(locComm);}
    MPI_Barrier(mtloc.comm);
    return 0;
}

int parmt_locSearchXC64f(const MPI_Comm locComm,
                         const int iobs, const int blockSize,
                         const int nlags, const bool lwantLags,
                         struct localMT_struct mtloc,
                         struct parmtData_struct *data,
                         double *__restrict__ phi, int *__restrict__ lags)
{
    const char *fcnm = "parmt_locSearchXC64f\0";
    double *G, *d, *phiLoc, *phiWork;
    int *lagLoc, *lagWork, ierr, iloc, jndx, jloc, k,
        myloc, npmax, nprocs, npts;
    const int master = 0;
    ierr = 0;
    myloc =-1;
    if (mtloc.myid == master)
    {
        MPI_Comm_rank(locComm, &myloc);
        MPI_Comm_size(locComm, &nprocs);
    }
    MPI_Bcast(&myloc, 1, MPI_INT, master, mtloc.comm);
    MPI_Bcast(&nprocs, 1, MPI_INT, master, mtloc.comm);
    if (iobs < 0 || iobs >= data->nobs)
    {
        printf("%s: Invalid observation number %d\n", fcnm, iobs);
        return -1;
    }
    if (mtloc.ldm <= 6)
    {
        printf("%s: Error leading dimension must be at least 6\n", fcnm);
        return -1;
    }
    if (mtloc.mts == NULL || phi == NULL)
    {
        if (mtloc.mts == NULL)
        {
            fprintf(stderr, "%s: Error mts is NULL\n", __func__);
        }
        if (phi == NULL){fprintf(stderr, "%s: Error phi is NULL\n", __func__);}
        return -1;
    }
    npmax = getNpMax(iobs, *data, mtloc);
    if (npmax < 1)
    {
        printf("%s: No data points\n", fcnm);
        return -1;
    }
    // Set space and copy data
    G = memory_calloc64f(6*npmax);
    d = memory_calloc64f(npmax);
    phiLoc = memory_calloc64f(mtloc.nmt);
    if (nprocs > 1)
    {
        if (mtloc.myid == master)
        {
            phiWork = memory_calloc64f(data->nlocs*mtloc.nmtAll);
            if (lwantLags)
            {
                lagWork = memory_calloc32i(data->nlocs*mtloc.nmtAll);
            }
        }
        else
        {
             phiWork = memory_calloc64f(1);
             lagWork = memory_calloc32i(1);
        }
    }
    else
    {
        phiWork = phi;
        lagWork = lags;
    }
    if (lwantLags)
    {
        lagLoc = memory_calloc32i(mtloc.nmt);
    }
    else
    {
        lagLoc = memory_calloc32i(1);
    }
    npts = data->data[iobs].npts;
    cblas_dcopy(npts, data->data[iobs].data, 1, d, 1);
    for (jloc=0; jloc<data->nlocs; jloc=jloc+nprocs)
    {
        iloc = jloc + myloc;
        if (iloc >= data->nlocs){goto NEXT_LOCATION;}
        k = iobs*data->nlocs + iloc;
        // Get the Green's functions onto the matrix G
        ierr = parmt_utils_setDataOnG(iobs, iloc, npmax, *data, G);
        if (ierr != 0)
        {
            printf("%s: Error setting Greens functions\n", fcnm);
            return -1;
        }
        // Tally the objective function
        ierr = parmt_mtSearchXC64f(mtloc.ldm, mtloc.nmt,
                                   npts, blockSize,
                                   nlags, lwantLags,
                                   &G[0*npmax], &G[1*npmax], &G[2*npmax],
                                   &G[3*npmax], &G[4*npmax], &G[5*npmax],
                                   mtloc.mts, d, phiLoc, lagLoc);
        if (ierr != 0)
        {
            printf("%s: Error calling XC64f search %d %d\n",
                   fcnm, myloc, mtloc.myid);
            return -1;
        }
        // Get the results on the master
        jndx = 0;
        if (mtloc.myid == master){jndx = iloc*mtloc.nmtAll;}
        MPI_Gatherv(phiLoc, mtloc.nmt, MPI_DOUBLE,
                    &phiWork[jndx], mtloc.nmtProc, mtloc.offset,
                    MPI_DOUBLE, master, mtloc.comm);
        if (lwantLags)
        {
            MPI_Gatherv(lagLoc, mtloc.nmt, MPI_INT,
                        &lagWork[jndx], mtloc.nmtProc, mtloc.offset,
                        MPI_INT, master, mtloc.comm);
        }
NEXT_LOCATION:;
        MPI_Barrier(mtloc.comm);
    }
    // Have the location masters reduce their result onto the master
    if (mtloc.myid == master && nprocs > 1)
    {
        MPI_Reduce(phiWork, phi, data->nlocs*mtloc.nmtAll,
                   MPI_DOUBLE, MPI_SUM, master, locComm);
        if (lwantLags)
        {
            MPI_Reduce(lagWork, lags, data->nlocs*mtloc.nmtAll,
                       MPI_INT, MPI_SUM, master, locComm);
        }
    }
    // Free memory
    memory_free32i(&lagLoc);
    memory_free64f(&phiLoc);
    memory_free64f(&d);
    memory_free64f(&G);
    if (nprocs > 1)
    {
        memory_free64f(&phiWork);
        memory_free32i(&lagWork);
    }
    phiWork = NULL;
    lagWork = NULL;
    return 0;
}

static int getNpMax(const int iobs, const struct parmtData_struct data,
                    const struct localMT_struct mtloc)
{
    const char *fcnm = "getNpMax\0";
    int iloc, k, npmax, npts;
    const int master = 0;
    // Get the workspace size
    npmax = 0;
    npts = data.data[iobs].header.npts;
    if (mtloc.myid == master)
    {
        for (iloc=0; iloc<data.nlocs; iloc++)
        {
            k = iobs*data.nlocs + iloc;
            npmax = MAX(npmax, data.data[iobs].header.npts);
            if (data.data[iobs].header.npts != data.sacGxx[k].header.npts ||
                data.data[iobs].header.npts != data.sacGyy[k].header.npts ||
                data.data[iobs].header.npts != data.sacGzz[k].header.npts ||
                data.data[iobs].header.npts != data.sacGxy[k].header.npts ||
                data.data[iobs].header.npts != data.sacGxz[k].header.npts ||
                data.data[iobs].header.npts != data.sacGyz[k].header.npts)
            {
                printf("%s: Inconsistent sizes\n", fcnm);
                npmax = 0;
                break;
            }
        }
    }
    MPI_Bcast(&npmax, 1, MPI_INTEGER, master, mtloc.comm);
    if (npmax < 1)
    {
        printf("%s: Error no data points\n", fcnm);
        return -1;
    }
    return npmax;
}

/*
static int setDataOnG(const int iobs, const int iloc, const int npmax,
                       const struct parmtData_struct data,
                       double *__restrict__ G)
{
    const char *fcnm = "setDataOnG\0";
    int k;
    if (iobs < 0 || iobs >= data.nobs)
    {
        printf("%s: Error invalid observation\n", fcnm);
        return -1;
    }
    if (iloc < 0 || iloc >= data.nlocs)
    {
        printf("%s: Error invalid location\n", fcnm);
        return -1;
    }
    k = iobs*data.nlocs + iloc;
    if (npmax > data.sacGxx[k].npts || npmax > data.sacGyy[k].npts ||
        npmax > data.sacGzz[k].npts || npmax > data.sacGxy[k].npts ||
        npmax > data.sacGxz[k].npts || npmax > data.sacGyz[k].npts)
    {
        printf("%s: npmax is too small\n", fcnm);
        return -1;
    }
    if (data.sacGxx[k].data == NULL || data.sacGyy[k].data == NULL ||
        data.sacGzz[k].data == NULL || data.sacGxy[k].data == NULL ||
        data.sacGxz[k].data == NULL || data.sacGyz[k].data == NULL)
    {
        printf("%s: Greens function is null\n", fcnm);
        return -1;
    }
    // Get the Green's functions onto the matrix G
    array_zeros64f_work(6*npmax, G);
    cblas_dcopy(data.sacGxx[k].header.npts,
                data.sacGxx[k].data, 1, &G[0*npmax], 1);
    cblas_dcopy(data.sacGyy[k].header.npts,
                data.sacGyy[k].data, 1, &G[1*npmax], 1);
    cblas_dcopy(data.sacGzz[k].header.npts,
                data.sacGzz[k].data, 1, &G[2*npmax], 1);
    cblas_dcopy(data.sacGxy[k].header.npts,
                data.sacGxy[k].data, 1, &G[3*npmax], 1);
    cblas_dcopy(data.sacGxz[k].header.npts,
                data.sacGxz[k].data, 1, &G[4*npmax], 1);
    cblas_dcopy(data.sacGyz[k].header.npts,
                data.sacGyz[k].data, 1, &G[5*npmax], 1);
    return 0;
}
*/


/*
ODE: a program to get optime Runge-Kutta and multi-steps methods.

Copyright 2011-2019, Javier Burguete Tolosa.

Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:

	1. Redistributions of source code must retain the above copyright notice,
		this list of conditions and the following disclaimer.

	2. Redistributions in binary form must reproduce the above copyright notice,
		this list of conditions and the following disclaimer in the
		documentation and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY Javier Burguete Tolosa ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
SHALL Javier Burguete Tolosa OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/

/**
 * \file ode.c
 * \brief Source file with the main function.
 * \author Javier Burguete Tolosa.
 * \copyright Copyright 2011-2019.
 */
#define _GNU_SOURCE
#include <stdio.h>
#include <stdlib.h>
#include <getopt.h>
#include <math.h>
#include <string.h>
#include <alloca.h>
#include <time.h>
#include <unistd.h>
#include <libxml/parser.h>
#include <glib.h>
#include <gsl/gsl_rng.h>
#include <libintl.h>
#if HAVE_MPI
#include <mpi.h>
#endif
#include "config.h"
#include "utils.h"
#include "optimize.h"
#include "steps.h"
#include "rk.h"

// OPTIMES
//
// RK_2_2 (cfl=1, cfl/steps=1/2)
// t1=1 t2=1
// a10=1 a20=a21=1/2
// b10=1 b20=b21=1/2
// c10=1 c20=0 c21=1
//
// RK_3_2 (cfl=2, cfl/steps=2/3)
// t1=1/2 t2=t3=1
// a10=1 a20=0 a21=1 a30=1/3 a31=0 a32=2/3
// b10=1/2 b20=b21=1/2 b30=b31=b32=1/3
// c10=1/2 c20=0 c21=1/2 c30=0 c31=0 c32=1/2
//
// RK_4_2 (cfl=3, cfl/steps=3/4)
// t1=1/3 t2=2/3 t3=t4=1
// a10=1 a20=0 a21=1 a30=a31=0 a32=1 a40=1/4 a41=a42=0 a43=3/4
// b10=1/3 b20=b21=1/2 b30=b31=b32=1/3
// c10=1/3 c20=0 c21=1/3 c30=c31=0 c32=1/3 c40=c41=c42=0 c43=1/3
//
// RK_5_2 (cfl=4, cfl/steps=4/5)
// t1=1/4 t2=1/2 t3=3/4 t4=t5=1
// a10=1 a20=0 a21=1 a30=a31=0 a32=1 a40=a41=a42=0 a43=1
// a50=1/5 a51=a52=a53=0 a54=4/5
// b10=b20=b21=b30=b31=b32=b40=b41=b42=b43=1/4 b50=b51=b52=b53=b54=1/5
// c10=1/4 c20=0 c21=1/4 c30=c31=0 c32=1/4 c40=c41=c42=0 c43=1/4
// c50=c51=c52=c53=0 c54=1/4
//
// RK_6_2 (cfl=5, cfl/steps=5/6)
// t1=1/5 t2=2/5 t3=3/5 t4=4/5 t5=t6=1
// a10=1 a20=0 a21=1 a30=a31=0 a32=1 a40=a41=a42=0 a43=1 a50=a51=a52=a53=0 a54=1
// a60=1/6 a61=a62=a63=a64=0 a65=5/6
// b10=b20=b21=b30=b31=b32=b40=b41=b42=b43b50=b51=b52=b53=b54=1/5
// b60=b61=b62=b63=b64=b65=1/6
// c10=1/5 c20=0 c21=1/5 c30=c31=0 c32=1/5 c40=c41=c42=0 c43=1/5
// c50=c51=c52=c53=0 c54=1/5 c60=c61=c62=c63=c64=0 c65=1/5
//
// RK_7_2 (cfl=6, cfl/steps=6/7)
// t1=1/6 t2=2/6 t3=3/6 t4=4/6 t5=5/6 t6=t7=1
// a10=1 a20=0 a21=1 a30=a31=0 a32=1 a40=a41=a42=0 a43=1 a50=a51=a52=a53=0 a54=1
// a60=a61=a62=a63=a64=0 a65=1 a70=1/7 a71=a72=a73=a74=a75=0 a76=6/7
// b10=b20=b21=b30=b31=b32=b40=b41=b42=b43b50=b51=b52=b53=b54=b60=b61=b62=b63
// =b64=b65=1/6 b70=b71=b72=b73=b74=b75=b76=1/7
// c10=1/6 c20=0 c21=1/6 c30=c31=0 c32=1/6 c40=c41=c42=0 c43=1/6
// c50=c51=c52=c53=0 c54=1/6 c60=c61=c62=c63=c64=0 c65=1/6
// c70=c71=c73=c74=c75=0 c76=1/6
//
// STEPS_3_2 (cfl=1/2)
// a0=3/4 a1=0 a2=1/4
// b0=3/2 b1=b2=0
// c0=2 c1=c2=0
//
// STEPS_4_2 (cfl=2/3)
// a0=8/9 a1=a2=0 a3=1/9
// b0=4/3 b1=b2=b3=0
// c0=3/2 c1=c2=c3=0
//
// STEPS_5_2 (cfl=3/4)
// a0=15/16 a1=a2=a3=0 a4=1/16
// b0=5/4 b1=b2=b3=b4=0
// c0=4/3 c1=c2=c3=c4=0
//
// STEPS_6_2 (cfl=4/5)
// a0=24/25 a1=a2=a3=a4=0 a5=1/25
// b0=6/5 b1=b2=b3=b4=b5=0
// c0=5/4 c1=c2=c3=c4=c5=0
//
// STEPS_7_2 (cfl=5/6)
// a0=35/36 a1=a2=a3=a4=0 a5=1/36
// b0=7/6 b1=b2=b3=b4=b5=0
// c0=6/5 c1=c2=c3=c4=c5=0
//
// STEPS_8_2 (cfl=6/7)
// a0=48/49 a1=a2=a3=a4=0 a5=1/49
// b0=8/7 b1=b2=b3=b4=b5=0
// c0=7/6 c1=c2=c3=c4=c5=0
//
// RK_3_3 (cfl=1, cfl/steps=1/3)
// t1=t3=1 t2=1/2
// a10=1 a20=3/4 a21=1/4 a30=1/3 a31=0 a32=2/3
// b10=1 b20=b21=1/4 b30=b31=1/6 b32=2/3
// c10=1 c20=0 c21=1 c30=0 c31=0 c32=1
//
// RK_4_3 (cfl=2, cfl/steps=1/2)
// t1=t3=1/2 t2=1
// a10=1 a20=0 a21=1 a30=2/3 a31=0 a32=1/3 a40=a41=a42=0 a43=1
// b10=b20=b21=1/2 b30=b31=b32=b40=b41=b42=1/6 b43=1/2
// c10=c20=c21=1/2 c30=0 c31=c32=c40=c41=c42=c43=1/2
//
// STEPS_4_3 (cfl=1/3)
// a0=16/27 a1=a2=0 a3=11/27
// b0=16/9 b1=b2=0 b3=4/9
// c0=3 c1=c2=0 c3=12/11
//
// STEPS_5_3 (cfl=1/2)
// a0=25/32 a1=a2=a3=0 a4=7/32
// b0=25/16 b1=b2=b3=0 b4=5/16
// c0=2 c1=c2=c3=0 c4=10/7
//
// STEPS_6_3 (cfl=0.58282164314264111327)
// a0=0.85070887167257828565    // (1-a4-a5)
// a1=a2=a3=0
// a4=0.030664864534382320725 // (sqrt(10*a5-1)-10*a5+1)/8
// a5=0.11862626379303939363
//      (63*sqrt(2614)+3221)^(1/3)-5*(63*sqrt(2614)+3221)^(-1/3)-13)/45
// b0=1.4596384360152765194     // a0*c0
// b1=b2=b3=0
// b4=0.052614491749197671863   // a4*c4
// b5=0.20353784933825205974    // a5*c5
// c0=c4=c5=1.715790777102726251        // (1+4*a4+5*a5)
// c1=c2=c3=0
//
// RK_4_4
// b20=b30=b31=0
// t1=t2=b10=b21=1/2
// t3=t4=b32=1
// b40=b43=1/6
// b41=b42=1/3
//
// RK_5_4 (cfl=5.7383119999072648693e-01)
// a10=1
// a20=7.6291847536448934231e-01
// a21=2.3708152463551065768e-01
// a30=2.8277566215397998339e-03
// a31=9.4483076489543642366e-01
// a32=5.2341478483023776481e-02
// a40=6.6309349322657261432e-01
// a41=4.4608078655530437600e-04
// a42=3.3644655897571642926e-01
// a43=1.3867011155652078012e-05
// a50=6.1508837844244168818e-01
// a51=1.6215445203250317099e-01
// a52=1.5031540295088349761e-03
// a53=2.9995002701206228898e-03
// a54=2.1825451522542568299e-01
// b10=4.5307898578512145396e-01
// b20=1.0742850906542086858e-01
// b21=4.1289584245869493973e-01
// b30=4.3724780003845571699e-01
// b31=1.6681424138984873981e+00
// b32=9.0588475806896936944e-02
// b40=3.6664090929447934446e-02
// b41=1.3964776663947759666e-01
// b42=5.8495388577489235762e-01
// b43=1.9355255172522962676e-05
// b50=1.8734964237542205069e-01
// b51=3.0001844590932289148e-01
// b52=1.2903718344972795025e-01
// b53=3.4166232498545846666e-03
// b54=3.8017810501567252292e-01
// c10=4.5307898578512145396e-01
// c20=1.5535519922690283242e-05
// c21=1.7415774725317857109e+00
// c30=1.2525364871787093798e+00
// c31=1.7426727581493662919e+00
// c32=1.7307206145557779180e+00
// c40=4.7046995817421687883e-04
// c41=1.5854730818354572705e+00
// c42=1.7386197420604550316e+00
// c43=1.3957769958693602267e+00
// c50=1.6974106727520458494e-01
// c51=1.6275559956612365566e+00
// c52=7.2955698585694530597e-01
// c53=1.1376557995384390896e+00
// c54=1.7419025884665109550e+00
//
// STEPS_6_4 (cfl=1.6475925238473621578e-01)
// a0=3.4246085571701207596e-01
// a1=a2=0
// a3=1.9179825943473607269e-01
// a4=9.3562124939009442453e-02
// a5=3.721787599092424089e-01
// b0=2.078553105578055306e+00
// b1=b2=b5=0
// b3=1.1641122222796929277e+00
// b4=5.6787174974870979874e-01
// c0=c3=c4=6.0694618695213438363e+00
// c1=c2=c5=0

/**
 * enum to define the method type.
 */
enum
{
  METHOD_TYPE_RUNGE_KUTTA = 1,  ///< Runge-Kutta method.
  METHOD_TYPE_STEPS = 2,        ///< multi-steps method.
} MethodType;

/**
 * enum to define the program error code.
 */
enum
{
  ERROR_CODE_NARGS = 1,         ///< bad command line arguments number.
  ERROR_CODE_BAD_DOC = 2,       ///< bad XML file.
  ERROR_CODE_NO_XML_ROOT = 3,   ///< no XML root node.
  ERROR_CODE_BAD_RK = 4,        ///< bad Runge-Kutta method.
  ERROR_CODE_BAD_STEPS = 5,     ///< bad multi-steps method.
  ERROR_CODE_UNKNOWN_METHOD = 6,        ///< unknown method.
  ERROR_CODE_UNKNOWN_OPTION = 7,        ///< unknown option.
} ErrorCode;

unsigned int nsteps;            ///< steps number.
unsigned int order;             ///< accuracy order.

/**
 * Main function
 *
 * \return 0 on succes, error code on error.
 */
int
main (int argn,                 ///< arguments number.
      char **argc)              ///< argument chains array.
{
  const struct option options[] = {
    {"help", no_argument, NULL, 'h'},
    {"seed", required_argument, NULL, 's'},
    {"threads", required_argument, NULL, 't'},
    {NULL, 0, NULL, 0}
  };
  const char *usage = _("Usage is:\n"
                        "./ode "
                        "[-t --threads threads_number] "
                        "[-s --seed random_seed] "
                        "input_file [variables_file]");
  xmlDoc *doc;
  xmlNode *node;
  gsl_rng *rng0, **rng;
  time_t d0;
  clock_t t0;
  unsigned long int seed = 7l;
  int o, option_index;
  unsigned int i, j, k, h = 0;

#if HAVE_MPI
  // Init MPI
  MPI_Init (&argn, &argc);
#endif

  // Enabling spaces in XML files
  xmlKeepBlanksDefault (0);

  // Setting the threads as the number of processors
  nthreads = sysconf (_SC_NPROCESSORS_CONF);

  // Parsing command line options
  while (1)
    {
      o = getopt_long (argn, argc, "hs:t:", options, &option_index);
      if (o == -1)
        break;
      switch (o)
        {
        case 's':
          seed = atol (optarg);
          break;
        case 't':
          nthreads = atoi (optarg);
          break;
        case 'h':
          printf ("%s\n", usage);
          h = 1;
          break;
        default:
          show_error (_("Unknown option"));
          return ERROR_CODE_UNKNOWN_OPTION;
        }
    }
  argn -= optind;
  if (argn != 1 && argn != 2)
    {
      if (h)
        return 0;
      show_error (usage);
      return ERROR_CODE_NARGS;
    }

  // Init the clock
  t0 = clock ();
  d0 = time (NULL);

#if HAVE_MPI

  // Nodes number
  MPI_Comm_size (MPI_COMM_WORLD, &nnodes);

  // Actual node
  MPI_Comm_rank (MPI_COMM_WORLD, &rank);

#else

  nnodes = 1;
  rank = 0;

#endif

  // Select the numerical model
  printf ("Rank=%d nnodes=%d nthreads=%u\n", rank, nnodes, nthreads);
  printf ("Selecting method optind=%d\n", optind);
  doc = xmlParseFile (argc[optind]);
  if (!doc)
    {
      show_error (_("Unable to parse the input file"));
      return ERROR_CODE_BAD_DOC;
    }
  node = xmlDocGetRootElement (doc);
  if (!node)
    {
      show_error (_("No XML root node"));
      return ERROR_CODE_NO_XML_ROOT;
    }

  // Init a random numbers generator per node and thread
  printf ("Initing random numbers\n");
  rng = (gsl_rng **) g_slice_alloc (nnodes * nthreads * sizeof (gsl_rng *));
  rng0 = gsl_rng_alloc (gsl_rng_ranlxs2);
  gsl_rng_set (rng0, seed);
  for (i = k = 0; (int) i < nnodes; ++i)
    for (j = 0; j < nthreads; ++j, ++k)
      {
        rng[k] = gsl_rng_alloc (gsl_rng_taus2);
        gsl_rng_set (rng[k], gsl_rng_get (rng0));
      }

  if (argn == 2)
    file_variables = fopen (argc[++optind], "w");

  j = rank * nthreads;
  if (!xmlStrcmp (node->name, XML_RUNGE_KUTTA))
    {
      if (!rk_run (node, rng))
        {
          show_error (error_message);
          return ERROR_CODE_BAD_RK;
        }
    }
  else if (!xmlStrcmp (node->name, XML_STEPS))
    {
      if (!steps_run (node, rng))
        {
          show_error (error_message);
          return ERROR_CODE_BAD_STEPS;
        }
    }
  else
    {
      show_error (_("Unknown method type"));
      return ERROR_CODE_UNKNOWN_METHOD;
    }

  printf ("cpu time=%lg real time=%lu\n",
          (clock () - t0) / ((double) CLOCKS_PER_SEC), time (NULL) - d0);

  // Free memory
  xmlFreeDoc (doc);
  if (file_variables)
    fclose (file_variables);
  j = nnodes * nthreads;
  for (i = 0; i < j; ++i)
    gsl_rng_free (rng[i]);
  g_slice_free1 (j * sizeof (gsl_rng *), rng);
  gsl_rng_free (rng0);

#if HAVE_MPI
  // Close MPI
  MPI_Finalize ();
#endif

  return 0;
}