#include <config.h>
#include <math.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_sort_vector.h>

static int compute_rank(gsl_vector *v);

#define BASE_LONG_DOUBLE
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_LONG_DOUBLE

#define BASE_DOUBLE
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_DOUBLE

#define BASE_FLOAT
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_FLOAT

#define BASE_ULONG
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_ULONG

#define BASE_LONG
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_LONG

#define BASE_UINT
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_UINT

#define BASE_INT
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_INT

#define BASE_USHORT
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_USHORT

#define BASE_SHORT
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_SHORT

#define BASE_UCHAR
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_UCHAR

#define BASE_CHAR
#include "templates_on.h"
#include "covariance_source.c"
#include "templates_off.h"
#undef  BASE_CHAR

/*
compute_rank()
  Compute rank of a sorted vector

Inputs: v - sorted data vector on input; rank vector on output

Notes: ranks are always computed in double precision
*/

static int
compute_rank(gsl_vector *v)
{
  const size_t n = v->size;
  size_t i = 0;

  while (i < n - 1)
    {
      double vi = gsl_vector_get(v, i);

      if (vi == gsl_vector_get(v, i + 1))
        {
          size_t j = i + 2;
          size_t k;
          double rank = 0.0;

          /* we have detected a tie, find number of equal elements */
          while (j < n && vi == gsl_vector_get(v, j))
            ++j;

          /* compute rank */
          for (k = i; k < j; ++k)
            rank += k + 1.0;

          /* divide by number of ties */
          rank /= (double) (j - i);

          for (k = i; k < j; ++k)
            gsl_vector_set(v, k, rank);

          i = j;
        }
      else
        {
          /* no tie - set rank to natural ordered position */
          gsl_vector_set(v, i, i + 1.0);
          ++i;
        }
    }

  if (i == n - 1)
    gsl_vector_set(v, n - 1, (double) n);

  return GSL_SUCCESS;
} /* compute_rank() */


/**
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_interp.h>
#include "aXe_grism.h"
#include "aXe_utils.h"
#include "inout_aper.h"
#include "aper_conf.h"
#include "spc_spc.h"
#include "spce_PET.h"
#include "fringe_conf.h"
#include "ipixcorr_utils.h"

#define AXE_IMAGE_PATH "AXE_IMAGE_PATH"
#define AXE_OUTPUT_PATH "AXE_OUTPUT_PATH"
#define AXE_CONFIG_PATH "AXE_CONFIG_PATH"

int
main (int argc, char *argv[])
{
  char *opt;
  char aper_file[MAXCHAR];
  char aper_file_path[MAXCHAR];

  char conf_file[MAXCHAR];
  char conf_file_path[MAXCHAR];

  char grism_file[MAXCHAR];
  char grism_file_path[MAXCHAR];

  char IPC_file[MAXCHAR];
  char IPC_file_path[MAXCHAR];

  char PET_file[MAXCHAR];
  char PET_file_path[MAXCHAR];

  char IPC_func[MAXCHAR];
  char IPC_func_path[MAXCHAR];
  char ID[60];

  aperture_conf *conf;

  object **oblist;
  observation *obs = NULL;

  interpolator *ipcorr;

  int index;
  //int i;

  ap_pixel *PET;

  fitsfile  *PET_ptr;
  fitsfile  *IPC_ptr;
  FITScards *cards;

  int f_status=0;
  int bckmode = 0;

  int aperID=0, beamID=0;
  //int objindex;

  int spec_OAF=0;
  int point_like=0;
  int origname=0;

  beam act_beam;

  double max_ext;

  if ((argc < 3) || (opt = get_online_option ("help", argc, argv)))
    {
      fprintf (stdout,
         "aXe_FRINGECORR Version %s:\n",RELEASE);
      exit (1);
    }

  fprintf (stdout, "aXe_PETIPC: Starting...\n");

  // reset the parameter index
  index = 0;

  // read in the grism image name
  strcpy(grism_file, argv[++index]);
  build_path (AXE_IMAGE_PATH, grism_file, grism_file_path);

  // read in the configuration file name
  strcpy(conf_file, argv[++index]);
  build_path (AXE_CONFIG_PATH, conf_file, conf_file_path);

  // load the configuration file
  conf = get_aperture_descriptor(conf_file_path);

  // determine the science extension number
  get_extension_numbers(grism_file_path, conf,conf->optkey1,conf->optval1);

  // Determine if we are using the special bck mode
  // In this mode, file names are handled diferently
  if ((opt = get_online_option("bck", argc, argv)))
    bckmode = 1;

  // determine whether the corrected PET should maintain the
  // filename of the original PET
  if ((opt = get_online_option("origname", argc, argv)))
    origname = 1;

  // get or set up the input OAF name
  if ((opt = get_online_option("in_OAF", argc, argv)))
    {
      // copy the parameter value if given
      strcpy(aper_file, opt);

      // mark that there is a special OAF file
      spec_OAF=1;
    }
  else
    {
      // copy the grism name and construct the name
      // if not given as parameter
      strcpy(aper_file, grism_file);
      replace_file_extension (grism_file, aper_file, ".fits",
			      ".OAF", conf->science_numext);
    }
  build_path(AXE_OUTPUT_PATH, aper_file, aper_file_path);

  // get or set up the output PET name
  if ((opt = get_online_option("out_PET", argc, argv)))
    {
      // copy the parameter value if given
      strcpy(IPC_file, opt);
    }
  else
    {
      // copy the grism name and construct the name
      // if not given as parameter
      strcpy(IPC_file, grism_file);

      if (bckmode)
	replace_file_extension(grism_file, IPC_file, ".fits",
			       "_ipc.BCK.PET.fits", conf->science_numext);
      else
	replace_file_extension(grism_file, IPC_file, ".fits",
			       "_ipc.PET.fits", conf->science_numext);
    }
  build_path(AXE_OUTPUT_PATH, IPC_file, IPC_file_path);

  // get or set up the output PET name
  if ((opt = get_online_option("in_PET", argc, argv)))
    {
      // copy the parameter value if given
      strcpy(PET_file, opt);
    }
  else
    {
      // copy the grism name and construct the name
      // if not given as parameter
      strcpy(PET_file, grism_file);
      if (bckmode)
	replace_file_extension(grism_file, PET_file, ".fits",
			       ".BCK.PET.fits", conf->science_numext);
      else
	replace_file_extension(grism_file, PET_file, ".fits",
			       ".PET.fits", conf->science_numext);

    }
  build_path(AXE_OUTPUT_PATH, PET_file, PET_file_path);

  // Build the intrapixel correction file name
  sprintf(IPC_func,"%s",conf->IPIXfunc);

  // overwrite it with the parameter if given
  if ((opt = get_online_option ("IPIXFUNCTION", argc, argv)))
    strcpy(IPC_func,opt);

  if (!strcmp(IPC_file,"None"))
    // check whether the correction function is given;
    // complain if not given!
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		 "aXe_PETIPC: Correction function must be given!!\n");
  else
    // compose the full pathname
    build_path (AXE_CONFIG_PATH, IPC_func, IPC_func_path);

  // get the maximum extension number
  if ((opt = get_online_option ("max_ext", argc, argv)))
    max_ext = atof(opt);
  else
    max_ext = 0.0;

  // check whether either max_ext is defined
  // OR a special OAF file is given
  if (!max_ext && !spec_OAF)
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		 "aXe_PETIPC: Either maximum extension\n"
		 "OR a special OAF file must be given!\n");

  fprintf (stdout, "aXe_PETIPC: Grism file name:                     %s\n",
	   grism_file_path);
  fprintf (stdout, "aXe_PETIPC: Configuration file name:             %s\n",
	   conf_file_path);
  fprintf (stdout, "aXe_PETIPC: Correction function:                 %s\n",
	   IPC_func_path);
  fprintf (stdout, "aXe_PETIPC: Input OAF file name:                 %s\n",
	   aper_file_path);
  fprintf (stdout, "aXe_PETIPC: Input PET file name:                 %s\n",
	   PET_file_path);
  if (origname)
    fprintf (stdout, "aXe_PETIPC: Output PET file name:                %s\n",
	     PET_file_path);
  else
    fprintf (stdout, "aXe_PETIPC: Output PET file name:                %s\n",
	     IPC_file_path);
  fprintf (stdout, "aXe_PETIPC: Maximal extension for point objects: %f\n",
	   max_ext);

  // load the aperture list
  fprintf (stdout, "aXe_PETIPC: Loading object aperture list...");
  fflush(stdout);
  oblist = file_to_object_list_seq (aper_file_path, obs);
  fprintf (stdout,"%d objects loaded.\n",object_list_size(oblist));
  fflush(stdout);

  // Open the PET file for reading
  fits_open_file (&PET_ptr, PET_file_path, READONLY, &f_status);
  if (f_status)
    {
      ffrprt (stdout, f_status);
      aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		   "aXe_PETIPC: Could not open file: %s\n",
		   PET_file_path);
    }

  // open the output PET file
  IPC_ptr = create_PET_opened(IPC_file_path,1);

  // copy the keywords from the input
  // to the output PET
  cards = get_FITS_cards_opened(PET_ptr);
  put_FITS_cards_opened(IPC_ptr, cards);
  free_FITScards(cards);

  // create an interpolator reading in the fits file
  ipcorr = create_interp_ftable(IPC_func_path,2,"X","FX",IPCORR_INTERP_TYPE);

  while ((aperID!=-1) || (beamID!=-1))
    {
      // Get the PET for this object
      PET = get_ALL_from_next_in_PET(PET_ptr, &aperID, &beamID);
      if ((aperID==-1) && (beamID==-1))
	break;

      // PET is empty, skip it
      if (PET==NULL)
	{
	  fprintf(stdout, "Empty PET BEAM %d%c...\n", aperID, BEAM(beamID));
	  continue; }

      // select the actual beam from the beam list
      act_beam = find_beam_in_object_list(oblist, aperID, beamID);

      // determine whether the object is pointlike
      point_like = is_pointlike(act_beam, spec_OAF, max_ext);

      if (point_like)
	{
	  fprintf(stdout, "aXe_PETIPC: Correcting BEAM %d%c...\n", aperID, BEAM(beamID));
	  intpix_corr_pet(act_beam, conf_file_path, ipcorr, PET);
	}
      else
	{
	  fprintf(stdout, "aXe_PETIPC: Skipping BEAM %d%c...\n", aperID, BEAM(beamID));
	}

      sprintf(ID, "%d%c", aperID, BEAM (beamID));
      add_ALL_to_PET(PET, ID, IPC_ptr, 0);

      /* Copy header from OPET extension into this SPC extension */
      cards = get_FITS_cards_opened(PET_ptr);
      put_FITS_cards_opened(IPC_ptr,cards);
      free_FITScards(cards);

      if (PET!=NULL)
	free(PET);
    }

  // free the object list
  if (oblist!=NULL)
    free_oblist (oblist);

  // free the interpolator
  free_interp(ipcorr);

  // free the configuration structure
  free_aperture_conf(conf);

  fits_close_file (PET_ptr, &f_status);
  if (f_status)
    {
      ffrprt (stderr, f_status);
      aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		   "aXe_PETIPC: " "Error closing PET: %s\n",
		   PET_file_path);
    }

  fits_close_file (IPC_ptr, &f_status);
  if (f_status)
    {
      ffrprt (stderr, f_status);
      aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		   "aXe_PETIPC: " "Error closing PET: %s\n",
		   IPC_file_path);
    }

  // check whether the old
  // PET name should be retained
  if (origname)
    {
      // delete the original
      // PET file
      if (remove(PET_file_path) != 0)
	fprintf (stdout, "aXe_PETIPC: Problems deleting %s!\n", PET_file_path);

      // rename the corrcted PET file
      if (rename(IPC_file_path, PET_file_path) !=0)
	fprintf (stdout, "aXe_PETIPC: Problems renaming %s to %s!\n", IPC_file_path, PET_file_path);

    }

  // say goodbye
  fprintf (stdout, "aXe_PETIPC: Done...\n");
  exit (0);
}


