/* Copyright (C) 2015 Atsushi Togo */
/* All rights reserved. */

/* This file is part of phonopy. */

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

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

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

/* * Neither the name of the phonopy project nor the names of its */
/*   contributors may be used to endorse or promote products derived */
/*   from this software without specific prior written permission. */

/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
/* "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 THE */
/* COPYRIGHT HOLDER 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. */

#include <lapacke.h>
#include <stdlib.h>
#include <phonoc_array.h>
#include <phonoc_utils.h>
#include <phonon4_h/frequency_shift.h>
#include <phonon4_h/real_to_reciprocal.h>

static void get_fc4_normal_for_frequency_shift_at_gp
(double *fc4_normal_real,
 const double *frequencies,
 const lapack_complex_double *eigenvectors,
 const int grid_point0,
 const int grid_point1,
 const int *grid_address,
 const int *mesh,
 const double *fc4,
 const Darray *shortest_vectors,
 const Iarray *multiplicity,
 const double *masses,
 const int *p2s_map,
 const int *s2p_map,
 const Iarray *band_indices,
 const double cutoff_frequency);
static lapack_complex_double fc4_sum(const int bi0,
				     const int bi1,
				     const lapack_complex_double *eigvecs0,
				     const lapack_complex_double *eigvecs1,
				     const lapack_complex_double *fc4_reciprocal,
				     const double *masses,
				     const int num_atom);
static int collect_undone_grid_points(int *undone,
				      char *phonon_done,
				      const int num_grid_points,
				      const int *grid_points);

void get_fc4_frequency_shifts(double *frequency_shifts,
			      const double *fc4_normal_real,
			      const double *frequencies,
			      const Iarray *grid_points1,
			      const Darray *temperatures,
			      const int *band_indicies,
			      const int num_band0,
			      const int num_band,
			      const double unit_conversion_factor)
{
  int i, j, k, l;
  double shift, num_phonon;

  for (i = 0; i < temperatures->dims[0]; i++) {
    for (j = 0; j < num_band0; j++) {
      shift = 0;
#pragma omp parallel for reduction(+:shift) private(k, l, num_phonon)
      for (k = 0; k < grid_points1->dims[0]; k++) {
	for (l = 0; l < num_band; l++) {
	  if (temperatures->data[i] > 0) {
	    num_phonon = 2 *
	      bose_einstein(frequencies[grid_points1->data[k] * num_band + l],
			    temperatures->data[i]) + 1;
	  } else {
	    num_phonon = 1;
	  }
	  shift += unit_conversion_factor * fc4_normal_real
	    [k * num_band0 * num_band + j * num_band + l] * num_phonon;
	}
      }
      frequency_shifts[i * num_band0 + j] = shift;
    }
  }
}

void
get_fc4_normal_for_frequency_shift(double *fc4_normal_real,
				   const double *frequencies,
				   const lapack_complex_double *eigenvectors,
				   const int grid_point0,
				   const Iarray *grid_points1,
				   const int *grid_address,
				   const int *mesh,
				   const double *fc4,
				   const Darray *shortest_vectors,
				   const Iarray *multiplicity,
				   const double *masses,
				   const int *p2s_map,
				   const int *s2p_map,
				   const Iarray *band_indicies,
				   const double cutoff_frequency)
{
  int i, num_atom, num_band, num_band0;

  num_atom = multiplicity->dims[1];
  num_band = num_atom * 3;
  num_band0 = band_indicies->dims[0];

#pragma omp parallel for private(i)
  for (i = 0; i < grid_points1->dims[0]; i++) {
    get_fc4_normal_for_frequency_shift_at_gp(fc4_normal_real +
					     i * num_band0 * num_band,
					     frequencies,
					     eigenvectors,
					     grid_point0,
					     grid_points1->data[i],
					     grid_address,
					     mesh,
					     fc4,
					     shortest_vectors,
					     multiplicity,
					     masses,
					     p2s_map,
					     s2p_map,
					     band_indicies,
					     cutoff_frequency);
  }
}

void set_phonons_for_frequency_shift(Darray *frequencies,
				     Carray *eigenvectors,
				     char *phonon_done,
				     const Iarray *grid_points,
				     const int *grid_address,
				     const int *mesh,
				     const Darray *fc2,
				     const Darray *svecs_fc2,
				     const Iarray *multi_fc2,
				     const double *masses_fc2,
				     const int *p2s_fc2,
				     const int *s2p_fc2,
				     const double unit_conversion_factor,
				     const double *born,
				     const double *dielectric,
				     const double *reciprocal_lattice,
				     const double *q_direction,
				     const double nac_factor,
				     const char uplo)
{
  int num_undone;
  int *undone;

  undone = (int*)malloc(sizeof(int) * frequencies->dims[0]);
  num_undone = collect_undone_grid_points(undone,
					  phonon_done,
					  grid_points->dims[0],
					  grid_points->data);

  get_undone_phonons(frequencies,
		     eigenvectors,
		     undone,
		     num_undone,
		     grid_address,
		     mesh,
		     fc2,
		     svecs_fc2,
		     multi_fc2,
		     masses_fc2,
		     p2s_fc2,
		     s2p_fc2,
		     unit_conversion_factor,
		     born,
		     dielectric,
		     reciprocal_lattice,
		     q_direction,
		     nac_factor,
		     uplo);

  free(undone);
}

void reciprocal_to_normal4(lapack_complex_double *fc4_normal,
			   const lapack_complex_double *fc4_reciprocal,
			   const double *freqs0,
			   const double *freqs1,
			   const lapack_complex_double *eigvecs0,
			   const lapack_complex_double *eigvecs1,
			   const double *masses,
			   const int *band_indices,
			   const int num_band0,
			   const int num_band,
			   const double cutoff_frequency)
{
  int i, j, bi, num_atom;
  lapack_complex_double fc4_sum_elem;

  num_atom = num_band / 3;

  for (i = 0; i < num_band0; i++) {
    bi = band_indices[i];
    if (freqs0[bi] > cutoff_frequency) {
      for (j = 0; j < num_band; j++) {
	if (freqs1[j] > cutoff_frequency) {
	  fc4_sum_elem = fc4_sum(bi,
				 j,
				 eigvecs0,
				 eigvecs1,
				 fc4_reciprocal,
				 masses,
				 num_atom);
	  fc4_normal[i * num_band + j] = lapack_make_complex_double
	    (lapack_complex_double_real(fc4_sum_elem) / freqs0[bi] / freqs1[j],
	     lapack_complex_double_imag(fc4_sum_elem) / freqs0[bi] / freqs1[j]);
	} else {
	  fc4_normal[i * num_band + j] = lapack_make_complex_double(0, 0);
	}
      }
    } else {
      for (j = 0; j < num_band; j++) {
	fc4_normal[i * num_band + j] = lapack_make_complex_double(0, 0);
      }
    }
  }
}

static void get_fc4_normal_for_frequency_shift_at_gp
(double *fc4_normal_real,
 const double *frequencies,
 const lapack_complex_double *eigenvectors,
 const int grid_point0,
 const int grid_point1,
 const int *grid_address,
 const int *mesh,
 const double *fc4,
 const Darray *shortest_vectors,
 const Iarray *multiplicity,
 const double *masses,
 const int *p2s_map,
 const int *s2p_map,
 const Iarray *band_indices,
 const double cutoff_frequency)
{
  int i, num_atom, num_band, num_band0;
  lapack_complex_double *fc4_reciprocal, *fc4_normal;
  double q[12];

  num_atom = multiplicity->dims[1];
  num_band = num_atom * 3;
  num_band0 = band_indices->dims[0];

  fc4_reciprocal = (lapack_complex_double*)
    malloc(sizeof(lapack_complex_double) *
	   num_atom * num_atom * num_atom * num_atom * 81);
  fc4_normal = (lapack_complex_double*)
    malloc(sizeof(lapack_complex_double) * num_band0 * num_band);

  for (i = 0; i < 3; i++) {
    q[i + 3] = (double)grid_address[grid_point0 * 3 + i] / mesh[i];
    q[i] = -q[i + 3];
    q[i + 6] = (double)grid_address[grid_point1 * 3 + i] / mesh[i];
    q[i + 9] = -q[i + 6];
  }

  real_to_reciprocal4(fc4_reciprocal,
		      q,
		      fc4,
		      shortest_vectors,
		      multiplicity,
		      p2s_map,
		      s2p_map);
  reciprocal_to_normal4(fc4_normal,
			fc4_reciprocal,
			frequencies + grid_point0 * num_band,
			frequencies + grid_point1 * num_band,
			eigenvectors + grid_point0 * num_band * num_band,
			eigenvectors + grid_point1 * num_band * num_band,
			masses,
			band_indices->data,
			num_band0,
			num_band,
			cutoff_frequency);

  for (i = 0; i < num_band0 * num_band; i++) {
    fc4_normal_real[i] = lapack_complex_double_real(fc4_normal[i]);
  }

  free(fc4_reciprocal);
  free(fc4_normal);
}

static lapack_complex_double fc4_sum(const int bi0,
				     const int bi1,
				     const lapack_complex_double *eigvecs0,
				     const lapack_complex_double *eigvecs1,
				     const lapack_complex_double *fc4_reciprocal,
				     const double *masses,
				     const int num_atom)
{
  int i, j, k, l, m, n, p, q;
  double sum_real, sum_imag, sum_real_cart, sum_imag_cart, mmm;
  lapack_complex_double eig_prod, eigvec0conj, eigvec1conj;

  sum_real = 0;
  sum_imag = 0;
  for (i = 0; i < num_atom; i++) {
    for (j = 0; j < num_atom; j++) {
      for (k = 0; k < num_atom; k++) {
	for (l = 0; l < num_atom; l++) {
	  sum_real_cart = 0;
	  sum_imag_cart = 0;
	  mmm = sqrt(masses[i] * masses[j] * masses[k] * masses[l]);
	  for (m = 0; m < 3; m++) {
	    eigvec0conj = lapack_make_complex_double
	      (lapack_complex_double_real
	       (eigvecs0[(i * 3 + m) * num_atom * 3 + bi0]),
	       -lapack_complex_double_imag
	       (eigvecs0[(i * 3 + m) * num_atom * 3 + bi0]));
	    for (n = 0; n < 3; n++) {
	    for (p = 0; p < 3; p++) {
	    for (q = 0; q < 3; q++) {
	      eigvec1conj = lapack_make_complex_double
		(lapack_complex_double_real
		 (eigvecs1[(l * 3 + q) * num_atom * 3 + bi1]),
		 -lapack_complex_double_imag
		 (eigvecs1[(l * 3 + q) * num_atom * 3 + bi1]));
	      eig_prod =
		phonoc_complex_prod(eigvec0conj,
		phonoc_complex_prod(eigvecs0[(j * 3 + n) * num_atom * 3 + bi0],
                phonoc_complex_prod(eigvecs1[(k * 3 + p) * num_atom * 3 + bi1],
                phonoc_complex_prod(eigvec1conj,
                fc4_reciprocal[i * num_atom * num_atom * num_atom * 81 +
			       j * num_atom * num_atom * 81 +
			       k * num_atom * 81 +
			       l * 81 +
			       m * 27 +
			       n * 9 +
			       p * 3 +
			       q]))));
	      sum_real_cart += lapack_complex_double_real(eig_prod);
	      sum_imag_cart += lapack_complex_double_imag(eig_prod);
	    }
	    }
	    }
	  }
	  sum_real += sum_real_cart / mmm;
	  sum_imag += sum_imag_cart / mmm;
	}
      }
    }
  }
  return lapack_make_complex_double(sum_real, sum_imag);
}