//! \file reaction.h
//! Data for an incident neutron reaction

#ifndef OPENMC_REACTION_H
#define OPENMC_REACTION_H

#include <string>

#include <gsl/gsl>
#include "hdf5.h"

#include "openmc/reaction_product.h"
#include "openmc/vector.h"

namespace openmc {

//==============================================================================
//! Data for a single reaction including cross sections (possibly at multiple
//! temperatures) and reaction products (with secondary angle-energy
//! distributions)
//==============================================================================

class Reaction {
public:
  //! Construct reaction from HDF5 data
  //! \param[in] group HDF5 group containing reaction data
  //! \param[in] temperatures Desired temperatures for cross sections
  explicit Reaction(hid_t group, const vector<int>& temperatures);

  //! \brief Calculate reaction rate based on group-wise flux distribution
  //
  //! \param[in] i_temp Temperature index
  //! \param[in] energy Energy group boundaries in [eV]
  //! \param[in] flux Flux in each energy group (not normalized per eV)
  //! \param[in] grid Nuclide energy grid
  //! \return Reaction rate
  double collapse_rate(gsl::index i_temp, gsl::span<const double> energy,
    gsl::span<const double> flux, const vector<double>& grid) const;

  //! Cross section at a single temperature
  struct TemperatureXS {
    int threshold;
    vector<double> value;
  };

  int mt_;             //!< ENDF MT value
  double q_value_;     //!< Reaction Q value in [eV]
  bool scatter_in_cm_; //!< scattering system in center-of-mass?
  bool redundant_;     //!< redundant reaction?
  vector<TemperatureXS> xs_;         //!< Cross section at each temperature
  vector<ReactionProduct> products_; //!< Reaction products
};

//==============================================================================
// Non-member functions
//==============================================================================

//! Return reaction name given an ENDF MT value
//
//! \param[in] mt  ENDF MT value
//! \return Name of the corresponding reaction
std::string reaction_name(int mt);

//! Return reaction type (MT value) given a reaction name
//
//! \param[in] name  Reaction name
//! \return Corresponding reaction type (MT value)
int reaction_type(std::string name);

} // namespace openmc

#endif // OPENMC_REACTION_H


#include <mpi.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <unistd.h>
#include <math.h>
#include <gsl/gsl_math.h>

#ifdef INVARIANCETEST
#define DO_NOT_REDEFINE_MPI_COMM_WORLD
#endif

#include "allvars.h"
#include "proto.h"

/*! \file main.c
 *  \brief start of the program
 */
/*!
 *  This function initializes the MPI communication packages, and sets
 *  cpu-time counters to 0. Then begrun() is called, which sets up
 *  the simulation either from IC's or from restart files.  Finally,
 *  run() is started, the main simulation loop, which iterates over
 *  the timesteps.
 */
int main(int argc, char **argv)
{
  int i;

  MPI_Init(&argc, &argv);
  MPI_Comm_rank(MPI_COMM_WORLD, &ThisTask);
  MPI_Comm_size(MPI_COMM_WORLD, &NTask);

#ifdef INVARIANCETEST
  World_ThisTask = ThisTask;
  World_NTask = NTask;

  if(World_NTask != (INVARIANCETEST_SIZE1 + INVARIANCETEST_SIZE2))
    {
      printf("wrong number of procs for invariance-test\n");
      MPI_Finalize();		/* clean up & finalize MPI */
      return 0;
    }

  if(World_ThisTask < INVARIANCETEST_SIZE1)
    Color = 0;
  else
    Color = 1;

  MPI_Comm_split(MPI_COMM_WORLD, Color, 0, &MPI_CommLocal);
  MPI_Comm_rank(MPI_CommLocal, &ThisTask);
  MPI_Comm_size(MPI_CommLocal, &NTask);
#endif

  for(PTask = 0; NTask > (1 << PTask); PTask++);

  if(argc < 2)
    {
      if(ThisTask == 0)
	{
	  printf("Parameters are missing.\n");
	  printf("Call with <ParameterFile> [<RestartFlag>] [<RestartSnapNum>]\n");
	}
      endrun(0);
    }

  strcpy(ParameterFile, argv[1]);

  if(argc >= 3)
    RestartFlag = atoi(argv[2]);
  else
    RestartFlag = 0;

  if(argc >= 4)
    RestartSnapNum = atoi(argv[3]);
  else
    RestartSnapNum = -1;

  /* initialize CPU-time/Wallclock-time measurement */
  for(i = 0; i < CPU_PARTS; i++)
    All.CPU_Sum[i] = CPU_Step[i] = 0;

  CPUThisRun = 0;
  WallclockTime = second();

  begrun();			/* set-up run  */

  run();			/* main simulation loop */

  MPI_Finalize();		/* clean up & finalize MPI */

  return 0;
}

/* ----------------------------------------------------------------------
   The rest of this file contains documentation for compiling and
   running the code, in a format appropriate for 'doxygen'.
   ----------------------------------------------------------------------
 */