static int collect_undone_grid_points(int *undone,
				      char *phonon_done,
				      const int num_grid_points,
				      const int *grid_points)
{
  int i, gp, num_undone;

  num_undone = 0;

  for (i = 0; i < num_grid_points; i++) {
    gp = grid_points[i];
    if (phonon_done[gp] == 0) {
      undone[num_undone] = gp;
      num_undone++;
      phonon_done[gp] = 1;
    }
  }

  return num_undone;
}


/**
 *
 * @file core_ztstrf.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 Jakub Kurzak
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include "common.h"
#include <cblas.h>
#include <math.h>

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_ztstrf computes an LU factorization of a complex matrix formed
 *  by an upper triangular NB-by-N tile U on top of a M-by-N tile A
 *  using partial pivoting with row interchanges.
 *
 *  This is the right-looking Level 2.5 BLAS version of the algorithm.
 *
 *******************************************************************************
 *
 * @param[in] M
 *         The number of rows of the tile A.  M >= 0.
 *
 * @param[in] N
 *         The number of columns of the tile A.  N >= 0.
 *
 * @param[in] IB
 *         The inner-blocking size.  IB >= 0.
 *
 * @param[in] NB
 *
 * @param[in,out] U
 *         On entry, the NB-by-N upper triangular tile.
 *         On exit, the new factor U from the factorization
 *
 * @param[in] LDU
 *         The leading dimension of the array U.  LDU >= max(1,NB).
 *
 * @param[in,out] A
 *         On entry, the M-by-N tile to be factored.
 *         On exit, the factor L from the factorization
 *
 * @param[in] LDA
 *         The leading dimension of the array A.  LDA >= max(1,M).
 *
 * @param[in,out] L
 *         On entry, the IB-by-N lower triangular tile.
 *         On exit, the interchanged rows form the tile A in case of pivoting.
 *
 * @param[in] LDL
 *         The leading dimension of the array L.  LDL >= max(1,IB).
 *
 * @param[out] IPIV
 *         The pivot indices; for 1 <= i <= min(M,N), row i of the
 *         tile U was interchanged with row IPIV(i) of the tile A.
 *
 * @param[in,out] WORK
 *
 * @param[in] LDWORK
 *         The leading dimension of the array WORK.
 *
 * @param[out] INFO
 *
 *******************************************************************************
 *
 * @return
 *         \retval PLASMA_SUCCESS successful exit
 *         \retval <0 if INFO = -k, the k-th argument had an illegal value
 *         \retval >0 if INFO = k, 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_ztstrf = PCORE_ztstrf
#define CORE_ztstrf PCORE_ztstrf
#define CORE_zssssm PCORE_zssssm
int  CORE_zssssm(int M1, int N1, int M2, int N2, int K, int IB,
                 PLASMA_Complex64_t *A1, int LDA1,
                 PLASMA_Complex64_t *A2, int LDA2,
                 const PLASMA_Complex64_t *L1, int LDL1,
                 const PLASMA_Complex64_t *L2, int LDL2,
                 const int *IPIV);
#endif
int CORE_ztstrf(int M, int N, int IB, int NB,
                PLASMA_Complex64_t *U, int LDU,
                PLASMA_Complex64_t *A, int LDA,
                PLASMA_Complex64_t *L, int LDL,
                int *IPIV,
                PLASMA_Complex64_t *WORK, int LDWORK,
                int *INFO)
{
    static PLASMA_Complex64_t zzero = 0.0;
    static PLASMA_Complex64_t mzone =-1.0;

    PLASMA_Complex64_t alpha;
    int i, j, ii, sb;
    int im, ip;

    /* Check input arguments */
    *INFO = 0;
    if (M < 0) {
        coreblas_error(1, "Illegal value of M");
        return -1;
    }
    if (N < 0) {
        coreblas_error(2, "Illegal value of N");
        return -2;
    }
    if (IB < 0) {
        coreblas_error(3, "Illegal value of IB");
        return -3;
    }
    if ((LDU < max(1,NB)) && (NB > 0)) {
        coreblas_error(6, "Illegal value of LDU");
        return -6;
    }
    if ((LDA < max(1,M)) && (M > 0)) {
        coreblas_error(8, "Illegal value of LDA");
        return -8;
    }
    if ((LDL < max(1,IB)) && (IB > 0)) {
        coreblas_error(10, "Illegal value of LDL");
        return -10;
    }

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

    /* Set L to 0 */
    memset(L, 0, LDL*N*sizeof(PLASMA_Complex64_t));

    ip = 0;
    for (ii = 0; ii < N; ii += IB) {
        sb = min(N-ii, IB);

        for (i = 0; i < sb; i++) {
            im = cblas_izamax(M, &A[LDA*(ii+i)], 1);
            IPIV[ip] = ii+i+1;

            if (cabs(A[LDA*(ii+i)+im]) > cabs(U[LDU*(ii+i)+ii+i])) {
                /*
                 * Swap behind.
                 */
                cblas_zswap(i, &L[LDL*ii+i], LDL, &WORK[im], LDWORK );
                /*
                 * Swap ahead.
                 */
                cblas_zswap(sb-i, &U[LDU*(ii+i)+ii+i], LDU, &A[LDA*(ii+i)+im], LDA );
                /*
                 * Set IPIV.
                 */
                IPIV[ip] = NB + im + 1;

                for (j = 0; j < i; j++) {
                    A[LDA*(ii+j)+im] = zzero;
                }
            }

            if ((*INFO == 0) && (cabs(A[LDA*(ii+i)+im]) == zzero)
                && (cabs(U[LDU*(ii+i)+ii+i]) == zzero)) {
                *INFO = ii+i+1;
            }

            alpha = ((PLASMA_Complex64_t)1. / U[LDU*(ii+i)+ii+i]);
            cblas_zscal(M, CBLAS_SADDR(alpha), &A[LDA*(ii+i)], 1);
            cblas_zcopy(M, &A[LDA*(ii+i)], 1, &WORK[LDWORK*i], 1);
            cblas_zgeru(
                CblasColMajor, M, sb-i-1,
                CBLAS_SADDR(mzone), &A[LDA*(ii+i)], 1,
                &U[LDU*(ii+i+1)+ii+i], LDU,
                &A[LDA*(ii+i+1)], LDA );
            ip = ip+1;
        }
        /*
         * Apply the subpanel to the rest of the panel.
         */
        if(ii+i < N) {
            for(j = ii; j < ii+sb; j++) {
                if (IPIV[j] <= NB) {
                    IPIV[j] = IPIV[j] - ii;
                }
            }

            CORE_zssssm(
                NB, N-(ii+sb), M, N-(ii+sb), sb, sb,
                &U[LDU*(ii+sb)+ii], LDU,
                &A[LDA*(ii+sb)], LDA,
                &L[LDL*ii], LDL,
                WORK, LDWORK, &IPIV[ii]);

            for(j = ii; j < ii+sb; j++) {
                if (IPIV[j] <= NB) {
                    IPIV[j] = IPIV[j] + ii;
                }
            }
        }
    }
    return PLASMA_SUCCESS;
}


/**
 *
 * @file core_zlag2c.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 Mathieu Faverge
 * @date 2010-11-15
 * @precisions mixed zc -> ds
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_PLASMA_zlag2c converts a PLASMA_Complex64_t matrix, A, to a
 *  PLASMA_Complex32_t matrix, B.
 *
 *******************************************************************************
 *
 * @param[in] m
 *          The number of rows of the matrices A and B. m >= 0.
 *
 * @param[in] n
 *          The number of columns of the matrices A and B. n >= 0.
 *
 * @param[in] A
 *          The PLASMA_Complex64_t m-by-n matrix to convert.
 *
 * @param[in] lda
 *          The leading dimension of the array A. lda >= max(1,m).
 *
 * @param[out] B
 *          The PLASMA_Complex32_t m-by-n matrix to convert.
 *
 * @param[in] ldb
 *          The leading dimension of the array B. ldb >= max(1,m).
 *
 * @param[out] info
 *         - 0 on successful exit.
 *         - 1 if an entry of the matrix A is greater than the SINGLE
 *         PRECISION overflow threshold, in this case, the content
 *         of B in exit is unspecified.
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlag2c = PCORE_zlag2c
#define CORE_zlag2c PCORE_zlag2c
#endif
void CORE_zlag2c(int m, int n,
                 const PLASMA_Complex64_t *A, int lda,
                 PLASMA_Complex32_t *B, int ldb, int *info)
{
    *info = LAPACKE_zlag2c_work(LAPACK_COL_MAJOR, m, n, A, lda, B, ldb);
}

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_PLASMA_clag2z converts a PLASMA_Complex32_t matrix, A, to a
 *  PLASMA_Complex64_t matrix, B.
 *
 *******************************************************************************
 *
 * @param[in] m
 *          The number of rows of the matrices A and B. m >= 0.
 *
 * @param[in] n
 *          The number of columns of the matrices A and B. n >= 0.
 *
 * @param[in] A
 *          The PLASMA_Complex32_t m-by-n matrix to convert.
 *
 * @param[in] lda
 *          The leading dimension of the array A. lda >= max(1,m).
 *
 * @param[out] B
 *          The PLASMA_Complex64_t m-by-n matrix to convert.
 *
 * @param[in] ldb
 *          The leading dimension of the array B. ldb >= max(1,m).
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_clag2z = PCORE_clag2z
#define CORE_clag2z PCORE_clag2z
#endif
void CORE_clag2z(int m, int n,
                 const PLASMA_Complex32_t *A, int lda,
                 PLASMA_Complex64_t *B, int ldb)
{
    LAPACKE_clag2z_work(LAPACK_COL_MAJOR, m, n, A, lda, B, ldb);
}


/*
 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *
 */

/* This file was automatically generated --- DO NOT EDIT */
/* Generated on Sun Nov  7 20:44:21 EST 1999 */

#include <fftw-int.h>
#include <fftw.h>

/* Generated by: ./genfft -magic-alignment-check -magic-twiddle-load-all -magic-variables 4 -magic-loopi -hc2real 10 */

/*
 * This function contains 34 FP additions, 14 FP multiplications,
 * (or, 26 additions, 6 multiplications, 8 fused multiply/add),
 * 20 stack variables, and 20 memory accesses
 */
static const fftw_real K500000000 = FFTW_KONST(+0.500000000000000000000000000000000000000000000);
static const fftw_real K1_902113032 = FFTW_KONST(+1.902113032590307144232878666758764286811397268);
static const fftw_real K1_175570504 = FFTW_KONST(+1.175570504584946258337411909278145537195304875);
static const fftw_real K2_000000000 = FFTW_KONST(+2.000000000000000000000000000000000000000000000);
static const fftw_real K1_118033988 = FFTW_KONST(+1.118033988749894848204586834365638117720309180);