/*! \mainpage Reference documentation of GADGET-2

\author Volker Springel \n
        Max-Planck-Institute for Astrophysics \n
        Garching, Germany \n
        volker@mpa-garching.mpg.de \n

\n

\section install Compilation

GADGET-2 needs the following non-standard libraries for compilation:

- \b MPI - the Message Passing Interface (version 1.0 or higher). Many
  vendor supplied versions exist, in addition to excellent open source
  implementations, e.g.  MPICH
  (http://www-unix.mcs.anl.gov/mpi/mpich/) or LAM
  (http://www.lam-mpi.org/).
- \b GSL - the GNU scientific library. This open-source package can be
  obtained at http://www.gnu.org/software/gsl, for example. GADGET
  only needs this library for a few very simple cosmological
  integrations at start-up.
- \b FFTW - the Fastest Fourier Transform in the West. This
  open-source package can be obtained at http://www.fftw.org,
  for example. It is only needed for simulations that use the TreePM algorithm.

Note that FFTW needs to be compiled with parallel support enabled.
This can be achieved by passing the option --enable-mpi to the
configure script. When at it, you might as well add
--enable-type-prefix to obtain the libraries in both a single
and double precision version. If this has not been done, you should
set the option \b NOTYPEPREFIX_FFTW in GADGET's \ref Gadget-Makefile
"Makefile".

Note that if any of the above libraries is not installed in standard
locations on your system, the \ref Gadget-Makefile "Makefile" provided
with the code may need slight adjustments. Similarly, compiler
options, particularly with respect to optimisations, may need
adjustment to the C-compiler that is used. Finally, the \ref
Gadget-Makefile "Makefile" contains a number of compile-time options
that need to be set appropriately for the type of simulation that is
simulated.

The provided makefile is compatible with GNU-make, i.e. typing \b make
or \b gmake should then build the executable P-Gadget2.  If your
site does not have GNU-make, get it, or write your own makefile.

\section howtorun Running the code

In order to start the code, a \ref parameterfile "parameterfile" needs
to be specified.

*/

/*! \page parameterfile  Parameterfile of GADGET-2

- \b ViscositySourceScaling \n Parameter for dynamic viscosity (e.g. 2.5)

- \b ViscosityDecayLength \n Parameter for dynamic viscosity (e.g. 2.0)

- \b ViscosityAlphaMin \n  Parameter for dynamic viscosity (e.g. 0.01)

- \b ViscosityAlphaMin \n  value for w of equation of state (e.g. -0.4)

- \b DarkEnergyFile \n  file containing z and w(z) (e.g. wz_0.83_RP.txt)

- \b VelIniScale \n  factor to rescale v_ini (e.g. 1.10)

*/

/*! \page Gadget-Makefile  Makefile of GADGET-2

There are a number of new types of simulations that can be run with
GADGET-2, most importantly some that use different variants of the
TreePM algorithm. A schematic overview of these simulation-types is
given in Table 1.

The TreePM algorithm is switched on by passing the desired PM
mesh-size at compile time via the makefile to the code. The relevant
parameter is \b PMGRID, see below. Using an explicit force split, the
long-range force is then computed with Fourier techniques, while the
short-range force is done with the tree. Because the tree needs only
be walked locally, a speed-up can arise, particularly for near to
homogeneous particle distributions, but not only restricted to
them. Periodic and non-periodic boundary conditions are
implemented. In the latter case, the code will internally compute FFTs
of size \b 2*PMGRID in order to allow for the required zero-padding.

Pure SPH simulations can also be run in periodic boxes whose
x-dimension is an integer multiple of the dimensions in the y- and
z-directions. This can be useful for hydrodynamic test calculations,
e.g. shock tubes in 3D.

Many aspects of these new features are controlled with compile-time
options in the makefile rather than by the parameterfile. This was
done in order to allow the generation of highly optimised binaries by
the compiler, even when the underlying source allows for many
different ways to run the code. Unfortunately, this technique has the
disadvantage that different simulations may require different binaries
of GADGET. If several simulations are run concurrently, there is
hence the danger that a simulation is started/resumed with the `wrong'
binary. Note that while GADGET checks the plausibility of some of
the most important code options, this is not done for all of them. To
minimise the risk of using the wrong code for a simulation, my
recommendation is therefore to produce a separate executable for each
simulation that is run. For example, a good strategy is to make a copy
of the whole code together with its makefile in the output directory
of each simulation run, and then to use this copy to compile the code
and to run the simulation.

The makefile contains a dummy list of all available compile-time code
options, with most of them commented out by default. To activate a
certain feature, the corresponding parameter should be commented in,
and given the desired value, where appropriate.  At the beginning of
the makefile, there is also a brief explanation of each of the
options.

Important Note:Whenever you change one of the makefile options
described below, a full recompilation of the code is necessary. To
guarantee that this is done, you should give the command make
clean, which will erase all object files, followed by make.

\section secmake1 Options that describe the physics of the simulation

- \b PERIODIC \n Set this if you want to have periodic boundary
   conditions.

- \b COOLING \n This enables radiative cooling and heating. It also
   enables an external UV background which is read from a file called
   TREECOOL.

- \b SFR \n This enables star formation using an effective multiphase
   models. This option requires cooling.

- \b METALS \n This activates the tracking of metal enrichment in gas
   and stars. Note that cooling by metal-lines is not yet included in
   the code.

- \b STELLARAGE \n This stores the formation times of each star
   particle, and includes this information in snapshot files.

- \b WINDS \n This activates galactic winds. Requires star formation.

- \b ISOTROPICWINDS \n This makes the wind isotropic. If not set, the
   wind is spawned in an axial way. Requires winds to be activated.

- \b NOGRAVITY \n This switches off gravity. Makes only sense for pure
   SPH simulations in non-expanding space.

- \b LONG_X/Y/Z \n These options can be used together with PERIODIC and
     NOGRAVITY only.  When set, the options define numerical factors that
     can be used to distorts the periodic simulation cube into a
     parallelepiped of arbitrary aspect ratio. This can be useful for
     idealized SPH tests.

- \b TWODIMS \n This effectively switches of one dimension in SPH,
     i.e. the code follows only 2d hydrodynamics in the xy-, yz-, or
     xz-plane. This only works with NOGRAVITY, and if all coordinates of
     the third axis are exactly equal. Can be useful for idealized SPH
     tests.

- \b SPH_BND_PARTICLES \n If this is set, particles with a particle-ID
     equal to zero do not receive any SPH acceleration. This can be useful
     for idealized SPH tests, where these particles represent fixed
     "walls".

\section secmake2 Options that affect SPH

- \b NOFIXEDMASSINKERNEL \n If set, the number of SPH particles in the
   kernel is kept constant instead of the mass contained in the
   kernel.

- \b NOGRADHSML \n If activated, an SPH equation of motion without
   \f$\nabla h\f$-correction factors is used.  Note, for the default
   `entropy'-formulation of SPH (Springel and Hernquist, 2002, MNRAS,
   333, 649), the switches NOFIXEDMASSINKERNEL and
   NOGRADHSML should not be set.

- \b NOVISCOSITYLIMITER \n If this is set, there is no explicit upper
   limit on the viscosity.  In the default version, this limiter will
   try to protect against possible particle `reflections', which may
   in principle occur for poor timestepping in the presence of strong
   shocks.

\section secmake3 Options for the numerical algorithms

- \b PMGRID=128 \n This enables the TreePM method, i.e. the long-range
   force is computed with a PM-algorithm, and the short range force
   with the tree. The parameter has to be set to the size of the mesh
   that should be used, e.g.~64, 96, 128, etc. The mesh dimensions
   need not necessarily be a power of two, but the FFT is fastest for
   such a choice.  Note: If the simulation is not in a periodic box,
   then a FFT method for vacuum boundaries is employed, using a mesh
   with dimension twice that specified by PMGRID.

- \b PLACEHIGHRESREGION=1+8 \n If this option is set (will only work
   together with \b PMGRID, then the long range force is computed in
   two stages: One Fourier-grid is used to cover the whole simulation
   volume, allowing the computation of the large-scale force.  A
   second Fourier mesh is placed on the region occupied by
   `high-resolution' particles, allowing the computation of an
   intermediate-scale force. Finally, the force on very small scales
   is computed by the tree. This procedure can be useful for
   `zoom-simulations', where the majority of particles (the high-res
   particles) are occupying only a small fraction of the volume. To
   activate this option, the parameter needs to be set to an integer
   that encodes the particle types that make up the high-res particles
   in the form of a bit mask. For example, if types 0, 1, and 4 are
   the high-res particles, then the parameter should be set to
   PLACEHIGHRESREGION=1+2+16, i.e. to the sum
   \f$2^0+2^1+2^4\f$. The spatial region covered by the high-res grid
   is determined automatically from the initial conditions. Note: If a
   periodic box is used, the high-res zone may not intersect the box
   boundaries.

- \b ENLARGEREGION=1.1 \n The spatial region covered by the high-res
   zone normally has a fixed size during the simulation, which
   initially is set to the smallest region that encompasses all
   high-res particles. Normally, the simulation will be interrupted,
   if high-res particles leave this region in the course of the
   run. However, by setting this parameter to a value larger than one,
   the high-res region can be expanded.  For example, setting it to
   1.4 will enlarge its side-length by 40% (it remains centred on the
   high-res particles). Hence, with such a setting, the high-res
   region may expand or move by a limited amount. If in addition \b
   SYNCHRONIZATION is activated, then the code will be able to
   continue even if high-res particles leave the initial high-res
   grid. In this case, the code will update the size and position of
   the grid that is placed onto the high-resolution region
   automatically. To prevent that this potentially happens every
   single PM step, one should nevertheless assign a value slightly
   larger than 1 to \b ENLARGEREGION.

- \b DOUBLEPRECISION \n This makes the code store and compute internal
   particle data in double precision. Note that output files are
   nevertheless written by converting the values that are saved to
   single precision.

- \b NOTREERND \n If this is not set, the tree construction will
   succeed even when there are a few particles at identical
   locations. This is done by `rerouting' particles once the node-size
   has fallen below \f$10^{-3}\f$ of the softening length. When this
   option is activated, this will be suppressed and the tree
   construction will always fail if there are particles at extremely
   close or identical coordinates.

- \b NOSTOP_WHEN_BELOW_MINTIMESTEP \n If this is
   activated, the code will not terminate when the timestep falls
   below the value of \b MinSizeTimestep specified in the
   parameterfile. This is useful for runs where one wants to enforce a
   constant timestep for all particles. This can be done by activating
   this option, and by setting \b MinSizeTimestep} and \b
   MaxSizeTimestep to an equal value.

- \b NOPMSTEPADJUSTMENT \n When this is set, the long-range timestep
   for the PM force computation is always determined by \b
   MaxSizeTimeStep.  Otherwise, it is set to the minimum of \b
   MaxSizeTimeStep and the timestep obtained for the maximum
   long-range force with an effective softening scale equal to the PM
   smoothing-scale.

\section secmake4 Architecture specific options

- \b T3E \n The code assumes that \b sizeof(int)=4 holds. A few
   machines (like Cray T3E) have \b sizeof(int)=8. In this case, set
   the T3E flag.

- \b NOTYPEPREFIX_FFTW \n If this is set, the fftw-header/libraries
   are accessed without type prefix (adopting whatever was chosen as
   default at compile-time of fftw). Otherwise, the type prefix 'd'
   for double-precision is used.

\section secmake5 Input options

- \b MOREPARAMS \n Activate this to allow a set of additional
   parameters in the parameterfile which control the star formation
   and feedback sector. This option must be activated when star
   formation is switched on.

\section secmake6 Output options

- \b OUTPUTPOTENTIAL \n This will force the code to compute
   gravitational potentials for all particles each time a snapshot
   file is generated. These values are then included in the snapshot
   files. Note that the computation of the values of the potential
   costs additional time.

- \b OUTPUTACCELERATION \n This will include the physical acceleration
   of each particle in snapshot files.

- \b OUTPUTCHANGEOFENTROPY \n This will include the rate of change of
   entropy of gas particles in snapshot files.

- \b OUTPUTTIMESTEP \n This will include the timesteps actually taken
   by each particle in the snapshot files.

\section secmake7 Miscellaneous options

- \b PEANOHILBERT \n This is a tuning option. When set, the code will
   bring the particles into Peano-Hilbert order after each domain
   decomposition. This improves cache utilisation and performance.

- \b WALLCLOCK \n If set, a wallclock timer is used by the code to
   measure internal time consumption (see cpu-log file).  Otherwise, a
   timer that measures consumed processor ticks is used.

- \b FORCETEST=0.01 \n This can be set to check the force accuracy of
   the code, and is only included as a debugging option. The option
   needs to be set to a number between 0 and 1 (e.g. 0.01), which
   specifies the fraction of randomly chosen particles for which at
   each timestep forces by direct summation are computed. The normal
   tree-forces and the `correct' direct summation forces are then
   collected in a file \b forcetest.txt for later inspection. Note
   that the simulation itself is unaffected by this option, but it
   will of course run much(!)  slower, particularly if
   FORCETEST*NumPart*NumPart \f$>>\f$ \b NumPart. Note: Particle IDs
   must be set to numbers \f$>=1\f$ for this option to work.

*/


/**
 * @file piecewise_regimes.c
 * @author Carl Boettiger <cboettig@gmail.com>
 * @date 17 May 2010
 *
 * @section LICENSE
 *
 * GPLv3
 *
 * @section DESCRIPTION
 *
 * Code for computing the likelihood of a multitype OU process on a phylogenetic tree
 *
 */

#include "likelihood.h"
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_errno.h>
#include "optimizers.h"
#include "mvn.h"

/**
* @brief Function which wraps general format used by siman and multimin
*        into the likelihood format of calc_lik
*
* @param v vector of values being optimized by the algorithm
* @param params specifies the tree and observed data
*
* @return minus log likelihood
*/
double optim_func (const gsl_vector *v, void *params)
{
  tree * mytree = (tree *) params;
  int i, n_regimes = mytree->n_regimes;
// Force root to match Theta of regime assigned to it, should also reduce vector size!
  mytree->Xo[0] = mytree->theta[mytree->regimes[0]];
 // mytree->Xo[0] = gsl_vector_get(v, 0);
  for(i = 0; i < n_regimes; i++){
    mytree->alpha[i] = v->data[i];
    mytree->theta[i] = v->data[n_regimes+i];
    mytree->sigma[i] = v->data[2*n_regimes+i];

    if( (mytree->alpha[i] < 0) | (mytree->sigma[i] < 0) ){ return GSL_POSINF; }
    if(  mytree->theta[i] < 0 ){ return GSL_POSINF; }
  }

  double llik = 0;
    calc_lik(mytree->Xo, mytree->alpha, mytree->theta, mytree->sigma,
         mytree->regimes, mytree->ancestor, mytree->branch_length,
             mytree->traits, &(mytree->n_nodes), mytree->lca_matrix, &llik);
    return -llik;
}

/** Fit the model by maximum likelihood, called by R */
void fit_model(double * Xo,
  double * alpha,
  double * theta,
  double * sigma,
  int * regimes,
  int * ancestor,
  double * branch_length,
  double * traits,
  int * n_nodes,
  int * n_regimes,
  double * llik,
  int * use_siman)
{

//  Perhaps don't want to see gsl_errors once we're handling in R?
//  Still want better/smarter behavior of the optimizer
  gsl_set_error_handler_off ();

    /** First, initialize the tree structure to facilitate passing all these elements */
  int i,j;
  tree * mytree = (tree  *) malloc(sizeof(tree));
  mytree->Xo = Xo;
  mytree->alpha = alpha;
  mytree->theta = theta;
  mytree->sigma = sigma;
  mytree->regimes = regimes;
  mytree->ancestor = ancestor;
  mytree->branch_length = branch_length;
  mytree->traits = traits;
  mytree->n_nodes = *n_nodes;
  mytree->n_regimes = *n_regimes;

    /** Second, save time by storing the least common ancestor matrix */
  /* Save time by calculating least common ancestor ahead of time.
   * Though this does the calc for all nodes, only tip ones are used.
   * Current get_lca algorithm is only designed for tips anyway.  */
  double sep; // separation time, not actually used
  mytree->lca_matrix = (int *) malloc(gsl_pow_2(*n_nodes) * sizeof(int) );
  for(i=0; i < *n_nodes; i++){
    for(j=0; j < *n_nodes; j++){
      mytree->lca_matrix[*n_nodes*i+j] = get_lca(i,j, *n_nodes, ancestor, branch_length, &sep);
    }
  }

    /** Then initialize the vector of parameters to be searched */
  gsl_vector *x = gsl_vector_alloc(3 * *n_regimes);
//  gsl_vector_set(x, 0, *Xo);  /* Forces Xo to match theta (?) */
  for(i = 0; i < *n_regimes; i++){
    gsl_vector_set(x, i, alpha[i]);
    gsl_vector_set(x, *n_regimes+i, theta[i]);
    gsl_vector_set(x, 2 * *n_regimes+i, mytree->sigma[i]);
  }

    /** Select and call a likelihood optimization routine
     *  given the tree (with data) and parameters */
  gsl_rng * rng = gsl_rng_alloc(gsl_rng_default);
  if(*use_siman)
    *llik = siman(x, mytree, rng);
  else
    *llik = multimin(x, mytree);

  gsl_rng_free(rng);
  gsl_vector_free(x);
  free(mytree->lca_matrix);
  free(mytree);
}

/* Externally exported function to determine LCA matrix */
/**
* @brief Determine the last common ancestor matrix of the tips,
* used in the likelihood calculation
*
* @param ancestor ancestor of the specified nide
* @param branch_length double branch lengths below each of the nodes
* @param n_nodes: integer number of nodes (including tips) in the tree
* @param lca_matrix must be an integer array of size n_nodes^2
*/
void calc_lca(int * ancestor, double * branch_length,
              int * n_nodes, int * lca_matrix)
{
  int i,j;
  /* Save time by calculating least common ancestor ahead of time.
   * Though this does the calc for all nodes, only tip ones are used.
   * Current get_lca algorithm is only designed for tips anyway.  */
  double sep; // separation time, not actually used
  for(i=0; i < *n_nodes; i++){
    for(j=0; j < *n_nodes; j++){
      lca_matrix[*n_nodes*i+j] = get_lca(i,j, *n_nodes, ancestor,
                                               branch_length, &sep);
    }
  }

}