/*
 * Generator Id's :
 * $Id: exprdag.ml,v 1.41 1999/05/26 15:44:14 fftw Exp $
 * $Id: fft.ml,v 1.43 1999/05/17 19:44:18 fftw Exp $
 * $Id: to_c.ml,v 1.25 1999/10/26 21:41:32 stevenj Exp $
 */

void fftw_hc2real_10(const fftw_real *real_input, const fftw_real *imag_input, fftw_real *output, int real_istride, int imag_istride, int ostride)
{
     fftw_real tmp3;
     fftw_real tmp11;
     fftw_real tmp23;
     fftw_real tmp31;
     fftw_real tmp20;
     fftw_real tmp30;
     fftw_real tmp10;
     fftw_real tmp28;
     fftw_real tmp14;
     fftw_real tmp16;
     fftw_real tmp18;
     fftw_real tmp19;
     ASSERT_ALIGNED_DOUBLE;
     {
	  fftw_real tmp1;
	  fftw_real tmp2;
	  fftw_real tmp21;
	  fftw_real tmp22;
	  ASSERT_ALIGNED_DOUBLE;
	  tmp1 = real_input[0];
	  tmp2 = real_input[5 * real_istride];
	  tmp3 = tmp1 - tmp2;
	  tmp11 = tmp1 + tmp2;
	  tmp21 = imag_input[4 * imag_istride];
	  tmp22 = imag_input[imag_istride];
	  tmp23 = tmp21 - tmp22;
	  tmp31 = tmp21 + tmp22;
     }
     tmp18 = imag_input[2 * imag_istride];
     tmp19 = imag_input[3 * imag_istride];
     tmp20 = tmp18 - tmp19;
     tmp30 = tmp18 + tmp19;
     {
	  fftw_real tmp6;
	  fftw_real tmp12;
	  fftw_real tmp9;
	  fftw_real tmp13;
	  ASSERT_ALIGNED_DOUBLE;
	  {
	       fftw_real tmp4;
	       fftw_real tmp5;
	       fftw_real tmp7;
	       fftw_real tmp8;
	       ASSERT_ALIGNED_DOUBLE;
	       tmp4 = real_input[2 * real_istride];
	       tmp5 = real_input[3 * real_istride];
	       tmp6 = tmp4 - tmp5;
	       tmp12 = tmp4 + tmp5;
	       tmp7 = real_input[4 * real_istride];
	       tmp8 = real_input[real_istride];
	       tmp9 = tmp7 - tmp8;
	       tmp13 = tmp7 + tmp8;
	  }
	  tmp10 = tmp6 + tmp9;
	  tmp28 = K1_118033988 * (tmp6 - tmp9);
	  tmp14 = tmp12 + tmp13;
	  tmp16 = K1_118033988 * (tmp12 - tmp13);
     }
     output[5 * ostride] = tmp3 + (K2_000000000 * tmp10);
     {
	  fftw_real tmp32;
	  fftw_real tmp34;
	  fftw_real tmp29;
	  fftw_real tmp33;
	  fftw_real tmp27;
	  ASSERT_ALIGNED_DOUBLE;
	  tmp32 = (K1_175570504 * tmp30) - (K1_902113032 * tmp31);
	  tmp34 = (K1_902113032 * tmp30) + (K1_175570504 * tmp31);
	  tmp27 = tmp3 - (K500000000 * tmp10);
	  tmp29 = tmp27 - tmp28;
	  tmp33 = tmp28 + tmp27;
	  output[7 * ostride] = tmp29 - tmp32;
	  output[3 * ostride] = tmp29 + tmp32;
	  output[ostride] = tmp33 - tmp34;
	  output[9 * ostride] = tmp33 + tmp34;
     }
     output[0] = tmp11 + (K2_000000000 * tmp14);
     {
	  fftw_real tmp24;
	  fftw_real tmp26;
	  fftw_real tmp17;
	  fftw_real tmp25;
	  fftw_real tmp15;
	  ASSERT_ALIGNED_DOUBLE;
	  tmp24 = (K1_175570504 * tmp20) - (K1_902113032 * tmp23);
	  tmp26 = (K1_902113032 * tmp20) + (K1_175570504 * tmp23);
	  tmp15 = tmp11 - (K500000000 * tmp14);
	  tmp17 = tmp15 - tmp16;
	  tmp25 = tmp16 + tmp15;
	  output[2 * ostride] = tmp17 - tmp24;
	  output[8 * ostride] = tmp17 + tmp24;
	  output[6 * ostride] = tmp25 - tmp26;
	  output[4 * ostride] = tmp25 + tmp26;
     }
}

fftw_codelet_desc fftw_hc2real_10_desc =
{
     "fftw_hc2real_10",
     (void (*)()) fftw_hc2real_10,
     10,
     FFTW_BACKWARD,
     FFTW_HC2REAL,
     235,
     0,
     (const int *) 0,
};


/* Routines for manipulating evolutionary rate matrices.
 *
 * There is no specific object for this module.  Rate matrix
 * operations use square nxn ESL_DMATRIX data objects. (The rmx
 * module essentially subclasses the dmx module.)
 *
 * An instantaneous rate matrix is usually denoted by Q.  A
 * conditional probability matrix (for a specific t) is usually
 * denoted by P. An exchangeability matrix is denoted by E.
 * A stationary residue probability vector is denoted by pi.
 *
 * Two important relations among these:
 *
 *    Q in terms of E and pi:
 *      $Q_{ij} = E_{ij} \pi_j$ for $i \neq j$;
 *      $Q_{ii} = -\sum_{j \neq i} Q_{ij}$
 *
 *    P in terms of Q and t:
 *      $P = e^{tQ}$
 *
 * Contents:
 *   1. Setting standard rate matrix models.
 *   2. Debugging routines for validating or dumping rate matrices.
 *   3. Other routines in the exposed ratematrix API.
 *   4. Benchmark driver.
 *   5. Regression test driver.
 *   6. Unit tests.
 *   7. Test driver.
 *   8. Example.
 *   9. Copyright/license information.
 *
 *
 *
 * See also:
 *   paml   - i/o of rate matrices from/to data files in PAML format
 *
 */
#include "esl_config.h"

#include <math.h>

#include "easel.h"
#include "esl_composition.h"
#include "esl_dmatrix.h"
#include "esl_vectorops.h"
#include "esl_ratematrix.h"

/*****************************************************************
 * 1. Setting standard rate matrix models.
 *****************************************************************/

/* Function:  esl_rmx_SetWAG()
 * Incept:    SRE, Thu Mar  8 18:00:00 2007 [Janelia]
 *
 * Purpose:   Sets a $20 \times 20$ rate matrix <Q> to WAG parameters.
 *            The caller allocated <Q>.
 *
 *            If <pi> is non-<NULL>, it provides a vector of 20 amino
 *            acid stationary probabilities in Easel alphabetic order,
 *            A..Y, and the WAG stationary probabilities are set to
 *            these desired $\pi_i$. If <pi> is <NULL>, the default
 *            WAG stationary probabilities are used.
 *
 *            The WAG parameters are a maximum likelihood
 *            parameterization obtained by Whelan and Goldman
 *            \citep{WhelanGoldman01}.
 *
 * Note:      The data table was reformatted from wag.dat by the UTILITY1
 *            executable in the paml module. The wag.dat file was obtained from
 *            \url{http://www.ebi.ac.uk/goldman/WAG/wag.dat}. A copy
 *            is in formats/wag.dat.
 *
 * Args:      Q   - a 20x20 rate matrix to set, allocated by caller.
 *            pi  - desired stationary probabilities A..Y, or
 *                  NULL to use WAG defaults.
 *
 * Returns:   <eslOK> on success.
 *
 * Throws:    <eslEINVAL> if <Q> isn't a 20x20 general matrix; and
 *            the state of <Q> is undefined.
 */
int
esl_rmx_SetWAG(ESL_DMATRIX *Q, double *pi)
{
  static double wagE[190] = {
    1.027040, 0.738998, 0.030295, 1.582850, 0.021352, 6.174160, 0.210494, 0.398020, 0.046730, 0.081134,
    1.416720, 0.306674, 0.865584, 0.567717, 0.049931, 0.316954, 0.248972, 0.930676, 0.570025, 0.679371,
    0.249410, 0.193335, 0.170135, 0.039437, 0.127395, 1.059470, 0.030450, 0.138190, 0.906265, 0.074034,
    0.479855, 2.584430, 0.088836, 0.373558, 0.890432, 0.323832, 0.397915, 0.384287, 0.084805, 0.154263,
    2.115170, 0.061304, 0.499462, 3.170970, 0.257555, 0.893496, 0.390482, 0.103754, 0.315124, 1.190630,
    0.174100, 0.404141, 4.257460, 0.934276, 4.854020, 0.509848, 0.265256, 5.429420, 0.947198, 0.096162,
    1.125560, 3.956290, 0.554236, 3.012010, 0.131528, 0.198221, 1.438550, 0.109404, 0.423984, 0.682355,
    0.161444, 0.243570, 0.696198, 0.099929, 0.556896, 0.415844, 0.171329, 0.195081, 0.908598, 0.098818,
    0.616783, 5.469470, 0.099921, 0.330052, 4.294110, 0.113917, 3.894900, 0.869489, 1.545260, 1.543640,
    0.933372, 0.551571, 0.528191, 0.147304, 0.439157, 0.102711, 0.584665, 2.137150, 0.186979, 5.351420,
    0.497671, 0.683162, 0.635346, 0.679489, 3.035500, 3.370790, 1.407660, 1.071760, 0.704939, 0.545931,
    1.341820, 0.740169, 0.319440, 0.967130, 0.344739, 0.493905, 3.974230, 1.613280, 1.028870, 1.224190,
    2.121110, 0.512984, 0.374866, 0.822765, 0.171903, 0.225833, 0.473307, 1.458160, 1.386980, 0.326622,
    1.516120, 2.030060, 0.795384, 0.857928, 0.554413, 4.378020, 2.006010, 1.002140, 0.152335, 0.588731,
    0.649892, 0.187247, 0.118358, 7.821300, 0.305434, 1.800340, 2.058450, 0.196246, 0.314887, 0.301281,
    0.251849, 0.232739, 1.388230, 0.113133, 0.717070, 0.129767, 0.156557, 1.529640, 0.336983, 0.262569,
    0.212483, 0.137505, 0.665309, 0.515706, 0.071917, 0.139405, 0.215737, 1.163920, 0.523742, 0.110864,
    0.365369, 0.240735, 0.543833, 0.325711, 0.196303, 6.454280, 0.103604, 3.873440, 0.420170, 0.133264,
    0.398618, 0.428437, 1.086000, 0.216046, 0.227710, 0.381533, 0.786993, 0.291148, 0.314730, 2.485390};
  static double wagpi[20];
  int i,j,z;

  if (Q->m != 20 || Q->n != 20 || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a 20x20 general matrix");
  esl_composition_WAG(wagpi);

  /* 1. Transfer the wag E lower triagonal matrix directly into Q. */
  z = 0;
  for (i = 0; i < 20; i++)
    {
      Q->mx[i][i] = 0.; /* code below depends on this zero initialization */
      for (j = 0; j < i; j++) {
	Q->mx[i][j] = wagE[z++];
	Q->mx[j][i] = Q->mx[i][j];
      }
    }

  /* 2. Set offdiagonals Q_ij = E_ij * pi_j */
  for (i = 0; i < 20; i++)
    for (j = 0; j < 20; j++)
      if (pi != NULL) Q->mx[i][j] *= pi[j];
      else            Q->mx[i][j] *= wagpi[j];

  /* 3. Set diagonal Q_ii to -\sum_{i \neq j} Q_ij */
  for (i = 0; i < 20; i++)
    Q->mx[i][i] = -1. * esl_vec_DSum(Q->mx[i], 20);

  /* 4. Renormalize matrix to units of 1 substitution/site. */
  if (pi != NULL) esl_rmx_ScaleTo(Q, pi,    1.0);
  else            esl_rmx_ScaleTo(Q, wagpi, 1.0);

  return eslOK;
}

/* Function:  esl_rmx_SetJukesCantor()
 * Incept:    SRE, Thu Mar 15 13:04:56 2007 [Janelia]
 *
 * Purpose:   Sets a 4x4 rate matrix to a Jukes-Cantor model,
 *            scaled to units of 1t = 1.0 substitutions/site.
 *
 * Note:     eigenvalues of Q are 0, -4\alpha, -4\alpha, -4\alpha
 */
int
esl_rmx_SetJukesCantor(ESL_DMATRIX *Q)
{
  int    i,j;
  double pi[4] = { 0.25, 0.25, 0.25, 0.25 };

  if (Q->m != 4 || Q->n != 4 || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a 4x4 general matrix");

  for (i = 0; i < 4; i++) {
    for (j = 0; j < 4; j++)
      {
	if (i != j) Q->mx[i][j] = 1.0;
	else        Q->mx[i][j] = 0.0;
      }
    Q->mx[i][i] =  -1. * esl_vec_DSum(Q->mx[i], 4);
  }
  esl_rmx_ScaleTo(Q, pi, 1.0);
  return eslOK;
}

/* Function:  esl_rmx_SetKimura()
 * Incept:    SRE, Thu Mar 15 13:08:08 2007 [Janelia]
 *
 * Purpose:   Sets a 4x4 rate matrix to a Kimura 2-parameter
 *            model, given transition and transversion
 *            relative rates <alpha> and <beta>, respectively,
 *            scaled to units of 1t = 1.0 substitutions/site.
 *
 * Note:     eigenvalues of Q are 0, -4\alpha, -2(\alpha+\beta), -2(\alpha+\beta)
 */
int
esl_rmx_SetKimura(ESL_DMATRIX *Q, double alpha, double beta)
{
  int i,j;
  double pi[4] = { 0.25, 0.25, 0.25, 0.25 };

  if (Q->m != 4 || Q->n != 4 || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a 4x4 general matrix");

  for (i = 0; i < 4; i++) {
    for (j = 0; j < 4; j++)
      {
	if (i != j) Q->mx[i][j] = ((i+j)%2)? beta : alpha; /* even=0=transition;odd=1=transversion */
	else        Q->mx[i][j] = 0.0;
      }
    Q->mx[i][i] =  -1. * esl_vec_DSum(Q->mx[i], 4);
  }
  esl_rmx_ScaleTo(Q, pi, 1.0);
  return eslOK;
}

/* Function:  esl_rmx_SetF81()
 * Incept:    SRE, Thu Mar 15 13:33:30 2007 [Janelia]
 *
 * Purpose:   Sets a 4x4 rate matrix to the F81 model (aka
 *            equal-input model) given stationary base
 *            compositions <pi>,
 *            scaled to units of 1t = 1.0 substitutions/site.
 */
int
esl_rmx_SetF81(ESL_DMATRIX *Q, double *pi)
{
  int i,j;

  if (Q->m != 4 || Q->n != 4 || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a 4x4 general matrix");

  for (i = 0; i < 4; i++) {
    for (j = 0; j < 4; j++)
      {
	if (i != j) Q->mx[i][j] = pi[j];
	else        Q->mx[i][j] = 0.0;
      }
    Q->mx[i][i] =  -1. * esl_vec_DSum(Q->mx[i], 4);
  }
  esl_rmx_ScaleTo(Q, pi, 1.0);
  return eslOK;
}

/* Function:  esl_rmx_SetHKY()
 * Incept:    SRE, Thu Aug 12 08:26:39 2004 [St. Louis]
 *
 * Purpose:   Given stationary base composition <pi> for ACGT, and
 *            transition and transversion relative rates <alpha> and
 *            <beta> respectively, sets the matrix <Q> to be the
 *            corresponding HKY (Hasegawa/Kishino/Yano) DNA rate
 *            matrix, scaled in units of 1t= 1.0 substitutions/site
 *            \citep{Hasegawa85}.
 *
 * Args:      pi     - stationary base composition A..T
 *            alpha  - relative transition rate
 *            beta   - relative transversion rate
 *
 *
 * Returns:   <eslOK>
 *
 * Xref:
 */
int
esl_rmx_SetHKY( ESL_DMATRIX *Q, double *pi, double alpha, double beta)
{
  int i,j;

  if (Q->m != 4 || Q->n != 4 || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a 4x4 general matrix");

  for (i = 0; i < 4; i++) {
    for (j = 0; j < 4; j++)
      {
	if (i != j)  Q->mx[i][j] = ((i+j)%2)? pi[j]*beta : pi[j]*alpha; /* even=0=transition;odd=1=transversion */
	else         Q->mx[i][j] = 0.;
      }
    Q->mx[i][i] =  -1. * esl_vec_DSum(Q->mx[i], 4);
  }
  esl_rmx_ScaleTo(Q, pi, 1.0);
  return eslOK;
}

/*****************************************************************
 * 2. Debugging routines for validating or dumping rate matrices.
 *****************************************************************/

/* Function:  esl_rmx_ValidateP()
 * Incept:    SRE, Sun Mar 11 10:30:50 2007 [Janelia]
 *
 * Purpose:   Validates a conditional probability matrix <P>, whose
 *            elements $P_{ij}$ represent conditional probabilities
 *            $P(j \mid i)$; for example in a first-order Markov
 *            chain, or a continuous-time Markov transition process
 *            where <P> is for a particular $t$.
 *
 *            Rows must sum to one, and each element $P_{ij}$ is a
 *            probability $0 \leq P_{ij} \leq 1$.
 *
 *            <tol> specifies the floating-point tolerance to which
 *            the row sums must equal one: <fabs(sum-1.0) <= tol>.
 *
 *            <errbuf> is an optional error message buffer. The caller
 *            may pass <NULL> or a pointer to a buffer of at least
 *            <eslERRBUFSIZE> characters.
 *
 * Args:      P      - matrix to validate
 *            tol    - floating-point tolerance (0.00001, for example)
 *            errbuf - OPTIONAL: ptr to an error buffer of at least
 *                     <eslERRBUFSIZE> characters.
 *
 * Returns:   <eslOK> on successful validation.
 *            <eslFAIL> on failure, and if a non-<NULL> <errbuf> was
 *            provided by the caller, a message describing
 *            the reason for the failure is put there.
 *
 * Throws:    (no abnormal error conditions)
 */
int
esl_rmx_ValidateP(ESL_DMATRIX *P, double tol, char *errbuf)
{
  int    i,j;
  double sum;

  if (P->type != eslGENERAL) ESL_EXCEPTION(eslEINVAL, "P must be type eslGENERAL to be validated");

  for (i = 0; i < P->n; i++)
    {
      sum = esl_vec_DSum(P->mx[i], P->m);
      if (fabs(sum-1.0) > tol) ESL_FAIL(eslFAIL, errbuf, "row %d does not sum to 1.0", i);

      for (j = 0; j < P->m; j++)
	if (P->mx[i][j] < 0.0 || P->mx[i][j] > 1.0)
	  ESL_FAIL(eslFAIL, errbuf, "element %d,%d is not a probability (%f)", i,j,P->mx[i][j]);
    }
  return eslOK;
}

/* Function:  esl_rmx_ValidateQ()
 * Incept:    SRE, Sun Mar 11 10:30:50 2007 [Janelia]
 *
 * Purpose:   Validates an instantaneous rate matrix <Q> for a
 *            continuous-time Markov process, whose elements $q_{ij}$
 *            represent instantaneous transition rates $i \rightarrow
 *            j$.
 *
 *            Rows satisfy the condition that
 *            $q_{ii} = -\sum_{i \neq j} q_{ij}$, and also
 *            that $q_{ij} \geq 0$ for all $j \neq i$.
 *
 *            <tol> specifies the floating-point tolerance to which
 *            that condition must hold: <fabs(sum-q_ii) <= tol>.
 *
 *            <errbuf> is an optional error message buffer. The caller
 *            may pass <NULL> or a pointer to a buffer of at least
 *            <eslERRBUFSIZE> characters.
 *
 * Args:      Q      - rate matrix to validate
 *            tol    - floating-point tolerance (0.00001, for example)
 *            errbuf - OPTIONAL: ptr to an error buffer of at least
 *                     <eslERRBUFSIZE> characters.
 *
 * Returns:   <eslOK> on successful validation.
 *            <eslFAIL> on failure, and if a non-<NULL> <errbuf> was
 *            provided by the caller, a message describing
 *            the reason for the failure is put there.
 *
 * Throws:    (no abnormal error conditions)
 */
int
esl_rmx_ValidateQ(ESL_DMATRIX *Q, double tol, char *errbuf)
{
  int    i,j;
  double qi;

  if (Q->type != eslGENERAL) ESL_EXCEPTION(eslEINVAL, "Q must be type eslGENERAL to be validated");
  if (Q->n    != Q->m)       ESL_EXCEPTION(eslEINVAL, "a rate matrix Q must be square");

  for (i = 0; i < Q->n; i++)
    {
      qi = 0.;
      for (j = 0; j < Q->m; j++)
	{
	  if (i != j) {
	    if (Q->mx[i][j] < 0.)       ESL_FAIL(eslFAIL, errbuf, "offdiag elem %d,%d < 0",i,j);
	    qi += Q->mx[i][j];
	  } else {
	    if (Q->mx[i][j] > 0.)       ESL_FAIL(eslFAIL, errbuf, "diag elem %d,%d < 0", i,j);
	  }
	}
      if (fabs(qi + Q->mx[i][i]) > tol) ESL_FAIL(eslFAIL, errbuf, "row %d does not sum to 0.0", i);
    }
  return eslOK;
}

/*****************************************************************
 * 3. Other routines in the exposed ratematrix API.
 *****************************************************************/

/* Function:  esl_rmx_ScaleTo()
 * Incept:    SRE, Tue Jul 13 16:05:16 2004 [St. Louis]
 *
 * Purpose:   Rescales rate matrix <Q> so that expected substitution
 *            rate per dt is <unit>.
 *
 *            Expected substitution rate is:
 *               $\sum_i \sum_j pi_i Q_ij  \forall i \neq j$
 *
 *            <unit> typically taken to be 1.0, so time units are substitutions/site.
 *            An exception is PAM, where <unit> = 0.01 for 1 PAM unit.
 *
 * Args:      Q     - rate matrix to normalize
 *            pi    - stationary residue frequencies
 *            unit  - expected subsitution rate per dt
 *                    (1.0 = substitutions/site; 0.01 = PAMs)
 *
 * Returns:   <eslOK> on success, and matrix Q is rescaled.
 *
 * Xref:      STL8/p56.
 */
int
esl_rmx_ScaleTo(ESL_DMATRIX *Q, double *pi, double unit)
{
  int     i,j;
  double  sum = 0.;

  if (Q->m != Q->n || Q->type != eslGENERAL)
    ESL_EXCEPTION(eslEINVAL, "Q must be a square general matrix");

  for (i = 0; i < Q->m; i++)
    for (j = 0; j < Q->n; j++)
      if (i != j) sum += pi[i] * Q->mx[i][j];

  for (i = 0; i < Q->m; i++)
    for (j = 0; j < Q->n; j++)
      Q->mx[i][j] *= (unit / sum);

  return eslOK;
}

/* Function:  esl_rmx_E2Q()
 * Incept:    SRE, Tue Jul 13 15:52:41 2004 [St. Louis]
 *
 * Purpose:   Given a lower triangular matrix ($j<i$) of
 *            residue exchangeabilities <E>, and a stationary residue
 *            frequency vector <pi>; assuming $E_{ij} = E_{ji}$;
 *            calculates a rate matrix <Q> as
 *
 *            $Q_{ij} = E_{ij} * \pi_j$
 *
 *            The resulting <Q> is not normalized to any particular
 *            number of substitutions/site/time unit. See
 *            <esl_rmx_ScaleTo()> for that.
 *
 * Args:      E     - symmetric residue "exchangeabilities";
 *                    only lower triangular entries are used.
 *            pi    - residue frequencies at stationarity.
 *            Q     - RETURN: rate matrix, square (NxN).
 *                    Caller allocates the memory for this.
 *
 * Returns:   <eslOK> on success; Q is calculated and filled in.
 *
 * Xref:      STL8/p56.
 */
int
esl_rmx_E2Q(ESL_DMATRIX *E, double *pi, ESL_DMATRIX *Q)
{
  int          i,j;

  if (E->n != Q->n) ESL_EXCEPTION(eslEINVAL, "E and Q sizes differ");

  /* Scale all off-diagonals to pi[j] * E[i][j].
   */
  for (i = 0; i < E->n; i++)
    for (j = 0; j < i; j++)	/* only look at lower triangle of E. */
      {
	Q->mx[i][j] = pi[j] * E->mx[i][j];
	Q->mx[j][i] = pi[i] * E->mx[i][j];
      }

  /* Set diagonal to  -\sum of all j != i.
   */
  for (i = 0; i < Q->n; i++)
    {
      Q->mx[i][i] = 0.;		/* makes the vector sum work for j != i */
      Q->mx[i][i] = -1. * esl_vec_DSum(Q->mx[i], Q->n);
    }
  return eslOK;
}

/* Function:  esl_rmx_RelativeEntropy()
 * Incept:    SRE, Fri Mar 23 09:18:26 2007 [Janelia]
 *
 * Purpose:   Given a conditional substitution probability matrix <P>,
 *            with stationary probabilities <pi>, calculate its
 *            relative entropy $H$:
 *
 *               $H_t = \sum_{ij} P(j \mid i,t) \pi_i \log_2 \frac{P(j \mid i,t)} {\pi_j}$
 *
 *            This assumes that the stationary probabilities are the
 *            same as the background (null model) probabilities.
 *
 * Returns:   the relative entropy, $H$, in bits
 */
double
esl_rmx_RelativeEntropy(ESL_DMATRIX *P, double *pi)
{
  double H = 0.;
  int    i,j;

  for (i = 0; i < P->m; i++)
    for (j = 0; j < P->n; j++)
      H += P->mx[i][j] * pi[i] * log(P->mx[i][j] / pi[j]);
  return H / eslCONST_LOG2;
}

/* Function:  esl_rmx_ExpectedScore()
 * Incept:    SRE, Fri Mar 23 09:32:05 2007 [Janelia]
 *
 * Purpose:   Given a conditional substitution probability matrix <P>
 *            with stationary probabilities <pi>, calculate its
 *            expected score:
 *
 *               $ = \sum_{ij} \pi_j \pi_i \log_2 \frac{P(j \mid i,t)} {\pi_j}$
 *
 *            This assumes that the stationary probabilities are the
 *            same as the background (null model) probabilities.
 *
 * Returns:   the expected score, in bits
 */
double
esl_rmx_ExpectedScore(ESL_DMATRIX *P, double *pi)
{
  double S = 0.;
  int    i,j;

  for (i = 0; i < P->m; i++)
    for (j = 0; j < P->n; j++)
      S += pi[j] * pi[i] * log(P->mx[i][j] / pi[j]);
  return S / eslCONST_LOG2;
}

/*****************************************************************
 * 4. Benchmark driver
 *****************************************************************/

#ifdef eslRATEMATRIX_BENCHMARK

/*
  without GSL:
  gcc -O2 -I. -L. -o benchmark -DeslRATEMATRIX_BENCHMARK esl_ratematrix.c -leasel -lm

  with GSL:
  gcc -g -Wall -I. -L. -o benchmark -DeslRATEMATRIX_BENCHMARK -DHAVE_LIBGSL esl_dmatrix.c esl_ratematrix.c -leasel -lgsl -lgslcblas -lm
 */

#include <esl_config.h>

#ifdef HAVE_LIBGSL
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#endif

#include "easel.h"
#include "esl_stopwatch.h"
#include "esl_dmatrix.h"
#include "esl_ratematrix.h"

int
main(void)
{
  ESL_STOPWATCH *w = NULL;
  ESL_DMATRIX *Q  = NULL;
  ESL_DMATRIX *P  = NULL;
  double       t = 5.0;
  int          esl_iterations = 100;
  int          i;
#ifdef HAVE_LIBGSL
  gsl_matrix  *Qg = NULL;
  gsl_matrix  *Pg = NULL;
  int          gsl_iterations = 100;
#endif

  w = esl_stopwatch_Create();
  Q = esl_dmatrix_Create(20, 20);
  P = esl_dmatrix_Create(20, 20);
  esl_rmx_SetWAG(Q, NULL);

  esl_stopwatch_Start(w);
  for (i = 0; i < esl_iterations; i++)
    esl_dmx_Exp(Q, t, P);
  esl_stopwatch_Stop(w);
  printf("Easel takes:   %g sec\n", w->user / (double) esl_iterations);

#ifdef HAVE_LIBGSL
  if (esl_dmx_MorphGSL(Q, &Qg)             != eslOK) esl_fatal("morph to gsl_matrix failed");
  if ((Pg = gsl_matrix_alloc(20, 20))      == NULL)  esl_fatal("gsl alloc failed");
  gsl_matrix_scale(Qg, t);

  esl_stopwatch_Start(w);
  for (i = 0; i < gsl_iterations; i++)
    gsl_linalg_exponential_ss(Qg, Pg, GSL_PREC_DOUBLE);
  esl_stopwatch_Stop(w);
  printf("  GSL takes:   %g sec\n", w->user / (double) gsl_iterations);

  gsl_matrix_free(Qg);
  gsl_matrix_free(Pg);
#endif /*HAVE_LIBGSL*/

  esl_dmatrix_Destroy(Q);
  esl_dmatrix_Destroy(P);
  esl_stopwatch_Destroy(w);
  return 0;
}

#endif /*eslRATEMATRIX_BENCHMARK*/

/*****************************************************************
 * 5. Regression test driver
 *****************************************************************/
#ifdef eslRATEMATRIX_REGRESSION
#ifdef HAVE_LIBGSL

/* This tests rate matrix exponentiation against the GSL's
 * undocumented implementation of a matrix exponential.
 */
/*
  gcc -g -Wall -I. -L. -o ratematrix_regression -DeslRATEMATRIX_REGRESSION -DHAVE_LIBGSL esl_dmatrix.c esl_ratematrix.c -leasel -lgsl -lgslcblas -lm
 */

#include "esl_config.h"

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

#include "easel.h"
#include "esl_dmatrix.h"
#include "esl_ratematrix.h"

int
main(void)
{
  char errbuf[eslERRBUFSIZE];
  char *alphabet = "ACDEFGHIKLMNPQRSTVWY";
  ESL_DMATRIX *Q  = NULL;
  ESL_DMATRIX *P  = NULL;
  gsl_matrix  *Qg = NULL;
  gsl_matrix  *Pg = NULL;
  ESL_DMATRIX *Pge = NULL;
  double       t = 15.0;

  if ((Q = esl_dmatrix_Create(20, 20))     == NULL)  esl_fatal("malloc failed");
  if ((P = esl_dmatrix_Create(20, 20))     == NULL)  esl_fatal("malloc failed");

  if (esl_rmx_SetWAG(Q, NULL)              != eslOK) esl_fatal("_SetWAG() failed");
  if (esl_rmx_ValidateQ(Q, 0.0001, errbuf) != eslOK) esl_fatal("Q validation failed: %s", errbuf);

  if (esl_dmx_Exp(Q, t, P)                 != eslOK) esl_fatal("matrix exponentiation failed");
  if (esl_rmx_ValidateP(P, 0.0001, errbuf) != eslOK) esl_fatal("P validation failed: %s", errbuf);

  if (esl_dmx_MorphGSL(Q, &Qg)             != eslOK) esl_fatal("morph to gsl_matrix failed");
  if ((Pg = gsl_matrix_alloc(20, 20))      == NULL)  esl_fatal("gsl alloc failed");
  gsl_matrix_scale(Qg, t);
  if (gsl_linalg_exponential_ss(Qg, Pg, GSL_PREC_DOUBLE) != 0) esl_fatal("gsl's exponentiation failed");
  if (esl_dmx_UnmorphGSL(Pg, &Pge)         != eslOK) esl_fatal("morph from gsl_matrix failed");

  esl_dmatrix_Dump(stdout, P, alphabet, alphabet);

  if (esl_dmatrix_Compare(Pge, P, 0.00001) != eslOK) esl_fatal("whoops, different answers.");

  esl_dmatrix_Destroy(Q);
  esl_dmatrix_Destroy(P);
  esl_dmatrix_Destroy(Pge);
  gsl_matrix_free(Qg);
  gsl_matrix_free(Pg);
  return 0;
}
#else
  /* if we don't have GSL, then compile in a dummy main(), solely
   *  to quiet any tests that are verifying that all drivers compile
   *  and run. */
int main(void) { return 0; }
#endif /*HAVE_LIBGSL*/

#endif /*eslRATEMATRIX_REGRESSION*/

/*****************************************************************
 * 6. Unit tests.
 *****************************************************************/
#ifdef eslRATEMATRIX_TESTDRIVE

static void
utest_SetWAG(void)
{
  char errbuf[eslERRBUFSIZE];
  ESL_DMATRIX *Q = NULL;
  ESL_DMATRIX *P = NULL;
  double       t = 50.0;	/* sufficiently large to drive e^tQ to stationarity  */
  double       pi[20];
  int          i;

  if ((Q = esl_dmatrix_Create(20, 20))     == NULL)  esl_fatal("malloc failed");
  if ((P = esl_dmatrix_Create(20, 20))     == NULL)  esl_fatal("malloc failed");

  /* This tests that exponentiating WAG gives a stable conditional
   * probability matrix solution. (It doesn't particularly test that
   * WAG was set correctly, but how could we have screwed that up?)
   */
  if (esl_rmx_SetWAG(Q, NULL)              != eslOK) esl_fatal("_SetWAG() failed");
  if (esl_dmx_Exp(Q, t, P)                 != eslOK) esl_fatal("matrix exponentiation failed");
  if (esl_rmx_ValidateP(P, 1e-7, errbuf)   != eslOK) esl_fatal("P validation failed: %s", errbuf);
  if (esl_rmx_ValidateQ(Q, 1e-7, errbuf)   != eslOK) esl_fatal("Q validation failed: %s", errbuf);

  /* This tests setting WAG to different stationary pi's than default,
   * then tests that exponentiating to large t reaches those stationaries.
   */
  esl_vec_DSet(pi, 20, 0.05);
  if (esl_rmx_SetWAG(Q, pi)                != eslOK) esl_fatal("_SetWAG() failed");
  if (esl_dmx_Exp(Q, t, P)                 != eslOK) esl_fatal("matrix exponentiation failed");
  if (esl_rmx_ValidateP(P, 1e-7, errbuf)   != eslOK) esl_fatal("P validation failed: %s", errbuf);
  if (esl_rmx_ValidateQ(Q, 1e-7, errbuf)   != eslOK) esl_fatal("Q validation failed: %s", errbuf);
  for (i = 0; i < 20; i++)
    if (esl_vec_DCompare(P->mx[i], pi, 20, 1e-7) != eslOK) esl_fatal("P didn't converge to right pi's");

  esl_dmatrix_Destroy(Q);
  esl_dmatrix_Destroy(P);
  return;
}

#ifdef HAVE_LIBLAPACK
static void
utest_Diagonalization(void)
{
  ESL_DMATRIX *P      = NULL;
  ESL_DMATRIX *P2     = NULL;
  ESL_DMATRIX *C      = NULL;
  ESL_DMATRIX *D      = NULL;
  double      *lambda = NULL;		/* eigenvalues */
  ESL_DMATRIX *U      = NULL;		/* left eigenvectors */
  ESL_DMATRIX *Ui     = NULL;		/* inverse of U */
  int  i,j;

  /* Create a J/C probability matrix for t=1:
   *    1/4 + 3/4 e^{-4/3 at}
   *    1/4 - 1/4 e^{-4/3 at}
   */
  if ((P  = esl_dmatrix_Create(4, 4))    == NULL)  esl_fatal("malloc failed");
  if ((C  = esl_dmatrix_Create(4, 4))    == NULL)  esl_fatal("malloc failed");
  if ((Ui = esl_dmatrix_Create(4, 4))    == NULL)  esl_fatal("malloc failed");
  if ((D  = esl_dmatrix_Create(4, 4))    == NULL)  esl_fatal("malloc failed");
  if ((P2 = esl_dmatrix_Create(4, 4))    == NULL)  esl_fatal("malloc failed");
  for (i = 0; i < 4; i++)
    for (j = 0; j < 4; j++)
      if (i == j) P->mx[i][j] = 0.25 + 0.75 * exp(-4./3.);
      else        P->mx[i][j] = 0.25 - 0.25 * exp(-4./3.);

  /* Diagonalize it
   */
  if (esl_dmx_Diagonalize(P, &lambda, NULL, &U, NULL) != eslOK) esl_fatal("diagonalization failed");

  /* Calculate P^k by U [diag(lambda_i)]^k U^{-1}
   */
  esl_dmatrix_SetZero(D);
  for (i = 0; i < P->n; i++) D->mx[i][i] = lambda[i];
  esl_dmx_Invert(U, Ui);
  esl_dmx_Multiply(U, D,  C);
  esl_dmx_Multiply(C, Ui, P2);

  if (esl_dmatrix_Compare(P, P2, 1e-7) != eslOK) esl_fatal("diagonalization unit test failed");

  free(lambda);
  esl_dmatrix_Destroy(P2);
  esl_dmatrix_Destroy(Ui);
  esl_dmatrix_Destroy(U);
  esl_dmatrix_Destroy(D);
  esl_dmatrix_Destroy(C);
  esl_dmatrix_Destroy(P);
  return;
}
#endif /*HAVE_LIBLAPACK*/

#endif /*eslRATEMATRIX_TESTDRIVE*/

/*****************************************************************
 * 7. Test driver
 *****************************************************************/

#ifdef eslRATEMATRIX_TESTDRIVE
/* gcc -g -Wall -o test -I. -L. -DeslRATEMATRIX_TESTDRIVE esl_ratematrix.c -leasel -lm
 * ./test
 *
 * gcc -g -Wall -o test -I. -L. -DHAVE_LIBLAPACK -DeslRATEMATRIX_TESTDRIVE esl_ratematrix.c esl_dmatrix.c -leasel -llapack -lm
 */
#include "esl_config.h"

#include "easel.h"
#include "esl_ratematrix.h"

int
main(void)
{
  utest_SetWAG();
#ifdef HAVE_LIBLAPACK
  utest_Diagonalization();
#endif

  return 0;

}
#endif /*eslRATEMATRIX_TESTDRIVE*/

/*****************************************************************
 * 8. Example driver
 *****************************************************************/

/*****************************************************************
 * Easel - a library of C functions for biological sequence analysis
 * Version h3.1b2; February 2015
 * Copyright (C) 2015 Howard Hughes Medical Institute.
 * Other copyrights also apply. See the COPYRIGHT file for a full list.
 *
 * Easel is distributed under the Janelia Farm Software License, a BSD
 * license. See the LICENSE file for more details.
 *
 * SVN $Id: esl_ratematrix.c 849 2013-01-31 15:10:24Z eddys $
 * SVN $URL: https://svn.janelia.org/eddylab/eddys/easel/branches/hmmer/3.1/esl_ratematrix.c $
 *****************************************************************/


//
//  mclib_pluto.c
//  to read in pluto AMR chombo files
//
//  Created by Tyler Parsotan on 11/26/19.
//

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdbool.h>
#include <unistd.h>
#include <dirent.h>
#include <limits.h>
#include "hdf5.h"
#include <math.h>
#include <time.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf_bessel.h>
#include "mclib.h"

#include <omp.h>

void readPlutoChombo( char pluto_file[200], double r_inj, double fps, double **x, double **y, double **szx, double **szy, double **r,\
double **theta, double **velx, double **vely, double **dens, double **pres, double **gamma, double **dens_lab, double **temp, int *number, int ph_inj_switch, double min_r, double max_r, double min_theta, double max_theta, FILE *fPtr)
{
    hid_t  file, dset, space, group, attr;
    herr_t status;
    hsize_t dims[1]={0}; //hold number of processes in each level
    int i=0, j=0, k=0, l=0, m=0, r_count=0, num_dims=0, num_levels=0, num_vars=4, logr=0;
    int nbx=0, nby=0, nbz=0, total_size=0, total_box_size=0, offset=0, elem_factor=0;
    box2d prob_domain[1]={0,0,0,0};
    char level[200]="";
    double ph_rmin=0, ph_rmax=0, ph_thetamin=0, ph_thetamax=0, r_grid_innercorner=0, r_grid_outercorner=0, theta_grid_innercorner=0, theta_grid_outercorner=0;
    int *level_dims=NULL, *box_offset=NULL;
    double *radii=NULL, *angles=NULL, *dradii=NULL, *dangles=NULL;
    double *dombeg1=NULL, *dombeg2=NULL, *dombeg3=NULL, *dx=NULL, *g_x2stretch=NULL, *g_x3stretch=NULL;
    double *all_data=NULL, *x1_buffer=NULL, *x2_buffer=NULL, *dx1_buffer=NULL, *dx2_buffer=NULL;
    double *dens_buffer=NULL, *pres_buffer=NULL, *vel_x2_buffer=NULL, *vel_x1_buffer=NULL;

    if (ph_inj_switch==0)
    {
        ph_rmin=min_r;
        ph_rmax=max_r;
        ph_thetamin=min_theta-2*0.017453292519943295; //min_theta - 2*Pi/180 (2 degrees)
        ph_thetamax=max_theta+2*0.017453292519943295; //max_theta + 2*Pi/180 (2 degrees)
    }

    //define dataset for boxes of each level
    hid_t box_dtype = H5Tcreate (H5T_COMPOUND, sizeof(box2d));
    H5Tinsert(box_dtype, "lo_i", HOFFSET(box2d, lo_i), H5T_NATIVE_INT);
    H5Tinsert(box_dtype, "lo_j", HOFFSET(box2d, lo_j), H5T_NATIVE_INT);
    H5Tinsert(box_dtype, "hi_i", HOFFSET(box2d, hi_i), H5T_NATIVE_INT);
    H5Tinsert(box_dtype, "hi_j", HOFFSET(box2d, hi_j), H5T_NATIVE_INT);

    //open the pluto file
    file = H5Fopen (pluto_file, H5F_ACC_RDONLY, H5P_DEFAULT);

    fprintf(fPtr, ">> MCRaT: Reading positional, density, pressure, and velocity information...\n");
    fflush(fPtr);

    //1. read in the number of dims
    group = H5Gopen (file, "/Chombo_global", H5P_DEFAULT);

    attr = H5Aopen (group, "SpaceDim", H5P_DEFAULT);
    status = H5Aread (attr, H5T_NATIVE_INT, &num_dims);

    status = H5Aclose (attr);
    status = H5Gclose (group);

    //printf("readPlutoChombo spacedim: %d\n", num_dims);

    //2. get the number of levels
    attr = H5Aopen (file, "num_levels", H5P_DEFAULT);
    status = H5Aread (attr, H5T_NATIVE_INT, &num_levels);

    status = H5Aclose (attr);
    //printf("readPlutoChombo num_levels: %d\n", num_levels);

    dombeg1=malloc(num_levels*sizeof(double));
    dombeg2=malloc(num_levels*sizeof(double));
    dombeg3=malloc(num_levels*sizeof(double));
    dx=malloc(num_levels*sizeof(double));
    g_x2stretch=malloc(num_levels*sizeof(double));
    g_x3stretch=malloc(num_levels*sizeof(double));
    level_dims=malloc(num_levels*sizeof(int));

    //3. get number of variables to read in (should be 4 in non-MHD case)
    attr = H5Aopen (file, "num_components", H5P_DEFAULT);
    status = H5Aread (attr, H5T_NATIVE_INT, &num_vars);

    status = H5Aclose (attr);
    //printf("readPlutoChombo num_vars: %d\n", num_vars);

    //get the total number of values that I need to allocate memory for
    for (i=0;i<num_levels;i++)
    {
        snprintf(level, sizeof(level), "level_%d", i);
        //printf("Opening level %d Boxes\n", i);

        group = H5Gopen(file, level, H5P_DEFAULT);

        dset= H5Dopen(group, "data:datatype=0", H5P_DEFAULT);

        //get dimensions of array and save it
        space = H5Dget_space (dset);
        H5Sget_simple_extent_dims(space, dims, NULL); //save dimesnions in dims

        total_size+=dims[0];
        *(level_dims+i)=dims[0];

        status = H5Sclose (space);
        H5Dclose(dset);
        H5Gclose(group);
    }
    //printf("The total number of elements is %d\n", total_size);

    //now allocate space to save data
    all_data=malloc(total_size*sizeof (double));

    //and allocate arrays to hold r and theta values to calculate them on the fly
    x1_buffer=malloc((total_size/num_vars)*sizeof (double));
    x2_buffer=malloc((total_size/num_vars)*sizeof (double));
    dx1_buffer=malloc((total_size/num_vars)*sizeof (double));
    dx2_buffer=malloc((total_size/num_vars)*sizeof (double));

    vel_x1_buffer= malloc ((total_size/num_vars) * sizeof (double));
    vel_x2_buffer=malloc ((total_size/num_vars) * sizeof (double));
    dens_buffer= malloc ((total_size/num_vars) * sizeof (double));
    pres_buffer=malloc ((total_size/num_vars) * sizeof (double));

    offset=0;
    //read in the data
    for (i=0;i<num_levels;i++)
    {
        snprintf(level, sizeof(level), "level_%d", i);
        //printf("Opening level %d Boxes\n", i);

        group = H5Gopen(file, level, H5P_DEFAULT);

        //read in the data
        dset= H5Dopen(group, "data:datatype=0", H5P_DEFAULT);
        status = H5Dread (dset, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, H5P_DEFAULT,(all_data+offset));
        H5Dclose(dset);
        //printf("First few data %e %e %e Last few data %e %e\n", *(all_data+offset), *(all_data+offset+1), *(all_data+offset+2), *(all_data+offset+(*(level_dims+i))-2), *(all_data+offset+(*(level_dims+i))-1));

        //read in the box offsets in all_data
        dset= H5Dopen(group, "data:offsets=0", H5P_DEFAULT);

        space = H5Dget_space (dset);
        H5Sget_simple_extent_dims(space, dims, NULL); //save dimesnions in dims
        box_offset=malloc(dims[0]*sizeof(int));
        status = H5Sclose (space);

        status = H5Dread (dset, H5T_NATIVE_INT, H5S_ALL, H5S_ALL, H5P_DEFAULT, box_offset);
        H5Dclose(dset);

        //open various properties about that refinement level
        attr = H5Aopen (group, "prob_domain", H5P_DEFAULT);
        status = H5Aread (attr, box_dtype, &prob_domain);
        status = H5Aclose (attr);
        //printf("Prob_domain %d %d %d %d\n", prob_domain->lo_i, prob_domain->lo_j, prob_domain->hi_i, prob_domain->hi_j);

        attr = H5Aopen (group, "dx", H5P_DEFAULT);
        status = H5Aread (attr, H5T_NATIVE_DOUBLE, (dx+i));
        status = H5Aclose (attr);
        //printf("dx %e\n", *(dx+i));

        attr = H5Aopen (group, "logr", H5P_DEFAULT);
        status = H5Aread (attr, H5T_NATIVE_INT, &logr);
        status = H5Aclose (attr);
        //printf("logr %d\n", logr);

        attr = H5Aopen (group, "domBeg1", H5P_DEFAULT);
        status = H5Aread (attr, H5T_NATIVE_DOUBLE, (dombeg1+i));
        status = H5Aclose (attr);
        //printf("dombeg1 %e\n", *(dombeg1+i));

        //set default just in case
        *(dombeg2+i)=0;
        *(dombeg3+i)=0;

        if (num_dims==2)
        {
            attr = H5Aopen (group, "g_x2stretch", H5P_DEFAULT);
            status = H5Aread (attr, H5T_NATIVE_DOUBLE, (g_x2stretch+i));
            status = H5Aclose (attr);
            //printf("g_x2stretch %e\n", *(g_x2stretch+i));

            attr = H5Aopen (group, "domBeg2", H5P_DEFAULT);
            status = H5Aread (attr, H5T_NATIVE_DOUBLE, (dombeg2+i));
            status = H5Aclose (attr);
            //printf("dombeg2 %e\n", *(dombeg2+i));

        }
        else if (num_dims==3)
        {
            attr = H5Aopen (group, "g_x3stretch", H5P_DEFAULT);
            status = H5Aread (attr, H5T_NATIVE_DOUBLE, (g_x3stretch+i));
            status = H5Aclose (attr);

            attr = H5Aopen (group, "domBeg3", H5P_DEFAULT);
            status = H5Aread (attr, H5T_NATIVE_DOUBLE, (dombeg3+i));
            status = H5Aclose (attr);
        }

        //read in the boxes
        dset= H5Dopen(group, "boxes", H5P_DEFAULT);

        //get dimensions of array and save it
        space = H5Dget_space (dset);
        H5Sget_simple_extent_dims(space, dims, NULL); //save dimesnions in dims

        box2d box_data[dims[0]];

        status = H5Dread (dset, box_dtype, H5S_ALL, H5S_ALL, H5P_DEFAULT,box_data);
        status = H5Sclose (space);
        H5Dclose(dset);

        radii=malloc( (prob_domain->hi_i - prob_domain->lo_i +1) * sizeof (double ));
        angles=malloc( (prob_domain->hi_j - prob_domain->lo_j +1) * sizeof (double ));
        dradii=malloc( (prob_domain->hi_i - prob_domain->lo_i +1) * sizeof (double ));
        dangles=malloc( (prob_domain->hi_j - prob_domain->lo_j +1) * sizeof (double ));

        //create the arrays that hold the refinement level radii and angles
        for (j=0;j<(prob_domain->hi_i - prob_domain->lo_i +1);j++)
        {
            if (logr==0)
            {
                *(radii+j)=(*(dombeg1+i)) + (*(dx+i)) * (prob_domain->lo_i + j + 0.5);
                *(dradii+j)=(*(dx+i));
            }
            else
            {
                *(radii+j)=(*(dombeg1+i)) * 0.5 * (exp((*(dx+i)) * (prob_domain->lo_i + j + 1)) + exp((*(dx+i)) * (prob_domain->lo_i + j))   );
                *(dradii+j)=(*(dombeg1+i)) * (exp((*(dx+i)) * (prob_domain->lo_i + j + 1)) - exp((*(dx+i)) * (prob_domain->lo_i + j))   );
            }
            //if (i==2) printf("radii: %0.8e dr: %0.8e\n", *(radii+j), *(dradii+j));
        }

        for (j=0;j<(prob_domain->hi_j - prob_domain->lo_j +1);j++)
        {
            *(angles+j)=(*(dombeg2+i)) + (*(dx+i)) * (*(g_x2stretch+i)) * (prob_domain->lo_j + j + 0.5);
            *(dangles+j)=(*(dx+i))*(*(g_x2stretch+i));
        }

        //go through the boxes to create the r and theta arrays
        total_box_size=0;
        for (j=0; j<dims[0]; j++)
        {
            //printf("i %d %d %d %d %d \n", j, box_data[j].lo_i, box_data[j].lo_j, box_data[j].hi_i, box_data[j].hi_j);
            nbx=box_data[j].hi_i-box_data[j].lo_i+1;
            nby=1;
            nbz=1;

            if (num_dims >1)
            {
                nby=box_data[j].hi_j-box_data[j].lo_j+1;
            }
            /* for future 3D support
            else if (dim>2)
            {
                nbz=box_data[j].hi_k-box_data[j].lo_k+1;
            }
             */
            //loop over each variable values of box
            for (k=0;k<num_vars;k++)
            {
                //loop over the radii
                for (l=0; l<nby; l++)
                {
                    //loop over the angles
                    for (m=0 ;m<nbx ;m++)
                    {
                        switch (k)
                        {
                            case 0:
                                //when k is 0 save the radii, caus eonly need to do once and also save the densities
                                #if GEOMETRY == SPHERICAL
                                    *(x1_buffer+offset/num_vars+(*(box_offset+j))/num_vars+ l*nbx +m  )= (*(radii+box_data[j].lo_i+m))*HYDRO_L_SCALE;
                                    *(x2_buffer+(offset+(*(box_offset+j)))/num_vars + l*nbx +m )=(*(angles+box_data[j].lo_j+l));
                                    *(dx1_buffer+(offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(dradii+box_data[j].lo_i+m))*HYDRO_L_SCALE;
                                    *(dx2_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m )=(*(dangles+box_data[j].lo_j+l));
                                #elif GEOMETRY == CARTESIAN
                                    *(x1_buffer+offset/num_vars+(*(box_offset+j))/num_vars+ l*nbx +m  )= (*(radii+box_data[j].lo_i+m))*HYDRO_L_SCALE;
                                    *(x2_buffer+(offset+(*(box_offset+j)))/num_vars + l*nbx +m )=(*(angles+box_data[j].lo_j+l))*HYDRO_L_SCALE;
                                    *(dx1_buffer+(offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(dradii+box_data[j].lo_i+m))*HYDRO_L_SCALE;
                                    *(dx2_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m )=(*(dangles+box_data[j].lo_j+l))*HYDRO_L_SCALE;
                                #endif

                                *(dens_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(all_data+offset+(*(box_offset+j))+ k*nbx*nby + l*nbx +m  ));
                                break;
                            case 1:
                                *(vel_x1_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(all_data+offset+(*(box_offset+j))+ k*nbx*nby + l*nbx +m  ));
                                break;
                            case 2:
                                *(vel_x2_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(all_data+offset+(*(box_offset+j))+ k*nbx*nby + l*nbx +m  ));
                                break;
                            case 3:
                                *(pres_buffer+ (offset+(*(box_offset+j)))/num_vars + l*nbx +m)=(*(all_data+offset+(*(box_offset+j))+ k*nbx*nby + l*nbx +m  ));
                                break;
                            default:
                                break;
                        }

                    }
                }
            }
            /*
              // this was for testing, the actual nested loop is below
              if (i==2 && j==dims[0]-1)
              {

                  r_count=0;
                  for (k=0;k<1;k++)
                  {
                      //loop over the radii
                      for (l=0; l<nby; l++)
                      {
                          //loop over the angles
                          for (m=0 ;m<nbx ;m++)
                          {
                              printf("count: %d idx: %d all_data val: %0.8e r: %e theta %e\n", (*(box_offset+j))+r_count, (*(box_offset+j))+k*nbx*nby + l*nby +m, *(all_data+offset+(*(box_offset+j))+ k*nbx*nby + l*nbx +m  ), *(radii+box_data[j].lo_i+m), *(angles+box_data[j].lo_j+l));
                              r_count++;
                          }
                          printf("\n");
                      }
                      printf("\n");
                  }

                  for (k=0;k<64;k++)
                  {
                      printf("r: %e, theta %e dens data: %e\n",*(x1_buffer+ (offset+(*(box_offset+j)))/num_vars+k), *(x2_buffer+ (offset+(*(box_offset+j)))/num_vars +k), *(dens_buffer+ (offset+(*(box_offset+j)))/num_vars +k) );
                  }
                  printf("\n");

              }
        */

        }

        offset+=(*(level_dims+i));

        H5Gclose(group);
        free(radii); free(angles); free(dradii); free(dangles); free(box_offset);

    }
    status = H5Fclose (file);
    free(dombeg1); free(dombeg2); free(dombeg3); free(dx); free(g_x2stretch); free(g_x3stretch); free(all_data);

    //have all the data so need to go through and decide which values we will be keeping based on phtoon ranges we want to keep
    //fill in radius array and find in how many places r > injection radius
    #if SYNCHROTRON_SWITCH == ON
        elem_factor=2;
    #else
        elem_factor=0;
    #endif
    r_count=0;
    while (r_count==0)
    {
        r_count=0;
        elem_factor++;
        for (i=0;i<(total_size/num_vars);i++)
        {
            if (ph_inj_switch==0)
            {
                #if GEOMETRY == SPHERICAL
                    r_grid_innercorner = (*(x1_buffer+i)) - 0.5 * (*(dx1_buffer+i));
                    r_grid_outercorner = (*(x1_buffer+i)) + 0.5 * (*(dx1_buffer+i));

                    theta_grid_innercorner = (*(x2_buffer+i)) - 0.5 * (*(dx2_buffer+i));
                    theta_grid_outercorner = (*(x2_buffer+i)) + 0.5 * (*(dx2_buffer+i));
                #elif GEOMETRY == CARTESIAN
                    r_grid_innercorner = pow((*(x1_buffer+i) - *(dx1_buffer+i)/2.0) * ((*(x1_buffer+i) - *(dx1_buffer+i)/2.0))+(*(x2_buffer+i) - *(dx2_buffer+i)/2.0) * (*(x2_buffer+i) - *(dx2_buffer+i)/2.0),0.5);
                    r_grid_outercorner = pow((*(x1_buffer+i) + *(dx1_buffer+i)/2.0) * ((*(x1_buffer+i) + *(dx1_buffer+i)/2.0))+(*(x2_buffer+i) + *(dx2_buffer+i)/2.0) * (*(x2_buffer+i) + *(dx2_buffer+i)/2.0),0.5);

                    theta_grid_innercorner = acos( (*(x2_buffer+i) - *(dx2_buffer+i)/2.0) /r_grid_innercorner); //arccos of y/r for the bottom left corner
                    theta_grid_outercorner = acos( (*(x2_buffer+i) + *(dx2_buffer+i)/2.0) /r_grid_outercorner);
                #endif

                if (((ph_rmin - elem_factor*C_LIGHT/fps) <= r_grid_outercorner) && (r_grid_innercorner  <= (ph_rmax + elem_factor*C_LIGHT/fps) ) && (theta_grid_outercorner >= ph_thetamin) && (theta_grid_innercorner <= ph_thetamax) )
                {
                    r_count++;
                }

            }
            else
            {
                if ((*(x1_buffer+i)) > (0.95*r_inj) )
                {
                    r_count++;
                }
            }
        }
        //printf( "r_count: %d\n", r_count);
    }
    fprintf(fPtr, "Elem factor: %d Ph_rmin: %e rmax: %e Chosen FLASH min_r: %e max_r: %e min_theta: %e degrees max_theta: %e degrees\n", elem_factor, ph_rmin, ph_rmax, ph_rmin - (elem_factor*C_LIGHT/fps), ph_rmax + (elem_factor*C_LIGHT/fps), ph_thetamin*180/M_PI, ph_thetamax*180/M_PI);
    fflush(fPtr);

    //allocate memory to hold processed data
    (*pres)=malloc (r_count * sizeof (double ));
    (*velx)=malloc (r_count * sizeof (double ));
    (*vely)=malloc (r_count * sizeof (double ));
    (*dens)=malloc (r_count * sizeof (double ));
    (*x)=malloc (r_count * sizeof (double ));
    (*y)=malloc (r_count * sizeof (double ));
    (*r)=malloc (r_count * sizeof (double ));
    (*theta)=malloc (r_count * sizeof (double ));
    (*gamma)=malloc (r_count * sizeof (double ));
    (*dens_lab)=malloc (r_count * sizeof (double ));
    (*szx)=malloc (r_count * sizeof (double ));
    (*szy)=malloc (r_count * sizeof (double ));
    (*temp)=malloc (r_count * sizeof (double ));

    //assign values based on r> 0.95*r_inj
    j=0;
    for (i=0;i<(total_size/num_vars);i++)
    {
        if (ph_inj_switch==0)
        {
           #if GEOMETRY == SPHERICAL
               r_grid_innercorner = (*(x1_buffer+i)) - 0.5 * (*(dx1_buffer+i));
               r_grid_outercorner = (*(x1_buffer+i)) + 0.5 * (*(dx1_buffer+i));

               theta_grid_innercorner = (*(x2_buffer+i)) - 0.5 * (*(dx2_buffer+i));
               theta_grid_outercorner = (*(x2_buffer+i)) + 0.5 * (*(dx2_buffer+i));
           #elif GEOMETRY == CARTESIAN
               r_grid_innercorner = pow((*(x1_buffer+i) - *(dx1_buffer+i)/2.0) * ((*(x1_buffer+i) - *(dx1_buffer+i)/2.0))+(*(x2_buffer+i) - *(dx2_buffer+i)/2.0) * (*(x2_buffer+i) - *(dx2_buffer+i)/2.0),0.5);
               r_grid_outercorner = pow((*(x1_buffer+i) + *(dx1_buffer+i)/2.0) * ((*(x1_buffer+i) + *(dx1_buffer+i)/2.0))+(*(x2_buffer+i) + *(dx2_buffer+i)/2.0) * (*(x2_buffer+i) + *(dx2_buffer+i)/2.0),0.5);

               theta_grid_innercorner = acos( (*(x2_buffer+i) - *(dx2_buffer+i)/2.0) /r_grid_innercorner); //arccos of y/r for the bottom left corner
               theta_grid_outercorner = acos( (*(x2_buffer+i) + *(dx2_buffer+i)/2.0) /r_grid_outercorner);
           #endif

            if (((ph_rmin - elem_factor*C_LIGHT/fps) <= r_grid_outercorner) && (r_grid_innercorner  <= (ph_rmax + elem_factor*C_LIGHT/fps) ) && (theta_grid_outercorner >= ph_thetamin) && (theta_grid_innercorner <= ph_thetamax))
            {
                (*pres)[j]=(*(pres_buffer+i));
                (*velx)[j]= (*(vel_x1_buffer+i))*sin((*(x2_buffer+i))) + (*(vel_x2_buffer+i))*cos((*(x2_buffer+i))) ; //convert from spherical to cartesian
                (*vely)[j]= (*(vel_x1_buffer+i))*cos((*(x2_buffer+i))) - (*(vel_x2_buffer+i))*sin((*(x2_buffer+i))); //z axis is actually y axis in 2D

                (*dens)[j]=(*(dens_buffer+i));
                (*x)[j]=(*(x1_buffer+i))*sin((*(x2_buffer+i)));
                (*y)[j]=(*(x1_buffer+i))*cos((*(x2_buffer+i)));
                (*r)[j]=(*(x1_buffer+i));
                (*szx)[j]=(*(dx1_buffer+i));
                (*szy)[j]=(*(dx2_buffer+i));
                (*theta)[j]=(*(x2_buffer+i));//theta in radians in relation to jet axis
                (*gamma)[j]=1/pow(1.0-( (*(vel_x1_buffer+i))*(*(vel_x1_buffer+i)) + (*(vel_x2_buffer+i))*(*(vel_x2_buffer+i)) ),0.5); //v is in units of c
                (*dens_lab)[j]= (*(dens_buffer+i)) /pow(1.0-( (*(vel_x1_buffer+i))*(*(vel_x1_buffer+i)) + (*(vel_x2_buffer+i))*(*(vel_x2_buffer+i)) ),0.5);
                (*temp)[j]=pow(3*(*(pres_buffer+i))*pow(C_LIGHT,2.0)/(A_RAD) ,1.0/4.0);
                j++;
            }
        }
        else
        {
            if ((*(x1_buffer+i)) > (0.95*r_inj) )
            {
                (*pres)[j]=(*(pres_buffer+i));
                (*velx)[j]= (*(vel_x1_buffer+i))*sin((*(x2_buffer+i))) + (*(vel_x2_buffer+i))*cos((*(x2_buffer+i))) ; //convert from spherical to cartesian
                (*vely)[j]= (*(vel_x1_buffer+i))*cos((*(x2_buffer+i))) - (*(vel_x2_buffer+i))*sin((*(x2_buffer+i))); //z axis is actually y axis in 2D

                (*dens)[j]=(*(dens_buffer+i));
                (*x)[j]=(*(x1_buffer+i))*sin((*(x2_buffer+i)));
                (*y)[j]=(*(x1_buffer+i))*cos((*(x2_buffer+i)));
                (*r)[j]=(*(x1_buffer+i));
                (*szx)[j]=(*(dx1_buffer+i));
                (*szy)[j]=(*(dx2_buffer+i));
                (*theta)[j]=(*(x2_buffer+i));//theta in radians in relation to jet axis
                (*gamma)[j]=1/pow(1.0-( (*(vel_x1_buffer+i))*(*(vel_x1_buffer+i)) + (*(vel_x2_buffer+i))*(*(vel_x2_buffer+i)) ),0.5); //v is in units of c
                (*dens_lab)[j]= (*(dens_buffer+i)) /pow(1.0-( (*(vel_x1_buffer+i))*(*(vel_x1_buffer+i)) + (*(vel_x2_buffer+i))*(*(vel_x2_buffer+i)) ),0.5);
                (*temp)[j]=pow(3*(*(pres_buffer+i))*pow(C_LIGHT,2.0)/(A_RAD) ,1.0/4.0);
                j++;
            }
        }
    }

    //fprintf(fPtr, "number: %d\n", r_count);

    *number=r_count;

    free(x1_buffer); free(x2_buffer); free(dx1_buffer); free(dx2_buffer); free(dens_buffer); free(pres_buffer); free(vel_x1_buffer); free(vel_x2_buffer);

}

void modifyPlutoName(char file[200], char prefix[200], int frame)
{
    int lim1=0, lim2=0, lim3=0;
    char test[200]="" ;

    //if (strcmp(DIM_SWITCH, dim_2d_str)==0)
    #if DIMENSIONS == 2
    {
        //2D case
        lim1=10;
        lim2=100;
        lim3=1000;
    }
    #else
    {
        //3d case
        lim1=100;
        lim2=1000;
        lim3=10000;
    }
    #endif

    if (frame<lim1)
    {
        snprintf(test,sizeof(test), "%s%.3d%d.hdf5",prefix,000,frame);
    }
    else if (frame<lim2)
    {
        snprintf(test,sizeof(test), "%s%.2d%d.hdf5",prefix,00,frame);
    }
    else if (frame<lim3)
    {
        snprintf(test,sizeof(test), "%s%d%d.hdf5",prefix,0,frame);
    }
    else
    {
        snprintf(test,sizeof(test), "%s%d.hdf5",prefix,frame);
    }
    strncpy(file, test, sizeof(test));//had to do this workaround for some weird reason
}


#include <stdio.h>
#include <stdlib.h>
#include <gsl/gsl_histogram.h>

int
main (int argc, char **argv)
{
  double a, b;
  size_t n;

  if (argc != 4)
    {
      printf ("Usage: gsl-histogram xmin xmax n\n"
              "Computes a histogram of the data "
              "on stdin using n bins from xmin "
              "to xmax\n");
      exit (0);
    }

  a = atof (argv[1]);
  b = atof (argv[2]);
  n = atoi (argv[3]);

  {
    double x;
    gsl_histogram * h = gsl_histogram_alloc (n);
    gsl_histogram_set_ranges_uniform (h, a, b);

    while (fscanf (stdin, "%lg", &x) == 1)
      {
        gsl_histogram_increment (h, x);
      }
    gsl_histogram_fprintf (stdout, h, "%g", "%g");
    gsl_histogram_free (h);
  }
  exit (0);
}