/** Simulate under the model.  Called by R */
void simulate_model (double * Xo, double * alpha, double * theta,
                     double * sigma, int * regimes, int * ancestor,
                     double * branch_length, double * traits, int * n_nodes,
                     int * n_regimes, double * llik, double * seed)
{

  /* Turn off likelihood calcuation on the simulated data for speed */
  int return_likelihood = 0; // consider making an option at the .C level

  int i,j;
  tree * mytree = (tree  *) malloc(sizeof(tree));
  mytree->Xo = Xo;
  mytree->alpha = alpha;
  mytree->theta = theta;
  mytree->sigma = sigma;
  mytree->regimes = regimes;
  mytree->ancestor = ancestor;
  mytree->branch_length = branch_length;
  mytree->traits = traits;
  mytree->n_nodes = *n_nodes;
  mytree->n_regimes = *n_regimes;

  /* Save time by calculating least common ancestor ahead of time. */
  double sep; // separation time, not actually used
  mytree->lca_matrix = (int *) malloc(gsl_pow_2(*n_nodes) * sizeof(int) );
  for(i=0; i < *n_nodes; i++){
    for(j=0; j < *n_nodes; j++){
      mytree->lca_matrix[*n_nodes*i+j] =
                get_lca(i,j, *n_nodes, ancestor, branch_length, &sep);
    }
  }

    /* Allocate the parameter vector */
  gsl_vector *x = gsl_vector_alloc(1 + 3 * *n_regimes);
  gsl_vector_set(x, 0, *Xo);
  for(i = 0; i < *n_regimes; i++){
    gsl_vector_set(x, 1+i, alpha[i]);
    gsl_vector_set(x, 1+*n_regimes+i, theta[i]);
    gsl_vector_set(x, 1+2 * *n_regimes+i, mytree->sigma[i]);
  }

  gsl_rng * rng = gsl_rng_alloc(gsl_rng_default);
  gsl_rng_set(rng, *seed);

   /* These are the only lines that differ from the fit_models wrapper */
  simulate (rng, mytree);

  if(return_likelihood){
    calc_lik(mytree->Xo, mytree->alpha, mytree->theta, mytree->sigma,
             mytree->regimes, mytree->ancestor, mytree->branch_length,
                   mytree->traits, &(mytree->n_nodes), mytree->lca_matrix, llik);
  }

//  for(i=0; i< mytree->n_regimes; i++) printf("%g %g %g\n", mytree->alpha[i], mytree->theta[i], mytree->sigma[i] );
//  printf("sim llik: %g\n", *llik);

  gsl_rng_free(rng);
  gsl_vector_free(x);
  free(mytree->lca_matrix);
  free(mytree);
}

/** Test code by running in pure C */
int main(void)
{
  /** Define the tree and the trait data (Anoles tree from "ouch" R package) */
  int n_nodes = 45;

  double branch_length[] = { 0.0, 12./38, 20./38,  2./38,  2./38,  4./38,
               8./38,  5./38,  5./38,  5./38,  5./38, 10./38,
               9./38,  4./38,  8./38,  2./38, 20./38,  2./38,
               4./38,  2./38, 1./38,  2./38, 26./38, 4./38,
               2./38, 2./38,  2./38,  2./38, 15./38, 10./38,
               10./38, 10./38, 10./38, 16./38, 12./38,  4./38,
               2./38,  2./38, 10./38,  8./38,  2./38,  1./38,
               1./38,  2./38,  2./38};

/* Almost a star tree */
/*  double branch_length[] = { 0.000, .001, .001,  .001,  .001,
			     0.001, .001, .001,  .001,  .001,
			     0.001, .001, .001,  .001,  .001,
			     0.001, .001, .001,  .001,  .001,
			     0.001, .001, .999,  .999,  .999,
			     0.999, .999, .999,  .999,  .999,
			     0.999, .999, .999,  .999,  .999,
			     0.999, .999, .999,  .999,  .999,
			     0.999, .999, .999,  .999,  .999 };
*/

  int ancestor[] = {-1,  0,  1,  2,  3,  2,  0,  6,  7,  8,  9,
                     8,  7, 12, 13,14,  6, 16, 17, 18, 19, 18, 1,
                     3,  4,  4,  5,  5,  9, 10, 10, 11, 11, 12,
                    13, 14, 15, 15, 16, 17, 19, 20, 20, 21, 21};

  double traits[] = {0.000000, 0.000000, 0.000000, 0.000000, 0.000000,
                     0.000000, 0.000000, 0.000000, 0.000000, 0.000000,
                     0.000000, 0.000000, 0.000000, 0.000000, 0.000000,
                     0.000000, 0.000000, 0.000000, 0.000000, 0.000000,
                     0.000000, 0.000000, 2.602690, 2.660260, 2.660260,
                     2.653242, 2.674149, 2.701361, 7.161247, 13.299534,
                     3.328627, 3.353407, 3.360375, 3.049273, 2.906901,
                     2.980619, 2.933857, 3.975530, -3.104587, 3.346389,
                     12.928524, -12.939162, 7.990720, 8.058707, -5.068053};

/*
  int regimes[] =  {1, 1, 2, 2, 2,
                    2, 1, 1, 0, 0,
                    0, 0, 1, 1, 1,
                    1, 1, 1, 1, 1,
                    1, 1, 2, 2, 2,
                    2, 2, 2, 0, 0,
                    0, 0, 0, 1, 1,
                    1, 1, 0, 1, 1,
                    1, 1, 1, 1, 1};
*/

  int regimes[] =   {0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0,
                    0, 0, 0, 0, 0};

  double Xo = 3;

  double alpha[3] = {2.6, 2.6, 2.6};
  double theta[3] = {3., 3.,3};
  double sigma[3] = {0.2, 0.2, 0.2 };
  int n_regimes = 3;

  double llik = 0;

  /* Initialize the lca matrix */
  int * lca = (int *) calloc(n_nodes*n_nodes, sizeof(int));

  /* test the pure likelihood function first */
  calc_lca(ancestor, branch_length, &n_nodes, lca);

  calc_lik(&Xo, alpha, theta, sigma, regimes, ancestor,
           branch_length, traits, &n_nodes, lca, &llik);
  printf("log likelihood: %g\n", llik);

  /* We'll use the faster Nelder-Mead algorithm for the check */
  int use_siman = 0;
  /* Test the fitting routine */

  fit_model(&Xo, alpha, theta, sigma, regimes, ancestor, branch_length,
            traits, &n_nodes, &n_regimes, &llik, &use_siman);
  printf("Xo = %g\n", Xo);
  printf("alphas: %g %g %g\n", alpha[0], alpha[1], alpha[2]);
  printf("thetas: %g %g %g\n", theta[0], theta[1], theta[2]);
  printf("sigmas: %g %g %g\n", sigma[0], sigma[1], sigma[2]);
  printf("log likelihood: %g\n", llik);

  /* Test the simulation code */
/*
  double seed = 1.0;
  printf("seed: %lo\n", (unsigned long int) seed);
  simulate_model(&Xo, alpha, theta, sigma, regimes, ancestor, branch_length,
                 traits, &n_nodes, &n_regimes, &llik, &seed);
  int i;
  printf("simulated traits:\n");
  for(i=0; i < 45; i++)
    printf("%g ", traits[i]);
  printf("\n");
*/

  free(lca);
  return 0;
}


/* Copyright (c) 2016 PaddlePaddle Authors. All Rights Reserve.

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License. */

#ifndef MATHFUNCTIONS_H_
#define MATHFUNCTIONS_H_

#ifdef PADDLE_USE_MKL
#include <mkl.h>
#include <mkl_lapacke.h>
#else
extern "C" {
#include <cblas.h>
}
#ifdef PADDLE_USE_ATLAS
extern "C" {
#include <clapack.h>
}
#else
#include <lapacke.h>
#endif
#endif

#include <cmath>

namespace paddle {

template <class T>
void gemm(const CBLAS_TRANSPOSE transA,
          const CBLAS_TRANSPOSE transB,
          const int M,
          const int N,
          const int K,
          const T alpha,
          const T* A,
          const int lda,
          const T* B,
          const int ldb,
          const T beta,
          T* C,
          const int ldc);

template <class T>
int getrf(const CBLAS_ORDER Order,
          const int M,
          const int N,
          T* A,
          const int lda,
          int* ipiv);

template <class T>
int getri(
    const CBLAS_ORDER Order, const int N, T* A, const int lda, const int* ipiv);

template <class T>
void axpy(const int n, const T alpha, const T* x, T* y);

template <class T>
T dotProduct(const int n, const T* x, const T* y);

template <class T>
void vExp(const int n, const T* a, T* r);

template <class T>
void vPow(const int n, const T* a, const T b, T* r);

template <class T>
void vLog(const int n, const T* a, T* r);

template <class T>
void vAdd(const int n, const T* a, const T* b, T* r);

template <class T>
void vInvSqrt(const int n, const T* a, T* r);

template <class T>
void vLog1p(const int n, const T* a, T* r);

template <class T>
void vTanh(const int n, const T* a, T* r);

}  // namespace paddle

#endif  // MATHFUNCTIONS_H_


// Test driver for the pyramid class.

#include <math.h>
#include <stdlib.h>

#include <glib.h>
#include <gsl/gsl_math.h>

#include <asf_meta.h>
#include <float_image.h>

#include "meta_read_wrapper.h"
#include "pyramid.h"

// Base name of .img/.meta pair we will use for testing.
//#define TEST_IMG_BASENAME "E116306133G1S009"
#define TEST_IMG_BASENAME "E116306133G1S009_subimage"

// Directory to use as a scratch directory for pyramid layers.
#define SCRATCH_DIR "/tmp/"

// When we make JPEG images we give this mask value to the routine
// which does it.  This make should have any effect for the image we
// are using.
#define TEST_IMG_BOGUS_MASK_VALUE -999999.9

int
main (void)
{
  g_print ("This test may take a few moments...\n");

  GString *meta_name = g_string_new (TEST_IMG_BASENAME);
  g_string_append (meta_name, ".meta");

  GString *data_name = g_string_new (TEST_IMG_BASENAME);
  g_string_append (data_name, ".img");

  meta_parameters *md = meta_read_wrapper (meta_name->str);

  g_string_free (meta_name, TRUE);

  ssize_t tisx = md->general->sample_count;
  ssize_t tisy = md->general->line_count;

  FloatImage *tiafi
    = float_image_new_from_file (tisx, tisy, data_name->str, 0,
				 FLOAT_IMAGE_BYTE_ORDER_BIG_ENDIAN);

  g_string_free (data_name, TRUE);

  float_image_export_as_jpeg (tiafi, "test_pyramid_base_layer_direct.jpg",
			      GSL_MAX (tisx, tisy), TEST_IMG_BOGUS_MASK_VALUE);

  meta_free (md);

  Pyramid *p = pyramid_new (TEST_IMG_BASENAME, SCRATCH_DIR);

  // "Testing" currently consists of creating jpeg images of each
  // layer and checking to see if they look decent.

  size_t ii;
  for ( ii = 0 ; ii < p->layers->len ; ii++ ) {

    pyramid_layer *cl = g_ptr_array_index (p->layers, ii);

    float *region;
    size_t rstart_x, rstart_y, rw, rh;
    gboolean unowned_memory;

    pyramid_get_region (p, 0, 0, tisx, tisy, pow (2, ii), &region, &rstart_x,
			&rstart_y, &rw, &rh, &unowned_memory);
    g_assert (rstart_x == 0 & rstart_y == 0);
    g_assert (rstart_x + rw * pow (2.0, ii) >= tisx);
    g_assert (rstart_y + rh * pow (2.0, ii) >= tisy);

    FloatImage *layer_image = float_image_new_from_memory (rw, rh, region);

    if ( unowned_memory ) {
      g_free (region);
    }

    GString *layer_file_name = g_string_new ("");
    g_string_append_printf (layer_file_name, "layer_%d.jpg", ii);

    ssize_t max_dimension = rw > rh ? rw : rh;

    int return_code
      = float_image_export_as_jpeg (layer_image, layer_file_name->str,
				    max_dimension, TEST_IMG_BOGUS_MASK_VALUE);
    g_assert (return_code == 0);

    float_image_unref (layer_image);

    g_string_free (layer_file_name, TRUE);
  }

  g_print ("JPEG images of pyramid layers formed, now look at them and\n"
	   "'touch test_pyramid_stamp' if they are ok.\n");

  exit (EXIT_SUCCESS);
}


/*
 * Copyright (c) 2010-2018 The University of Tennessee and The University
 *                         of Tennessee Research Foundation.  All rights
 *                         reserved.
 *
 * @precisions normal z -> s d c
 *
 */

#include <math.h>
#include <stdlib.h>
#include <core_blas.h>
#include <cblas.h>
#include "dplasma.h"
#include "dplasmatypes.h"
#include "dplasma/lib/dplasmaaux.h"
#include "parsec/private_mempool.h"

#include "dplasma/lib/zhetrf.h"
#include "dplasma/lib/ztrmdm.h"

/*
 * dplasma_zhetrf_New()
 */
parsec_taskpool_t*
dplasma_zhetrf_New( parsec_tiled_matrix_dc_t *A, int *INFO)
{
    int ldwork, lwork, ib;
    parsec_taskpool_t *parsec_zhetrf = NULL;
    parsec_memory_pool_t *pool_0, *pool_1;

    ib = A->mb;

    /* ldwork and lwork are necessary for the macros zhetrf_pool_0_SIZE and zhetrf_pool_1_SIZE */
    ldwork = (A->nb+1)*ib;
    lwork = (A->mb+1)*A->nb + ib*ib;

    pool_0 = (parsec_memory_pool_t*)malloc(sizeof(parsec_memory_pool_t));
    parsec_private_memory_init( pool_0, zhetrf_pool_0_SIZE );

    pool_1 = (parsec_memory_pool_t*)malloc(sizeof(parsec_memory_pool_t));
    parsec_private_memory_init( pool_1, zhetrf_pool_1_SIZE );

    parsec_zhetrf = (parsec_taskpool_t *)parsec_zhetrf_new(PlasmaLower, A, (parsec_data_collection_t *)A, ib, pool_1, pool_0, INFO);

    dplasma_add2arena_tile(((parsec_zhetrf_taskpool_t*)parsec_zhetrf)->arenas[PARSEC_zhetrf_DEFAULT_ARENA],
                           A->mb*A->nb*sizeof(parsec_complex64_t),
                           PARSEC_ARENA_ALIGNMENT_SSE,
                           parsec_datatype_double_complex_t, A->mb);

    return parsec_zhetrf;
}

void
dplasma_zhetrf_Destruct( parsec_taskpool_t *tp )
{
    parsec_zhetrf_taskpool_t *obut = (parsec_zhetrf_taskpool_t *)tp;

    parsec_matrix_del2arena( obut->arenas[PARSEC_zhetrf_DEFAULT_ARENA] );

    parsec_taskpool_free(tp);
}

/*
 * dplasma_ztrmdm_New()
 */
parsec_taskpool_t*
dplasma_ztrmdm_New( parsec_tiled_matrix_dc_t *A)
{
    parsec_taskpool_t *parsec_ztrmdm = NULL;

    parsec_ztrmdm = (parsec_taskpool_t *)parsec_ztrmdm_new(A);

    dplasma_add2arena_tile(((parsec_ztrmdm_taskpool_t*)parsec_ztrmdm)->arenas[PARSEC_ztrmdm_DEFAULT_ARENA],
                           A->mb*A->nb*sizeof(parsec_complex64_t),
                           PARSEC_ARENA_ALIGNMENT_SSE,
                           parsec_datatype_double_complex_t, A->mb);

    return parsec_ztrmdm;
}

void
dplasma_ztrmdm_Destruct( parsec_taskpool_t *tp )
{
    parsec_ztrmdm_taskpool_t *obut = (parsec_ztrmdm_taskpool_t *)tp;

    parsec_matrix_del2arena( obut->arenas[PARSEC_ztrmdm_DEFAULT_ARENA] );

    parsec_taskpool_free(tp);
}

/*
 * Blocking Interface
 */

int dplasma_zhetrf(parsec_context_t *parsec, parsec_tiled_matrix_dc_t *A)
{
    parsec_taskpool_t *parsec_zhetrf/*, *parsec_ztrmdm*/;
    int info = 0, ginfo = 0;

    parsec_zhetrf = dplasma_zhetrf_New(A, &info);
    parsec_context_add_taskpool(parsec, (parsec_taskpool_t *)parsec_zhetrf);
    dplasma_wait_until_completion(parsec);
    dplasma_zhetrf_Destruct(parsec_zhetrf);

    /*
    parsec_ztrmdm = dplasma_ztrmdm_New(A);
    parsec_context_add_taskpool(parsec, (parsec_taskpool_t *)parsec_ztrmdm);
    dplasma_wait_until_completion(parsec);
    dplasma_ztrmdm_Destruct(parsec_ztrmdm);
    */

    /* This covers both cases when we have not compiled with MPI, or we don't need to do the reduce */
    ginfo = info;
#if defined(PARSEC_HAVE_MPI)
    /* If we don't need to reduce, don't do it, this way we don't require MPI to be initialized */
    if( A->super.nodes > 1 )
        MPI_Allreduce( &info, &ginfo, 1, MPI_INT, MPI_MAX, *(MPI_Comm*)dplasma_pcomm);
#endif
    return ginfo;
}


// Standard libraries.
#include <math.h>
#include <signal.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

// Libraries from packages outside ASF.
#include <glib.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_statistics_double.h>

// Libraries developed at ASF.
#include <asf.h>
#include <asf_meta.h>
#include <asf_raster.h>
#include "float_image.h"
#include "uint8_image.h"
#include <libasf_proj.h>
#include <spheroids.h>
#include <asf_contact.h>

void usage()
{
    printf("Usage: flip [v|h|vh] <input basename> <output basename>\n");
    exit(1);
}

int main(int argc, char *argv[])
{
  handle_common_asf_args(&argc, &argv, "flip");

  if (argc != 4) {
    usage();
  }

  if ( ! (strcmp(argv[1], "v") == 0 ||
	  strcmp(argv[1], "h") == 0 ||
	  strcmp(argv[1], "hv") == 0 ||
	  strcmp(argv[1], "vh") == 0))
  {
    usage();
  }

  int vert = strchr(argv[1], 'v') != NULL;
  int horz = strchr(argv[1], 'h') != NULL;

  if (!vert && !horz) {
    usage();
  }

  char *input_meta_name = appendExt(argv[2], ".meta");
  char *input_data_name = appendExt(argv[2], ".img");

  char *output_meta_name = appendExt(argv[3], ".meta");
  char *output_data_name = appendExt(argv[3], ".img");

  printf("Flipping image %s.\n",
	 vert && horz ? "vertically and horizontally" :
	 (vert ? "vertically" : "horizontally"));

  printf("Input data file: %s\n", input_data_name);
  printf("Output data file: %s\n", output_data_name);

  meta_parameters *imd = meta_read(input_meta_name);
  meta_write(imd, output_meta_name);

  FloatImage *finput = NULL;
  UInt8Image *binput = NULL;
  if (imd->optical || imd->general->data_type == BYTE) {
    binput = uint8_image_new_from_file(imd->general->sample_count,
                                       imd->general->line_count,
                                       input_data_name, 0);
  }
  else {
    finput = float_image_new_from_file(imd->general->sample_count,
                                       imd->general->line_count,
                                       input_data_name, 0,
                                       FLOAT_IMAGE_BYTE_ORDER_BIG_ENDIAN);
  }

  if (imd->optical || imd->general->data_type == BYTE) {
    if (horz)
      uint8_image_flip_x(binput);

    if (vert)
      uint8_image_flip_y(binput);

    uint8_image_store(binput, output_data_name);
    uint8_image_free(binput);
  }
  else {
    if (horz)
      float_image_flip_x(finput);

    if (vert)
      float_image_flip_y(finput);

    float_image_store(finput, output_data_name,
                      FLOAT_IMAGE_BYTE_ORDER_BIG_ENDIAN);
    float_image_free(finput);
  }

  meta_free(imd);

  free(input_data_name);
  free(input_meta_name);
  free(output_data_name);
  free(output_meta_name);

  return EXIT_SUCCESS;
}


/**
 *
 * @file qwrapper_zlanhe.c
 *
 *  PLASMA core_blas quark wrapper
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Julien Langou
 * @author Henricus Bouwmeester
 * @author Mathieu Faverge
 * @date 2010-11-15
 * @precisions normal z -> c
 *
 **/
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 **/
void QUARK_CORE_zlanhe(Quark *quark, Quark_Task_Flags *task_flags,
                       int norm, PLASMA_enum uplo, int N,
                       const PLASMA_Complex64_t *A, int LDA, int szeA,
                       int szeW, double *result)
{
    szeW = max(1, szeW);
    DAG_CORE_LANHE;
    QUARK_Insert_Task(quark, CORE_zlanhe_quark, task_flags,
        sizeof(PLASMA_enum),                &norm,  VALUE,
        sizeof(PLASMA_enum),                &uplo,  VALUE,
        sizeof(int),                        &N,     VALUE,
        sizeof(PLASMA_Complex64_t)*szeA,     A,             INPUT,
        sizeof(int),                        &LDA,   VALUE,
        sizeof(double)*szeW,                 NULL,          SCRATCH,
        sizeof(double),                     result,         OUTPUT,
        0);
}

/***************************************************************************//**
 *
 **/
void QUARK_CORE_zlanhe_f1(Quark *quark, Quark_Task_Flags *task_flags,
                          PLASMA_enum norm, PLASMA_enum uplo, int N,
                          const PLASMA_Complex64_t *A, int LDA, int szeA,
                          int szeW, double *result,
                          double *fake, int szeF)
{
    szeW = max(1, szeW);
    DAG_CORE_LANHE;

    if ( result == fake ) {
        QUARK_Insert_Task(quark, CORE_zlanhe_quark, task_flags,
            sizeof(PLASMA_enum),                &norm,  VALUE,
            sizeof(PLASMA_enum),                &uplo,  VALUE,
            sizeof(int),                        &N,     VALUE,
            sizeof(PLASMA_Complex64_t)*szeA,     A,             INPUT,
            sizeof(int),                        &LDA,   VALUE,
            sizeof(double)*szeW,                 NULL,          SCRATCH,
            sizeof(double)*szeF,                 result,        OUTPUT | GATHERV,
            0);
    } else {
        QUARK_Insert_Task(quark, CORE_zlanhe_f1_quark, task_flags,
            sizeof(PLASMA_enum),                &norm, VALUE,
            sizeof(PLASMA_enum),                &uplo, VALUE,
            sizeof(int),                        &N,    VALUE,
            sizeof(PLASMA_Complex64_t)*szeA,     A,             INPUT,
            sizeof(int),                        &LDA,  VALUE,
            sizeof(double)*szeW,                 NULL,          SCRATCH,
            sizeof(double),                      result,        OUTPUT,
            sizeof(double)*szeF,                 fake,          OUTPUT | GATHERV,
            0);
    }
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlanhe_quark = PCORE_zlanhe_quark
#define CORE_zlanhe_quark PCORE_zlanhe_quark
#endif
void CORE_zlanhe_quark(Quark *quark)
{
    double *normA;
    int norm;
    PLASMA_enum uplo;
    int N;
    PLASMA_Complex64_t *A;
    int LDA;
    double *work;

    quark_unpack_args_7(quark, norm, uplo, N, A, LDA, work, normA);
    *normA = LAPACKE_zlanhe_work(
        LAPACK_COL_MAJOR,
        lapack_const(norm), lapack_const(uplo),
        N, A, LDA, work);
}

/***************************************************************************//**
 *
 **/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_zlanhe_f1_quark = PCORE_zlanhe_f1_quark
#define CORE_zlanhe_f1_quark PCORE_zlanhe_f1_quark
#endif
void CORE_zlanhe_f1_quark(Quark *quark)
{
    double *normA;
    int norm;
    PLASMA_enum uplo;
    int N;
    PLASMA_Complex64_t *A;
    int LDA;
    double *work;
    double *fake;

    quark_unpack_args_8(quark, norm, uplo, N, A, LDA, work, normA, fake);
    *normA = LAPACKE_zlanhe_work(
        LAPACK_COL_MAJOR,
        lapack_const(norm), lapack_const(uplo),
        N, A, LDA, work);
}


//////////////////////////////////////////////////////////////////////////////////////
// This file is distributed under the University of Illinois/NCSA Open Source License.
// See LICENSE file in top directory for details.
//
// Copyright (c) 2016 Jeongnim Kim and QMCPACK developers.
//
// File developed by: Paul R. C. Kent, kentpr@ornl.gov, Oak Ridge National Laboratory
//                    Mark A. Berrill, berrillma@ornl.gov, Oak Ridge National Laboratory
//
// File created by: Paul R. C. Kent, kentpr@ornl.gov, Oak Ridge National Laboratory
//////////////////////////////////////////////////////////////////////////////////////

//           http://pathintegrals.info                     //
/////////////////////////////////////////////////////////////

#ifndef VECTOR_OPS_H
#define VECTOR_OPS_H

// extern "C"{
// #ifdef USE_MKL
//   #include <mkl_cblas.h>
// #else
//   #include <cblas.h>
// #endif
// }
#include "Blitz.h"
#include "../config.h"

typedef TinyVector<int, 3> Int3;
typedef Array<std::complex<double>, 1> zVec;
typedef Array<cVec3, 1> zVecVec;
typedef Array<cMat3, 1> zMatVec;

#ifdef USE_CBLAS
extern "C"
{
#ifdef USE_MKL_CBLAS
#include <mkl_cblas.h>
#else
#include <cblas.h>
#endif
}
#else

#define F77_DZNRM2 F77_FUNC(dznrm2, DZNRM2)
#define F77_ZDSCAL F77_FUNC(zdscal, ZDSCAL)
#define F77_ZDOTC F77_FUNC(zdotc, ZDOTC)
#define F77_ZGEMV F77_FUNC(zgemv, ZGEMV)
#define F77_ZAXPY F77_FUNC(zaxpy, ZAXPY)

extern "C" double F77_DZNRM2(const int* N, const void* X, const int* INC);
extern "C" void F77_ZDSCAL(const int* N, double* ALPHA, const void* X, const int* INC);
// extern "C" void F77_ZDOTC (std::complex<double> *z, const int *N,
// 			   const void *X, const int *INCX,
// 			   const void *Y, const int *INCY);
extern "C" std::complex<double> F77_ZDOTC(const int* N, const void* X, const int* INCX, const void* Y, const int* INCY);
extern "C" void F77_ZGEMV(char* TRANS,
                          const int* M,
                          const int* N,
                          std::complex<double>* alpha,
                          const void* A,
                          const int* LDA,
                          const void* X,
                          const int* INCX,
                          std::complex<double>* beta,
                          const void* Y,
                          const int* INCY);

extern "C" void F77_ZAXPY(const int* N, std::complex<double>* ALPHA, void* X, int* INCX, void* Y, int* INCY);
#endif

#ifdef USE_CBLAS
inline void Normalize(zVec& c)
{
  double norm = cblas_dznrm2(c.size(), c.data(), 1);
  norm        = 1.0 / norm;
  cblas_zdscal(c.size(), norm, c.data(), 1);
}

inline double norm(const zVec& c) { return cblas_dznrm2(c.size(), c.data(), 1); }

inline std::complex<double> conjdot(zVec& cA, zVec& cB)
{
  std::complex<double> z;
  cblas_zdotc_sub(cA.size(), cA.data(), 1, cB.data(), 1, &z);
  return z;
}

inline void Orthogonalize(const Array<std::complex<double>, 2>& A, zVec& x)
{
  int m = A.rows();
  int n = A.cols();
  assert(n == x.size());
  std::complex<double> zero(0.0, 0.0);
  std::complex<double> one(1.0, 0.0);
  std::complex<double> minusone(-1.0, 0.0);
  Array<std::complex<double>, 1> S(m);

  cblas_zgemv(CblasColMajor, CblasConjTrans, n, m, &one, A.data(), n, x.data(), 1, &zero, S.data(), 1);
  cblas_zgemv(CblasRowMajor, CblasTrans, m, n, &minusone, A.data(), n, S.data(), 1, &one, x.data(), 1);
}

#else

inline void Normalize(zVec& c)
{
  const int inc = 1;
  int n         = c.size();
  double norm   = F77_DZNRM2(&n, c.data(), &inc);
  norm          = 1.0 / norm;
  F77_ZDSCAL(&n, &norm, c.data(), &inc);
}

inline double norm(const zVec& c)
{
  double norm;
  int n         = c.size();
  const int inc = 1;
  return F77_DZNRM2(&n, c.data(), &inc);
}

inline std::complex<double> conjdot(zVec& cA, zVec& cB)
{
  const int n    = cA.size();
  const int incA = 1;
  const int incB = 1;
  return F77_ZDOTC(&n, cA.data(), &incA, cB.data(), &incB);

  //   std::complex<double> z;
  //   F77_ZDOTC (&z, &n, cA.data(), &incA, cB.data(), &incB);
  //   return z;
}

inline void Orthogonalize(const Array<std::complex<double>, 2>& A, zVec& x)
{
  int m = A.rows();
  int n = A.cols();
  assert(n == x.size());
  std::complex<double> zero(0.0, 0.0);
  std::complex<double> one(1.0, 0.0);
  std::complex<double> minusone(-1.0, 0.0);
  Array<std::complex<double>, 1> S(m);

  // Calculate overlaps
  // Calling with column major and ConjTrans is equivalent to
  // conjugate of untransposed row major
  char trans    = 'C';
  const int inc = 1;

  F77_ZGEMV(&trans, &n, &m, &one, A.data(), &n, x.data(), &inc, &zero, S.data(), &inc);

  //   cblas_zgemv(CblasColMajor, CblasConjTrans, n, m, &one,
  // 	      A.data(), n, x.data(), 1, &zero, S.data(), 1);

  //   for (int i=0; i<m; i++) {
  //     fprintf (stderr, "S[%d] = %18.14f + %18.14fi\n",
  // 	     real(S[i]), imag(S[i]));

  // Now, subtract off components * overlaps
  trans = 'T';
  F77_ZGEMV(&trans, &m, &n, &minusone, A.data(), &n, S.data(), &inc, &one, x.data(), &inc);
  //   cblas_zgemv(CblasRowMajor, CblasTrans, m, n, &minusone,
  //  	      A.data(), n, S.data(), 1, &one, x.data(), 1);
}

#endif

inline double realconjdot(zVec& cA, zVec& cB) { return conjdot(cA, cB).real(); }

inline double mag(std::complex<double> x) { return (x.real() * x.real() + x.imag() * x.imag()); }

inline void Orthogonalize2(Array<std::complex<double>, 2>& A, zVec& x, int lastBand)
{
  int m = A.rows();
  int n = A.cols();
  assert(n == x.size());
  zVec Ar;
  Array<std::complex<double>, 1> S(m);

  for (int row = 0; row <= lastBand; row++)
  {
    Ar.reference(A(row, Range::all()));
    S(row) = conjdot(Ar, x);
  }
  for (int row = 0; row <= lastBand; row++)
    x -= S(row) * A(row, Range::all());
  //   for (int row=0; row<=lastBand; row++) {
  //     Ar.reference (A(row,Range::all()));
  //     S(row) = conjdot (Ar, x);
  //     if (mag(S(row)) > 1.0e-14) {
  //       std::cerr << "row = " << row << " lastband = " << lastBand << std::endl;
  //       std::cerr << "Error in Orthogonalize2!, s = " << S(row) << std::endl;
  //       double norm = realconjdot (Ar, Ar);
  //       std::cerr << "norm = " << norm << std::endl;
  //     }
  //   }
}

inline void OrthogExcluding(const Array<std::complex<double>, 2>& A, zVec& x, int excluding)
{
  int m = A.rows();
  int n = A.cols();
  assert(n == x.size());
  zVec Ar;

#ifndef __INTEL_COMPILER
  std::complex<double> S[m];
  for (int row = 0; row < m; row++)
  {
    Ar.reference(A(row, Range::all()));
    S[row] = conjdot(Ar, x);
  }
  for (int row = 0; row < m; row++)
    if (row != excluding)
      x -= S[row] * A(row, Range::all());
#else

  double Sre[m], Sim[m];

  for (int row = 0; row < m; row++)
  {
    Ar.reference(A(row, Range::all()));
    std::complex<double> S = conjdot(Ar, x);
    Sre[row]               = real(S);
    Sim[row]               = imag(S);
  }
  for (int row = 0; row < m; row++)
    if (row != excluding)
      x -= std::complex<double>(Sre[row], Sim[row]) * A(row, Range::all());
#endif
}

inline void OrthogLower(const Array<std::complex<double>, 2>& A, zVec& x, int currBand)
{
  int m = currBand;
  int n = A.cols();
  assert(n == x.size());
  zVec Ar;
  std::complex<double> S;

  for (int row = 0; row < m; row++)
  {
    Ar.reference(A(row, Range::all()));
    S = conjdot(Ar, x);
    x -= S * A(row, Range::all());
  }
}

inline void GramSchmidt(Array<std::complex<double>, 2>& A)
{
  zVec a, b;
  for (int i = 0; i < A.rows(); i++)
  {
    a.reference(A(i, Range::all()));
    Normalize(a);
    for (int j = i + 1; j < A.rows(); j++)
    {
      b.reference(A(j, Range::all()));
      b = b - (conjdot(a, b) * a);
      Normalize(b);
    }
  }
}

inline void Orthogonalize(Array<std::complex<double>, 2>& A)
{
  zVec x, y;
  Array<std::complex<double>, 1> S(A.rows());
  for (int iter = 0; iter < 40; iter++)
  {
    for (int i = 0; i < A.rows(); i++)
    {
      x.reference(A(i, Range::all()));
      for (int j = i + 1; j < A.rows(); j++)
      {
        y.reference(A(j, Range::all()));
        S(j) = conjdot(y, x);
      }
      for (int j = i + 1; j < A.rows(); j++)
      {
        y.reference(A(j, Range::all()));
        x -= S(j) * y;
      }
      Normalize(x);
    }
  }
}

inline void CheckOrthog(const Array<std::complex<double>, 2>& A, zVec& x)
{
  zVec Ai;
  double normInv = 1.0 / norm(x);
  for (int i = 0; i < A.rows(); i++)
  {
    Ai.reference(A(i, Range::all()));
    if (normInv * mag(conjdot(Ai, x)) > 1.0e-13)
    {
      std::cerr << "CheckOrthog failed for i=" << i << ".\n";
      exit(1);
    }
  }
}

inline void zaxpy(std::complex<double> alpha,
                  const Array<std::complex<double>, 1>& x,
                  const std::complex<double> y,
                  Array<std::complex<double>, 1>& axpy)
{}

// inline Array<std::complex<double>,3>&
// operator*= (Array<std::complex<double>,3> &A, const Array<std::complex<double>,3> &B)
// {

// }

#endif