Task: Implement GRHydro_PPM.F90 for EinsteinEvolve/GRHydro thorn

thorn_name: EinsteinEvolve/GRHydro
src_filename: GRHydro_PPM.F90
interface: # Interface definition for thorn GRHydro

####################################################################
###  GRHydro needs to inherit the metric from Einstein.           ###
###  Other thorns will need to know what EOS we're using. They   ###
###  inherit to get the handle.                                  ###
####################################################################

implements: GRHydro
inherits: ADMBase, Boundary, SpaceMask, Tmunubase, HydroBase

USES INCLUDE: SpaceMask.h
USES INCLUDE HEADER: carpet.hh

###############################################################
###  Provided functions. These are mainly to allow RNSID    ###
###  to convert back to primitive / conservative variables  ###
###  without having an explicit coupling to GRHydro.         ###
###  NOTE: the function that converts conservative to       ###
###  primitive variables requires pointers to the conserved ###
###  variables as well as these variables are reset if      ###
###  we're in the atmosphere.                               ###
###############################################################

void FUNCTION SpatialDet(CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                         CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                         CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                         CCTK_REAL OUT det)

void FUNCTION UpperMet(CCTK_REAL OUT uxx, CCTK_REAL OUT uxy, \
                       CCTK_REAL OUT uxz, CCTK_REAL OUT uyy, \
                       CCTK_REAL OUT uyz, CCTK_REAL OUT uzz, \
                       CCTK_REAL IN det, CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                       CCTK_REAL IN gxz, CCTK_REAL IN gyy, CCTK_REAL IN gyz, \
                       CCTK_REAL IN gzz)

void FUNCTION Con2PrimGen(CCTK_INT IN handle, CCTK_REAL INOUT dens, \
                           CCTK_REAL INOUT sx, CCTK_REAL INOUT sy, CCTK_REAL INOUT sz, \
                           CCTK_REAL INOUT tau, CCTK_REAL INOUT rho, \
                           CCTK_REAL INOUT velx, CCTK_REAL INOUT vely, CCTK_REAL INOUT velz, \
                           CCTK_REAL INOUT epsilon, CCTK_REAL INOUT pressure, \
                           CCTK_REAL INOUT w_lorentz, \
                           CCTK_REAL IN uxx, CCTK_REAL IN uxy, CCTK_REAL IN uxz, \
                           CCTK_REAL IN uyy, CCTK_REAL IN uyz, CCTK_REAL IN uzz, \
                           CCTK_REAL IN det, \
                           CCTK_REAL IN x, CCTK_REAL IN y, CCTK_REAL IN z, \
                           CCTK_REAL IN r, \
                           CCTK_INT OUT epsnegative, \
		           CCTK_REAL IN GRHydro_rho_min, CCTK_REAL IN pmin, \
		           CCTK_REAL IN epsmin, \
                           CCTK_INT IN GRHydro_reflevel, \
                           CCTK_REAL OUT retval)

void FUNCTION Con2PrimGenMee(CCTK_INT IN handle, CCTK_INT IN keytemp, \
     CCTK_REAL IN prec, CCTK_REAL IN gamma_eos, \
     CCTK_REAL INOUT dens, \
     CCTK_REAL INOUT sx, CCTK_REAL INOUT sy, CCTK_REAL INOUT sz, \
     CCTK_REAL INOUT tau, \
     CCTK_REAL IN Bconsx, CCTK_REAL IN Bconsy, CCTK_REAL IN Bconsz, \
     CCTK_REAL INOUT entropycons, \
     CCTK_REAL INOUT y_e, CCTK_REAL INOUT temp, CCTK_REAL INOUT rho, \
     CCTK_REAL INOUT velx, CCTK_REAL INOUT vely, CCTK_REAL INOUT velz, \
     CCTK_REAL INOUT epsilon, CCTK_REAL INOUT pressure, \
     CCTK_REAL OUT Bvecx, CCTK_REAL OUT Bvecy, CCTK_REAL OUT Bvecz, \
     CCTK_REAL OUT Bvecsq, \
     CCTK_REAL INOUT w_lorentz, \
     CCTK_REAL IN gxx, CCTK_REAL IN gxy, CCTK_REAL IN gxz, \
     CCTK_REAL IN gyy, CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
     CCTK_REAL IN uxx, CCTK_REAL IN uxy, CCTK_REAL IN uxz, \
     CCTK_REAL IN uyy, CCTK_REAL IN uyz, CCTK_REAL IN uzz, \
     CCTK_REAL IN det, \
     CCTK_INT OUT epsnegative, \
     CCTK_REAL OUT retval)

void FUNCTION Con2PrimGenM(CCTK_INT IN handle, CCTK_INT IN keytemp, CCTK_REAL IN prec,CCTK_REAL IN gamma_eos, CCTK_REAL INOUT dens, \
                           CCTK_REAL INOUT sx, CCTK_REAL INOUT sy, CCTK_REAL INOUT sz, \
                           CCTK_REAL INOUT tau, CCTK_REAL IN Bconsx, CCTK_REAL IN Bconsy, CCTK_REAL IN Bconsz, \
			   CCTK_REAL INOUT y_e,  CCTK_REAL INOUT temp,  CCTK_REAL INOUT rho, \
                           CCTK_REAL INOUT velx, CCTK_REAL INOUT vely, CCTK_REAL INOUT velz, \
                           CCTK_REAL INOUT epsilon, CCTK_REAL INOUT pressure, \
                           CCTK_REAL OUT Bvecx, CCTK_REAL OUT Bvecy, CCTK_REAL OUT Bvecz, \
                           CCTK_REAL OUT bvecsq, \
                           CCTK_REAL INOUT w_lorentz, \
                           CCTK_REAL IN gxx, CCTK_REAL IN gxy, CCTK_REAL IN gxz, \
                           CCTK_REAL IN gyy, CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                           CCTK_REAL IN uxx, CCTK_REAL IN uxy, CCTK_REAL IN uxz, \
                           CCTK_REAL IN uyy, CCTK_REAL IN uyz, CCTK_REAL IN uzz, \
                           CCTK_REAL IN det, \
                           CCTK_INT OUT epsnegative, \
                           CCTK_REAL OUT retval)

void FUNCTION Con2PrimPoly(CCTK_INT IN handle, CCTK_REAL INOUT dens, \
                           CCTK_REAL INOUT sx, CCTK_REAL INOUT sy, \
                           CCTK_REAL INOUT sz, CCTK_REAL OUT tau, \
                           CCTK_REAL INOUT rho, CCTK_REAL INOUT velx, \
                           CCTK_REAL INOUT vely, CCTK_REAL INOUT velz, \
                           CCTK_REAL INOUT epsilon, CCTK_REAL INOUT press, \
                           CCTK_REAL INOUT w_lorentz, CCTK_REAL IN uxx, \
                           CCTK_REAL IN uxy, CCTK_REAL IN uxz, \
                           CCTK_REAL IN uyy, CCTK_REAL IN uyz, \
                           CCTK_REAL IN uzz, CCTK_REAL IN det, \
                           CCTK_REAL IN x, CCTK_REAL IN y, CCTK_REAL IN z, \
                           CCTK_REAL IN r, CCTK_REAL IN rho_min, \
			   CCTK_INT IN GRHydro_reflevel, CCTK_REAL OUT GRHydro_C2P_failed)

void FUNCTION Con2PrimPolyM(CCTK_INT IN handle, CCTK_REAL IN gamma_eos, CCTK_REAL INOUT dens, \
                           CCTK_REAL INOUT sx, CCTK_REAL INOUT sy, CCTK_REAL INOUT sz, \
                           CCTK_REAL INOUT sc, CCTK_REAL IN Bconsx, CCTK_REAL IN Bconsy, CCTK_REAL IN Bconsz, \
			   CCTK_REAL INOUT rho, \
                           CCTK_REAL INOUT velx, CCTK_REAL INOUT vely, CCTK_REAL INOUT velz, \
                           CCTK_REAL INOUT epsilon, CCTK_REAL INOUT pressure, \
                           CCTK_REAL OUT Bvecx, CCTK_REAL OUT Bvecy, CCTK_REAL OUT Bvecz, \
                           CCTK_REAL OUT Bvecsq, \
                           CCTK_REAL INOUT w_lorentz, \
                           CCTK_REAL IN gxx, CCTK_REAL IN gxy, CCTK_REAL IN gxz, \
                           CCTK_REAL IN gyy, CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                           CCTK_REAL IN uxx, CCTK_REAL IN uxy, CCTK_REAL IN uxz, \
                           CCTK_REAL IN uyy, CCTK_REAL IN uyz, CCTK_REAL IN uzz, \
                           CCTK_REAL IN det, \
                           CCTK_INT OUT epsnegative, \
                           CCTK_REAL OUT retval)

void FUNCTION Prim2ConGen(CCTK_INT IN handle, \
                          CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                          CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                          CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                          CCTK_REAL IN det, CCTK_REAL OUT dens, \
                          CCTK_REAL OUT sx, CCTK_REAL OUT sy, \
                          CCTK_REAL OUT sz, CCTK_REAL OUT tau, \
                          CCTK_REAL IN rho, CCTK_REAL IN velx, \
                          CCTK_REAL IN vely, \
                          CCTK_REAL IN velz, CCTK_REAL IN epsilon, \
                          CCTK_REAL OUT press, CCTK_REAL OUT w_lorentz)

void FUNCTION Prim2ConPoly(CCTK_INT IN handle, \
                           CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                           CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                           CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                           CCTK_REAL IN det, CCTK_REAL OUT dens, \
                           CCTK_REAL OUT sx, CCTK_REAL OUT sy, \
                           CCTK_REAL OUT sz, CCTK_REAL OUT tau, \
                           CCTK_REAL IN rho, CCTK_REAL IN velx, \
                           CCTK_REAL IN vely, \
                           CCTK_REAL IN velz, CCTK_REAL OUT epsilon, \
                           CCTK_REAL OUT press, CCTK_REAL OUT w_lorentz)

void FUNCTION Prim2ConGenM(CCTK_INT IN handle, \
                          CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                          CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                          CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                          CCTK_REAL IN det, CCTK_REAL OUT dens, \
                          CCTK_REAL OUT sx, CCTK_REAL OUT sy, \
                          CCTK_REAL OUT sz, CCTK_REAL OUT tau, \
                          CCTK_REAL OUT Bconsx, CCTK_REAL OUT Bconsy, \
                          CCTK_REAL OUT Bconsz, CCTK_REAL IN rho, CCTK_REAL IN velx, \
                          CCTK_REAL IN vely, \
                          CCTK_REAL IN velz, CCTK_REAL IN epsilon, \
                          CCTK_REAL OUT press, CCTK_REAL IN Bvecx, CCTK_REAL IN Bvecy, \
                          CCTK_REAL IN Bvecz, CCTK_REAL OUT w_lorentz)

void FUNCTION Prim2ConGenM_hot(CCTK_INT IN handle, CCTK_INT IN GRHydro_reflevel, CCTK_INT IN i, CCTK_INT IN j, CCTK_INT IN k, \
                          CCTK_REAL IN x, CCTK_REAL IN y, CCTK_REAL IN z, \
                          CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                          CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                          CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                          CCTK_REAL IN det, CCTK_REAL OUT dens, \
                          CCTK_REAL OUT sx, CCTK_REAL OUT sy, \
                          CCTK_REAL OUT sz, CCTK_REAL OUT tau, \
                          CCTK_REAL OUT Bconsx, CCTK_REAL OUT Bconsy, \
                          CCTK_REAL OUT Bconsz, CCTK_REAL IN rho, CCTK_REAL IN velx, \
                          CCTK_REAL IN vely, \
                          CCTK_REAL IN velz, CCTK_REAL IN epsilon, \
                          CCTK_REAL OUT press, CCTK_REAL IN Bvecx, CCTK_REAL IN Bvecy, \
                          CCTK_REAL IN Bvecz, CCTK_REAL OUT w_lorentz, \
                          CCTK_REAL INOUT temperature, CCTK_REAL IN Y_e)

void FUNCTION Prim2ConPolyM(CCTK_INT IN handle, \
                           CCTK_REAL IN gxx, CCTK_REAL IN gxy, \
                           CCTK_REAL IN gxz, CCTK_REAL IN gyy, \
                           CCTK_REAL IN gyz, CCTK_REAL IN gzz, \
                           CCTK_REAL IN det, CCTK_REAL OUT dens, \
                           CCTK_REAL OUT sx, CCTK_REAL OUT sy, \
                           CCTK_REAL OUT sz, CCTK_REAL OUT tau, \
                           CCTK_REAL OUT Bconsx, CCTK_REAL OUT Bconsy, \
                           CCTK_REAL OUT Bconsz, CCTK_REAL IN rho, CCTK_REAL IN velx, \
                           CCTK_REAL IN vely, \
                           CCTK_REAL IN velz, CCTK_REAL OUT epsilon, \
                           CCTK_REAL OUT press,  CCTK_REAL IN Bvecx, CCTK_REAL IN Bvecy, \
                           CCTK_REAL IN Bvecz, CCTK_REAL OUT w_lorentz)

PROVIDES FUNCTION SpatialDet WITH SpatialDeterminant LANGUAGE Fortran
PROVIDES FUNCTION UpperMet WITH UpperMetric LANGUAGE Fortran
PROVIDES FUNCTION Con2PrimPoly WITH Con2PrimPolyWrapper LANGUAGE Fortran
PROVIDES FUNCTION Con2PrimGenM WITH Con2PrimGenMWrapper LANGUAGE Fortran
PROVIDES FUNCTION Con2PrimGenMee WITH Con2PrimGenMeeWrapper LANGUAGE Fortran
PROVIDES FUNCTION Con2PrimGen WITH Con2PrimGenWrapper LANGUAGE Fortran
PROVIDES FUNCTION Con2PrimPolyM WITH Con2PrimPolyMWrapper LANGUAGE Fortran
PROVIDES FUNCTION Prim2ConGen WITH Prim2ConGenWrapper LANGUAGE Fortran
PROVIDES FUNCTION Prim2ConPoly WITH Prim2ConPolyWrapper LANGUAGE Fortran
PROVIDES FUNCTION Prim2ConGenM WITH Prim2ConGenMWrapper LANGUAGE Fortran
PROVIDES FUNCTION Prim2ConGenM_hot WITH Prim2ConGenM_hotWrapper LANGUAGE Fortran
PROVIDES FUNCTION Prim2ConPolyM WITH Prim2ConPolyMWrapper LANGUAGE Fortran

####################################################
###  Functions provided by MoL for registration  ###
####################################################

CCTK_INT FUNCTION MoLRegisterEvolved(CCTK_INT IN EvolvedIndex, \
                                         CCTK_INT IN RHSIndex)
CCTK_INT FUNCTION MoLRegisterEvolvedSlow(CCTK_INT IN EvolvedIndex, \
                                         CCTK_INT IN RHSIndexSlow)
CCTK_INT FUNCTION MoLRegisterConstrained(CCTK_INT IN ConstrainedIndex)
CCTK_INT FUNCTION MoLRegisterEvolvedGroup(CCTK_INT IN EvolvedIndex, \
                                          CCTK_INT IN RHSIndex)
CCTK_INT FUNCTION MoLRegisterEvolvedGroupSlow(CCTK_INT IN EvolvedIndex, \
                                          CCTK_INT IN RHSIndexSlow)
CCTK_INT FUNCTION MoLRegisterConstrainedGroup(CCTK_INT IN ConstrainedIndex)
CCTK_INT FUNCTION MoLRegisterSaveAndRestoreGroup(CCTK_INT IN SandRIndex)

USES FUNCTION MoLRegisterEvolved
USES FUNCTION MoLRegisterEvolvedSlow
USES FUNCTION MoLRegisterConstrained
USES FUNCTION MoLRegisterEvolvedGroup
USES FUNCTION MoLRegisterEvolvedGroupSlow
USES FUNCTION MoLRegisterConstrainedGroup
USES FUNCTION MoLRegisterSaveAndRestoreGroup

#########################################
###  Aliased functions from Boundary  ###
#########################################

CCTK_INT FUNCTION Boundary_SelectVarForBC(CCTK_POINTER_TO_CONST IN GH, \
  CCTK_INT IN faces, CCTK_INT IN boundary_width, CCTK_INT IN table_handle, \
  CCTK_STRING IN var_name, CCTK_STRING IN bc_name)
CCTK_INT FUNCTION Boundary_SelectGroupForBC(CCTK_POINTER_TO_CONST IN GH, \
  CCTK_INT IN faces, CCTK_INT IN boundary_width, CCTK_INT IN table_handle, \
  CCTK_STRING IN group_name, CCTK_STRING IN bc_name)

USES FUNCTION Boundary_SelectVarForBC
USES FUNCTION Boundary_SelectGroupForBC

############################################
###  Aliased function from DriftCorrect  ###
############################################

void FUNCTION SetDriftCorrectPosition ( CCTK_POINTER_TO_CONST IN GH_Pointer, \
                                        CCTK_REAL IN x, \
                                        CCTK_REAL IN y, \
                                        CCTK_REAL IN z )
USES FUNCTION SetDriftCorrectPosition


#######################################################
### Functions provided by the Omni EOS interface    ###
#######################################################

CCTK_INT FUNCTION EOS_Omni_GetHandle(CCTK_STRING IN name)
USES FUNCTION EOS_Omni_GetHandle


void FUNCTION EOS_Omni_pressOMP(CCTK_INT IN eoskey,         \
			     CCTK_INT IN havetemp,       \
			     CCTK_REAL IN rf_precision,   \
                             CCTK_INT IN npoints,        \
			     CCTK_REAL IN ARRAY rho,     \
			     CCTK_REAL INOUT ARRAY eps,  \
			     CCTK_REAL INOUT ARRAY temp, \
			     CCTK_REAL IN ARRAY ye,      \
			     CCTK_REAL OUT ARRAY press,  \
			     CCTK_INT OUT ARRAY keyerr,  \
			     CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_pressOMP

void FUNCTION EOS_Omni_press(CCTK_INT IN eoskey,         \
			     CCTK_INT IN havetemp,       \
			     CCTK_REAL IN rf_precision,   \
                             CCTK_INT IN npoints,        \
			     CCTK_REAL IN ARRAY rho,     \
			     CCTK_REAL INOUT ARRAY eps,  \
			     CCTK_REAL INOUT ARRAY temp, \
			     CCTK_REAL IN ARRAY ye,      \
			     CCTK_REAL OUT ARRAY press,  \
			     CCTK_INT OUT ARRAY keyerr,  \
			     CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_press

void FUNCTION EOS_Omni_press_cs2(CCTK_INT IN eoskey,         \
			     CCTK_INT IN havetemp,       \
			     CCTK_REAL IN rf_precision,   \
                             CCTK_INT IN npoints,        \
			     CCTK_REAL IN ARRAY rho,     \
			     CCTK_REAL INOUT ARRAY eps,  \
			     CCTK_REAL INOUT ARRAY temp, \
			     CCTK_REAL IN ARRAY ye,      \
			     CCTK_REAL OUT ARRAY press,  \
			     CCTK_REAL OUT ARRAY cs2,    \
			     CCTK_INT OUT ARRAY keyerr,  \
			     CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_press_cs2


void FUNCTION EOS_Omni_DPressByDEps(CCTK_INT IN eoskey,      \
			     CCTK_INT IN havetemp,           \
			     CCTK_REAL IN rf_precision,       \
                             CCTK_INT IN npoints,            \
			     CCTK_REAL IN ARRAY rho,         \
			     CCTK_REAL INOUT ARRAY eps,      \
			     CCTK_REAL INOUT ARRAY temp,     \
			     CCTK_REAL IN ARRAY ye,          \
			     CCTK_REAL OUT ARRAY dpdepsrho,  \
			     CCTK_INT OUT ARRAY keyerr,      \
			     CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_DPressByDEps


void FUNCTION EOS_Omni_DPressByDRho(CCTK_INT IN eoskey,         \
			     CCTK_INT IN havetemp,        	\
			     CCTK_REAL IN rf_precision,          \
                             CCTK_INT IN npoints,        	\
			     CCTK_REAL IN ARRAY rho,     	\
			     CCTK_REAL INOUT ARRAY eps,  	\
			     CCTK_REAL INOUT ARRAY temp, 	\
			     CCTK_REAL IN ARRAY ye,      	\
			     CCTK_REAL OUT ARRAY dpdrhoeps,  	\
			     CCTK_INT OUT ARRAY keyerr,  	\
			     CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_DPressByDRho

void FUNCTION EOS_Omni_dpderho_dpdrhoe(CCTK_INT IN eoskey,         \
                             CCTK_INT IN havetemp,              \
                             CCTK_REAL IN rf_precision,         \
                             CCTK_INT IN npoints,               \
                             CCTK_REAL IN ARRAY rho,            \
                             CCTK_REAL INOUT ARRAY eps,         \
                             CCTK_REAL INOUT ARRAY temp,        \
                             CCTK_REAL IN ARRAY ye,             \
                             CCTK_REAL OUT ARRAY dpderho,       \
                             CCTK_REAL OUT ARRAY dpdrhoe,       \
                             CCTK_INT OUT ARRAY keyerr,         \
                             CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_dpderho_dpdrhoe

void FUNCTION EOS_Omni_cs2(CCTK_INT IN eoskey,                  \
			     CCTK_INT IN havetemp,              \
			     CCTK_REAL IN rf_precision,          \
                             CCTK_INT IN npoints,               \
			     CCTK_REAL IN ARRAY rho,     	\
			     CCTK_REAL INOUT ARRAY eps,  	\
			     CCTK_REAL INOUT ARRAY temp, 	\
			     CCTK_REAL IN ARRAY ye,      	\
			     CCTK_REAL OUT ARRAY cs2,  		\
			     CCTK_INT OUT ARRAY keyerr,   	\
                             CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_cs2 

void FUNCTION EOS_Omni_EpsFromPress(CCTK_INT IN eoskey,         \
			     CCTK_INT IN havetemp,        	\
			     CCTK_REAL IN rf_precision,          \
                             CCTK_INT IN npoints,        	\
			     CCTK_REAL IN ARRAY rho,     	\
			     CCTK_REAL INOUT ARRAY eps,  	\
			     CCTK_REAL INOUT ARRAY temp, 	\
			     CCTK_REAL IN ARRAY ye,      	\
			     CCTK_REAL IN ARRAY press,  	\
			     CCTK_REAL OUT ARRAY xeps,  	\
			     CCTK_INT OUT ARRAY keyerr,   	\
                             CCTK_INT OUT anyerr)

USES FUNCTION EOS_Omni_EpsFromPress 

  
public:

int GRHydro_eos_scalars type = SCALAR
{
  GRHydro_eos_handle
  GRHydro_polytrope_handle
} "Handle number for EOS"

CCTK_REAL GRHydro_minima type = SCALAR
{
  GRHydro_rho_min
  GRHydro_tau_min
#  GRHydro_dens_min
} "Atmosphere values"

real dens type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 jacobian="inverse_jacobian" interpolator="matter"' "generalized particle number"

real tau  type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 jacobian="inverse_jacobian" interpolator="matter"' "internal energy"

real scon[3] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="D" tensorweight=+1.0 jacobian="inverse_jacobian" interpolator="matter"' "generalized momenta"

real Bcons[3] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="U" tensorparity=-1 tensorweight=+1.0 jacobian="jacobian" interpolator="matter"' "B-field conservative variable"

real Evec[3] type = GF Timelevels = 1 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="U" tensorweight=+1.0 jacobian="jacobian" interpolator="matter"' "Electric field at edges"

real Y_e_con type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 jacobian="inverse_jacobian" interpolator="matter"' "Conserved electron fraction"

real entropycons type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 jacobian="inverse_jacobian" interpolator="matter"' "Conserved entropy density"

real GRHydro_tracers[number_of_tracers] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar"'
{
  tracer
} "Tracers"

#real w_lorentz type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 interpolator="matter"' "Lorentz factor"

real sdetg type = GF Timelevels = 1 tags='Prolongation="None" tensortypealias="Scalar" tensorweight=+1.0 interpolator="matter" checkpoint="no"' "Sqrt of the determinant of the 3-metric"

real psidc type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" tensorweight=+1.0 tensorparity=-1 jacobian="inverse_jacobian" interpolator="matter"' "Psi parameter for divergence cleaning"

real densrhs type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for dens"
real taurhs  type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for tau"
real srhs[3] type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for s"
real Bconsrhs[3] type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for Bcons"
real Avecrhs[3] type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for Avec"
real Aphirhs type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for Aphi"

real psidcrhs type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for psidc"

real entropyrhs type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for entropycons"

real divB type = GF Timelevels = 1 tags='Prolongation="Restrict" checkpoint="no" tensorparity=-1' "Magnetic field constraint"

real bcom[3] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="U" tensorparity=-1 interpolator="matter"' "b^i: comoving contravariant magnetic field 4-vector spatial components"
real bcom0 type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" interpolator="matter"' "b^0 component of the comoving contravariant magnetic field 4-vector"
real bcom_sq type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar" interpolator="matter"' "half of magnectic pressure: contraction of b_a b^a "

##################################################
### variables in the local tensor basis
##################################################

CCTK_REAL lvel[3]  type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="U" jacobian="jacobian" interpolator="matter"' "local velocity v^i"
CCTK_REAL lBvec[3] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="U" jacobian="jacobian" tensorparity=-1 interpolator="matter"' "local Magnetic field components B^i"

# We should only need one timelevel. However, InitialAtmosphereReset also wants to set past timelevels!
# There must be a better way!
CCTK_REAL local_metric type = GF Timelevels = 3 tags='Prolongation="None" checkpoint="no"'
{
  gaa, gab, gac
  gbb, gbc
  gcc
} "local ADM metric g_ij"

CCTK_REAL local_extrinsic_curvature type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  kaa, kab, kac
  kbb, kbc
  kcc
} "local extrinsic curvature K_ij"


CCTK_REAL local_shift type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' 
{
  betaa, betab, betac
} "local ADM shift \beta^i"

##################################################
### These variables are only protected so that ###
### the tests in init_data work. Should fix.   ###
##################################################

real GRHydro_prim_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  rhoplus, velxplus, velyplus, velzplus, pressplus, epsplus, w_lorentzplus, 
  cs2plus, rhominus, velxminus, velyminus, velzminus, pressminus, epsminus, 
  w_lorentzminus, cs2minus
} "Primitive variables extended to the cell boundaries"

int GRHydro_scalars type = SCALAR tags='checkpoint="no"'
{
  flux_direction, xoffset, yoffset, zoffset
} "Which direction are we taking the fluxes in and the offsets"

int GRHydro_atmosphere_mask type = GF Timelevels = 1 tags='Prolongation="None"'
{
  atmosphere_mask
} "Flags to say whether a point needs to be reset to the atmosphere"

# This real mask is set during UpdateAtmosphereMask and sync'ed afterwards (including possible interpatch interpolation)
# After syn'ing and before any con2prim fun, we set the integer mask above based on the real-valued mask.
# This ensures that any routine using the int mask is still correctly working.
real GRHydro_atmosphere_mask_real type = GF Timelevels = 1 tags='Prolongation="sync" checkpoint="no"'
{
  atmosphere_mask_real
} "Flags to say whether a point needs to be reset to the atmosphere. This is sync'ed (and possibly interpolated)!"

int GRHydro_atmosphere_descriptors type=SCALAR
{
  atmosphere_field_descriptor
  atmosphere_atmosp_descriptor
  atmosphere_normal_descriptor
}

real GRHydro_cons_tracers[number_of_tracers] TYPE=GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar"'
{
  cons_tracer
} "The conserved tracer variable"

# For measuring separations
CCTK_REAL GRHydro_maxima_position TYPE=SCALAR tags='checkpoint="no"'
{
  maxima_x
  maxima_y
  maxima_z
  maximum_density
} "The position (coordinate values) of the maximum value of rho"

CCTK_REAL maxrho_global TYPE=SCALAR tags='checkpoint="no"' "store the global maximum of rho, for refinment-grid steering"

# functions can be prolonged only if they are real (not integer).
CCTK_REAL GRHydro_C2P_failed TYPE=GF Timelevels = 1 tags='Prolongation="restrict" tensortypealias="Scalar" checkpoint="no"' "Mask that stores the points where C2P has failed"

# Should we do the same for the atmo masks?

real GRHydro_fluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  densflux, sxflux, syflux, szflux, tauflux
} "Fluxes for each conserved variable"

real GRHydro_Bfluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Bconsxflux, Bconsyflux, Bconszflux
} "Fluxes for each B-field variable"

real GRHydro_psifluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  psidcflux
} "Fluxes for the divergence cleaning parameter"

real GRHydro_entropyfluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  entropyflux
} "Fluxes for the conserved entropy density"

real GRHydro_Avecfluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Avecxflux, Avecyflux, Aveczflux
} "Fluxes for each Avec variable"

real GRHydro_Aphifluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Aphiflux
} "Fluxes for Aphi"

int evolve_Y_e type = SCALAR tags='checkpoint="no"' "Are we evolving Y_e? Set in Paramcheck"

int evolve_temper type = SCALAR tags='checkpoint="no"' "Are we evolving temperature? Set in Paramcheck"

int evolve_entropy type = SCALAR tags='checkpoint="no"' "Are we evolving entropy? Set in Paramcheck"

int evolve_MHD type = SCALAR tags='checkpoint="no"' "Are we doing MHD? Set in ParamCheck"

int evolve_Lorenz_gge type = SCALAR tags='checkpoint="no"' "Are we evolving the Lorenz gauge?"

int GRHydro_reflevel type = SCALAR tags='checkpoint="no"' "Refinement level GRHydro is working on right now"

private:

int InLastMoLPostStep type = SCALAR tags='checkpoint="no"' "Flag to indicate if we are currently in the last MoL_PostStep"

int execute_MoL_Step type = SCALAR tags='checkpoint="no"' "Flag indicating whether we use the slow sector of multirate RK time integration"
int execute_MoL_PostStep type = SCALAR tags='checkpoint="no"' "Flag indicating whether we use the slow sector of multirate RK time integration"

real GRHydro_con_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  densplus, sxplus, syplus, szplus, tauplus,
  densminus, sxminus, syminus, szminus, tauminus
} "Conservative variables extended to the cell boundaries"

real GRHydro_MHD_con_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Bconsxplus,Bconsyplus,Bconszplus,Bconsxminus,Bconsyminus,Bconszminus
} "Conservative variables extended to the cell boundaries"

real GRHydro_MHD_prim_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Bvecxplus,Bvecyplus,Bveczplus,Bvecxminus,Bvecyminus,Bveczminus
} "Primitive mhd variables extended to the cell boundaries"

real GRHydro_Avec_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Avecxplus,Avecyplus,Aveczplus,Avecxminus,Avecyminus,Aveczminus
} "Vector potential extended to the cell boundaries"

real GRHydro_Aphi_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  Aphiplus,Aphiminus
} "Vector potential phi extended to the cell boundaries"

real GRHydro_MHD_psidc_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  psidcplus,psidcminus
} "Divergence cleaning variable extended to the cell boundaries for diverence cleaning"

real GRHydro_entropy_prim_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  entropyplus,entropyminus
} "Primitive entropy extended to the cell boundaries"

real GRHydro_entropy_con_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"'
{
  entropyconsplus,entropyconsminus
} "Conservative entropy extended to the cell boundaries"

int whichpsidcspeed type = SCALAR tags='checkpoint="no"' "Which speed to set for psidc? Set in ParamCheck"

real GRHydro_coords type=GF timelevels=3 
{
  GRHydro_x
  GRHydro_y
  GRHydro_z
} "Coordinates to use with the comoving shift"

real GRHydro_coords_rhs type=GF timelevels=1 tags='Prolongation="None"'
{
  GRHydro_x_rhs
  GRHydro_y_rhs
  GRHydro_z_rhs
} "RHS for coordinates to use with the comoving shift"

#real GRHydro_hamiltonian type=GF  tags='tensortypealias="Scalar"'
#{
#  GRHydro_hamnormalized
#  GRHydro_ham
#} "GRHydro hamiltonian constraints"

#real GRHydro_momentum type=GF tags='tensortypealias="U" checkpoint="no"'
#{
#  GRHydro_momx,
#  GRHydro_momy,
#  GRHydro_momz  
#} "GRHydro momentum constraints"

int GRHydro_trivial_rp_gf_group type=GF timelevels=1 tags='Prolongation="None"'
{
  GRHydro_trivial_rp_gf_x
  GRHydro_trivial_rp_gf_y
  GRHydro_trivial_rp_gf_z
} "set gf for triv. rp (only for debugging)"


real flux_splitting TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  densfplus, densfminus
  sxfplus, sxfminus
  syfplus, syfminus
  szfplus, szfminus
  taufplus, taufminus
} "Fluxes for use in the flux splitting"

real fs_alpha TYPE=SCALAR
{
  fs_alpha1
  fs_alpha2
  fs_alpha3
  fs_alpha4
  fs_alpha5
} "Maximum characteristic speeds for the flux splitting"

public:
real Y_e_con_rhs TYPE=GF tags='Prolongation="None" checkpoint="no"' "RHS for the electron fraction"
real Y_e_con_flux TYPE=GF tags='Prolongation="None" checkpoint="no"' "Flux for the electron fraction"
private:
real Y_e_plus TYPE=GF tags='Prolongation="None" checkpoint="no"' "Plus state  for the electron fraction"
real Y_e_minus TYPE=GF tags='Prolongation="None" checkpoint="no"' "Minus state for the electron fraction"
real tempplus TYPE=GF tags='Prolongation="None" checkpoint="no"' "Plus state  for the temperature"
real tempminus TYPE=GF tags='Prolongation="None" checkpoint="no"' "Minus state for the temperature"

real GRHydro_tracer_rhs[number_of_tracers] TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  cons_tracerrhs
} "RHS for the tracer"

real GRHydro_tracer_flux[number_of_tracers] TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  cons_tracerflux
} "Flux for the tracer"

real GRHydro_tracer_cons_bext[number_of_tracers] TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  cons_tracerplus, cons_tracerminus
} "Cell boundary values for the tracer"

real GRHydro_tracer_prim_bext[number_of_tracers] TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  tracerplus, tracerminus
} "Primitive cell boundary values for the tracer"

real GRHydro_tracer_flux_splitting[number_of_tracers] TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  tracerfplus, tracerfminus
} "Flux splitting for the tracer"

real GRHydro_mppm_eigenvalues TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  GRHydro_mppm_eigenvalue_x_left, GRHydro_mppm_eigenvalue_x_right
  GRHydro_mppm_eigenvalue_y_left, GRHydro_mppm_eigenvalue_y_right
  GRHydro_mppm_eigenvalue_z_left, GRHydro_mppm_eigenvalue_z_right
  GRHydro_mppm_xwind
} "debug variable for flux eigenvalues in mppm"


CCTK_REAL particles TYPE=ARRAY DIM=1 TIMELEVELS=3 SIZE=number_of_particles GHOSTSIZE=0 DISTRIB=DEFAULT
{
  particle_x
  particle_y
  particle_z
} "Coordinates of particles to be tracked"

CCTK_REAL particle_rhs TYPE=ARRAY DIM=1 TIMELEVELS=1 SIZE=number_of_particles GHOSTSIZE=0 DISTRIB=DEFAULT
{
  particle_x_rhs
  particle_y_rhs
  particle_z_rhs
} "RHS functions for particles to be tracked"

CCTK_REAL particle_arrays TYPE=ARRAY DIM=1 TIMELEVELS=1 SIZE=number_of_particles GHOSTSIZE=0 DISTRIB=DEFAULT tags='checkpoint="no"'
{
  particle_vx
  particle_vy
  particle_vz
  particle_alp
  particle_betax
  particle_betay
  particle_betaz
} "Temporaries to hold interpolated values for particle tracking"

# For measuring separations

CCTK_REAL GRHydro_maxima_location TYPE=SCALAR tags='checkpoint="no"'
{
  maxima_i
  maxima_j
  maxima_k
} "The location (point index) of the maximum value of rho"

CCTK_INT GRHydro_maxima_iteration TYPE=SCALAR "Iteration on which maximum was last set"

CCTK_REAL GRHydro_maxima_separation TYPE=SCALAR tags='checkpoint="no"'
{
  GRHydro_separation
  GRHydro_proper_separation
} "The distance between the centres (locations of maximum density) of a binary NS"

CCTK_REAL DiffRho TYPE=GF tags='Prolongation="None" checkpoint="no"' "The first difference in rho"

# For the new EOS interface a couple of temporaries are required

CCTK_REAL EOS_temps TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  eos_cs2_p, eos_cs2_m
  eos_dpdeps_p, eos_dpdeps_m
} "Temporaries for the EOS calls"

CCTK_REAL RoeAverage_temps TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  rho_ave, velx_ave, vely_ave, velz_ave, eps_ave, press_ave
  eos_cs2_ave, eos_dpdeps_ave
} "Temporaries for the Roe solver"

CCTK_REAL Con2Prim_temps TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  press_old, press_new
  eos_dpdeps_temp, eos_dpdrho_temp
} "Temporaries for the conservative to primitive conversion"

CCTK_REAL H_viscosity_temps TYPE=GF tags='Prolongation="None" checkpoint="no"'
{
  eos_c
} "Temporaries for H viscosity"



schedule: # Schedule definitions for thorn GRHydro
# $Header$

#######################################################################
### We leave the storage on all the time for the variables required ###
### by MoL. There is probably a better way of doing this.           ###
#######################################################################

#################################################
### Storage for MoL execution flag            ###
#################################################

STORAGE: execute_MoL_Step
STORAGE: execute_MoL_PostStep

# Set execution flags initially to "True"
SCHEDULE GRHydro_Reset_Execution_Flags AT CCTK_BASEGRID
{
  LANG: C
  OPTIONS: GLOBAL
} "Initially set execution flags to 'YEAH, Execute'!"

# When using MoL with multirate, we need to set execution flags for each MoL step!
if (use_MoL_slow_multirate_sector)
{
   SCHEDULE GRHydro_Set_Execution_Flags IN MoL_Step AFTER MoL_DecrementCounter BEFORE MoL_PostStepModify
   {
      LANG: C
      OPTIONS: LEVEL
   } "Check if we need to execute RHS / Post-step calculation"
   
   SCHEDULE GRHydro_Reset_Execution_Flags IN MoL_StartStep AFTER MoL_SetCounter
   {
      LANG: C
      OPTIONS: LEVEL
   } "Reset execution flags to 'YEAH, Execute'!"
   
   SCHEDULE GRHydro_Reset_Execution_Flags IN MoL_Evolution AFTER MoL_FinishLoop
   {
      LANG: C
      OPTIONS: LEVEL
   } "Reset execution flags to 'YEAH, Execute'!"
}



#################################################
### Storage for the extra timelevels for the  ###
### use of MoL with Einstein                  ###
#################################################

STORAGE:dens[timelevels]
STORAGE:tau[timelevels]
STORAGE:scon[timelevels]
if (number_of_particles)
{
  STORAGE:particles[timelevels]
}
if(CCTK_Equals(Y_e_evolution_method,"GRHydro"))
{
  STORAGE: Y_e_con[timelevels]	
  STORAGE: Y_e_con_rhs, Y_e_con_flux, Y_e_plus, Y_e_minus
  STORAGE: HydroBase::Y_e[timelevels]
}
if(CCTK_Equals(temperature_evolution_method,"GRHydro"))
{
  STORAGE: tempplus, tempminus
  STORAGE: HydroBase::temperature[timelevels]
  STORAGE: HydroBase::entropy[timelevels]
}
if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
{
  STORAGE: HydroBase::Bvec[timelevels]	
  STORAGE: GRHydro::Bcons[timelevels]	
  STORAGE: Bconsrhs
  if (clean_divergence)
  {
    STORAGE:psidc[timelevels]
  }
} else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
  STORAGE: HydroBase::Bvec[timelevels]
  STORAGE: HydroBase::Avec[timelevels]
  if (CCTK_Equals(Avec_gauge,"Lorenz")) 
  {
    STORAGE: HydroBase::Aphi[timelevels]
  } 
}
STORAGE:evolve_MHD
STORAGE:evolve_Y_e
STORAGE:evolve_temper
STORAGE:GRHydro_reflevel
STORAGE:InLastMoLPostStep
STORAGE:sdetg
STORAGE:densrhs
STORAGE:taurhs
STORAGE:srhs
if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
{
  STORAGE:Bconsrhs
  if (clean_divergence)
  {
    STORAGE:psidcrhs
    STORAGE:whichpsidcspeed 
  }
  if (track_divB)
  {
    STORAGE:divB
  }
  if (calculate_bcom)
  {
    STORAGE:GRHydro::bcom[timelevels]
    STORAGE:GRHydro::bcom0[timelevels]
    STORAGE:GRHydro::bcom_sq[timelevels]
  }
} else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
  STORAGE:Avecrhs
  STORAGE:evolve_Lorenz_gge
  if (CCTK_Equals(Avec_gauge,"Lorenz"))
  {
    STORAGE:Aphirhs
  }
  if (track_divB)
  {
    STORAGE:divB
  }
  if (calculate_bcom)
  {
    STORAGE:GRHydro::bcom[timelevels]
    STORAGE:GRHydro::bcom0[timelevels]
    STORAGE:GRHydro::bcom_sq[timelevels]
  }
}
if(CCTK_Equals(entropy_evolution_method,"GRHydro"))
{
  STORAGE: HydroBase::entropy[timelevels]	
  STORAGE: GRHydro::entropycons[timelevels]	
  STORAGE: entropyrhs
}
STORAGE:evolve_MHD
STORAGE:evolve_Y_e
STORAGE:evolve_temper
STORAGE:evolve_entropy
STORAGE:GRHydro_reflevel
STORAGE:InLastMoLPostStep
STORAGE:densrhs
STORAGE:taurhs
STORAGE:srhs
STORAGE:GRHydro_eos_scalars
STORAGE:GRHydro_minima
STORAGE:GRHydro_scalars
#STORAGE:fluxweightvolume
#STORAGE:cell_surface
if (number_of_particles)
{
  STORAGE:particle_rhs
  STORAGE:particle_arrays
}

if (evolve_tracer)
{
  STORAGE:GRHydro_tracers[timelevels]
  STORAGE:GRHydro_cons_tracers[timelevels]
  STORAGE:GRHydro_tracer_rhs
}

# FIXME: make temporary storage in FluxTerms or remove altogether, rename to be
# _not_ Evec which will likely collide with a future HydroBase electric field
# variable
if (transport_constraints)
{
  STORAGE:Evec
}

# leave this here for compatibility with older code, should not be used anymore
# and go out at some point
schedule group GRHydro_Initial IN HydroBase_Initial
{
} "GRHydro initial data group"

if(CCTK_Equals(Bvec_evolution_method,"GRHydro") || CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec"))
{
  if (clean_divergence)
  {
    schedule GRHydro_InitDivergenceClean IN HydroBase_Initial
    {
      LANG: Fortran
    } "Set psi for divergence cleaning initially to zero"
  }
  if (track_divB)
  {
    schedule GRHydro_DivBInit IN HydroBase_Initial
    {
      LANG: Fortran
    } "Set divB initially to zero"
  }
}

if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec") && CCTK_Equals(initial_Bvec,"Bvec_from_Avec") )
{
#    schedule GRHydro_BvecfromAvec AT CCTK_POSTINITIAL
    schedule GRHydro_BvecfromAvec IN HydroBase_Initial
    {
      LANG: Fortran
    } "Populate Bvec from Avec"
#   SCHEDULE group HydroBase_Boundaries AT CCTK_POSTINITIAL AFTER GRHydro_PoloidalMagFieldM AFTER GRHydro_BvecfromAvec
    SCHEDULE group HydroBase_Boundaries IN HydroBase_Initial AFTER GRHydro_PoloidalMagFieldM AFTER GRHydro_Bvec_from_Avec
    {
    } "Call boundary conditions after magnetic field initial data setup"
}

#################################################
### Storage for the extra timelevels for the  ###
### use of MoL with Einstein                  ###
#################################################

STORAGE: ADMBase::metric[timelevels], ADMBase::curv[timelevels]
STORAGE: ADMBase::lapse[timelevels]
if (!CCTK_Equals(initial_shift,"none")) 
{
  STORAGE: ADMBase::shift[timelevels]
  if (CCTK_Equals(shift_evolution_method,"Comoving"))
  {
    STORAGE: GRHydro_coords[timelevels]
    STORAGE: GRHydro_coords_rhs

    schedule GRHydro_SetUpCoords IN HydroBase_Initial
    {
      LANG: Fortran
    } "Set up the coordinates for use with the comoving shift"

    schedule GRHydro_EvolveCoords IN GRHydroRHS
    {
      LANG: Fortran
    } "Evolve the coordinates for the comoving shift"

    schedule GRHydro_ComovingShift IN HydroBase_PostStep AFTER HydroBase_Con2Prim
    {
      LANG: Fortran
    } "Comoving shift"

  }           
}

##############################################
### Storage for local tensor quantities    ###
##############################################

# the official test is to test Coordinates::general_coordinates, however
# at schedule time, this is not yet set or accessible if we really insist on
# running with Coordinates but with a Cartesian (trivial) coordinate system
# _and_ we really want to safe this memory then it has to be turned off at
# runtime via CCTK_GroupStorageDecrease
if(CCTK_IsImplementationActive("Coordinates")) {
  STORAGE: lvel[timelevels]
  if(CCTK_Equals(Bvec_evolution_method,"GRHydro") ||
     CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
     STORAGE: lBvec[timelevels]
  }
  STORAGE: local_metric[timelevels]
  STORAGE: local_extrinsic_curvature
  STORAGE: local_shift
}

##############################################
### Storage for the conformal state scalar ###
##############################################

STORAGE: conformal_state


###############################################
### Storage for the H viscosity temporaries ###
###############################################

if (apply_H_viscosity)
{
   STORAGE: H_viscosity_temps
}

###############################
### Register startup banner ###
###############################

schedule GRHydro_Startup AT WRAGH
{
  LANG: Fortran
} "Startup banner"

#########################################
### Register the masks with SpaceMask ###
#########################################

schedule GRHydro_RegisterMask AT STARTUP
{
  LANG: C
} "Register the hydro masks"


####################################
### Check the parameters are ok. ###
####################################

schedule GRHydro_ParamCheck AT PARAMCHECK
{
  LANG: Fortran
} "Check parameters"

if(CCTK_IsImplementationActive("Coordinates")) {
  schedule GRHydro_check_Jacobian_state AT BASEGRID AFTER (TmunuBase_SetStressEnergyState Coordinates_SetGlobalCoords_Group)
  {
    LANG: C
    OPTIONS: GLOBAL
  } "Test state of Jacobians"
}

######################################
### Standard symmetry registration ###
######################################

schedule GRHydro_InitSymBound AT BASEGRID AFTER (ADMBase_SetShiftStateOn,ADMBase_SetShiftStateOff)
{
  LANG: Fortran
} "Schedule symmetries and check shift state"

##########################################################
### Schedule the flux weighting calculation at initial ###
##########################################################

# schedule GRHydro_Weights AT CCTK_INITIAL
# {
#   LANG: C
# } "Set up the weighting terms for the fluxes"


#################################
### Set the handle for the EOS ###
##################################

schedule GRHydro_EOSHandle AT CCTK_INITIAL before HydroBase_Initial
{
  LANG: C
  OPTIONS: global
} "Set the EOS number"

schedule GRHydro_EOSHandle AT CCTK_POST_RECOVER_VARIABLES
{
  LANG: C
  OPTIONS: global
} "Set the EOS number"

####################################
### Setup of rho minima scalars  ###
####################################

schedule GRHydro_Rho_Minima_Setup  AT CCTK_Initial BEFORE HydroBase_Initial
{
  LANG: Fortran
} "Set up minimum for the rest-mass density in the atmosphere (before intial data)"

if (rho_abs_min_after_recovery > 0.0)
{
  schedule GRHydro_Change_Rho_Minimum_At_Recovery AT CCTK_POST_RECOVER_VARIABLES
  {
    LANG: Fortran
  } "Set up minimum for the rest-mass density in the atmosphere (before intial data)"
}


if (CCTK_IsThornActive("PUGH" ))
{
   schedule GRHydro_Rho_Minima_Setup_Final_PUGH AT CCTK_PostInitial BEFORE (MoL_PostStepModify MoL_PostStep)
   {
     LANG: C
   } "Set the value of the rest-mass density of the atmosphere which will be used during the evolution (PUGH)"
}
else if (CCTK_IsThornActive("Carpet"))
{
   schedule GRHydro_Rho_Minima_Setup_Final AT CCTK_PostPostInitial BEFORE Con2Prim
   {
     LANG: C
   } "Set the value of the rest-mass density of the atmosphere which will be used during the evolution"
}


schedule GRHydro_SqrtSpatialDeterminant AT CCTK_INITIAL AFTER (HydroBase_Initial,GRHydroTransformADMToLocalBasis) BEFORE HydroBase_Prim2ConInitial
{
  LANG: Fortran
} "Calculate sdetg"

if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
{

  if (CCTK_IsThornActive("PUGH" ))
  {
     schedule GRHydro_InitialAtmosphereResetM AT CCTK_PostInitial BEFORE (MoL_PostStepModify MoL_PostStep) AFTER GRHydro_Rho_Minima_Setup_Final_PUGH
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }
  else if (CCTK_IsThornActive("Carpet"))
  {
     schedule GRHydro_InitialAtmosphereResetM AT CCTK_PostPostInitial BEFORE Con2Prim AFTER GRHydro_Rho_Minima_Setup_Final
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }

} else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {

  if (CCTK_IsThornActive("PUGH" ))
  {
     schedule GRHydro_InitialAtmosphereResetAM AT CCTK_PostInitial BEFORE (MoL_PostStepModify MoL_PostStep) AFTER GRHydro_Rho_Minima_Setup_Final_PUGH
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }
  else if (CCTK_IsThornActive("Carpet"))
  {
     schedule GRHydro_InitialAtmosphereResetAM AT CCTK_PostPostInitial BEFORE Con2Prim AFTER GRHydro_Rho_Minima_Setup_Final
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }

} else if(CCTK_EQUALS(evolution_method, "GRHydro")){

  if (CCTK_IsThornActive("PUGH" ))
  {
     schedule GRHydro_InitialAtmosphereReset AT CCTK_PostInitial BEFORE (MoL_PostStepModify MoL_PostStep) AFTER GRHydro_Rho_Minima_Setup_Final_PUGH
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }
  else if (CCTK_IsThornActive("Carpet"))
  {
     schedule GRHydro_InitialAtmosphereReset AT CCTK_PostPostInitial BEFORE Con2Prim AFTER GRHydro_Rho_Minima_Setup_Final
     {
       LANG: Fortran
     } "Use mask to enforce atmosphere at initial time"
  }

}


# this is a temporary hack, because carpet does allow only one loop over the levels for Basegrid-Iniital-Postinitial
# so we must compute GRHydro_rho_min at postpostinitial and the constraints after this (and afer C2P)
#  schedule GROUP ADMConstraintsGroup at CCTK_POSTINITIAL after (MoL_PostStep MoL_PostInitial)
  schedule GROUP ADMConstraintsGroup at CCTK_POSTPOSTINITIAL
  {
  } "Evaluate ADM constraints, and perform symmetry boundary conditions"

###########################################################################
### Setup and remove the coefficient arrays for ENO/WENO reconstruction ###
###########################################################################

if (CCTK_Equals(recon_method,"eno")) 
{

  schedule GRHydro_ENOSetup AT CCTK_Basegrid
  {
    OPTIONS: global
    LANG:Fortran
  } "Coefficients for ENO reconstruction"

  schedule GRHydro_ENOShutdown AT CCTK_Terminate BEFORE Driver_Terminate
  {
    OPTIONS: global
    LANG:Fortran
  } "Deallocate ENO coefficients"

}

if (CCTK_Equals(recon_method,"weno") || CCTK_Equals(recon_method,"weno-z"))
{

  schedule GRHydro_WENOSetup AT CCTK_Basegrid
  {
    OPTIONS: global
    LANG:Fortran
  } "Coefficients for WENO reconstruction"

  schedule GRHydro_WENOShutdown AT CCTK_Terminate BEFORE Driver_Terminate
  {
    OPTIONS: global
    LANG:Fortran
  } "Deallocate WENO coefficients"

}


######################################################################
### This routine is a bit strangely situated, as it's really to do ###
### with initial data. There may be a better place for it later.   ###
### What it does is reset the hydrodynamical quantities if we have ###
### changed the EoS between constructing the initial model and     ###
### evolving. Essentially, we assume that the polytropic EoS that  ###
### we are using for the atmosphere is correct, and reset eps      ###
### given the values for rho. We then can call the primitive to    ###
### conservative routine to get the pressure.                      ###
######################################################################
if (EoS_Change)
{
  if (CCTK_Equals(EoS_Change_type,"Gamma"))
  {
    schedule GRHydro_EoSChangeGamma AT CCTK_Initial AFTER HydroBase_Initial BEFORE GRHydro_IVP
    { 
      LANG: Fortran
    } "Reset the specific internal energy if the EoS changes between ID and evolution"
  }
  if (CCTK_Equals(EoS_Change_type,"K"))
  {
    schedule GRHydro_EoSChangeK AT CCTK_Initial AFTER HydroBase_Initial BEFORE GRHydro_IVP
    { 
      LANG: Fortran
    } "Reset the hydro variables if the EoS (K) changes between ID and evolution"
  }
  if (CCTK_Equals(EoS_Change_type,"GammaKS"))
  {
      schedule GRHydro_EoSChangeGammaK_Shibata AT CCTK_Initial AFTER HydroBase_Initial BEFORE GRHydro_IVP
      { 
        LANG: Fortran
        SYNC: dens
        SYNC: tau
        SYNC: scon
        SYNC: hydrobase::w_lorentz
        SYNC: hydrobase::rho
        SYNC: hydrobase::press
        SYNC: hydrobase::eps
        SYNC: hydrobase::vel
        SYNC: lvel
        SYNC: hydrobase::temperature
        SYNC: hydrobase::entropy
        SYNC: hydrobase::Y_e
        SYNC: Y_e_con
      } "Reset the hydro variables if the EoS Gamma and K change between ID and evolution"
  }
}

#####################################
### Setup of dens minima scalars  ###
#####################################
# commented out, since unused for a long time
#schedule GRHydro_Dens_Minima_Setup AT CCTK_Postinitial
#{
#  LANG: Fortran
#} "Set up and check minima for dens"

#################################################
### Standard registration of variables to MoL ###
#################################################

schedule GRHydro_Register IN MoL_Register
{
  LANG: C
} "Register variables for MoL"

####################################################
### Setup of any scalars for efficiency purposes ###
####################################################

schedule GRHydro_Scalar_Setup IN MoL_PreStep
{
  LANG: Fortran
} "Set up and check scalars for efficiency"

schedule GRHydro_Scalar_Setup IN CCTK_POSTINITIAL
{
  LANG: Fortran
} "Set up and check scalars for efficiency"

################################################
### We might want to switch off evolution... ###
################################################

if (CCTK_EQUALS(evolution_method, "GRHydro")) {

STORAGE:GRHydro_atmosphere_mask
STORAGE:GRHydro_atmosphere_mask_real
STORAGE:GRHydro_atmosphere_descriptors

schedule GRHydro_SetupMask AT CCTK_Initial BEFORE HydroBase_Initial
{
  LANG: Fortran
} "Initialize the atmosphere mask"

# alternatively drop support for wk_atmosphere and schedule GRHydro_SetupMask
# only in CCTK_BaseGrid
schedule GRHydroCopyIntegerMask AT CCTK_POST_RECOVER_VARIABLES BEFORE MoL_PostStep
{
  LANG: Fortran
} "Initialize the real valued atmosphere mask after checkpoint recovery"

# If using mesh refinement
schedule GRHydro_SetupMask AT POSTREGRID BEFORE MoL_PostStep AFTER (MaskOne,MaskZero)
{
  LANG: Fortran
} "Initialize the atmosphere mask"

schedule GRHydro_SetupMask AT POSTREGRIDINITIAL BEFORE MoL_PostStep AFTER (MaskOne,MaskZero)
{
  LANG: Fortran
} "Initialize the atmosphere mask"

# Early atmosphere reset. This will not capture relative atmosphere settings (rho_rel_min) which
# is scheduled later. However, this will ensure that all time and refinement levels are handled
# correctly for rho_abs_min set.
schedule GRHydro_InitialAtmosphereReset AT CCTK_Initial AFTER HydroBase_Initial BEFORE HydroBase_Prim2ConInitial AFTER GRHydro_SqrtSpatialDeterminant 
{
  LANG: Fortran
} "Use mask to enforce atmosphere at initial time"

if (wk_atmosphere)
{
  schedule GRHydro_InitAtmosMask AT CCTK_PostInitial
  {
    LANG: Fortran
  } "Set the atmosphere mask"

  schedule GRHydro_InitAtmosMask AT POSTREGRID AFTER GRHydro_SetupMask BEFORE MoL_PostStep
  {
    LANG: Fortran
  } "Set the atmosphere mask"

  schedule GRHydro_InitAtmosMask AT POSTREGRIDINITIAL AFTER GRHydro_SetupMask BEFORE HydroBase_PostStep
  {
    LANG: Fortran
  } "Set the atmosphere mask"
}

# If using mesh refinement


#####################################################################
### The group to calculate the update term for MoL. This contains ###
### the calculation of the source terms and the flux update.      ###
#####################################################################


if(CCTK_IsImplementationActive("Coordinates")) {
  schedule GRHydroTransformPrimToLocalBasis AT INITIAL AFTER (HydroBase_Initial, ADMBase_PostInitial) BEFORE HydroBase_Prim2ConInitial
  {
     LANG: C
  } "Transform primitive vars to local tensor basis."


  schedule GRHydroTransformADMToLocalBasis AT INITIAL AFTER HydroBase_Initial BEFORE GRHydroTransformPrimToLocalBasis
  {
     LANG: C
  } "Transform ADM metric, extr. curv. and shift to local tensor basis."


  schedule GRHydroTransformADMToLocalBasis IN ADMBase_SetADMVars IF GRHydro::execute_MoL_Step
  {
     LANG: C
  } "Transform metric and shift to local tensor basis."


  schedule GRHydroTransformPrimToGlobalBasis IN HydroBase_PostStep AFTER HydroBase_Con2Prim IF GRHydro::execute_MoL_PostStep
  {
     LANG: C
  } "Transform primitive vars to global tensor basis."
}


schedule group GRHydroRHS IN HydroBase_RHS IF GRHydro::execute_MoL_Step
{
  STORAGE:GRHydro_scalars
} "Calculate the update terms"

#============================================
# Uncomment the following lines for debugging
#
# schedule GRHydro_Scalar_Setup AT CCTK_Initial
# {
#   LANG: Fortran
# } "Set up and check scalars for efficiency"
# 
# schedule group GRHydroRHS AT CCTK_Analysis
# {
#   STORAGE:GRHydro_scalars
#   TRIGGERS: densrhs
#   TRIGGERS: srhs
#   TRIGGERS: taurhs
# if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
#   {
#     TRIGGERS: Bvecrhs
#   }  
# } "Calculate the update terms"
# 
# STORAGE:GRHydro_fluxes
# STORAGE:GRHydro_con_bext
# STORAGE:GRHydro_prim_bext
# if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
#   {
#     STORAGE:GRHydro_MHD_con_bext
#   }  
# STORAGE:EOS_temps
# 
# if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
#   {
#     schedule Primitive2ConservativeCellsM AT CCTK_POSTINITIAL AFTER GZPatchSystem_cxform BEFORE MoL_PostStep
#     {
#       LANG: Fortran
#     } "Convert to conserved variables - MHD version"
# } else {
#    schedule Primitive2ConservativeCells AT CCTK_POSTINITIAL AFTER GZPatchSystem_cxform BEFORE MoL_PostStep
#    {
#      LANG: Fortran
#    } "Convert to conserved variables"
#  }
#
#==============================================

if (number_of_particles)
{
  schedule GRHydroParticleInitial AT CCTK_Initial BEFORE HydroBase_Initial
  {
    OPTIONS: GLOBAL
    LANG: Fortran
  } "Initial data for the particle arrays"

  schedule GRHydroParticleRHS IN GRHydroRHS
  {
    OPTIONS: GLOBAL
    LANG: Fortran
  } "Update terms for the particles"
}

####################################################################
### Do the source terms first, as this does not require the loop ###
### over the different directions                                ###
####################################################################

if(use_cxx_code) {
  schedule SourceTerms IN GRHydroRHS BEFORE FluxTerms
  {
    LANG: C
  } "Source term calculation"
} else {
  if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
  {
    schedule SourceTermsM IN GRHydroRHS BEFORE FluxTerms 
    {
      LANG: Fortran
    } "Source term calculation - MHD version"
  } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
    schedule SourceTermsAM IN GRHydroRHS BEFORE FluxTerms
    {
      LANG: Fortran
    } "Source term calculation - Vector Potential MHD version"
  } else {
    schedule SourceTerms IN GRHydroRHS BEFORE FluxTerms
    {
      LANG: Fortran
    } "Source term calculation"
  }
}
#################################################################
### Initial setup for the loop over the different directions. ###
#################################################################

schedule GRHydroStartLoop IN GRHydroRHS BEFORE FluxTerms
{
  LANG: Fortran
  OPTIONS: level
} "Set the flux_direction variable"

###################################################################
### The group to calculate the update terms from the fluxes. We ###
### do this as a loop over each direction to reduce coding and  ###
### hopefully to reduce bugs. The parameter flux_direction runs ###
### from (3->0) corresponding to (z->x) and stopping. At each   ###
### step in the loop the data is reconstructed and then the     ###
### fluxes are computed by the Riemann solve.                   ###
###################################################################

#######################################################
### Switch between RSA FV and flux split FD methods ###
#######################################################

if (CCTK_Equals(method_type, "RSA FV"))
{
   	
  if (evolve_tracer)
  {  
    if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
    {
    
      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_MHD_con_bext
        STORAGE:GRHydro_MHD_prim_bext
        STORAGE:GRHydro_MHD_psidc_bext
        STORAGE:GRHydro_entropy_prim_bext
        STORAGE:GRHydro_entropy_con_bext
        STORAGE:GRHydro_Bfluxes
        STORAGE:GRHydro_psifluxes
        STORAGE:GRHydro_entropyfluxes
        STORAGE:GRHydro_tracer_cons_bext
        STORAGE:GRHydro_tracer_prim_bext
        STORAGE:GRHydro_tracer_flux
      } "Calculation of intercell fluxes"
    } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec") && CCTK_Equals(Avec_gauge,"Algebraic")) {

      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_MHD_con_bext
        STORAGE:GRHydro_MHD_prim_bext
	STORAGE:GRHydro_Avec_bext
        STORAGE:GRHydro_Avecfluxes
        STORAGE:GRHydro_tracer_cons_bext
        STORAGE:GRHydro_tracer_prim_bext
        STORAGE:GRHydro_tracer_flux
      } "Calculation of intercell fluxes"

    } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec") && CCTK_Equals(Avec_gauge,"Lorenz")) {

      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_MHD_con_bext
        STORAGE:GRHydro_MHD_prim_bext
	STORAGE:GRHydro_Avec_bext
	STORAGE:GRHydro_Aphi_bext
        STORAGE:GRHydro_Avecfluxes
	STORAGE:GRHydro_Aphifluxes
        STORAGE:GRHydro_tracer_cons_bext
        STORAGE:GRHydro_tracer_prim_bext
        STORAGE:GRHydro_tracer_flux
      } "Calculation of intercell fluxes"

    } else {
      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_tracer_cons_bext
        STORAGE:GRHydro_tracer_prim_bext
        STORAGE:GRHydro_tracer_flux
      } "Calculation of intercell fluxes"

    }
  }
  else
  {
    if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
    {
      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_MHD_con_bext
        STORAGE:GRHydro_MHD_prim_bext
        STORAGE:GRHydro_MHD_psidc_bext
        STORAGE:GRHydro_entropy_con_bext
        STORAGE:GRHydro_entropy_prim_bext
        STORAGE:GRHydro_Bfluxes
        STORAGE:GRHydro_psifluxes
        STORAGE:GRHydro_entropyfluxes
      } "Calculation of intercell fluxes"
    } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec"))  {

      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
        STORAGE:GRHydro_MHD_con_bext
        STORAGE:GRHydro_MHD_prim_bext
        STORAGE:GRHydro_Avec_bext
        STORAGE:GRHydro_Aphi_bext
        STORAGE:GRHydro_Avecfluxes
        STORAGE:GRHydro_Aphifluxes
      } "Calculation of intercell fluxes"

    } else {
      schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction
      {
        STORAGE:GRHydro_prim_bext
        STORAGE:GRHydro_con_bext
        STORAGE:GRHydro_fluxes
      } "Calculation of intercell fluxes"
    }
  }
    
##############################################################
### This is a wrapper call to the reconstruction routines. ###
##############################################################

  if (CCTK_Equals(GRHydro_eos_type,"General")) {

    if (use_cxx_code && ! CCTK_EQUALS(recon_method,"eno")) {
       
       schedule Reconstruction_cxx IN FluxTerms AS Reconstruct
       {
          LANG: C
       } "Reconstruct the functions at the cell boundaries"
    
    } else {

       schedule Reconstruction IN FluxTerms AS Reconstruct
       {
          LANG: Fortran
       } "Reconstruct the functions at the cell boundaries"
    
    }
  }
  else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) {
    
    schedule ReconstructionPolytype IN FluxTerms AS Reconstruct
    {
      LANG: Fortran
    } "Reconstruct the functions at the cell boundaries"
  }
  
  if (set_trivial_rp_grid_function)
  {
    schedule Set_Trivial_Riemann_Problem_Grid_Function \
    IN FluxTerms AFTER Reconstruct
    {
      LANG: C
      SYNC: GRHydro_trivial_rp_gf_group
    } "Set the gridfunction for the trp (for debugging only)"
  }
  
######################################################
### This is a wrapper call to the Riemann solvers. ###
######################################################

  if (CCTK_Equals(GRHydro_eos_type,"General")) {
    if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
    {
      schedule RiemannSolveM IN FluxTerms AFTER Reconstruct AS Riemann
      {
        LANG: Fortran
        STORAGE: EOS_temps
      } "Solve the local Riemann problems - MHD version"
    } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
      schedule RiemannSolveAM IN FluxTerms AFTER Reconstruct AS Riemann
      {
        LANG: Fortran
        STORAGE: EOS_temps
      } "Solve the local Riemann problems - Vector Potential MHD version"
    } else {
      schedule RiemannSolve IN FluxTerms AFTER Reconstruct AS Riemann
      {
        LANG: Fortran
        STORAGE: EOS_temps
      } "Solve the local Riemann problems"
    }    
  }
  else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) {
    
    schedule RiemannSolvePolytype IN FluxTerms AFTER Reconstruct AS Riemann
    {
      LANG: Fortran
      STORAGE: EOS_temps
    } "Solve the local Riemann problems"
  }
  
}
else if (CCTK_Equals(method_type, "Flux split FD"))
{


##########################################
###  MHD not implemented yet for Flux split FD !!!
##########################################
  STORAGE:fs_alpha

  if (evolve_tracer)
  {

    schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction 
    {
      STORAGE: GRHydro_fluxes
      STORAGE: GRHydro_tracer_flux
    } "Calculation of intercell fluxes"

    schedule GRHydro_FSAlpha IN FluxTerms BEFORE GRHydro_SplitFlux
    {
      LANG: Fortran
    } "Compute the maximum characteristic speeds"

    schedule GRHydro_SplitFlux IN FluxTerms AS Reconstruct
    {
      LANG: Fortran
      STORAGE: flux_splitting
      STORAGE: GRHydro_tracer_flux_splitting
      SYNC: GRHydro_fluxes
    } "Compute the fluxes using WENO5 FD + Lax-Friedrichs splitting"

  }
  else
  {

    schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction 
    {
      STORAGE: GRHydro_fluxes
    } "Calculation of intercell fluxes"

    schedule GRHydro_FSAlpha IN FluxTerms BEFORE GRHydro_SplitFlux
    {
      LANG: Fortran
    } "Compute the maximum characteristic speeds"

    schedule GRHydro_SplitFlux IN FluxTerms AS Reconstruct
    {
      LANG: Fortran
      STORAGE: flux_splitting
      SYNC: GRHydro_fluxes
    } "Compute the fluxes using WENO5 FD + Lax-Friedrichs splitting"

  }

}

###########################################################
### After calculating the fluxes, calculate the update. ###
###########################################################

schedule UpdateCalculation IN FluxTerms AFTER Riemann AS UpdateCalcul
{
  LANG: Fortran
} "Calculate the update term from the fluxes"
  
#################################
### Advance the loop counter. ###
#################################

schedule GRHydroAdvanceLoop IN FluxTerms AFTER UpdateCalcul
{
  LANG: Fortran
  OPTIONS: level
} "Decrement the flux_direction variable"

###########################################################
### If we're in the atmosphere or inside the excision   ###
### region then we don't want to do any updating (in    ###
### fact if we're inside the excision region we don't   ###
### want to calculate the fluxes, but we'll worry about ###
### that later). Just zero the update terms where       ###
### certain conditions are violated.                    ###
###########################################################

schedule GRHydroUpdateAtmosphereMask IN GRHydroRHS AFTER FluxTerms
{
  LANG: Fortran
} "Alter the update terms if inside the atmosphere region"

###############################################################
### After we've done the update, there's a few things to do ###
###############################################################

# This should not be used anymore and be removed after some time
schedule group GRHydro_PostStep IN HydroBase_PostStep
{
} "Post step tasks for GRHydro"

#################################################################
### After MoL has updated the conserved variables, we need to ###
### convert back to primitive variables. This is a wrapper    ###
### over the entire grid.                                     ###
#################################################################

########################################################
### Find the refinement level that is being computed ###
########################################################

schedule GRHydro_RefinementLevel IN MoL_PostStep BEFORE HydroBase_PostStep
{
  LANG: Fortran
} "Calculate current refinement level"

schedule GRHydro_RefinementLevel IN FluxTerms BEFORE Reconstruct
{
  LANG: Fortran
} "Calculate current refinement level"

########################### Sqrt(detg) #################

# recompute root of metric determinant whenever metric is updated we could alse
# abuse ADMBase_SetADMVars the way GRHydroTransformADMToLocalBasis does. Abuse
# since the group description says to "Set the ADM variables before this group,
# and use them afterwards" it does not say to schedule anything in it.
# If we ever face trouble with the current placement we will ignore the
# description and do so anyway.
schedule GRHydro_SqrtSpatialDeterminant IN HydroBase_Con2Prim BEFORE Con2Prim IF GRHydro::execute_MoL_Step
{
  LANG: Fortran
} "Calculate sdetg"

schedule GRHydro_SqrtSpatialDeterminant AT CCTK_POST_RECOVER_VARIABLES
{
  LANG: Fortran
} "Calculate sdetg"


#debug
###schedule GRHydro_Debug IN HydroBase_PostStep
###{
###  LANG: Fortran
###} "debug"

schedule GRHydro_RefinementLevel AT CCTK_PostStep
{
  LANG: Fortran
} "Calculate current refinement level (for the check of the C2P mask)"

schedule GRHydro_RefinementLevel AT POSTREGRIDINITIAL 
{
  LANG: Fortran
} "Calculate current refinement level"

schedule GRHydro_RefinementLevel AT INITIAL BEFORE HydroBase_Initial
{
  LANG: Fortran
} "Calculate current refinement level"


if (CCTK_Equals(GRHydro_eos_type,"General")) 
{

  if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
  {
    schedule Conservative2PrimitiveM IN HydroBase_Con2Prim AS Con2Prim IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (general) - MHD version"
  
    schedule Primitive2ConservativeCellsM IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables - MHD version"
  } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) 
  {
    schedule GRHydro_BvecfromAvec IN HydroBase_Con2Prim
    {
      LANG: Fortran
    } "Populate Bvec from Avec"
#   SCHEDULE group HydroBase_Boundaries AT CCTK_POSTINITIAL AFTER GRHydro_PoloidalMagFieldM AFTER GRHydro_BvecfromAvec
    SCHEDULE group HydroBase_Boundaries IN HydroBase_Con2Prim AFTER GRHydro_BvecfromAvec
    {
    } "Call boundary conditions after magnetic field initial data setup"
    schedule Conservative2PrimitiveAM IN HydroBase_Con2Prim AS Con2Prim AFTER HydroBase_Boundaries IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (general) - MHD with Avec version"
  
    schedule Primitive2ConservativeCellsAM IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables - MHD with Avec version"
  } else {
    schedule Conservative2Primitive IN HydroBase_Con2Prim AS Con2Prim IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (general)"
  
    schedule Primitive2ConservativeCells IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables"
  }

}
else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) 
{
  
  if(CCTK_Equals(Bvec_evolution_method,"GRHydro"))
  {
    schedule Conservative2PrimitivePolytypeM IN HydroBase_Con2Prim AS Con2Prim IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (polytype) - MHD version"
  
    schedule Primitive2ConservativePolyCellsM IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables - MHD version"
  } else if(CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
    schedule Conservative2PrimitivePolytypeAM IN HydroBase_Con2Prim AS Con2Prim IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (polytype) - MHD with Avec version"
  
    schedule Primitive2ConservativePolyCellsAM IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables - MHD with Avec version"
  } else {
    schedule Conservative2PrimitivePolytype IN HydroBase_Con2Prim AS Con2Prim IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
    } "Convert back to primitive variables (polytype)"
  
    schedule Primitive2ConservativePolyCells IN HydroBase_Prim2ConInitial
    {
      LANG: Fortran
    } "Convert initial data given in primive variables to conserved variables"
  }
}

#################################################################
### Having finished all the updates, we apply the boundary    ###
### conditions and synchronize the conservative and primitive ###
### variables. All other grid functions are reset only in the ###
### interior of the grid and are totally reset at every step, ###
### and so synchronization is not necessary.                  ###
#################################################################

#schedule GRHydro_Boundaries IN HydroBase_PostStep AFTER Con2Prim

if (evolve_tracer)
{
  STORAGE:GRHydro_tracers[timelevels]
  STORAGE:GRHydro_cons_tracers[timelevels]
  STORAGE:GRHydro_tracer_rhs
}

# This should not be used anymore and should be removed after some time
schedule group Do_GRHydro_Boundaries IN HydroBase_Boundaries
{
} "GRHydro Boundary conditions group"


# Synchronize the atmosphere mask before doing other boundaries!
schedule group GRHydro_AtmosphereMaskBoundaries IN HydroBase_PostStep BEFORE (HydroBase_Boundaries,GRHydro_PrimitiveInitialGuessesBoundaries)
{
} "Apply boundary conditions to primitives"

schedule GRHydro_SelectAtmosphereMaskBoundaries IN GRHydro_AtmosphereMaskBoundaries
{
  LANG: Fortran
  OPTIONS: LEVEL
  SYNC: GRHydro_atmosphere_mask_real
} "Select atmosphere mask for boundary conditions"

schedule group ApplyBCs AS GRHydro_ApplyAtmosphereMaskBCs in GRHydro_AtmosphereMaskBoundaries AFTER GRHydro_SelectAtmosphereMaskBoundaries
{
} "Apply boundary conditions to real-valued atmosphere mask"


# Now synchronize other evolution variables
if (!sync_conserved_only)
{
   schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries AS GRHydro_Bound IF GRHydro::execute_MoL_PostStep
   {
      LANG: Fortran
      OPTIONS: LEVEL
      SYNC: dens
      SYNC: tau
      SYNC: scon
      SYNC: HydroBase::w_lorentz
      SYNC: HydroBase::rho
      SYNC: HydroBase::press
      SYNC: HydroBase::eps
      SYNC: HydroBase::vel
      SYNC: Bcons
      SYNC: entropycons
      SYNC: HydroBase::Bvec
      SYNC: psidc
      SYNC: GRHydro_cons_tracers
      SYNC: GRHydro_tracers
      SYNC: hydrobase::temperature
      SYNC: hydrobase::entropy
      SYNC: hydrobase::Y_e
      SYNC: Y_e_con
      SYNC: lvel
      SYNC: lBvec
   } "Select GRHydro boundary conditions"
}
else
{
    schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries AS GRHydro_Bound IF GRHydro::execute_MoL_PostStep
    {
      LANG: Fortran
      OPTIONS: LEVEL
      SYNC: dens
      SYNC: tau
      SYNC: scon
      SYNC: Bcons
      SYNC: entropycons
      SYNC: psidc
      SYNC: GRHydro_cons_tracers
      SYNC: Y_e_con
    } "Select GRHydro boundary conditions"

    # after a regrid Cactus relies on the boundary thorns to fill in the outer
    # and symmetry boundaries (we need valid data for the initial guess in Con2Prim)
    schedule group GRHydro_PrimitiveBoundaries IN CCTK_POSTREGRID BEFORE MoL_PostStep
    {
    } "Apply boundary conditions to all primitives"
    schedule group GRHydro_PrimitiveBoundaries IN CCTK_POSTREGRIDINITIAL BEFORE MoL_PostStep
    {
    } "Apply boundary conditions to all primitives"
    
    # Primitive sync is always necessary to provide initial guesses for Con2Prim in the buffer zones via prolongation.
    # Buffer zones are not guaranteed to have the correct values! Prolongation happens only in the last MoL poststep
    # so we only need to sync in the last MoL post step.
    schedule group GRHydro_PrimitiveInitialGuessesBoundaries IN HydroBase_PostStep BEFORE HydroBase_Boundaries IF GRHydro::InLastMoLPostStep
    {
    } "Apply boundary conditions to those primitives used as initial guesses"
    

    if(CCTK_IsImplementationActive("Coordinates")) {
    
      # Via prolongation, we only need to sync variables used for initial guesses!
      # With MP, we only need to sync primitives in LOCAL tensor base!!
      schedule GRHydro_SelectPrimitiveInitialGuessesBoundaries IN GRHydro_PrimitiveInitialGuessesBoundaries
      {
	 LANG: Fortran
	 OPTIONS: LEVEL
#         SYNC: HydroBase::w_lorentz      # not used as initial guess and hence not needed!
         SYNC: HydroBase::press          # con2prim_ptPolytype uses this for its initial guess
#         SYNC: HydroBase::vel            # not needed; lvel is used as initial guess instead
#         SYNC: HydroBase::Bvec           # not needed; lBvec is used as initial guess instead
#         SYNC: hydrobase::entropy        # not used as initial guess and hence not needed!
#         SYNC: hydrobase::Y_e            # not used as initial guess and hence not needed!
#         SYNC: GRHydro_tracers           # not used as initial guess and hence not needed!
         SYNC: HydroBase::rho
	 SYNC: HydroBase::eps
	 SYNC: hydrobase::temperature
	 SYNC: lvel
	 SYNC: lBvec
      } "Select initial guess primitive variables for boudary conditions"
      
      # After regridding, we better sync every primitive!
      # With MP, we only need to sync primitives in LOCAL tensor base!!
      schedule GRHydro_SelectPrimitiveBoundaries IN GRHydro_PrimitiveBoundaries
      {
	 LANG: Fortran
	 OPTIONS: LEVEL
#         SYNC: HydroBase::w_lorentz   # don't need that since computed in Con2Prim which runs in postregrid!
         SYNC: HydroBase::press          # con2prim_ptPolytype uses this for its initial guess
#         SYNC: HydroBase::vel         # not needed; obtained from lvel everywhere in post regrid after Con2Prim
#         SYNC: HydroBase::Bvec        # not needed; obtained from lBvec everywhere in post regrid after Con2Prim
         SYNC: hydrobase::entropy
         SYNC: hydrobase::Y_e
         SYNC: GRHydro_tracers
         SYNC: HydroBase::rho
	 SYNC: HydroBase::eps
	 SYNC: hydrobase::temperature
	 SYNC: lvel
	 SYNC: lBvec
      } "Select primitive variables for boundary conditions"
    }
    else
    {
      # Via prolongation, we only need to sync variables used for initial guesses!
      # Without MP, we only need to sync primitives in GLOBAL tensor base!!
      schedule GRHydro_SelectPrimitiveInitialGuessesBoundaries IN GRHydro_PrimitiveInitialGuessesBoundaries
      {
	 LANG: Fortran
	 OPTIONS: LEVEL
#         SYNC: HydroBase::w_lorentz      # not used as initial guess and hence not needed!
         SYNC: HydroBase::press          # con2prim_ptPolytype uses this for its initial guess
#         SYNC: hydrobase::entropy        # not used as initial guess and hence not needed!
#         SYNC: hydrobase::Y_e            # not used as initial guess and hence not needed!
#         SYNC: lvel
#         SYNC: lBvec
#         SYNC: GRHydro_tracers           # not used as initial guess and hence not needed!
	 SYNC: HydroBase::rho
	 SYNC: HydroBase::eps
	 SYNC: HydroBase::vel
	 SYNC: HydroBase::Bvec
	 SYNC: hydrobase::temperature
      } "Select initial guess primitive variables for boudary conditions"
    
      # After regridding, we better sync every primitive!
      # Without MP, we only need to sync primitives in GLOBAL tensor base!!
      schedule GRHydro_SelectPrimitiveBoundaries IN GRHydro_PrimitiveBoundaries
      {
	 LANG: Fortran
	 OPTIONS: LEVEL
#         SYNC: HydroBase::w_lorentz      # don't need that since computed in Con2Prim which runs in postregrid!
         SYNC: HydroBase::press          # con2prim_ptPolytype uses this for its initial guess
         SYNC: hydrobase::entropy
         SYNC: hydrobase::Y_e
         SYNC: GRHydro_tracers
	 SYNC: HydroBase::rho
	 SYNC: HydroBase::eps
	 SYNC: HydroBase::vel
	 SYNC: HydroBase::Bvec
	 SYNC: hydrobase::temperature
      } "Select primitive variables for boundary conditions"
    
    }
    
    schedule group ApplyBCs AS GRHydro_ApplyPrimitiveInitialGuessBCs in GRHydro_PrimitiveInitialGuessesBoundaries AFTER GRHydro_SelectPrimitiveInitialGuessesBoundaries
    {
    } "Apply boundary conditions to initial guess primitive variables"

    schedule group ApplyBCs AS GRHydro_ApplyPrimitiveBCs in GRHydro_PrimitiveBoundaries AFTER GRHydro_SelectPrimitiveBoundaries
    {
    } "Apply boundary conditions to all primitive variables"

}  # sync_conserved_only


#SCHEDULE GRHydro_TestSync in HydroBase_PostStep AFTER HydroBase_Boundaries BEFORE HydroBase_Con2Prim
#{
#  LANG: C
#  OPTIONS: LEVEL
#} "Sync test variables"

#SCHEDULE GROUP Bla in HydroBase_PostStep AFTER HydroBase_Boundaries AFTER HydroBase_Con2Prim
#{
#} "bla"

#SCHEDULE GRHydro_TestSync in Bla
#{
#  LANG: C
#  OPTIONS: LEVEL
#} "Sync test variables"

#SCHEDULE GRHydro_TestSync in CCTK_POSTRESTRICT AFTER Refluxing_CorrectState BEFORE MoL_PostStep
#{
#  LANG: C
#  OPTIONS: LEVEL
#} "Sync test variables"

#SCHEDULE GRHydro_TestSync in CCTK_POSTREGRID AFTER Refluxing_Reset
#{
#  LANG: C
#  OPTIONS: LEVEL
#} "Sync test variables"


############################################################
### Compute first differences of rho for mesh refinement ###
############################################################

# commented out (2006.08.22) since unused, for the time being
#STORAGE:DiffRho

#schedule GRHydro_DiffRho IN HydroBase_PostStep AFTER GRHydro_ApplyBCs
#{
#  LANG: Fortran
#} "Compute relative differences in rho"


# older version
# schedule GRHydro_DiffRho AT POSTREGRID
# {
#   LANG: Fortran
# } "Compute relative differences in rho"

################################################################
### Some actions are only required in the very last MoL sub- ###
### step but cannot be moved into PseudoEvolution since they ###
### affect other routines in PostStep. A prime example is    ###
### AmosphereReset which forms an operator split RHS.        ###
################################################################

schedule GRHydro_SetLastMoLPostStep IN MoL_PostStep
{
  LANG: C
  OPTIONS: level
} "Set grid scalar InLastMoLPostStep if this is the last MoL PostStep call"
# there used to be a comment along the lines "You did not see this abuse of
# MoL. Nothing to see here. Move along." Consider such a comment to be present
# again.
schedule GRHydro_ClearLastMoLPostStep IN MoL_Step AFTER MoL_PostStep
{
  LANG: C
  OPTIONS: level
} "Reset InLastMoLPostStep to zero"
schedule GRHydro_ClearLastMoLPostStep IN CCTK_WRAGH
{
  LANG: C
  OPTIONS: global-early
} "Initialize InLastMoLPostStep to zero"

################################################################
### If a point has been marked as requiring resetting to the ###
### atmosphere, this is where we do it.                      ###
###                                                          ###
### This is executed in the last MoL_PosStep                 ###
################################################################

# First (right after sync) we need to convert real (and synchronized mask) to an integer mask!
schedule GRHydroPostSyncAtmosphereMask IN HydroBase_PostStep AFTER GRHydro_AtmosphereMaskBoundaries
{
  LANG: Fortran
} "Set integer atmosphere mask from synchronized real atmosphere mask"

# Afterwards, reset mask!
if (CCTK_Equals(Bvec_evolution_method,"GRHydro"))
{
  schedule GRHydro_AtmosphereResetM IN HydroBase_PostStep AFTER GRHydroPostSyncAtmosphereMask BEFORE (HydroBase_Boundaries,GRHydro_PrimitiveInitialGuessesBoundaries) IF GRHydro::InLastMoLPostStep
  {
    LANG: Fortran
  } "Reset the atmosphere - MHD version"
} else if (CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec")) {
  schedule GRHydro_AtmosphereResetAM IN HydroBase_PostStep AFTER GRHydroPostSyncAtmosphereMask BEFORE (HydroBase_Boundaries,GRHydro_PrimitiveInitialGuessesBoundaries) IF GRHydro::InLastMoLPostStep
  {
    LANG: Fortran
  } "Reset the atmosphere - MHD with Avec version"
} else {
  schedule GRHydro_AtmosphereReset IN HydroBase_PostStep AFTER GRHydroPostSyncAtmosphereMask BEFORE (HydroBase_Boundaries,GRHydro_PrimitiveInitialGuessesBoundaries) IF GRHydro::InLastMoLPostStep
  {
    LANG: Fortran
  } "Reset the atmosphere"
}


if (set_trivial_rp_grid_function)
{
  STORAGE: GRHydro_trivial_rp_gf_group
}

if (ppm_mppm_debug_eigenvalues)
{
  STORAGE: GRHydro_mppm_eigenvalues
}

# Check that rho >= GRHydro_rho_min
if (Check_Rho_Minimum)
{
  schedule GRHydro_Check_Rho_Minimum AT ANALYSIS
  {
    LANG: Fortran
    TRIGGERS: HydroBase::rho
    TRIGGERS: HydroBase::press
    TRIGGERS: HydroBase::eps
  } "Check whether somewhere rho(i,j,k) < GRHydro_rho_min and produce a WARNING"
  
  schedule GRHydro_RefinementLevel AT ANALYSIS BEFORE GRHydro_Check_Rho_Minimum
  {
    LANG: Fortran
    TRIGGERS: HydroBase::rho
    TRIGGERS: HydroBase::press
    TRIGGERS: HydroBase::eps
  } "Calculate current refinement level"
}

# set and check a mask containing the failures of C2P; if they occur at points overwritten by finer grids, they can be ignored.

STORAGE: GRHydro_C2P_failed[1]

schedule reset_GRHydro_C2P_failed AT BASEGRID
{
  LANG: Fortran
} "Initialise the mask function that contains the points where C2P has failed (at BASEGRID)"

schedule reset_GRHydro_C2P_failed AT CCTK_PRESTEP
{
  LANG: Fortran
} "Reset the mask function that contains the points where C2P has failed (at PRESTEP)"

schedule sync_GRHydro_C2P_failed AT CCTK_EVOL AFTER MoL_Evolution
{
  LANG: Fortran
  SYNC: GRHydro_C2P_failed
} "Syncronise the mask function that contains the points where C2P has failed"

schedule check_GRHydro_C2P_failed AT CCTK_POSTSTEP AFTER GRHydro_RefinementLevel
{
  LANG: Fortran
} "Check the mask function that contains the points where C2P has failed and report an error in case a failure is found"

} # end of  if (CCTK_EQUALS(hydrobase::evolution_method, "GRHydro"))



if (CCTK_Equals(Bvec_evolution_method,"GRHydro") || CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec"))
{
  schedule GRHydro_TmunuM IN AddToTmunu
  {
    LANG: Fortran
  } "Compute the energy-momentum tensor - MHD version"
# bcom is already calculated in GRHydro_TmunuM. 
# When Tmunu is not calculated, then the following 
# routine is used to evaluate bcom, if requested.
  if (calculate_bcom){
    schedule GRHydro_CalcBcom IN HydroBase_PostStep AFTER GRHydroTransformPrimToGlobalBasis
    {
      LANG: Fortran
    } "Compute comoving magnetic field, pressure, etc..."
  }
} else {
  schedule GRHydro_Tmunu IN AddToTmunu 
  {
    LANG: Fortran
 } "Compute the energy-momentum tensor"
}

#the following is necessary because TmunuBase does not have enough schedule

schedule GROUP SetTmunu AT POSTPOSTINITIAL AFTER Con2Prim BEFORE ADMConstraintsGroup
{
} "Calculate the stress-energy tensor"

# Calculate divergence in PseudoEvolution

if(track_divB)
{
  schedule group GRHydroAnalysis IN MoL_PseudoEvolution
  {
  } "Calculate analysis quantities"

  schedule GRHydro_CalcDivB IN GRHydroAnalysis AFTER GRHydro_Analysis_Init
  {
    LANG: Fortran
  } "Calculate divB"

  schedule group ApplyBCs AS GRHydro_ApplyDivBBCs in GRHydroAnalysis AFTER GRHydro_CalcDivB
  {
  } "Apply boundary conditions to divB"
}


if (constrain_to_1D) {
  SCHEDULE ConstrainSconTo1D in MoL_PostStepModify
  {
    LANG: FORTRAN
    OPTION: LOCAL
  } "Constrain conserved fluid velocity to radial direction"
}


if (apply_H_viscosity) {
  if (use_cxx_code) {
    SCHEDULE H_viscosity_calc_cs_cc in GRHydroRHS BEFORE FluxTerms
    {
      LANG: C
      OPTION: LOCAL
    } "Compute local temporaries for H viscosity - C++ version"
  } else {
    SCHEDULE H_viscosity in GRHydroRHS BEFORE FluxTerms
    {
      LANG: FORTRAN
      OPTION: LOCAL
    } "Compute local temporaries for H viscosity"
  }
}


param: # Parameter definitions for thorn GRHydro
# $Header$

shares:ADMBase

USES int initial_shift ""
{
}

USES KEYWORD metric_type ""
{
}
 
EXTENDS KEYWORD shift_evolution_method ""
{
  "Comoving" :: "Set the shift so the matter is approximately comoving"
}


#########################################
###  PARAMETRES SHARED FROM HydroBase ###
#########################################

shares: HydroBase

USES CCTK_INT timelevels
USES KEYWORD prolongation_type
USES INT hydro_excision
EXTENDS KEYWORD evolution_method ""
{
  "GRHydro" :: "Use GRHydro to evolve the hydro variables"
}
EXTENDS KEYWORD Bvec_evolution_method ""
{
  "GRHydro"      :: "Use GRHydro to evolve the MHD variables, evolving the Magnetic Field"
  "GRHydro_Avec" :: "Use GRHydro to evolve the MHD variables, evolving the Vector Potential"
}
EXTENDS KEYWORD Y_e_evolution_method ""
{
  "GRHydro" :: "Use GRHydro to evolve Y_e"
}
EXTENDS KEYWORD temperature_evolution_method ""
{
  "GRHydro" :: "Use GRHydro to evolve temperature"
}
EXTENDS KEYWORD entropy_evolution_method ""
{
  "GRHydro" :: "Use GRHydro to evolve entropy"
}
EXTENDS KEYWORD initial_Bvec ""
{
  "Bvec_from_Avec" :: "Calculate B^i for an initially specified A_i"
}

#########################################
###  PARAMETRES SHARED FROM MoL       ###
#########################################

shares: MethodOfLines

USES CCTK_INT MoL_Num_Evolved_Vars
USES CCTK_INT MoL_Num_Evolved_Vars_Slow
USES CCTK_INT MoL_Num_Constrained_Vars
USES CCTK_INT MoL_Num_SaveAndRestore_Vars
USES CCTK_INT MoL_Max_Evolved_Array_Size 
USES CCTK_INT MoL_Num_ArrayEvolved_Vars

shares:SpaceMask

USES boolean use_mask

#########################################
###  PARAMETRES SHARED FROM EOS_Omni  ###
#########################################

SHARES: EOS_Omni

USES REAL poly_k

restricted:

KEYWORD use_evolution_mask "Set this to 'always' to skip validity tests in regions where CarpetEvolutionMask::evolution_mask vanishes." STEERABLE=ALWAYS
{
  "always" :: "use the mask"
  "auto"   :: "check if CarpetEvolutionMask is active, then use the mask"
  "never"  :: "do not use the mask"
} "never"

BOOLEAN GRHydro_enable_internal_excision "Set this to 'false' to disable the thorn-internal excision." STEERABLE=ALWAYS
{
} "true"

CCTK_INT GRHydro_hydro_excision "Turns excision automatically on in HydroBase" ACCUMULATOR-BASE=HydroBase::hydro_excision
{
  1:1 :: "Only '1' allowed"
} 1

INT sources_spatial_order "Order of spatial differencing of the source terms"
{
2 :: "2nd order finite differencing"
4 :: "4th order finite differencing"
} 2

CCTK_INT GRHydro_MaxNumEvolvedVars "The maximum number of evolved variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_Evolved_Vars
{
  0             :: "when using multirate"
  5:12		:: "dens scon[3] tau (B/A)vec[3] psidc ye entropy Aphi"
} 5

CCTK_INT GRHydro_MaxNumEvolvedVarsSlow "The maximum number of evolved variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_Evolved_Vars_Slow
{
  0             :: "do not use multirate"
  5:12		:: "dens scon[3] tau (B/A)vec[3] psidc ye entropy Aphi"
} 0

#  7  primitives (rho,press,eps,w_lorentz,vel)
# 10  Tmunu
#  3  Bvec
#  1  tau (polytype EOS)
#  1  Y_e
#  1  temperature
#  1  entropy
#  3  comoving shift
#  3  lvel
#  3  local_shift
#  6  local_metric
#  6  local_extrinsic_curvature
#  3  lBvec
CCTK_INT GRHydro_MaxNumConstrainedVars "The maximum number of constrained variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_Constrained_Vars
{
  7:48		:: "A small range, depending on testing or not"
} 37
 
CCTK_INT GRHydro_MaxNumSandRVars "The maximum number of save and restore variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_SaveAndRestore_Vars
{
  0:16		:: "A small range, depending on testing or not"
} 16

keyword recon_method "Which reconstruction method to use" STEERABLE=RECOVER
{
  "tvd"	   :: "Slope limited TVD"
  "ppm"    :: "PPM reconstruction"
  "eno"    :: "ENO reconstruction"
  "weno"   :: "WENO reconstruction"
  "weno-z" :: "WENO-Z reconstruction"
  "mp5"    :: "MP5 reconstruction"
} "tvd"

keyword method_type "Which type of method to use"
{
  "RSA FV"        :: "Reconstruct-Solve-Average finite volume method"
  "Flux Split FD" :: "Finite difference using Lax-Friedrichs flux splitting"
} "RSA FV"


boolean check_for_trivial_rp "Do check for trivial Riemann Problem"
{
} "yes"

keyword recon_vars "Which type of variables to reconstruct"
{
  "primitive" 		:: "Reconstruct the primitive variables"
  "conservative" 	:: "Reconstruct the conserved variables"
} "primitive"

keyword tvd_limiter "Which slope limiter to use"
{
  "minmod" 	:: "Minmod"
  "vanleerMC2"	:: "Van Leer MC - Luca"
  "Superbee"	:: "Superbee"
} "minmod"

real myfloor "A minimum number for the TVD reconstruction routine"
{
  0.0:		:: "Must be positive"
} 1.e-10

boolean use_optimized_ppm "use C++ templated version of PPM. Experimental"
{
} "no"

boolean ppm_detect "Should the PPM solver use shock detection?"
{
} "no"

keyword ppm_flatten "Which flattening procedure should the PPM solver use?"
{
  "stencil_3"   :: "our flattening procedure, which requires only stencil 3 and which may work"
  "stencil_4"   :: "original C&W flattening procedure, which requires stencil 4"
} "stencil_3"

real ppm_epsilon "Epsilon for PPM zone flattening"
{
  0.0: 		:: "Must be positive. Default is from Colella & Woodward"
} 0.33

real ppm_omega1 "Omega1 for PPM zone flattening"
{
  : 		:: "Anything goes. Default is from Colella & Woodward"
} 0.75

real ppm_omega2 "Omega2 for PPM zone flattening"
{
  :		:: "Anything goes. Default is from Colella & Woodward"
} 10.0

real ppm_omega_tracer "Omega for tracer PPM zone flattening"
{
  :		:: "Anything goes. Default is from Plewa & Mueller"
} 0.50

real ppm_epsilon_shock "Epsilon for PPM shock detection"
{
  :		:: "Anything goes. Default is from Colella & Woodward"
} 0.01

real ppm_eta1 "Eta1 for PPM shock detection"
{
  :		:: "Anything goes. Default is from Colella & Woodward"
} 20.0

real ppm_eta2 "Eta2 for PPM shock detection"
{
  :		:: "Anything goes. Default is from Colella & Woodward"
} 0.05

real ppm_k0 "K0 for PPM shock detection"
{
  :		:: "Anything goes. Default suggested by Colella & Woodward is: (polytropic constant)/10.0"
} 0.2

real ppm_small "A floor used by PPM shock detection"
{
  0.0:1.0	:: "In [0,1]"
} 1.e-7

int ppm_mppm "Use modified (enhanced) ppm scheme"
{
  0:1 :: "0 (off, default) or 1 (on)" 
} 0

int ppm_mppm_debug_eigenvalues "write eigenvalues into debug grid variables"
{
  0:1 :: "0 (off, default) or 1 (on)" 
} 0

real mp5_alpha "alpha parameter for MP5 reconstruction"
{
  0:* :: "positive"
} 4.0

real mp5_eps "epsilon parameter for MP5 reconstruction"
{
  0:* :: "0.0 or very small and positive. 1e-10 is suggested by Suresh&Huynh. TOV star requires 0.0"
} 0.0

boolean mp5_adaptive_eps "Same as WENO adaptive epsilon: adaptively reduce mp5_eps according to norm of stencil. Original algorithm does not use this."
{
} no

boolean use_enhanced_ppm "Use the enhanced ppm reconstruction method proposed by Colella & Sekora 2008 and McCorquodale & Colella 2011" STEERABLE=RECOVER
{
} no

int GRHydro_oppm_reflevel "Ref level where oPPM is used instead of ePPM (used with use_enhaced_ppm=yes)."
{
  -1:10 :: "0-10 (the reflevel number) or -1 (off)" 
} -1

real enhanced_ppm_C2 "Parameter for enhancecd ppm limiter. Default from McCorquodale & Colella 2011" STEERABLE=ALWAYS
{
   *:* :: "must be greater than 1. According to Colella&Sekora 2008, enhanced ppm is insensitive to C in [1.25,5]"
} 1.25

real enhanced_ppm_C3 "Parameter for enhancecd ppm limiter. Default from McCorquodale & Colella 2011" STEERABLE=ALWAYS
{
   0:* :: "must be greater than 0."
} 0.1

boolean reconstruct_Wv "Reconstruct the primitive velocity W_Lorentz*vel, rather than just vel." STEERABLE=ALWAYS
{
} no

int eno_order "The order of accuracy of the ENO reconstruction"
{
  1:*		:: "Anything above 1, but above 5 is pointless"
} 2

int WENO_order "The order of accuracy of the WENO reconstruction"
{
  5  :: "Fifth-order"
} 5

real weno_eps "WENO epsilon parameter. For WENO-z, 1e-40 is recommended" STEERABLE=ALWAYS
{
  0:*  :: "small and positive"
} 1e-26

boolean weno_adaptive_epsilon "use modified smoothness indicators that take into account scale of solution (adaptive epsilon)"
{
} yes

keyword riemann_solver "Which Riemann solver to use" STEERABLE=always
{
  "Roe"		:: "Standard Roe solver"
  "Marquina"	:: "Marquina flux"
  "HLLE"	:: "HLLE"
  "HLLC"	:: "HLLC"
  "LLF"	:: "Local Lax-Friedrichs (MHD only at the moment)"
} "HLLE"


keyword HLLE_type "Which HLLE type to use"
{
  "Standard"	:: "Standard HLLE solver"
  "Tadmor"	:: "Tadmor's simplification of HLLE"
} "Standard"



keyword left_eigenvectors "How to compute the left eigenvectors"
{
  "analytical"	:: "Analytical left eigenvectors"
  "numerical"	:: "Numerical left eigenvectors"
} "analytical"

keyword numerical_viscosity "How to compute the numerical viscosity"
{
  "fast"	:: "Fast numerical viscosity"
  "normal"	:: "Normal numerical viscosity"
} "fast"

boolean apply_H_viscosity "H viscosity is useful to fix the carbuncle instability seen at strong shocks"
{
} no

keyword bound "Which boundary condition to use - FIXME"
{
  "flat"	:: "Zero order extrapolation"
  "none"	:: "None"
  "static"	:: "Static, no longer supported"
  "scalar"	:: "Constant"
} "none"

int GRHydro_stencil "Width of the stencil"
{
  0:		:: "Must be positive"
} 2

keyword GRHydro_eos_type "Type of Equation of State"
{
  "Polytype"	:: "P = P(rho) or P = P(eps)"
  "General"	:: "P = P(rho, eps)"
} "General"

string GRHydro_eos_table "Name for the Equation of State"
{
  .*		:: "Can be anything"
} "Ideal_Fluid"


real GRHydro_eos_rf_prec "Precision to which root finding should be carried out" STEERABLE=ALWAYS
{
   (0.0:*       :: "anything larger than 0 goes"
} 1.0e-8

# cott@tapir.caltech.edu:
# The below parameter controls the handling of EOS_Omni keyerr=667
# failures. In these failures, no new temperature can be found for the
# eps it was called with. This may happen, for example, when a strong
# shock appears for the first time. Code checking this parameter will,
# if it is set to true, locally inject heat to fix the problem.
# This normally happens only very rarely, but one must monitor total energy
# conservation to check that this does ruin energy conservation.
boolean GRHydro_eos_hot_eps_fix "Activate quasi-failsafe mode for hot EOSs" STEERABLE=ALWAYS
{
} "no"

boolean GRHydro_eos_hot_prim2con_warn "Warn about temperature workaround in prim2con" STEERABLE=ALWAYS
{
} "yes"

boolean GRHydro_c2p_reset_eps_tau_hot_eos "As a last resort, reset tau" STEERABLE=ALWAYS
{
} "no"

boolean reconstruct_temper "if set to true, temperature will be reconstructed" STEERABLE=ALWAYS
{
} "no"
 
REAL GRHydro_hot_atmo_temp "Temperature of the hot atmosphere in MeV" STEERABLE=ALWAYS
{
 (0.0:*   :: "Larger than 0 MeV"
} 0.1e0

REAL GRHydro_max_temp "maximum temperature we allow" STEERABLE=ALWAYS
{
 (0.0:*   :: "Larger than 0 MeV"
} 90.0e0

REAL GRHydro_hot_atmo_Y_e "Y_e of the hot atmosphere" STEERABLE=ALWAYS
{
 0.0:*   :: "Larger than 0"
} 0.5e0

REAL GRHydro_Y_e_min "minimum allowed Y_e" STEERABLE=ALWAYS
{
 0.0:*   :: "Larger than or equal to zero"
} 0.0

REAL GRHydro_Y_e_max "maximum allowed Y_e" STEERABLE=ALWAYS
{
 0.0:*   :: "Larger than or equal to zero; 1 is default"
} 1.0


####################### Other Parameters ##############################

#Parameters controlling conservative <-> primitive change.
int GRHydro_c2p_warnlevel "Warnlevel for Con2Prim warnings" STEERABLE=ALWAYS
{
  0:1           :: "Either 0 or 1"
} 0

keyword GRHydro_c2p_failed_action "what to do when we detect a c2p failure"
{
  "abort"     :: "abort with error"
  "terminate" :: "request termination"
} "abort"

REAL sqrtdet_thr "Threshold to apply cons rescalings deep inside the horizon" STEERABLE=ALWAYS
{
 1.0:    :: "Larger values guarantees this sort of rescaling only deep inside the horizon"
 -1.0    :: "Do not apply limit"
} -1.0

REAL max_magnetic_to_gas_pressure_ratio "consider pressure to be magnetically dominated if magnetic pressure to gas pressure ratio is higher than this" STEERABLE=ALWAYS
{
  (0:*  :: "any positive value, eg. 100."
  -1.0  :: "disable"
} -1.0

boolean c2p_reset_pressure "If the pressure guess is unphysical should we recompute it?"
{
} "no"

real c2p_reset_pressure_to_value "The value to which the pressure is reset to when a failure occurrs in C2P"
{
  0: :: "greater than zero"
} 1.e-20

boolean c2p_resort_to_bisection "If the pressure guess is unphysical, should we try with bisection (slower, but more robust)" STEERABLE=ALWAYS
{
} no

real GRHydro_eps_min "Minimum value of specific internal energy - this is now only used in GRHydro_InitData's GRHydro_Only_Atmo routine"
{
 0: :: "Positive"
} 1.e-10

real GRHydro_perc_ptol "Tolerance for primitive variable solve (percent)" STEERABLE=ALWAYS
{
 0: :: "Do we really want both tolerances?"
} 1.e-8

real GRHydro_del_ptol "Tolerance for primitive variable solve (absolute)" STEERABLE=ALWAYS
{
  0: :: "Do we really want both tolerances?"
} 1.e-18

int GRHydro_countmax "Maximum number of iterations for Con2Prim solve"
{
  1:*		:: "Must be positive"
} 100

int GRHydro_countmin "Minimum number of iterations for Con2Prim solve"
{
  0:*		:: "Must be non negative"
} 1

int GRHydro_polish "Number of extra iterations after root found"
{
  0:*		:: "Must be non negative"
} 0

###Parameters for compact fluid objects

REAL GRHydro_rho_central "Central Density for Star"
{
  : :: ""
} 1.e-5

##Parameters for the atmosphere.

REAL tau_rel_min "A minimum relative tau (taumin = maxtau(t=0) * tau_rel_min) below which tau is reschaled"
{
  0: :: ""
} 1.e-10

REAL rho_abs_min "A minimum rho below which evolution is turned off (atmosphere). If negative, the relative minimum will be used instead." STEERABLE=recover
{
  -1.0: :: ""
} -1.0

REAL rho_rel_min "A minimum relative rho (rhomin = centden * rho_rel_min) below which evolution is turned off (atmosphere). Only used if rho_abs_min < 0.0" STEERABLE=recover
{
  0: :: ""
} 1.e-9

REAL initial_rho_abs_min "An absolute value for rho in the atmosphere. To be used by initial data routines only. Unused if negative."
{
  -1.0: :: ""
} -1.0

REAL initial_rho_rel_min "A relative (to the central density) value for rho in the atmosphere. To be used by initial data routines only. Unused if negative."
{
  -1.0: :: ""
} -1.0

REAL initial_atmosphere_factor "A relative (to the initial atmosphere) value for rho in the atmosphere. This is used at initial time only. Unused if negative."
{
  -1.0: :: ""
} -1.0

REAL rho_abs_min_after_recovery "A new absolute value for rho in the atmosphere. To be used after recovering. Unused if negative." STEERABLE=ALWAYS
{
  -1.0: :: ""
} -1.0

REAL GRHydro_atmo_tolerance "A point is set to atmosphere in the Con2Prim's if its rho < GRHydro_rho_min *(1+GRHydro_atmo_tolerance). This avoids occasional spurious oscillations in carpet buffer zones lying in the atmosphere (because prolongation happens on conserved variables)" STEERABLE=ALWAYS
{
   0.0: :: "Zero or larger. A useful value could be 0.0001"
}  0.0

REAL atmo_falloff_radius "The radius for which the atmosphere starts to falloff as (atmo_falloff_radius/r)**atmo_falloff_power"
{
  0:* :: "Anything positive"
} 50.0

REAL atmo_falloff_power "The power at which the atmosphere level falls off as (atmo_falloof_radius/r)**atmo_falloff_power"
{
  0:* :: "Anything positive"
} 0.0

REAL atmo_tolerance_radius "The radius for which the atmosphere tolerance starts to increase as (r/atmo_tolerance_radius)**atmo_tolerance_power"
{
  0:* :: "Anything positive"
} 50.0

REAL atmo_tolerance_power "The power at which the atmosphere tolerance increases as (r/atmo_tolerance_radius)**atmo_tolerance_power"
{
  0:* :: "Anything positive"
} 0.0

BOOLEAN wk_atmosphere "Use some of Wolfgang Kastauns atmosphere tricks"
{
} "no"

BOOLEAN Check_Rho_Minimum "Should a check on rho < GRHydro_rho_min be performed and written as WARNING level 2?"
{
} "no"

boolean EoS_Change "Recalculate fluid quantities if changing the EoS"
{
} "no"

keyword EoS_Change_type "Change polytropic K or Gamma?"
{
  "K"     :: "Change the K"
  "Gamma" :: "Change the Gamma"
  "GammaKS"  :: "Change K and Gamma, Shibata et al. 2004 3-D GR Core Collapse style"
} "Gamma"

real initial_Gamma "If changing Gamma, what was the value used in the initial data routine?"
{
  (0.0: :: "Positive"
} 1.3333

real initial_k "If changing K, what was the value used in the initial data routine?"
{
  (0.0: :: "Positive"
} 100.0

#If you want to use FishEye, you need the weighted fluxes

BOOLEAN use_weighted_fluxes "Weight the flux terms by the cell surface areas"
{
} "no"

#For the comoving shift 
  
real comoving_factor "Factor multiplying the velocity for the comoving shift"
{
  0.0:2.0 :: "[0,2] is allowed, but [0,1] is probably reasonable"
} 0.0

keyword comoving_attenuate "Which attenuation method for the comoving shift"
{
  "sqrt" :: "Multiply by sqrt(rho/rho_max)"
  "tanh" :: "Multiply by 1/2*(1+tanh(factor*(rho/rho_max - offset)))"
} "tanh"

keyword comoving_v_method "Which method for getting the radial velocity"
{
  "projected" :: "vr = x_i . v^i / r"
  "components" :: "vr = sqrt(v_i v^i)"
} "projected"

real comoving_tanh_factor "The factor in the above tanh attenuation"
{
  (0.0:* :: "Any positive number"
} 10.0

real comoving_tanh_offset "The offset in the above tanh attenuation"
{
  0.0:1.0 :: "Only makes sense in [0,1]"
} 0.05

int set_trivial_rp_grid_function "set gf for triv. rp (only for debugging)"
{
  0:1 :: "0 for no (default), 1 for yes"
} 0

#Advect a tracer?

boolean evolve_tracer "Should we advect tracers?"
{
} "no"

int number_of_tracers "Number of tracer variables to be advected"
{
  0:* :: "positive or zero"
} 0

boolean use_min_tracer "Should there be a floor on the tracer?"
{
} "no"

real min_tracer "The floor placed on the tracer"
{
  *:* :: "Anything"
} 0.0

#Track particles?
int number_of_particles "Number of particles to track" ACCUMULATOR-BASE=MethodOfLines::MoL_Max_Evolved_Array_Size
{
  0:* :: "0 switches off particle tracking"
} 0

int number_of_arrays "Number of arrays to evolve" ACCUMULATOR-BASE=MethodOfLines::MoL_Num_ArrayEvolved_Vars
{
  0:3           :: "Either zero or three, depending on the particles"
} 0

STRING particle_interpolator "What interpolator should be used for the particles"
{
  ".+"          :: "A valid interpolator name"
} "Lagrange polynomial interpolation"

CCTK_INT particle_interpolation_order "What order should be used for the particle interpolation"
{
  1:*           :: "A valid positive interpolation order"
} 2

#Finding the local gradient

keyword gradient_method "Which method is used to set GRHydro::DiffRho?"
{
  "First diff"    :: "Standard first differences"
  "Curvature"     :: "Curvature based method of Paramesh / FLASH"
  "Rho weighted"  :: "Based on the size of rho"
} "First diff"


# NaN detection level

INT GRHydro_NaN_verbose "The warning level for NaNs occuring within GRHydro" STEERABLE=always
{
  0:* :: "The warning level"
} 2

CCTK_REAL GRHydro_lorentz_overshoot_cutoff "Set the Lorentz factor to this value in case it overshoots (1/0)"
{
  0:* :: "Some big value"
} 1.e100

boolean clean_divergence "Use hyperbolic divergence cleaning"
{
} "no"

CCTK_REAL kap_dc "The kap parameter for divergence cleaning"
{
  0:* :: "Any non-negative value, but 1.0 to 10.0 seems preferred"
} 10.0

KEYWORD psidcspeed "Which speed to set for psidc"
{
  "char speed"  :: "Based on the characteristic speeds"
  "light speed" :: "Set the characteristic speeds to speed of light"
  "set speed"   :: "Manually set the characteristic speeds: [setcharmin,setcharmax]"
} "light speed"

CCTK_REAL setcharmax "Maximum characteristic speed for psidc if psidcspeed is set"
{
  0:1 :: "Any value smaller than speed of light"
} 1.0

CCTK_REAL setcharmin "Minimum characteristic speed for psidc if psidcspeed is set"
{
  -1:0 :: "Any value smaller than speed of light - sign should be negative"
} -1.0

BOOLEAN decouple_normal_Bfield "when using divergence cleaning properly decouple Bx,psidc subsystem"
{
} yes

boolean track_divB "Track the magnetic field constraint violations"
{
} "no"

boolean transport_constraints "Use constraint transport for magnetic field"
{
} "no"

boolean calculate_bcom  "Calculate the comoving contravariant magnetic 4-vector b^a?"
{
} "no"

############### Parameters for Avec evolution ###########################################

KEYWORD Avec_gauge "Which gauge condition to use when evolving the vector potential" 
{
  "algebraic"  :: "Algebraic gauge"
  "lorenz"     :: "Lorenz gauge"
} "lorenz"

############### Parameters for Tmunu damping (useful in atmosphere) #####################

CCTK_REAL Tmunu_damping_radius_min "damping radius at which we start to damp with a tanh function"
{
   -1  :: "damping switched off"
   0:* :: "damping radius at which we start to damp"
} -1


CCTK_REAL Tmunu_damping_radius_max "damping radius at which Tmunu becomes 0"
{
   -1  :: "damping switched off"
   0:* :: "greater than minimum radius above"
} -1


############### temporary parameters to be removed once connected issues are fixed.

boolean con2prim_oct_hack "Disregard c2p failures in oct/rotsym90 boundary cells with xyz < 0" STEERABLE=ALWAYS
{
} "no"

int GRHydro_c2p_warn_from_reflevel "Start warning on given refinement level and on higher levels" STEERABLE=ALWAYS
{
  0:           :: "Greater or equal to 0"
} 0



############### Optimization options ###################################################



# This can improve the performance on many cores, but may be dangerous 
# (it seems to work in simple testcases, but morde complicated settings may fail)
# If you encounter strange behavior, switch this OFF
BOOLEAN sync_conserved_only "Only sync evolved conserved quantities during evolution." STEERABLE = recover
{
} no


restricted:
# This uses the slow sector of MoL multirate methods.
# Since the CFL requirements for hydro are less demanding,
# it is possible to get a significant speed up by
# using a lower order time integration such as RK2, while the spacetime
# is still integrated with an RK4
BOOLEAN use_MoL_slow_multirate_sector "Whether to make use of MoL's slow multirate sector"
{
} no
private:



BOOLEAN verbose "Some debug output" STEERABLE = always
{
} no





############### Testing options ###################################################


# This constrains the flux velicity vectors to spherical symmetry.
# Only the radial contribution to the velocity vectors is considered.
# This is due to Kotake et al 2012.
BOOLEAN constrain_to_1D "Set fluid velocities to zero for non-radial motion"
{
} no



# use_cxx_code is used in schedule.ccl so cannot be STEERABLE=ALWAYS
BOOLEAN use_cxx_code "Use experimental C++ code?" STEERABLE = RECOVER
{
} yes

configuration: # Configuration definition for thorn GRHydro
# $Header$

REQUIRES EOS_Omni Boundary CartGrid3D SpaceMask

OPTIONAL_IFACTIVE Carpet
{
}

OPTIONAL EOS_Polytrope
{
}

context: GRHydro_Con2PrimM_pt.c:
```
/***********************************************************************************
    Copyright 2006 Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, 
                   and Luca Del Zanna.

                        PVS_GRMHD

    This file was derived from PVS_GRMHD.  The authors of PVS_GRMHD include 
    Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, and Luca Del Zanna.
    PVS_GRMHD is available under the GPL from:
    http://rainman.astro.uiuc.edu/codelib/  

    You are morally obligated to cite the following  paper in his/her 
    scientific literature that results from use of this file:

    [1] Noble, S. C., Gammie, C. F., McKinney, J. C., \& Del Zanna, L. \ 2006, 
        Astrophysical Journal, 641, 626.

    PVS_GRMHD 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.

    PVS_GRMHD 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 PVS_GRMHD; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

    If the user has any questions, please direct them to Scott C. Noble at 
    scn@astro.rit.edu  . 

***********************************************************************************/



#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <float.h>
#include <complex.h>

#include "cctk.h"
#include "cctk_Parameters.h"

/* Set this to be 1 if you want debug output */
#define DEBUG_CON2PRIMM (0)


/* Adiabatic index used for the state equation */

#define MAX_NEWT_ITER   (30)       /* Max. # of Newton-Raphson iterations for find_root_2D(); */
#define NEWT_TOL        (1.0e-10)  /* Min. of tolerance allowed for Newton-Raphson iterations */
#define MIN_NEWT_TOL    (1.0e-10)  /* Max. of tolerance allowed for Newton-Raphson iterations */
#define EXTRA_NEWT_ITER (2)

#define NEWT_TOL2       (1.0e-15)  /* TOL of new 1D^*_{v^2} gnr2 method */
#define MIN_NEWT_TOL2   (1.0e-10)  /* TOL of new 1D^*_{v^2} gnr2 method */

#define W_TOO_BIG       (1.e20)    /* \gamma^2 (\rho_0 + u + p) is assumed
                                      to always be smaller than this.  This
                                      is used to detect solver failures */

#define FAIL_VAL        (1.e30)    /* Generic value to which we set variables when a problem arises */

/**************************************************
  The following functions assume a Gamma-law EOS:
***************************************************/

/* Local Globals */
struct LocGlob {
  CCTK_REAL Bsq,QdotBsq,Qtsq,Qdotn,D,half_Bsq ;
} ;

// Declarations: 
static CCTK_REAL vsq_calc(CCTK_REAL W, struct LocGlob *lgp);

static CCTK_INT twod_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos, struct LocGlob *lgp,
                                     void (*funcd) (CCTK_REAL [], CCTK_REAL [], 
                                                    CCTK_REAL [], CCTK_REAL [][2], 
                                                    CCTK_REAL *, CCTK_REAL *, CCTK_REAL, struct LocGlob *) );

static  void func_vsq( CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], CCTK_REAL [][2], 
                       CCTK_REAL *f, CCTK_REAL *df, CCTK_REAL gammaeos, struct LocGlob *lgp);

static CCTK_REAL x1_of_x0(CCTK_REAL x0, struct LocGlob *lgp ) ;


// EOS STUFF:
static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq, CCTK_REAL gammaeos, struct LocGlob *lgp);
/* pressure as a function of rho0 and u */
static CCTK_REAL pressure_rho0_u(CCTK_REAL rho0, CCTK_REAL u, CCTK_REAL gammaeos)
{
  return((gammaeos - 1.)*u) ;
}

/* Pressure as a function of rho0 and w = rho0 + u + p */
static CCTK_REAL pressure_rho0_w(CCTK_REAL rho0, CCTK_REAL w,CCTK_REAL gammaeos)
{
  return((gammaeos-1.)*(w - rho0)/gammaeos) ;
}


void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_ptold) (
    CCTK_INT  *handle, CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in, CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval);

/**********************************************************************/
/**********************************************************************************

  Con2PrimM_pt():
  -----------------------------

   -- Attempts an inversion from GRMHD conserved variables to primitive variables assuming a guess.

   -- Uses the 2D method of Noble et al. (2006): 
       -- Solves for two independent variables (W,v^2) via a 2D
          Newton-Raphson method 
       -- Can be used (in principle) with a general equation of state. 

   -- Minimizes two residual functions using a homemade Newton-Raphson routine. 
       -- It is homemade so that it can catch exceptions and handle them correctly, plus it is 
          optimized for this particular  problem. 

  -- Note that the notation used herein is that of Noble et al. (2006) except for the argument 
     list. 


INPUT:  (using GRHydro variable defintions)

   s[x,y,z]   =  scons[0,1,2]  = \alpha \sqrt(\gamma) T^0_i 
   dens, tau  =  as defined in GRHydro and are assumed to be densitized (i.e. with sqrt(\gamma))   
   dens       =  D = \sqrt(\gamma) W \rho    
   tau        =  \alpha^2 \sqrt(\gamma) T^{00} - D 
   g[x,y,z][x,y,x] = spatial metric corresponding to \gamma 
   u[x,y,z][x,y,z] = inverse of the spatial metric, g[x,y,z][x,y,x]
   det        =  sqrt(\gamma)
   B[x,y,z]   =  Bvec[0,1,2] 
   bsq        = b^\mu b_\mu  

   epsnegative = (integer)
               = 0  if rho and epsilon are positive
              != 0  otherwise 


  --  (users should set B[x,y,z] = 0  for hydrodynamic runs) 


OUTPUT:  (using GRHydro variable defintions)
   rho, eps   =  as defined in GRHydro, primitive variables
   vel[x,y,z] =  as defined in GRHydro, primitive variables


RETURN VALUE: of retval = (i*100 + j)  where 
         i = 0 ->  Newton-Raphson solver either was not called (yet or not used) 
                   or returned successfully;
             1 ->  Newton-Raphson solver did not converge to a solution with the 
                   given tolerances;
             2 ->  Newton-Raphson procedure encountered a numerical divergence 
                   (occurrence of "nan" or "+/-inf" ;
             
         j = 0 -> success 
             1 -> failure: some sort of failure in Newton-Raphson; 
             2 -> failure: unphysical vsq = v^2  value at initial guess;
             3 -> failure: W<0 or W>W_TOO_BIG
             4 -> failure: v^2 > 1 
             ( used to be  5 -> failure: rho,uu <= 0   but now sets epsnegative to non-zero )

**********************************************************************************/
void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_ptold)  ( 
    CCTK_INT  *handle, CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in,     
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval)

{
  CCTK_REAL x_2d[2];
  CCTK_REAL sx, sy, sz;
  CCTK_REAL usx, usy, usz;
  CCTK_REAL tau, dens, gammaeos;
  CCTK_REAL QdotB;
  CCTK_REAL rho0,u,p,w,gammasq,gamma,gtmp,W_last,W,vsq;
  CCTK_REAL g_o_WBsq, QdB_o_W;
  CCTK_REAL sqrt_detg = *sdet;
  CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; 
  CCTK_INT  i_increase;
 
  DECLARE_CCTK_PARAMETERS;
 
  struct LocGlob lg; 

  gammaeos = *gamma_eos;

  /* Assume ok initially: */
  *retval = 0.;
  *epsnegative = 0; 

#if(DEBUG_CON2PRIMM)
  fprintf(stdout," *dens        = %26.16e \n", *dens_in         );
  fprintf(stdout," *sx          = %26.16e \n", *sx_in     );    
  fprintf(stdout," *sy          = %26.16e \n", *sy_in     );    
  fprintf(stdout," *sz          = %26.16e \n", *sz_in     );    
  fprintf(stdout," *tau         = %26.16e \n", *tau_in    );    
  fprintf(stdout," *Bconsx      = %26.16e \n", *Bconsx_in );    
  fprintf(stdout," *Bconsy      = %26.16e \n", *Bconsy_in );    
  fprintf(stdout," *Bconsz      = %26.16e \n", *Bconsz_in );    
  fprintf(stdout," *rho         = %26.16e \n", *rho       );    
  fprintf(stdout," *velx        = %26.16e \n", *velx      );    
  fprintf(stdout," *vely        = %26.16e \n", *vely      );    
  fprintf(stdout," *velz        = %26.16e \n", *velz      );    
  fprintf(stdout," *epsilon     = %26.16e \n", *epsilon     );
  fprintf(stdout," *pressure    = %26.16e \n", *pressure    );
  fprintf(stdout," *Bx          = %26.16e \n", *Bx        );    
  fprintf(stdout," *By          = %26.16e \n", *By        );    
  fprintf(stdout," *Bz          = %26.16e \n", *Bz        );    
  fprintf(stdout," *bsq         = %26.16e \n", *bsq       );    
  fprintf(stdout," *w_lorentz   = %26.16e \n", *w_lorentz   );
  fprintf(stdout," *gxx         = %26.16e \n", *gxx       );    
  fprintf(stdout," *gxy         = %26.16e \n", *gxy       );    
  fprintf(stdout," *gxz         = %26.16e \n", *gxz       );    
  fprintf(stdout," *gyy         = %26.16e \n", *gyy       );    
  fprintf(stdout," *gyz         = %26.16e \n", *gyz       );    
  fprintf(stdout," *gzz         = %26.16e \n", *gzz       );    
  fprintf(stdout," *uxx         = %26.16e \n", *uxx       );    
  fprintf(stdout," *uxy         = %26.16e \n", *uxy       );    
  fprintf(stdout," *uxz         = %26.16e \n", *uxz       );    
  fprintf(stdout," *uyy         = %26.16e \n", *uyy       );    
  fprintf(stdout," *uyz         = %26.16e \n", *uyz       );    
  fprintf(stdout," *uzz         = %26.16e \n", *uzz       );    
  fprintf(stdout," *sdet        = %26.16e \n", *sdet       );    
  fprintf(stdout," *epsnegative = %10d    \n", *epsnegative );
  fprintf(stdout," *retval      = %26.16e \n", *retval      );
  fflush(stdout);
#endif

  /* First undensitize all conserved variables : */
  sx   = (  *sx_in)   * inv_sqrt_detg;
  sy   = (  *sy_in)   * inv_sqrt_detg;
  sz   = (  *sz_in)   * inv_sqrt_detg;
  tau  = ( *tau_in)   * inv_sqrt_detg;
  dens = (*dens_in)   * inv_sqrt_detg;

  usx  =  (*uxx)*sx + (*uxy)*sy + (*uxz)*sz;
  usy  =  (*uxy)*sx + (*uyy)*sy + (*uyz)*sz;
  usz  =  (*uxz)*sx + (*uyz)*sy + (*uzz)*sz;

  *Bx = (*Bconsx_in) * inv_sqrt_detg;
  *By = (*Bconsy_in) * inv_sqrt_detg;
  *Bz = (*Bconsz_in) * inv_sqrt_detg;

  // Calculate various scalars (Q.B, Q^2, etc)  from the conserved variables:
  
  lg.Bsq = 
    (*gxx) * (*Bx) * (*Bx) + 
    (*gyy) * (*By) * (*By) + 
    (*gzz) * (*Bz) * (*Bz) + 
    2*( 
       (*gxy) * (*Bx) * (*By) +
       (*gxz) * (*Bx) * (*Bz) +
       (*gyz) * (*By) * (*Bz) );
    
  QdotB = (sx * (*Bx) + sy * (*By) + sz * (*Bz)) ;
  lg.QdotBsq = QdotB*QdotB ;

  lg.Qdotn = -(tau + dens) ;

  lg.Qtsq = (usx * sx  +  usy * sy  +  usz * sz) ;

  lg.D = dens;

  lg.half_Bsq = 0.5*lg.Bsq;

  /* calculate W from last timestep and use for guess */
  vsq = 
    (*gxx) * (*velx) * (*velx) + 
    (*gyy) * (*vely) * (*vely) + 
    (*gzz) * (*velz) * (*velz) + 
    2*( 
       (*gxy) * (*velx) * (*vely) +
       (*gxz) * (*velx) * (*velz) +
       (*gyz) * (*vely) * (*velz) );

  if( (vsq < 0.) && (fabs(vsq) < 1.0e-13) ) { 
    vsq = fabs(vsq);
  }
  if(vsq < 0. || vsq > 1. ) {
    *retval = 2.;
    return;
  }

  gammasq = 1. / (1. - vsq);
  gamma  = sqrt(gammasq);
        
  // Always calculate rho from D and gamma so that using D in EOS remains consistent
  //   i.e. you don't get positive values for dP/d(vsq) . 
  rho0 = lg.D / gamma ;
  u = (*epsilon) * rho0;
  p = pressure_rho0_u(rho0,u,gammaeos) ;  // EOS
  w = rho0 + u + p ;

  W_last = w*gammasq ;


  // Make sure that W is large enough so that v^2 < 1 : 
  i_increase = 0;
  while( (( W_last*W_last*W_last * ( W_last + 2.*lg.Bsq ) 
            - lg.QdotBsq*(2.*W_last + lg.Bsq) ) <= W_last*W_last*(lg.Qtsq-lg.Bsq*lg.Bsq))
         && (i_increase < 10) ) {
    W_last *= 10.;
    i_increase++;
  }
  
  // Calculate W and vsq: 
  x_2d[0] =  fabs( W_last );
  x_2d[1] = x1_of_x0( W_last, &lg ) ;
  *retval = 1.0*twod_newton_raphson( x_2d, gammaeos, &lg, func_vsq ) ;  

  W = x_2d[0];
  vsq = x_2d[1];
        
  /* Problem with solver, so return denoting error before doing anything further */
  if( ((*retval) != 0.) || (W == FAIL_VAL) ) {
    *retval = *retval*100.+1.;
    return;
  }
  else{
    if(W <= 0. || W > W_TOO_BIG) {
      *retval = 3.;
      return;
    }
  }

  // Calculate v^2:
  if( vsq >= 1. ) {
    *retval = 4.;
    return;
  }

  // Recover the primitive variables from the scalars and conserved variables:
  gtmp = sqrt(1. - vsq);
  gamma = 1./gtmp ;
  rho0 = lg.D * gtmp;

  w = W * (1. - vsq) ;
  p = pressure_rho0_w(rho0,w,gammaeos) ;  // EOS
  u = w - (rho0 + p) ;

  // User may want to handle this case differently, e.g. do NOT return upon 
  // a negative rho/u, calculate v^i so that rho/u can be floored by other routine:
  if( (rho0 <= 0.) || (u <= 0.) ) { 
    *epsnegative = 1; 
    return;
  }

  *rho = rho0;
  *epsilon = u / rho0;
  *w_lorentz = gamma; 
  *pressure = p ; 

  g_o_WBsq = 1./(W+lg.Bsq);
  QdB_o_W  = QdotB / W; 
  *bsq = lg.Bsq * (1.-vsq) + QdB_o_W*QdB_o_W;

  *velx = g_o_WBsq * ( usx + QdB_o_W*(*Bx) ) ;
  *vely = g_o_WBsq * ( usy + QdB_o_W*(*By) ) ;
  *velz = g_o_WBsq * ( usz + QdB_o_W*(*Bz) ) ;

  if (*rho <= rho_abs_min*(1.0+GRHydro_atmo_tolerance) ) {
    *rho = rho_abs_min;
    *velx = 0.0;
    *vely = 0.0;
    *velz = 0.0;
    *w_lorentz = 1.0;
  }


#if(DEBUG_CON2PRIMM)
  fprintf(stdout,"rho          = %26.16e \n",*rho      );
  fprintf(stdout,"epsilon      = %26.16e \n",*epsilon  );
  fprintf(stdout,"pressure     = %26.16e \n",*pressure );
  fprintf(stdout,"w_lorentz    = %26.16e \n",*w_lorentz);
  fprintf(stdout,"bsq          = %26.16e \n",*bsq      );
  fprintf(stdout,"velx         = %26.16e \n",*velx     );
  fprintf(stdout,"vely         = %26.16e \n",*vely     );
  fprintf(stdout,"velz         = %26.16e \n",*velz     );
  fprintf(stdout,"gammaeos     = %26.16e \n",gammaeos  );
  fflush(stdout);
#endif

  /* done! */
  return;

}


/**********************************************************************/ 
/****************************************************************************
   vsq_calc(): 
    
      -- evaluate v^2 (spatial, normalized velocity) from 
            W = \gamma^2 w 

****************************************************************************/
static CCTK_REAL vsq_calc(CCTK_REAL W, struct LocGlob *lgp)
{
        CCTK_REAL Wsq,Xsq,Bsq_W;
        
        Wsq = W*W ;
        Bsq_W = (lgp->Bsq + W);
        Xsq = Bsq_W * Bsq_W;

        return(  ( Wsq * lgp->Qtsq  + lgp->QdotBsq * (Bsq_W + W)) / (Wsq*Xsq) );
}


/********************************************************************

  x1_of_x0(): 
           
    -- calculates v^2 from W  with some physical bounds checking;
    -- asumes x0 is already physical
    -- makes v^2 physical  if not;

*********************************************************************/

static CCTK_REAL x1_of_x0(CCTK_REAL x0, struct LocGlob *lgp ) 
{
  CCTK_REAL vsq;
  CCTK_REAL dv = 1.e-15;

  vsq = fabs(vsq_calc(x0,lgp)) ; // guaranteed to be positive 

  return( ( vsq > 1. ) ? (1.0 - dv) : vsq   ); 

}

/********************************************************************

  validate_x(): 
           
    -- makes sure that x[0,1] have physical values, based upon 
       their definitions:
    
*********************************************************************/

static void validate_x(CCTK_REAL x[2], CCTK_REAL x0[2] ) 
{
  
  const CCTK_REAL dv = 1.e-15;

  /* Always take the absolute value of x[0] and check to see if it's too big:  */ 
  x[0] = fabs(x[0]);
  x[0] = (x[0] > W_TOO_BIG) ?  x0[0] : x[0];
  
  x[1] = (x[1] < 0.) ?   0.       : x[1];  /* if it's too small */
  x[1] = (x[1] > 1.) ?  (1. - dv) : x[1];  /* if it's too big   */

  return;

}

/************************************************************

  twod_newton_raphson(): 

    -- performs Newton-Rapshon method on an 2d system.

    -- inspired in part by Num. Rec.'s routine newt();

*****************************************************************/
static CCTK_INT twod_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos, struct LocGlob *lgp, 
                            void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                           CCTK_REAL [][2], CCTK_REAL *, 
                                           CCTK_REAL *, CCTK_REAL, struct LocGlob *) )
{
  CCTK_REAL f, df, dx[2], x_old[2];
  CCTK_REAL resid[2], jac[2][2];
  CCTK_REAL errx, x_orig[2];
  CCTK_INT    n_iter, i_extra, doing_extra;
  CCTK_REAL vsq,W,W_old;
  const CCTK_REAL dv = (1.-1.e-15);

  CCTK_INT   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ; 
  df = f = 1.;
  i_extra = doing_extra = 0;
  x_old[0] = x_orig[0] = x[0] ;
  x_old[1] = x_orig[1] = x[1] ;

  vsq = W = W_old = 0.;
  n_iter = 0;

  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) { 

    (*funcd) (x, dx, resid, jac, &f, &df, gammaeos, lgp);  /* returns with new dx, f, df */
      

    /* Save old values before calculating the new: */
    errx = 0.;
    x_old[0] = x[0] ; 
    x_old[1] = x[1] ; 

    /* Make the newton step: */
    x[0] += dx[0]  ; 
    x[1] += dx[1]  ; 

    /****************************************/
    /* Calculate the convergence criterion */
    /****************************************/
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]);


    /****************************************/
    /* Make sure that the new x[] is physical : */
    /****************************************/
    if( x[0] < 0. ) {  x[0] = fabs(x[0]);  } 
    else { 
     if(x[0] > W_TOO_BIG)  { x[0] = x_old[0] ; }
    }

    if( x[1] < 0. ) {  x[1] = 0.; } 
    else { 
      if( x[1] > 1. ) { x[1] = dv; }
    }
      
    /*****************************************************************************/
    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*  before stopping                                                          */
    /*****************************************************************************/
    
    if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 1;
    }

    if( doing_extra == 1 ) i_extra++ ;

    if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) 
        || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }   // END of while(keep_iterating)


    /*  Check for bad untrapped divergences : */
  if( (!finite(f)) ||  (!finite(df)) ) {
    return(2);
  }


  if( fabs(errx) <= NEWT_TOL ){
    return(0);
  }
  else if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){
    return(0);
  }
  else {
    return(1);
  } 

  

}



/**********************************************************************/
/*********************************************************************************
   func_vsq(): 

        -- calculates the residuals, and Newton step for general_newton_raphson();
        -- for this method, x=W,vsq here;

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/

static void func_vsq(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                     CCTK_REAL jac[][2], CCTK_REAL *f, CCTK_REAL *df, CCTK_REAL gammaeos, struct LocGlob *lgp)
{

  
  CCTK_REAL  W, vsq, p_tmp, dPdvsq, dPdW;
  CCTK_REAL t11, t16,t18,t2,t21,   t23,   t24,   t25,   t3,   t35,  t4,   t40;


  W = x[0];
  vsq = x[1];
  
  p_tmp = eos_info(W, vsq, &dPdW, &dPdvsq, gammaeos, lgp);

  // These expressions were calculated using Mathematica, but made into efficient 
  // code using Maple.  Since we know the analytic form of the equations, we can 
  // explicitly calculate the Newton-Raphson step: 

  t2 = -lgp->half_Bsq+dPdvsq;
  t3 = lgp->Bsq+W;
  t4 = t3*t3;
  t23 = 1/W;
  t16 = lgp->QdotBsq*t23*t23;
  t11 = lgp->Qtsq-vsq*t4+t16*(lgp->Bsq+W+W);
  t18 = -lgp->Qdotn-lgp->half_Bsq*(1.0+vsq)+0.5*t16-W+p_tmp;
  t24 = t16*t23;
  t25 = -1.0+dPdW-t24;
  t35 = t25*t3+(lgp->Bsq-2.0*dPdvsq)*(t16+vsq*W)*t23;
  //  t21 = 1/t3;
  //  t36 = 1/t35;
  t21 = 1/(t3*t35);
  dx[0] = -(t2*t11+t4*t18)*t21;
  t40 = -2*(vsq+t24)*t3;
  dx[1] = -(-t25*t11+t40*t18)*t21;
  //  detJ = t3*t35;
  jac[0][0] = t40;
  jac[0][1] = -t4;
  jac[1][0] = t25;
  jac[1][1] = t2;
  resid[0] = t11;
  resid[1] = t18;

  *df = -resid[0]*resid[0] - resid[1]*resid[1];

  *f = -0.5 * ( *df );

}


/********************************************************************** 
 ********************************************************************** 
   
 The following routines specify the equation of state.  All routines 
  above here should be indpendent of EOS.  If the user wishes 
  to use another equation of state, the below functions must be replaced 
  by equivalent routines based upon the new EOS. 

 **********************************************************************
**********************************************************************/

/**********************************************************************/
/********************************************************************** 
  eos_info():
 
      -- returns with all the EOS-related values needed;
 **********************************************************************/
static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq, CCTK_REAL gammaeos, struct LocGlob *lgp)
{
  register CCTK_REAL ftmp,gtmp;

  ftmp = 1. - vsq;
  gtmp = sqrt(ftmp);

  CCTK_REAL gam_m1_o_gam = ((gammaeos-1.)/gammaeos);

  *dpdw =  gam_m1_o_gam * ftmp ;
  *dpdvsq =  gam_m1_o_gam * ( 0.5 * lgp->D/gtmp  -  W ) ;

  return( gam_m1_o_gam * ( W * ftmp  -  lgp->D * gtmp )  );  // p 

}


/****************************************************************************** 
             END   
 ******************************************************************************/


#undef DEBUG_CON2PRIMM

```

GRHydro_MP5Reconstruct.F90:
```
 /*@@
   @file      GRHydro_MP5Reconstruct.F90
   @date      Fri Jan 3 2013
   @author    Ian Hawke, Christian Reisswig
   @desc 
   Routines to set up the coefficient array and to perform one dimensional 
   M5 reconstruction of arbitrary order.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"




 /*@@
   @routine    GRHydro_MP5Reconstruct1d
   @date       Fri Jan 3 2013
   @author     Christian Reisswig
   @desc 
   Perform a one dimensional reconstruction of a given array using M5.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

#define SpaceMask_CheckStateBitsF90_1D(mask,i,type_bits,state_bits) \
  (iand(mask((i)),(type_bits)).eq.(state_bits))

subroutine GRHydro_MP5Reconstruct1d(nx, v, vminus, vplus, trivial_rp, &
     hydro_excision_mask)

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: nx, i
  CCTK_REAL, dimension(nx) :: v, vplus, vminus

  CCTK_INT, dimension(nx) :: hydro_excision_mask
  logical, dimension(nx) :: trivial_rp
  logical, dimension(nx) :: excise
  logical :: normal_m5

  CCTK_REAL :: vl, vmp, djm1, dj, djp1, dm4jph, dm4jmh, vul, vav, vmd, vlc, vmin, vmax, vnorm

  ! sign requires its arguments to be of identical KIND
  CCTK_REAL, parameter :: one = 1d0
  
  vminus = 0.d0
  vplus = 0.d0

  excise = .false.
  trivial_rp = .false.

!!$    Initialize excision
  do i = 1, nx
    if (GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i) .ne. 0)) then
      trivial_rp(i) = .true.
      excise(i) = .true.
      if (i > 1) then
        trivial_rp(i-1) = .true.
      end if
    end if
  end do

  do i = 3, nx-2
!!$    Handle excision
    normal_m5 = .true.
    if (i < nx) then
     if (excise(i+1)) then
      vminus(i) = v(i)
      vplus(i) = v(i)
      normal_m5 = .false.
     end if
    end if
    if (i > 1) then
     if (excise(i-1)) then
      vminus(i) = v(i)
      vplus(i) = v(i)
      normal_m5 = .false.
     end if
    end if

    if (normal_m5) then
    
      vnorm = sqrt(v(i-2)**2 + v(i-1)**2 + v(i)**2 + v(i+1)**2 + v(i+2)**2)
    
#define MINMOD(x,y)  \
     (0.5d0*(sign(one,x) + sign(one,y)) * min(abs(x), abs(y)))

#define MINMOD4(w,x,y,z) \
     (0.125d0*( sign(one,w)+sign(one,x) )*abs( (sign(one,w)+sign(one,y)) * (sign(one,w)+sign(one,z)) )*min(abs(w), abs(x), abs(y), abs(z)))

#define MP5(am2, am1, a, ap1, ap2, arecon) \
      vl = (2.0d0*am2 - 13.0d0*am1 + 47.0d0*a + 27.0d0*ap1 - 3.0d0*ap2)/60.0d0  &&\
      vmp = a + MINMOD( ap1-a, mp5_alpha*(a-am1) )  &&\
      if ((vl-a)*(vl-vmp) .le. mp5_eps*vnorm) then &&\
         arecon = vl &&\
      else &&\
        djm1 = am2 -2.0d0*am1 + a &&\
        dj   = am1 -2.0d0*a + ap1 &&\
        djp1 = a -2.d0*ap1 + ap2 &&\
        dm4jph = MINMOD4(4.0d0*dj-djp1, 4.0d0*djp1-dj, dj, djp1) &&\
        dm4jmh = MINMOD4(4.0d0*dj-djm1, 4.0d0*djm1-dj, dj, djm1) &&\
        vul = a + mp5_alpha*(a-am1) &&\
        vav = 0.5d0*(a+ap1) &&\
        vmd = vav - 0.5d0*dm4jph &&\
        vlc = a + 0.5d0*(a-am1) + 4.0d0/3.0d0*dm4jmh &&\
        vmin = max(min(a,ap1,vmd), min(a,vul,vlc)) &&\
        vmax = min(max(a,ap1,vmd), max(a,vul,vlc)) &&\
        arecon = vl + MINMOD(vmin-vl, vmax-vl) &&\
      endif
      
      MP5(v(i-2), v(i-1), v(i), v(i+1), v(i+2), vplus(i))
      MP5(v(i+2), v(i+1), v(i), v(i-1), v(i-2), vminus(i))
      
    end if
  end do

  do i = 1, nx
    if (excise(i)) then
      if (i > 1) then
        if (.not. excise(i-1)) then
          vminus(i) = vplus(i-1)
        end if
      end if
      vplus(i) = vminus(i)
    end if
  end do
  do i = nx, 1, -1
    if (excise(i)) then
      if (i < nx) then
        if (.not. excise(i+1)) then
          vplus(i) = vminus(i+1)
        end if
      end if
      vminus(i) = vplus(i)
    end if
  end do

end subroutine GRHydro_MP5Reconstruct1d

```

GRHydro_HLLC.F90:
```
 /*@@
   @file      GRHydro_HLLC.F90
   @date      Sat Jan 26 01:40:14 2002
   @author    Ian Hawke, Pedro Montero, Toni Font, Roland Haas
   @desc 
   The HLLC solver. Called from the wrapper function, so works in 
   all directions.
   @enddesc 
 @@*/
   
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Macros.h"
#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_HLLC
   @date       Sat Jan 26 01:41:02 2002
   @author     Ian Hawke, Pedro Montero, Toni Font, Roland Haas
   @desc 
   The HLLC solver. Sufficiently simple that its just one big routine.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Based entirely on Matt Duez notes on HLL and HLLC
   @endhistory 

@@*/

module GRHydro_hllc_helpers

  implicit none

  contains
  ! using nested subroutines seems to not work (either because gfortran has a
  ! bug or because they are not allowed with OpenMP). So we have to pass each
  ! argument explictly. ok for now since I plan to re-implement this in C
  ! anyway.
  subroutine compute_stardata(charstar,pressstar,consm_i,consp,sqrt_avg_det,pressminus,pressplus,&
                              uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,usendh,avg_beta,avg_alp,vxR,vxL,charmin,charmax,i,j,k,&
                              cctk_ash1,cctk_ash2,cctk_ash3,xoffset,yoffset,zoffset,flux_direction)

    implicit none

    CCTK_REAL, intent(out) :: charstar, pressstar

    integer, intent(in) :: cctk_ash1, cctk_ash2, cctk_ash3
    CCTK_REAL, intent(in), DIMENSION(5) :: consm_i, consp
    CCTK_REAL, intent(in) :: sqrt_avg_det, avg_beta, avg_alp
    CCTK_REAL, intent(in), DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: pressminus, pressplus
    CCTK_REAL, intent(in) :: uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,usendh
    CCTK_REAL, intent(in) :: charmin, charmax
    CCTK_REAL, intent(in) :: vxR, vxL
    integer, intent(in) :: i,j,k
    CCTK_INT, intent(in) :: xoffset, yoffset, zoffset, flux_direction

    ! naming convention: in this routine we use the convention of Duez (and by
    ! extenstion Mignone et al.MNRAS 364 126 (2005) which means that L<->plus,
    ! R<->minus
    ! for convenience, use s^k = D h u^k = D h g^{k \mu} u_\mu
    ! ie. this is NOT s^k = gamma^{kj} s_j
    ! doing the math, I find: 
    ! s^k = gamma^{kj} s_j - beta^k/alpha sqrt(detgamma) rho h W**2
    ! where the last part is rho h W**2 = tau+D+press
    CCTK_REAL :: sXL, sXR
    ! the coefficients of the quadratic equaion determining lambdastar
    CCTK_REAL :: AL,AR,BL,BR,CL,CR,EL,ER

    ! the combination D*h*W which appear more than once
    CCTK_REAL :: DhWL,DhWR
    CCTK_REAL :: lamstar_tilde ! eq (22)


    ! compute sX
    DhWR = consm_i(1)+consm_i(5)+ &
           sqrt_avg_det*pressminus(i+xoffset,j+yoffset,k+zoffset)
    DhWL = consp  (1)+consp  (5)+ &
           sqrt_avg_det*pressplus (i        ,j        ,k        )
    if (flux_direction == 1) then
      sXR = uxxh*consm_i(2)+uxyh*consm_i(3)+uxzh*consm_i(4) - &
            avg_beta/avg_alp*DhWR
      sXL = uxxh*consp  (2)+uxyh*consp  (3)+uxzh*consp  (4) - &
            avg_beta/avg_alp*DhWL
    else if (flux_direction == 2) then
      sXR = uxyh*consm_i(2)+uyyh*consm_i(3)+uyzh*consm_i(4) - &
            avg_beta/avg_alp*DhWR
      sXL = uxyh*consp  (2)+uyyh*consp  (3)+uyzh*consp  (4) - &
            avg_beta/avg_alp*DhWL
    else if (flux_direction == 3) then
      sXR = uxzh*consm_i(2)+uyzh*consm_i(3)+uzzh*consm_i(4) - &
            avg_beta/avg_alp*DhWR
      sXL = uxzh*consp  (2)+uyzh*consp  (3)+uzzh*consp  (4) - &
            avg_beta/avg_alp*DhWL
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if

    ! compute the coefficients A-D of Duez (23)-(26)
    AR = (consm_i(5)+consm_i(1))*(charmax+avg_beta) - (avg_alp*sXR+DhWR*avg_beta)
    AL = (consp  (5)+consp  (1))*(charmin+avg_beta) - (avg_alp*sXL+DhWL*avg_beta)
    CR = avg_alp*usendh
    CL = CR
    BR = CR*sqrt_avg_det*pressminus(i+xoffset,j+yoffset,k+zoffset) - &
         (sXR+DhWR*avg_beta/avg_alp)*(charmax-vXR)
    BL = CL*sqrt_avg_det*pressplus (i        ,j        ,k        ) - &
         (sXL+DhWL*avg_beta/avg_alp)*(charmin-vXL)
    ER = -(avg_beta + charmax) ! sing ERROR in Duez (26)
    EL = -(avg_beta + charmin)

    ! we require the negative root only (see Mignone et al), this is (27) of
    ! Duez
    call solve_quadratic(EL*AR-AL*ER, -(AL*CR+BL*ER-CL*AR-EL*BR), BR*CL-BL*CR, &
                         lamstar_tilde)

    charstar = avg_alp * lamstar_tilde - avg_beta ! eq (22)
    ! pressstar is equal left and right of contact discontinuity
    pressstar = (AL*lamstar_tilde + BL)/((CL+EL*lamstar_tilde)*sqrt_avg_det)

  end subroutine

  ! this function is a straightforward transcription of the GSL solve_quadratic
  ! functions. Both codes are GPL. 
  ! Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Brian Gough
  subroutine solve_quadratic(a,b,c, res)

    implicit none

    CCTK_REAL, intent(in) :: a,b,c
    CCTK_REAL, intent(out) :: res

    CCTK_REAL, parameter :: one = 1
    CCTK_REAL :: disc, r, sgnb, temp, r1, r2
    character(len=256) :: warnline

    disc = b * b - 4 * a * c
  
    if (a == 0) then! Handle linear case
        if (b == 0) then
            write (warnline, '("Could not solve quadratic equation with coefficients ",3g22.15)') a,b,c
            call CCTK_ERROR(warnline)
            STOP
        else
            res = -c / b
        end if
        return
    end if
  
    if (disc > 0) then
        if (b == 0) then
            r = abs (0.5d0 * sqrt (disc) / a)
            res = -r
            !*x1 =  r ! only want negative root
        else
            sgnb = sign(one, b)
            temp = -0.5d0 * (b + sgnb * sqrt (disc))
            r1 = temp / a
            r2 = c / temp

            res = r2 ! only want negative (second) root
  
            !if (r1 < r2) then
            !    res = r1
            !    !*x1 = r2 ! only want negative root
            !else 
            !    res = r2
            !    !*x1 = r1 ! only want negative root
            !end if
        end if
    else if (disc == 0) then
        res = -0.5d0 * b / a
        !*x1 = -0.5 * b / a ! only want one root
    else
        write (warnline, '("Could not solve quadratic equation with coefficients ",3g22.15)') a,b,c
        call CCTK_ERROR(warnline)
        STOP
    end if

  end subroutine
end module GRHydro_hllc_helpers


subroutine GRHydro_HLLC(CCTK_ARGUMENTS)
  USE GRHydro_Eigenproblem
  USE GRHydro_hllc_helpers

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  integer :: i, j, k
  CCTK_INT :: keytemp
  CCTK_REAL, dimension(5) :: consp,consm_i,fplus,fminus,lamplus
  CCTK_REAL, dimension(5) :: f1,lamminus, consstar
  CCTK_REAL ::  charmin, charmax, charstar, avg_alp,avg_det
  CCTK_REAL :: gxxh, gxyh, gxzh, gyyh, gyzh, gzzh, uxxh, uxyh, &
       uxzh, uyyh, uyzh, uzzh, avg_beta, usendh
  CCTK_REAL :: pressstar ! NOTE: this name is unfortuante for MHD where it
                         ! conflicts
  CCTK_REAL :: sqrt_avg_det
  ! Duez und GRHydro define different quantities v^i, we have 
  ! v^i_Duez = alp*v^i_GRHydro - beta^i
  CCTK_REAL :: vXL, vXR
  CCTK_REAL :: velstar ! GRhydro's velocity in the star region
    
  CCTK_INT :: type_bits, trivial

  ! sign requires its arguments to be of identical KIND
  CCTK_REAL, parameter :: one = 1d0
  
  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)
  
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
    pvup = loc(vel)
  end if

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if

  if(evolve_temper.eq.1.and.reconstruct_temper.eq.1) then
     keytemp = 1
  else
     keytemp = 0
  endif

  !$OMP PARALLEL DO PRIVATE(k,j,i,f1,lamminus,lamplus,consp,consm_i,consstar, &
  !$OMP                     fplus,fminus,avg_beta,avg_alp,   &
  !$OMP                     avg_det,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
  !$OMP                     uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,         &
  !$OMP                     usendh, charmin, charmax, charstar, &
  !$OMP                     pressstar, sqrt_avg_det, vXL, vXR, velstar)
  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil
        
        f1 = 0.d0
        lamminus = 0.d0
        lamplus = 0.d0
        consp = 0.d0
        consm_i = 0.d0
        fplus = 0.d0
        fminus = 0.d0
        
!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        consp(1)   = densplus(i,j,k) 
        consp(2)   = sxplus(i,j,k)
        consp(3)   = syplus(i,j,k)
        consp(4)   = szplus(i,j,k)
        consp(5)   = tauplus(i,j,k)
        
        consm_i(1) = densminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(2) = sxminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(3) = syminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(4) = szminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(5) = tauminus(i+xoffset,j+yoffset,k+zoffset) 
          
!!$        Calculate various metric terms here.
!!$        Note also need the average of the lapse at the 
!!$        left and right points.

        if (flux_direction == 1) then
           avg_beta = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
               beta1(i,j,k))
        else if (flux_direction == 2) then
           avg_beta = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
               beta2(i,j,k))
        else if (flux_direction == 3) then
           avg_beta = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
               beta3(i,j,k))
        else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
         end if

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gxyh = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gxzh = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gyyh = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gyzh = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gzzh = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))

        avg_det =  SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,\
             gyyh,gyzh,gzzh)
        sqrt_avg_det = sqrt(avg_det)

!!$ If the Riemann problem is trivial, just calculate the fluxes from the 
!!$ left state and skip to the next cell
          
        if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then

          if (flux_direction == 1) then
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                 f1(1),f1(2),f1(3),&
                 f1(4),f1(5),&
                 velxplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                 f1(1),f1(3),f1(4),&
                 f1(2),f1(5),&
                 velyplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                 f1(1),f1(4),f1(2),&
                 f1(3),f1(5),&
                 velzplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
        else !!! The end of this branch is right at the bottom of the routine
            
          call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
               avg_det,gxxh, gxyh, gxzh, &
               gyyh, gyzh, gzzh)
          
          if (flux_direction == 1) then
            usendh = uxxh
            vXR = avg_alp*velxminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta
            vXL = avg_alp*velxplus (i        ,j        ,k        ) - avg_beta
          else if (flux_direction == 2) then
            usendh = uyyh
            vXR = avg_alp*velyminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta
            vXL = avg_alp*velyplus (i        ,j        ,k        ) - avg_beta
          else if (flux_direction == 3) then
            usendh = uzzh
            vXR = avg_alp*velzminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta
            vXL = avg_alp*velzplus (i        ,j        ,k        ) - avg_beta
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
!!$        Eigenvalues and fluxes either side of the cell interface
          
          if (flux_direction == 1) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velxplus(i,j,k),velyplus(i,j,k),&
                     velzplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velxplus(i,j,k),velyplus(i,j,k),&
                     velzplus(i,j,k),epsplus(i,j,k), &
                     tempplus(i,j,k),&
                     y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                 fplus(1),fplus(2),fplus(3),fplus(4),&
                 fplus(5),velxplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(2),consm_i(3),&
                 consm_i(4),consm_i(5),fminus(1),fminus(2),fminus(3),&
                 fminus(4), fminus(5),&
                 velxminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velyplus(i,j,k),velzplus(i,j,k),&
                     velxplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velyplus(i,j,k),velzplus(i,j,k),&
                     velxplus(i,j,k),epsplus(i,j,k),&
                     tempplus(i,j,k),y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                 fplus(1),fplus(3),fplus(4),fplus(2),&
                 fplus(5),velyplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(3),consm_i(4),&
                 consm_i(2),consm_i(5),fminus(1),fminus(3),fminus(4),&
                 fminus(2), fminus(5),&
                 velyminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velzplus(i,j,k),velxplus(i,j,k),&
                     velyplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velzplus(i,j,k),velxplus(i,j,k),&
                     velyplus(i,j,k),epsplus(i,j,k),&
                     tempplus(i,j,k),y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                 fplus(1),fplus(4),fplus(2),fplus(3),&
                 fplus(5),velzplus(i,j,k),pressplus(i,j,k),avg_det,&
                 avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(4),consm_i(2),&
                 consm_i(3),consm_i(5),fminus(1),fminus(4),fminus(2),&
                 fminus(3), fminus(5),&
                 velzminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if

          
!!$        we need characteristic speeds for leftmost and rightmost state only.
      
          ! Duez and GRHydro differ by a factor of lapse that we pull out of the
          ! fluxes. To aid the overall confusion, we are going to adhere to
          ! Duez' convetion for a while until we compute the fluxes. Note that
          ! the contained function compute_lamstar has access to all of our
          ! local variables and does indeed look at charmin and charmax.
          charmin = min(lamminus(1),lamplus(1))*avg_alp
          charmax = max(lamminus(5),lamplus(5))*avg_alp
          call compute_stardata(charstar, pressstar,consm_i,consp,sqrt_avg_det,pressminus,pressplus,&
                              uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,usendh,avg_beta,avg_alp,vxR,vxL,charmin,charmax,i,j,k,&
                              cctk_ash1,cctk_ash2,cctk_ash3,xoffset,yoffset,zoffset,flux_direction)
          
!!$        Calculate flux by standard formula

          ! TODO: possibly one can safe a bit of time but oly computing charstar
          ! when needed? No need to compute it when 0.lt.charmin or 0.gt.charmax
          ! TODO: only compute fplus and fminus when we need them
          ! TODO: clean this up. This is horrible. Consider reviving the GT C
          ! HLL code for this.
          if (0.lt.charmin) then
            f1 = fplus
          else if (0.lt.charstar) then
            ! solve for state vector ULstar using (12)-(16)
            ! note the change in sign in both numerator and denom
            consstar = (vXL - charmin)/(charstar-charmin)*consp
            ! sx, sy, sz
            consstar(1+flux_direction) = consstar(1+flux_direction) + &
              avg_alp*sqrt_avg_det* &
                (pressplus (i        ,j        ,k        )-pressstar) / &
                (charstar-charmin)
            ! tau
            consstar(5) = consstar(5) + sqrt_avg_det * &
              ((vXL+avg_beta)*pressplus (i        ,j        ,k        ) - &
               (charstar+avg_beta)*pressstar) / &
               (charstar-charmin)
            ! need to pass in GRHydro velocity computed from Duez velocity 
            ! which is charstar in the star region
            velstar = (charstar+avg_beta)/avg_alp
            if (flux_direction == 1) then
              call num_x_flux(consstar(1),consstar(2),consstar(3),&
                   consstar(4),consstar(5),&
                   f1(1),f1(2),f1(3),f1(4),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else if (flux_direction == 2) then
              call num_x_flux(consstar(1),consstar(3),consstar(4),&
                   consstar(2),consstar(5),&
                   f1(1),f1(3),f1(4),f1(2),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else if (flux_direction == 3) then
              call num_x_flux(consstar(1),consstar(4),consstar(2),&
                   consstar(3),consstar(5),&
                   f1(1),f1(4),f1(2),f1(3),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else
              call CCTK_ERROR("Flux direction not x,y,z")
              STOP
            end if
          else if (0.lt.charmax) then
            ! solve for state vector URstar using (12)-(16)
            ! note the change in sign in both numerator and denom
            consstar = (vXR - charmax)/(charstar-charmax)*consm_i
            ! sx, sy, sz
            consstar(1+flux_direction) = consstar(1+flux_direction) + &
              avg_alp*sqrt_avg_det* &
                (pressminus(i+xoffset,j+yoffset,k+zoffset)-pressstar) / &
                (charstar-charmax)
            ! tau
            consstar(5) = consstar(5) + sqrt_avg_det * &
              ((vXR+avg_beta)*pressminus(i+xoffset,j+yoffset,k+zoffset) - &
               (charstar+avg_beta)*pressstar) / &
               (charstar-charmax)
            ! need to pass in GRHydro velocity computed from Duez velocity 
            ! which is charstar in the star region
            velstar = (charstar+avg_beta)/avg_alp
            if (flux_direction == 1) then
              call num_x_flux(consstar(1),consstar(2),consstar(3),&
                   consstar(4),consstar(5),&
                   f1(1),f1(2),f1(3),f1(4),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else if (flux_direction == 2) then
              call num_x_flux(consstar(1),consstar(3),consstar(4),&
                   consstar(2),consstar(5),&
                   f1(1),f1(3),f1(4),f1(2),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else if (flux_direction == 3) then
              call num_x_flux(consstar(1),consstar(4),consstar(2),&
                   consstar(3),consstar(5),&
                   f1(1),f1(4),f1(2),f1(3),f1(5),&
                   velstar,pressstar,avg_det,avg_alp,avg_beta)
            else
              call CCTK_ERROR("Flux direction not x,y,z")
              STOP
            end if
          else
            f1 = fminus
          end if
          
        end if !!! The end of the SpaceMask check for a trivial RP.
            
        densflux(i, j, k) = f1(1)
        sxflux(i, j, k) = f1(2)
        syflux(i, j, k) = f1(3)
        szflux(i, j, k) = f1(4)
        tauflux(i, j, k) = f1(5)

        if(evolve_Y_e.ne.0) then
           if (densflux(i, j, k) > 0.d0) then
              Y_e_con_flux(i, j, k) = &
                   Y_e_plus(i, j, k) * &
                   densflux(i, j, k)
           else
              Y_e_con_flux(i, j, k) = &
                   Y_e_minus(i + xoffset, j + yoffset, k + zoffset) * &
                   densflux(i, j, k)
           endif
        endif

      end do
    end do
  end do
  !$OMP END PARALLEL DO


end subroutine GRHydro_HLLC


```

GRHydro_UtilsM.F90:
```
/*@@
@file      UtilsM.F
@date      Aug 30, 2010
@author    Joshua Faber, Scott Noble, Bruno Mundim
@desc 
Utility functions for other thorns. 
@enddesc 
@@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"


subroutine calc_vlow_blow(gxx,gxy,gxz,gyy,gyz,gzz, &
     velx,vely,velz,Bvecx,Bvecy,Bvecz, &
     velxlow,velylow,velzlow,Bvecxlow,Bvecylow,Bveczlow, &
     Bdotv,b2,v2,w,bxlow,bylow,bzlow)
  
!!$ Calculates v_i (see Anton Eq. 5) and B_i (Bvecxlow)- undensitized!
!!$ calculates B^i v_i [Anton eq. 44] and b^2 [LHS of Anton eq. 46] 
!!$ Calculates w (Lorentz factor) as (1-v^i v_i)^{-1/2}
!!$ Calculates b_i (bxlow)

  CCTK_REAL :: gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL :: velx,vely,velz,Bvecx,Bvecy,Bvecz
  CCTK_REAL :: velxlow,velylow,velzlow
  CCTK_REAL :: Bvecxlow,Bvecylow,Bveczlow
  CCTK_REAL :: Bdotv,v2,w,b2,bxlow,bylow,bzlow

!!$ vel_i  = g_ij v^j
!!$ B_i = g_ij B^i

  velxlow = gxx*velx + gxy*vely + gxz*velz
  velylow = gxy*velx + gyy*vely + gyz*velz
  velzlow = gxz*velx + gyz*vely + gzz*velz
  Bvecxlow = gxx*Bvecx + gxy*Bvecy + gxz*Bvecz
  Bvecylow = gxy*Bvecx + gyy*Bvecy + gyz*Bvecz
  Bveczlow = gxz*Bvecx + gyz*Bvecy + gzz*Bvecz
 
!!$  B^i v_i (= b^0/u^0)
  Bdotv = velxlow*Bvecx+velylow*Bvecy+velzlow*Bvecz
  
!!$v^2 = v_i v^i; w=(1-v^2)^{-1/2}

  v2 = velxlow*velx + velylow*vely + velzlow*velz
  w = 1.d0/sqrt(1.d0-v2)

!!$b^2 = B^i B_i / w^2 + (b^0/u^0)^2

  b2=(Bvecx*Bvecxlow+Bvecy*Bvecylow+Bvecz*Bveczlow)/w**2+Bdotv**2

!!$ b_i = B_i/w +w*(B dot v)*v_i
  bxlow = Bvecxlow/w+w*Bdotv*velxlow
  bylow = Bvecylow/w+w*Bdotv*velylow
  bzlow = Bveczlow/w+w*Bdotv*velzlow

end subroutine calc_vlow_blow

```

GRHydro_BvecfromAvec.F90:
```
  /*@@
   @file      GRHydro_BvecfromAvec 
   @date      Aug 31, 2010
   @author    Tanja Bode
   @desc 
   Calculate B^i (at cell center) from Avec (at edges)
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.h"

#define Bvecx(i,j,k) Bvec(i,j,k,1)
#define Bvecy(i,j,k) Bvec(i,j,k,2)
#define Bvecz(i,j,k) Bvec(i,j,k,3)
#define Avecx(i,j,k) Avec(i,j,k,1)
#define Avecy(i,j,k) Avec(i,j,k,2)
#define Avecz(i,j,k) Avec(i,j,k,3)

! Second order f.d. for volume-centered quantity from volume-centered quantity
#define DIFF_X_2(q) (0.5d0 * (q(i+1,j,k) - q(i-1,j,k)) * idx)
#define DIFF_Y_2(q) (0.5d0 * (q(i,j+1,k) - q(i,j-1,k)) * idy)
#define DIFF_Z_2(q) (0.5d0 * (q(i,j,k+1) - q(i,j,k-1)) * idz)

! Fourth order f.d. for volume-centered quantity from volume-centered quantity
#define DIFF_X_4(q) ((- q(i+2,j,k) + 8.d0 * q(i+1,j,k) \
                      - 8.d0 * q(i-1,j,k) + q(i-2,j,k)) / 12.d0 * idx)
#define DIFF_Y_4(q) ((- q(i,j+2,k) + 8.d0 * q(i,j+1,k) \
                      - 8.d0 * q(i,j-1,k) + q(i,j-2,k)) / 12.d0 * idy)
#define DIFF_Z_4(q) ((- q(i,j,k+2) + 8.d0 * q(i,j,k+1) \
                      - 8.d0 * q(i,j,k-1) + q(i,j,k-2)) / 12.d0 * idz)

 /*@@
   @routine   GRHydro_BvecfromAvec
   @date      Oct 24
   @author    Tanja Bode
   @desc 
   Calculate B^i (at cell center) from Avec (at edges)
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_BvecfromAvec(CCTK_ARGUMENTS)

  implicit none

  CCTK_REAL :: Az_y, Ay_z, Ax_z, Az_x, Ay_x, Ax_y
  CCTK_REAL :: sdet, isdet
  CCTK_REAL :: dx, dy, dz, idx, idy, idz
  CCTK_INT  :: i, j, k, nx, ny, nz, GRHydro_UseGeneralCoordinates
  CCTK_INT  :: local_spatial_order

  logical, allocatable, dimension (:,:,:) :: force_spatial_second_order

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
     call CCTK_ERROR("Bvec from Avec only in Cartesian at the moment.");
     STOP
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  dx = CCTK_DELTA_SPACE(1)
  dy = CCTK_DELTA_SPACE(2)
  dz = CCTK_DELTA_SPACE(3)
  idx = 1.d0/dx
  idy = 1.d0/dy
  idz = 1.d0/dz
 
  allocate (force_spatial_second_order(nx,ny,nz))
  force_spatial_second_order = .FALSE.
  
  if (sources_spatial_order > 2) then
    !$OMP PARALLEL DO PRIVATE(i, j, k)
    do k = 1 + GRHydro_stencil, nz - GRHydro_stencil
      do j = 1 + GRHydro_stencil, ny - GRHydro_stencil
        do i = 1 + GRHydro_stencil, nx - GRHydro_stencil
          if ((i < 3).or.(i > cctk_lsh(1) - 2).or. &
               (j < 3).or.(j > cctk_lsh(2) - 2).or. &
               (k < 3).or.(k > cctk_lsh(3) - 2) ) then
            force_spatial_second_order(i,j,k) = .TRUE.
          else if ( use_mask > 0 ) then
            if (minval(emask(i-2:i+2,j-2:j+2,k-2:k+2)) < 0.75d0) then
              force_spatial_second_order(i,j,k) = .TRUE.
            end if
          end if
        end do
      end do
    end do
    !$OMP END PARALLEL DO
  end if
  
 
  call CCTK_WARN(1,"Bvec from Avec start."); 
  !$OMP PARALLEL DO PRIVATE( i, j, k, sdet, isdet, local_spatial_order, &
  !$OMP                      Az_y, Ay_z, Ax_z, Az_x, Ay_x, Ax_y)
  do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1
    do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1
      do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1

          local_spatial_order = sources_spatial_order
          if (force_spatial_second_order(i,j,k)) then
            local_spatial_order = 2
          end if

          if (local_spatial_order .eq. 2) then
             Az_y = DIFF_Y_2(Avecz)
             Ay_z = DIFF_Z_2(Avecy)
             Ax_z = DIFF_Z_2(Avecx)
             Az_x = DIFF_X_2(Avecz)
             Ay_x = DIFF_X_2(Avecy)
             Ax_y = DIFF_Y_2(Avecx)
          else
             Az_y = DIFF_Y_4(Avecz)
             Ay_z = DIFF_Z_4(Avecy)
             Ax_z = DIFF_Z_4(Avecx)
             Az_x = DIFF_X_4(Avecz)
             Ay_x = DIFF_X_4(Avecy)
             Ax_y = DIFF_Y_4(Avecx)
          end if

          sdet = sdetg(i,j,k)
          isdet = 1.d0/sdet

          Bvecx(i,j,k) = isdet*( Az_y - Ay_z )
          Bvecy(i,j,k) = isdet*( Ax_z - Az_x )
          Bvecz(i,j,k) = isdet*( Ay_x - Ax_y )

      end do
    end do
  end do
  !$OMP END PARALLEL DO
  call CCTK_WARN(1,"Bvec from Avec end."); 


end subroutine GRHydro_BvecfromAvec

```

make.configuration.defn:
```
# make.configuration.defn for GRHydro

# add the utilities to the list
ALL_UTILS += Riemann1d

```

GRHydro_RegisterMask.c:
```
 /*@@
   @file      GRHydro_RegisterMask.c
   @date      Sun Jan 26 01:55:25 2003
   @author    Ian Hawke
   @desc 
   Routines to register states with SpaceMask.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"

#include "SpaceMask.h"

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

 /*@@
   @routine    GRHydro_RegisterMask
   @date       Sun Jan 26 01:56:06 2003
   @author     
   @desc 
   Register the different mask states with the SpaceMask thorn.
   
   At the moment, the recognized states and values are

   Hydro_RiemannProblem (trivial, not_trivial)

   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

int GRHydro_RegisterMask(void)
{
  
  DECLARE_CCTK_PARAMETERS;
  
  int ierr;

  const char *rp_list[2] = {"trivial","not_trivial"};
  
  ierr = SpaceMask_RegisterType("Hydro_RiemannProblemX", 2, rp_list);
  if (ierr)
  {
    CCTK_WARN(0, "Failed to register the x Riemann Problem with the mask!");
  }

  ierr = SpaceMask_RegisterType("Hydro_RiemannProblemY", 2, rp_list);
  if (ierr)
  {
    CCTK_WARN(0, "Failed to register the y Riemann Problem with the mask!");
  }

  ierr = SpaceMask_RegisterType("Hydro_RiemannProblemZ", 2, rp_list);
  if (ierr)
  {
    CCTK_WARN(0, "Failed to register the z Riemann Problem with the mask!");
  }

  return 0;
}


```

GRHydro_PreLoop.F90:
```
 /*@@
   @file      GRHydro_PreLoop.F90
   @date      Mon Feb 25 11:43:36 2002
   @author    
   @desc 
   Sets up various scalars used for efficiency reasons.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydro_Scalar_Setup
   @date       Mon Feb 25 11:25:27 2002
   @author     
   @desc 
   Sets up the logical scalars from the parameters. These are
   solely used for efficiency.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_Scalar_Setup(CCTK_ARGUMENTS)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  MINMOD = .false.
  MC2 = .false.
  SUPERBEE = .false.
  HLLE = .false.
  LLF = .false.

  if (CCTK_EQUALS(tvd_limiter,"minmod")) then
    MINMOD = .true.    
  else if (CCTK_EQUALS(tvd_limiter,"vanleerMC2")) then
    MC2 = .true.
  else if (CCTK_EQUALS(tvd_limiter,"Superbee")) then
    SUPERBEE = .true.
  else
    call CCTK_ERROR("TVD Limiter not recognized!")
    STOP
  end if

  PPM3=.false.
  PPM4=.false.

  if (CCTK_EQUALS(ppm_flatten,"stencil_3")) then
    PPM3=.true.
  else if (CCTK_EQUALS(ppm_flatten,"stencil_4")) then
    PPM4=.true.
  else
    call CCTK_ERROR("PPM Flattening Procedure not recognized!")
    STOP
  end if

  ANALYTICAL = .false.

  if (CCTK_EQUALS(left_eigenvectors,"analytical")) then
    ANALYTICAL = .true.
  else if (CCTK_EQUALS(left_eigenvectors,"numerical")) then
    ANALYTICAL = .false.
  else
    call CCTK_ERROR("Left Eigenvector Mode not recognized!")
    STOP
  end if

  FAST = .false.

  if (CCTK_EQUALS(numerical_viscosity,"fast")) then
    FAST = .true.
  else if (CCTK_EQUALS(numerical_viscosity,"normal")) then
    FAST = .false.
  else
    call CCTK_ERROR("Numerical Viscosity Mode not recognized!")
    STOP
  end if

  if (CCTK_EQUALS(riemann_solver,"HLLE")) then
    HLLE = .true.
  else if (CCTK_EQUALS(riemann_solver,"LLF")) then
    LLF = .true.
  end if

end subroutine GRHydro_Scalar_Setup



 /*@@
   @routine    GRHydro_DivBInit
   @date       Apr 06, 2011
   @author     Bruno Mundim
   @desc 
   Set divB=0 initially.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_DivBInit(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  divB=0.0

end subroutine GRHydro_DivBInit



```

GRHydro_Con2Prim.F90:
```
/*@@
   @file      GRHydro_RegisterVars.c
   @date      Sat Jan 26 01:06:01 2002
   @author    The GRHydro Developers
   @desc 
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"
#include "GRHydro_Macros.h"

 /*@@
   @routine    Conservative2Primitive
   @date       Sat Jan 26 01:08:33 2002
   @author     Ian Hawke
   @desc 
   Wrapper routine that converts from conserved to primitive variables
   at every grid cell centre.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Trimmed and altered from the GR3D routines, original author Mark Miller.
   2007?: Bruno excluded the points in the atmosphere and excision region from the computation.
   Aug. 2008: Luca added a check on whether a failure at a given point may be disregarded, 
   because that point will then be restricted from a finer level. This should be completely 
   safe only if *regridding happens at times when all levels are evolved.*
   Feb. 2009: The above procedure proved to be wrong, so Luca implemented another one. 
   When a failure occurs, it is temporarily ignored, except for storing the location of where 
   it occured in a mask. At the end, after a Carpet restriction, the mask is checked and if 
   it still contains failures, the run is aborted with an error message. Only used routines 
   have been updated to use this procedure.
   @endhistory 

@@*/

subroutine Conservative2Primitive(CCTK_ARGUMENTS)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  integer :: i, j, k, itracer, nx, ny, nz
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, pmin, epsmin, dummy1, dummy2
  logical :: epsnegative
  character*256 :: warnline
  
  CCTK_REAL :: local_min_tracer
  CCTK_REAL :: local_perc_ptol

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1)
  n = 1;keytemp = 0;anyerr = 0;keyerr(1) = 0
  xpress = 0.0d0;xeps = 0.0d0;xtemp = 0.0d0;xye = 0.0d0
! end EOS Omni vars

  if(evolve_temper.ne.0) then
     call Conservative2PrimitiveHot(CCTK_PASS_FTOF)
     return
  endif


  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  
  if (use_min_tracer .ne. 0) then
    local_min_tracer = min_tracer
  else
    local_min_tracer = 0.0d0
  end if

  ! this is a poly call
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
         GRHydro_rho_min,xeps,xtemp,xye,pmin,keyerr,anyerr)
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       GRHydro_rho_min,xeps,xtemp,xye,pmin,epsmin,keyerr,anyerr)

  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz, epsnegative, anyerr, keyerr, keytemp,&
  !$OMP warnline, dummy1, dummy2)
  do k = 1, nz 
    do j = 1, ny 
      do i = 1, nx

#if 0
         if (dens(i,j,k).ne.dens(i,j,k)) then
            !$OMP CRITICAL
            call CCTK_WARN(1,"dens NAN at entry of Con2Prim")
            write(warnline,"(A10,i5)") "reflevel: ",GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a32,2i3)') 'hydro_excision_mask, atmosphere_mask: ', hydro_excision_mask(i,j,k), atmosphere_mask(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_ERROR("Aborting!!!")
            STOP
            !$OMP END CRITICAL
         endif
#endif


#if 0
        !$OMP CRITICAL
         if (rho(i,j,k).le.0.0d0) then
            call CCTK_WARN(1,"rho less than zero at entry of Con2Prim")
            write(warnline,"(A10,i5)") "reflevel: ",GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_ERROR("Aborting!!!")
            STOP
         endif
         !$OMP END CRITICAL
#endif

        
        !do not compute if in atmosphere region!
        if (atmosphere_mask(i,j,k) .gt. 0) cycle
        
        epsnegative = .false.

        call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdetg(i,j,k)*sdetg(i,j,k),&
             g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),&
             g23(i,j,k),g33(i,j,k))        

        ! In excised region, set to atmosphere!    
        if (GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .gt. 0)) then
           SET_ATMO_MIN(dens(i,j,k), sdetg(i,j,k)*GRHydro_rho_min, r(i,j,k)) !sqrt(det)*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
           SET_ATMO_MIN(rho(i,j,k), GRHydro_rho_min, r(i,j,k)) !GRHydro_rho_min
           scon(i,j,k,:) = 0.d0
           vup(i,j,k,:) = 0.d0
           w_lorentz(i,j,k) = 1.d0

           if(evolve_temper.ne.0) then
              ! set hot atmosphere values
              temperature(i,j,k) = grhydro_hot_atmo_temp
              y_e(i,j,k) = grhydro_hot_atmo_Y_e
              y_e_con(i,j,k) = y_e(i,j,k) * dens(i,j,k)
              keytemp = 1
              call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),temperature(i,j,k),y_e(i,j,k),&
                   press(i,j,k),keyerr,anyerr)
           else
              keytemp = 0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),keyerr,anyerr)

              call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)
           endif

           ! w_lorentz=1, so the expression for tau reduces to:
           tau(i,j,k)  = sdetg(i,j,k) * (rho(i,j,k)+rho(i,j,k)*eps(i,j,k)) - dens(i,j,k)
           
           cycle
        endif
        
!!$        if (det < 0.e0) then  
!!$          call CCTK_ERROR("nan produced (det negative)")
!!$          STOP
!!$        end if

        if (evolve_tracer .ne. 0) then
           do itracer=1,number_of_tracers
              call Con2Prim_ptTracer(cons_tracer(i,j,k,itracer), tracer(i,j,k,itracer), &
                   dens(i,j,k))

              if (use_min_tracer .ne. 0) then
                if (tracer(i,j,k,itracer) .le. local_min_tracer) then
                  tracer(i,j,k,itracer) = local_min_tracer
                end if
              end if

           enddo
           
        endif
        
        if(evolve_Y_e.ne.0) then
           Y_e(i,j,k) = max(min(Y_e_con(i,j,k) / dens(i,j,k),GRHydro_Y_e_max),&
                GRHydro_Y_e_min)
        endif

         !if ( dens(i,j,k) .le. sqrt(det)*GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
         IF_BELOW_ATMO(dens(i,j,k), sdetg(i,j,k)*GRHydro_rho_min, GRHydro_atmo_tolerance, r(i,j,k)) then
           SET_ATMO_MIN(dens(i,j,k), sdetg(i,j,k)*GRHydro_rho_min, r(i,j,k)) !sqrt(det)*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
           SET_ATMO_MIN(rho(i,j,k), GRHydro_rho_min, r(i,j,k)) !GRHydro_rho_min
           scon(i,j,k,:) = 0.d0
           vup(i,j,k,:) = 0.d0
           w_lorentz(i,j,k) = 1.d0

           if(evolve_temper.ne.0) then
              ! set hot atmosphere values
              temperature(i,j,k) = grhydro_hot_atmo_temp
              y_e(i,j,k) = grhydro_hot_atmo_Y_e
              y_e_con(i,j,k) = y_e(i,j,k) * dens(i,j,k)
              keytemp = 1
              call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),temperature(i,j,k),y_e(i,j,k),&
                   press(i,j,k),keyerr,anyerr)
           else
              keytemp = 0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),keyerr,anyerr)

              call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)
           endif

           ! w_lorentz=1, so the expression for tau reduces to:
           tau(i,j,k)  = sdetg(i,j,k) * (rho(i,j,k)+rho(i,j,k)*eps(i,j,k)) - dens(i,j,k)
           
           cycle

         end if

         if(evolve_temper.eq.0) then
            call Con2Prim_pt(int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),&
                 GRHydro_eos_handle, dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2), &
                 scon(i,j,k,3),tau(i,j,k),rho(i,j,k),vup(i,j,k,1),vup(i,j,k,2), &
                 vup(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(i,j,k), &
                 uxx,uxy,uxz,uyy,uyz,uzz,sdetg(i,j,k),x(i,j,k),y(i,j,k), &
                 z(i,j,k),r(i,j,k),epsnegative,GRHydro_rho_min,pmin, epsmin, & 
                 GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
         else
            call CCTK_ERROR("Should never reach this point!")
            STOP
         endif


        if (epsnegative) then  

#if 0
          ! cott 2010/03/30:
          ! Set point to atmosphere, but continue evolution -- this is better than using
          ! the poly EOS -- it will lead the code to crash if this happens inside a (neutron) star,
          ! but will allow the job to continue if it happens in the atmosphere or in a
          ! zone that contains garbage (i.e. boundary, buffer zones)
          ! Ultimately, we want this fixed via a new carpet mask presently under development
!           GRHydro_C2P_failed(i,j,k) = 1

          !$OMP CRITICAL
          call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0! ')
          write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
          call CCTK_WARN(GRHydro_NaN_verbose+2,warnline)
          write(warnline,'(a20,3g16.7)') 'xyz location: ',&
               x(i,j,k),y(i,j,k),z(i,j,k)
          call CCTK_WARN(GRHydro_NaN_verbose+2,warnline)
          write(warnline,'(a20,g16.7)') 'radius: ',r(i,j,k)
          call CCTK_WARN(GRHydro_NaN_verbose+2,warnline)
          call CCTK_WARN(GRHydro_NaN_verbose+2,"Setting the point to atmosphere")
          !$OMP END CRITICAL

          ! for safety, let's set the point to atmosphere
          dens(i,j,k) = ATMOMIN(sdetg(i,j,k)*GRHydro_rho_min, r(i,j,k)) !sqrt(det)*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
          rho(i,j,k) = ATMOMIN(GRHydro_rho_min, r(i,j,k)) !GRHydro_rho_min
          scon(i,j,k,:) = 0.d0
          vup(i,j,k,:) = 0.d0
          w_lorentz(i,j,k) = 1.d0

           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),keyerr,anyerr)

           call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                rho(i,j,k),eps(i,j,k),xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)

          ! w_lorentz=1, so the expression for tau reduces to:
          tau(i,j,k)  = sdetg(i,j,k) * (rho(i,j,k)+rho(i,j,k)*eps(i,j,k)) - dens(i,j,k)

#else
          ! cott 2010/03/27:      
          ! Honestly, this should never happen. We need to flag the point where
          ! this happened as having led to failing con2prim.

          !$OMP CRITICAL
          call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype.')
          !$OMP END CRITICAL
          call Con2Prim_ptPolytype(GRHydro_polytrope_handle, &
               dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), &
               tau(i,j,k), rho(i,j,k), vup(i,j,k,1), vup(i,j,k,2), &
               vup(i,j,k,3), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k), &
               uxx, uxy, uxz, uyy, uyz, uzz, sdetg(i,j,k), x(i,j,k), y(i,j,k), &
               z(i,j,k), r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
#endif          

        end if


!! Some debugging convenience output
# if 0
         !$OMP CRITICAL
         if (dens(i,j,k).ne.dens(i,j,k)) then
            call CCTK_WARN(1,"NAN at exit of Con2Prim")
            write(warnline,"(A10,i5)") "reflevel: ",GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_ERROR("Aborting!!!")
            STOP
         endif
         if (rho(i,j,k).ne.rho(i,j,k)) then
            call CCTK_WARN(1,"NAN in rho at exit of Con2Prim")
            write(warnline,"(A10,i5)") "reflevel: ",GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_ERROR("Aborting!!!")
            STOP
         endif
         !$OMP END CRITICAL
         
         !$OMP CRITICAL
         if (rho(i,j,k).le.0.0d0) then
            call CCTK_WARN(1,"rho less than zero at exit of Con2Prim")
            write(warnline,"(A10,i5)") "reflevel: ",GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_ERROR("Aborting!!!")
            STOP
         endif
         !$OMP END CRITICAL
#endif
         

      end do
    end do
  end do
  !$OMP END PARALLEL DO

  return
  
end subroutine Conservative2Primitive

/*@@
@routine    Con2Prim_pt
@date       Sat Jan 26 01:09:39 2002
@author     The GRHydro Develpoers    
@desc 
Given all the appropriate data, recover the primitive variables at
a single point.
@enddesc 
 @calls     
@calledby   
@history 
@endhistory 

@@*/

subroutine Con2Prim_pt(cctk_iteration,ii,jj,kk,&
     handle, dens, sx, sy, sz, tau, rho, velx, vely, &
     velz, epsilon, press, w_lorentz, uxx, uxy, uxz, uyy, &
     uyz, uzz, sdetg, x, y, z, r, epsnegative, GRHydro_rho_min, pmin, epsmin, &
     GRHydro_reflevel, GRHydro_C2P_failed)
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL dens, sx, sy, sz, tau, rho, velx, vely, velz, epsilon, &
       press, uxx, uxy, uxz, uyy, uyz, uzz, sdetg, isdetg, w_lorentz, x, &
       y, z, r, GRHydro_rho_min
  
  CCTK_REAL s2, f, df, vlowx, vlowy, vlowz
  CCTK_INT count, i, handle, GRHydro_reflevel
  CCTK_REAL GRHydro_C2P_failed, dummy1, dummy2
  CCTK_REAL udens, usx, usy, usz, utau, pold, pnew, &
            temp1, drhobydpress, depsbydpress, dpressbydeps, dpressbydrho, pmin, epsmin

  CCTK_INT cctk_iteration,ii,jj,kk
  character(len=200) warnline
  logical epsnegative, mustbisect

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,tmp,plow
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xtemp=0.0d0;xye=0.0d0
! end EOS Omni vars


!!$  Undensitize the variables 

  isdetg = 1.0d0/sdetg
  udens = dens * isdetg
  usx = sx * isdetg
  usy = sy * isdetg
  usz = sz * isdetg
  utau = tau * isdetg
  s2 = usx*usx*uxx + usy*usy*uyy + usz*usz*uzz + 2.*usx*usy*uxy + &
       2.*usx*usz*uxz + 2.*usy*usz*uyz
  
  
!!$  Set initial guess for pressure:
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
                      rho,epsilon,xtemp,xye,xpress,keyerr,anyerr)
  !pold = max(1.d-10,xpress)
  ! This is the lowest admissible pressure, otherwise we are off the physical regime
  ! Sometimes, we may end up with bad initial guesses. In that case we need to start off with something
  ! reasonable at least
  plow = max(pmin, sqrt(s2) - utau - udens)
  
  ! Start out with some reasonable initial guess
  pold = max(plow+1.d-10,xpress)

  mustbisect = .false.

!!$  Check that the variables have a chance of being physical

  if( (utau + pold + udens)**2 - s2 .le. 0.0d0) then

    if (c2p_reset_pressure .ne. 0) then
      pold = sqrt(s2 + c2p_reset_pressure_to_value) - utau - udens
    else 
      !$OMP CRITICAL
!!!!      call CCTK_WARN(GRHydro_NaN_verbose, "c2p failed and being told not to reset the pressure")
      !call CCTK_ERROR("c2p failed and being told not to reset the pressure")
      !STOP
      GRHydro_C2P_failed = 1
      !$OMP END CRITICAL
    endif
  endif
  
!!$  Calculate rho and epsilon 

!define temporary variables to speed up

  rho = udens * sqrt( (utau + pold + udens)**2 - s2)/(utau + pold + udens)
  w_lorentz = (utau + pold + udens) / sqrt( (utau + pold + udens)**2 - s2)
  epsilon = (sqrt( (utau + pold + udens)**2 - s2) - pold * w_lorentz - &
       udens)/udens
  
!!$  Calculate the function

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
                      rho,epsilon,xtemp,xye,xpress,keyerr,anyerr)

  f = pold - xpress

  if (f .ne. f) then 
     ! Ok, this yielded nonsense, let's enforce bisection!
     mustbisect = .true.
  endif
  
!!$Find the root
  
  count = 0
  pnew = pold
  do while ( ((abs(pnew - pold)/abs(pnew) .gt. GRHydro_perc_ptol) .and. &
       (abs(pnew - pold) .gt. GRHydro_del_ptol))  .or. &
       (count .lt. GRHydro_countmin))
    count = count + 1

    if (count > GRHydro_countmax) then
      GRHydro_C2P_failed = 1

      !$OMP CRITICAL
      call CCTK_WARN(1, 'count > GRHydro_countmax! ')
      write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
      call CCTK_WARN(1,warnline)
      write(warnline,'(a28,i8)') 'cctk_iteration:', cctk_iteration
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,3i5,3g16.7)') 'ijk, xyz location: ',ii,jj,kk,x,y,z
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'radius: ',r
      call CCTK_WARN(1,warnline)
      call CCTK_WARN(1,"Setting the point to atmosphere")
      !$OMP END CRITICAL


      ! for safety, let's set the point to atmosphere
      SET_ATMO_MIN(rho, GRHydro_rho_min, r)
      udens = rho
      dens = sdetg * rho
      pnew = pmin
      epsilon = epsmin
      ! w_lorentz=1, so the expression for utau reduces to:
      utau  = rho + rho*epsmin - udens
      sx = 0.d0
      sy = 0.d0
      sz = 0.d0
      s2 = 0.d0
      usx = 0.d0
      usy = 0.d0
      usz = 0.d0
      w_lorentz = 1.d0
      goto 51
    end if

    call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,xtemp,xye,dpressbydrho,keyerr,anyerr)

    call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,xtemp,xye,dpressbydeps,keyerr,anyerr)

    temp1 = (utau+udens+pnew)**2 - s2
    drhobydpress = udens * s2 / (sqrt(temp1)*(udens+utau+pnew)**2)
    depsbydpress = pnew * s2 / (rho * (udens + utau + pnew) * temp1)
    df = 1.0d0 - dpressbydrho*drhobydpress - &
         dpressbydeps*depsbydpress


    pold = pnew
    
    ! Try to obtain new pressure via Newton-Raphson.
    
    pnew = pold - f/df
    
    ! Check if Newton-Raphson resulted in something reasonable!
    
    if (c2p_resort_to_bisection.ne.0) then 
    
      tmp = (utau + pnew + udens)**2 - s2
      plow = max(pmin, sqrt(s2) - utau - udens)
      
      if (pnew .lt. plow .or. tmp .le. 0.0d0 .or. mustbisect) then
      
         ! Ok, Newton-Raphson ended up finding something unphysical.
         ! Let's try to find our root via bisection (which converges slower but is more robust)
      
         pnew = (plow + pold) / 2
         tmp = (utau + pnew + udens)**2 - s2
         
         mustbisect = .false.
      end if
    
    else
      
      ! This is the standard algorithm without resorting to bisection.
    
      pnew = max(pmin, pnew)
      tmp = (utau + pnew + udens)**2 - s2
    
    endif
    
    ! Check if we are still in the physical range now.
    ! If not, we set the C2P failed mask, and set pnew = pold (which will exit the loop).
    
    if ((tmp .le. 0.0d0) .and. GRHydro_C2P_failed .eq. 0) then
      GRHydro_C2P_failed = 1
      pnew = pold
    endif

    
!!$    Recalculate primitive variables and function
        
    rho = udens * sqrt( tmp)/(utau + pnew + udens)

!! Some debugging convenience output
#if 0
    if (rho .ne. rho) then
    !$OMP CRITICAL
      write(warnline,'(a38, i16)') 'NAN in rho! Root finding iteration: ', count
      call CCTK_WARN(1,warnline)
      write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,3g16.7)') 'xyz location: ',x,y,z
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'radius: ',r
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'udens: ', udens
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'dens: ', dens
      call CCTK_WARN(1,warnline)
      !write(warnline,'(a20,g16.7)') 'rho-old: ', rhoold
      !call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'pnew: ', pnew
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'pold: ', pold
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'xpress: ', xpress
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'f: ', f
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'df: ', df
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'f/df: ', f/df
      call CCTK_WARN(1,warnline)
      write(warnline,'(a30,g16.7)') '(utau + pnew + udens)**2 - s2: ', (utau + pnew + udens)**2 - s2
      call CCTK_WARN(1,warnline)
      write(warnline,'(a30,g16.7)') '(utau + pnew + udens): ', (utau + pnew + udens)
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'drhobydpress: ', drhobydpress
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'depsbydpress: ', depsbydpress
      call CCTK_ERROR(warnline)
      STOP
   !$OMP END CRITICAL
  endif
#endif

    w_lorentz = (utau + pnew + udens) / sqrt( tmp)
    epsilon = (sqrt( tmp) - pnew * w_lorentz - &
         udens)/udens

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,xtemp,xye,xpress,keyerr,anyerr)
    
    f = pnew - xpress

    if (f .ne. f) then 
       ! Ok, this yielded nonsense, let's enforce bisection!
       mustbisect = .true.
    endif

  enddo
  
!!$  Polish the root

  do i=1,GRHydro_polish

    call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,xtemp,xye,dpressbydrho,keyerr,anyerr)

    call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,xtemp,xye,dpressbydeps,keyerr,anyerr)

    temp1 = (utau+udens+pnew)**2 - s2
    drhobydpress = udens * s2 / (sqrt(temp1)*(udens+utau+pnew)**2)
    depsbydpress = pnew * s2 / (rho * (udens + utau + pnew) * temp1)
    df = 1.0d0 - dpressbydrho*drhobydpress - &
         dpressbydeps*depsbydpress
    pold = pnew
    pnew = pold - f/df
    
!!$    Recalculate primitive variables and function

    rho = udens * sqrt( (utau + pnew + udens)**2 - s2)/(utau + pnew + udens)
    w_lorentz = (utau + pnew + udens) / sqrt( (utau + pnew + udens)**2 - &
         s2)
    epsilon = (sqrt( (utau + pnew + udens)**2 - s2) - pnew * w_lorentz - &
         udens)/udens

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n, &
         rho,epsilon,xtemp,xye,xpress,keyerr,anyerr)
    
    f = pold - xpress


  enddo

!!$  Calculate primitive variables from root

  !if (rho .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
  IF_BELOW_ATMO(rho, GRHydro_rho_min, GRHydro_atmo_tolerance, r) then
    SET_ATMO_MIN(rho, GRHydro_rho_min, r) !GRHydro_rho_min
    udens = rho
    dens = sdetg * rho
!    epsilon = (sqrt( (utau + pnew + udens)**2) - pnew -  udens)/udens
    epsilon = epsmin
    ! w_lorentz=1, so the expression for utau reduces to:
    utau  = rho + rho*epsmin - udens
    sx = 0.d0
    sy = 0.d0
    sz = 0.d0
    s2 = 0.d0
    usx = 0.d0
    usy = 0.d0
    usz = 0.d0
    w_lorentz = 1.d0
  end if

51 press = pnew
  vlowx = usx / ( (rho + rho*epsilon + press) * w_lorentz**2)
  vlowy = usy / ( (rho + rho*epsilon + press) * w_lorentz**2)
  vlowz = usz / ( (rho + rho*epsilon + press) * w_lorentz**2)
  velx = uxx * vlowx + uxy * vlowy + uxz * vlowz
  vely = uxy * vlowx + uyy * vlowy + uyz * vlowz
  velz = uxz * vlowx + uyz * vlowy + uzz * vlowz
  
    
!!$If all else fails, use the polytropic EoS

  if(epsilon .lt. 0.0d0) then
    epsnegative = .true.
  endif

#if 0
  if (rho .le. 0.0d0) then
    !$OMP CRITICAL
      write(warnline,'(a38, i16)') 'Epsilon negative!'
      call CCTK_WARN(1,warnline)
      write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,3g16.7)') 'xyz location: ',x,y,z
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'radius: ',r
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'udens: ', udens
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'dens: ', dens
      call CCTK_WARN(1,warnline)
      !write(warnline,'(a20,g16.7)') 'rho-old: ', rhoold
      !call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'pnew: ', pnew
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'pold: ', pold
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'xpress: ', xpress
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'f: ', f
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'df: ', df
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'f/df: ', f/df
      call CCTK_WARN(1,warnline)
      write(warnline,'(a30,g16.7)') '(utau + pnew + udens)**2 - s2: ', (utau + pnew + udens)**2 - s2
      call CCTK_WARN(1,warnline)
      write(warnline,'(a30,g16.7)') '(utau + pnew + udens): ', (utau + pnew + udens)
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'drhobydpress: ', drhobydpress
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'depsbydpress: ', depsbydpress
      call CCTK_ERROR(warnline)
      STOP
   !$OMP END CRITICAL
  endif
#endif

end subroutine Con2Prim_pt


 /*@@
   @routine    Conservative2PrimitiveBoundaries
   @date       Tue Mar 12 18:04:40 2002
   @author     The GRHydro Developers    
   @desc 
        This routine is used only if the reconstruction is performed on the conserved variables. 
        It computes the primitive variables on cell boundaries.
        Since reconstruction on conservative had not proved to be very successful, 
        some of the improvements to the C2P routines (e.g. the check about 
        whether a failure happens in a point that will be restriced anyway) 
        are not implemented here yet.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Conservative2PrimitiveBounds(CCTK_ARGUMENTS)

  use Con2Prim_fortran_interfaces
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS
  
  CCTK_REAL, parameter :: half = 0.5d0

  integer :: i, j, k, itracer, nx, ny, nz
  CCTK_REAL :: uxxl, uxyl, uxzl, uyyl, uyzl, uzzl,&
       uxxr, uxyr, uxzr, uyyr, uyzr, uzzr, pmin, epsmin
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr
  logical :: epsnegative
  character(len=100) warnline
 
  CCTK_REAL :: local_min_tracer

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,xeps
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xtemp=0.0d0;xye=0.0d0;xeps=0.0d0
! end EOS Omni vars
  
  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
  end if

  ! this is a poly call
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
         GRHydro_rho_min,1.0d0,xtemp,xye,pmin,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       GRHydro_rho_min,epsmin,xtemp,xye,pmin,epsmin,keyerr,anyerr)

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3) 
  
  if (use_min_tracer .ne. 0) then
    local_min_tracer = min_tracer
  else
    local_min_tracer = 0d0
  end if
  
  do k = GRHydro_stencil, nz - GRHydro_stencil + 1
    do j = GRHydro_stencil, ny - GRHydro_stencil + 1
      do i = GRHydro_stencil, nx - GRHydro_stencil + 1

        !do not compute if in atmosphere or in an excised region
        if ((atmosphere_mask(i,j,k) .ne. 0) .or. &
            GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle
         
        gxxl = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        gxyl = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        gxzl = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        gyyl = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        gyzl = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        gzzl = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        gxxr = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        gxyr = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        gxzr = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        gyyr = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        gyzr = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        gzzr = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        epsnegative = .false.

        avg_detl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
        avg_detr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
        call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl*avg_detl,&
             gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
        call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr*avg_detr,&
             gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        

        if (evolve_tracer .ne. 0) then
           do itracer=1,number_of_tracers
              call Con2Prim_ptTracer(cons_tracer(i,j,k,itracer), &
                   tracer(i,j,k,itracer), dens(i,j,k))
           enddo

           if (use_min_tracer .ne. 0) then
             if (tracer(i,j,k,itracer) .le. local_min_tracer) then
               tracer(i,j,k,itracer) = local_min_tracer
             end if
           end if

        endif

        if(evolve_Y_e.ne.0) then
           Y_e(i,j,k) = Y_e_con(i,j,k) / dens(i,j,k)
        endif

        call Con2Prim_pt(int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),&
             GRHydro_eos_handle, densminus(i,j,k),&
             sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k),&
             tauminus(i,j,k),rhominus(i,j,k),velxminus(i,j,k),&
             velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),&
             pressminus(i,j,k),w_lorentzminus(i,j,k),&
             uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl,&
             x(i,j,k)-half*CCTK_DELTA_SPACE(1),&
             y(i,j,k)-half*CCTK_DELTA_SPACE(2), &
             z(i,j,k)-half*CCTK_DELTA_SPACE(3),r(i,j,k),&
             epsnegative,GRHydro_rho_min,pmin, epsmin, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
        if (epsnegative) then
          !$OMP CRITICAL
          call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!')
          !$OMP END CRITICAL
          call Con2Prim_ptPolytype(GRHydro_polytrope_handle, densminus(i,j,k),&
               sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k),&
               tauminus(i,j,k),rhominus(i,j,k),velxminus(i,j,k),&
               velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),&
               pressminus(i,j,k),w_lorentzminus(i,j,k),&
               uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl,&
               x(i,j,k)-half*CCTK_DELTA_SPACE(1),&
               y(i,j,k)-half*CCTK_DELTA_SPACE(2), &
               z(i,j,k)-half*CCTK_DELTA_SPACE(3),r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
        end if

        if (epsminus(i,j,k) .lt. 0.0d0) then
          if (GRHydro_reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
            !$OMP CRITICAL
            call CCTK_WARN(1,'Con2Prim: stopping the code.')
            call CCTK_WARN(1, '   specific internal energy just went below 0! ')
            write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,3g16.7)') 'xyz location: ',&
                 x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,g16.7)') 'radius: ',r(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,3g16.7)') 'velocities: ',&
                 velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_WARN(GRHydro_c2p_warnlevel, "Specific internal energy negative")
            !$OMP END CRITICAL
            exit
          endif
        endif

        epsnegative = .false.
        call Con2Prim_pt(int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),&
             GRHydro_eos_handle, densplus(i,j,k),&
             sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k),&
             tauplus(i,j,k),rhoplus(i,j,k),velxplus(i,j,k),&
             velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),&
             pressplus(i,j,k),w_lorentzplus(i,j,k),&
             uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr,&
             x(i,j,k)+half*CCTK_DELTA_SPACE(1),&
             y(i,j,k)+half*CCTK_DELTA_SPACE(2), &
             z(i,j,k)+half*CCTK_DELTA_SPACE(3),r(i,j,k),&
             epsnegative,GRHydro_rho_min,pmin, epsmin, GRHydro_reflevel,GRHydro_C2P_failed(i,j,k))
        if (epsnegative) then
          !$OMP CRITICAL
          call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!!')
          !$OMP END CRITICAL
          call Con2Prim_ptPolytype(GRHydro_polytrope_handle, densplus(i,j,k),&
               sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k),&
               tauplus(i,j,k),rhoplus(i,j,k),velxplus(i,j,k),&
               velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),&
               pressplus(i,j,k),w_lorentzplus(i,j,k),&
               uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr,&
               x(i,j,k)+half*CCTK_DELTA_SPACE(1),&
               y(i,j,k)+half*CCTK_DELTA_SPACE(2), &
               z(i,j,k)+half*CCTK_DELTA_SPACE(3),r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
        end if

        if (epsplus(i,j,k) .lt. 0.0d0) then
          if (GRHydro_reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
            !$OMP CRITICAL
            call CCTK_WARN(1,'Con2Prim: stopping the code.')
            call CCTK_WARN(1, '   specific internal energy just went below 0! ')
            write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,3g16.7)') 'xyz location: ',&
                 x(i,j,k),y(i,j,k),z(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,g16.7)') 'radius: ',r(i,j,k)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a20,3g16.7)') 'velocities: ',&
                 velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k)
            call CCTK_WARN(1,warnline)
            call CCTK_WARN(GRHydro_c2p_warnlevel, "Specific internal energy negative")
            write(warnline,'(a25,4g15.6)') 'coordinates: x,y,z,r:',&
                 x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k)
            call CCTK_WARN(1,warnline)
            !$OMP END CRITICAL
          endif
        endif

      end do
    end do
  end do
  
end subroutine Conservative2PrimitiveBounds


 /*@@
   @routine    Con2PrimPolytype
   @date       Tue Mar 19 11:43:06 2002
   @author     Ian Hawke
   @desc 
   All routines below are identical to those above, just
   specialised from polytropic type EOS.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Conservative2PrimitivePolytype(CCTK_ARGUMENTS)
  
  use Con2Prim_fortran_interfaces

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k, itracer, nx, ny, nz
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz

  CCTK_REAL :: local_min_tracer
!  character(len=400) :: warnline

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)

  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
  end if

                                                                               
  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  
  if (use_min_tracer .ne. 0) then
    local_min_tracer = min_tracer
  else
    local_min_tracer = 0d0
  end if

  
!!$  do k = GRHydro_stencil + 1, nz - GRHydro_stencil
!!$    do j = GRHydro_stencil + 1, ny - GRHydro_stencil
!!$      do i = GRHydro_stencil + 1, nx - GRHydro_stencil
  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz)
  do k = 1, nz
    do j = 1, ny
      do i = 1, nx

        !do not compute if in atmosphere or in an excised region
        if ((atmosphere_mask(i,j,k) .ne. 0) .or. &
            GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle

        call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdetg(i,j,k)*sdetg(i,j,k),&
             g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),&
             g23(i,j,k),g33(i,j,k))        

        if (evolve_tracer .ne. 0) then
           do itracer=1,number_of_tracers
              call Con2Prim_ptTracer(cons_tracer(i,j,k,itracer), & 
                   tracer(i,j,k,itracer), dens(i,j,k))
           enddo

           if (use_min_tracer .ne. 0) then
             if (tracer(i,j,k,itracer) .le. local_min_tracer) then
               tracer(i,j,k,itracer) = local_min_tracer
             end if
           end if

        endif

        if(evolve_Y_e.ne.0) then
           Y_e(i,j,k) = Y_e_con(i,j,k) / dens(i,j,k)
        endif

        call Con2Prim_ptPolytype(GRHydro_eos_handle, dens(i,j,k),&
             scon(i,j,k,1),scon(i,j,k,2), &
             scon(i,j,k,3),tau(i,j,k),rho(i,j,k),vup(i,j,k,1),vup(i,j,k,2), &
             vup(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(i,j,k), &
             uxx,uxy,uxz,uyy,uyz,uzz,sdetg(i,j,k),x(i,j,k),y(i,j,k), &
             z(i,j,k),r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
                
      end do
    end do
  end do

  !$OMP END PARALLEL DO
  
  return

end subroutine Conservative2PrimitivePolytype


/*@@
@routine    Con2Prim_ptPolytype
@date       Sat Jan 26 01:09:39 2002
@author     The GRHydro Developers   
@desc 
Given all the appropriate data, recover the primitive variables at
a single point.
@enddesc 
 @calls     
@calledby   
@history 

@endhistory 

@@*/

subroutine Con2Prim_ptPolytype(handle, dens, sx, sy, sz, tau, rho, &
     velx, vely, velz, epsilon, press, w_lorentz, uxx, uxy, uxz, uyy, &
     uyz, uzz, sdetg, x, y, z, r, GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed)
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL dens, sx, sy, sz, tau, rho, velx, vely, velz, epsilon, &
       press, uxx, uxy, uxz, uyy, uyz, uzz, sdetg, isdetg, w_lorentz, x, &
       y, z, r, GRHydro_rho_min
  
  CCTK_REAL s2, f, df, vlowx, vlowy, vlowz
  CCTK_INT count, handle, GRHydro_reflevel
  CCTK_REAL udens, usx, usy, usz, rhoold, rhonew, &
       enthalpy, denthalpy, invfac, GRHydro_C2P_failed, dummy1, dummy2
  character(len=200) warnline

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1)
  n = 1;keytemp = 0;anyerr = 0;keyerr(1) = 0
  xpress = 0.0d0;xeps = 0.0d0;xtemp = 0.0d0;xye = 0.0d0
! end EOS Omni vars


!!$  Undensitize the variables 

  isdetg = 1.0d0/sdetg
  udens = dens*isdetg
  usx = sx*isdetg
  usy = sy*isdetg
  usz = sz*isdetg
  s2 = usx*usx*uxx + usy*usy*uyy + usz*usz*uzz + 2.d0*usx*usy*uxy + &
       2.d0*usx*usz*uxz + 2.d0*usy*usz*uyz

!!$  Set initial guess for rho:
  rhoold = max(GRHydro_rho_min,rho)

!  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
!       rhoold,xeps,xtemp,xye,xpress,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhoold,xeps,xtemp,xye,press,xeps,keyerr,anyerr)

  enthalpy = 1.0d0 + xeps(1) + press / rhoold

  w_lorentz = sqrt(1.d0 + s2 / ( (udens*enthalpy)**2 ))

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhoold,epsilon,xtemp,xye,press,keyerr,anyerr)

!!$  Calculate the function

  f = rhoold * w_lorentz - udens

!!$Find the root
  
  count = 0
  rhonew = rhoold

  do while ( ((abs(rhonew - rhoold)/abs(rhonew) .gt. GRHydro_perc_ptol) .and. &
       (abs(rhonew - rhoold) .gt. GRHydro_del_ptol))  .or. &
       (count .lt. GRHydro_countmin))
    count = count + 1

    if (count > GRHydro_countmax) then
      GRHydro_C2P_failed = 1

      !$OMP CRITICAL
      call CCTK_WARN(1, 'count > GRHydro_countmax! ')
      write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,3g16.7)') 'xyz location: ',x,y,z
      call CCTK_WARN(1,warnline)
      write(warnline,'(a20,g16.7)') 'radius: ',r
      call CCTK_WARN(1,warnline)
      call CCTK_WARN(1,"Setting the point to atmosphere")
      !$OMP END CRITICAL

      ! for safety, let's set the point to atmosphere
      SET_ATMO_MIN(rhonew, GRHydro_rho_min, r)
      udens = rhonew
      dens = sdetg * rhonew

      call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
           rhonew,1.0d0,xtemp,xye,press,keyerr,anyerr)

      call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
           rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

      sx = 0.d0
      sy = 0.d0
      sz = 0.d0
      s2 = 0.d0
      usx = 0.d0
      usy = 0.d0
      usz = 0.d0
      w_lorentz = 1.d0

      goto 50
    end if

!!$    Ian has the feeling that this is an error in general. But for the
!!$    2D_Polytrope it gives the right answers.

      call EOS_Omni_DPressByDrho(handle,keytemp,GRHydro_eos_rf_prec,n,&
           rhonew,epsilon,xtemp,xye,denthalpy,keyerr,anyerr)
      denthalpy = denthalpy / rhonew

    df = w_lorentz - rhonew * s2 * denthalpy / &
         (w_lorentz*(udens**2)*(enthalpy**3))

    rhoold = rhonew
    rhonew = rhoold - f/df

    if (rhonew .lt. 0.d0) then
#if 0
      GRHydro_C2P_failed = 1
      !$OMP CRITICAL
      call CCTK_WARN(GRHydro_NaN_verbose, 'rhonew went below 0')
      !$OMP END CRITICAL
#else
      rhonew = GRHydro_rho_min/100;
#endif
    end if
    
!!$    Recalculate primitive variables and function

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rhonew,epsilon,xtemp,xye,press,keyerr,anyerr)
    
    call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

    enthalpy = 1.0d0 + epsilon + press / rhonew

    w_lorentz = sqrt(1.d0 + s2 / ( (udens*enthalpy)**2 ))
    tau = sdetg * ((rho * enthalpy) * w_lorentz**2 - press) - dens
    
    f = rhonew * w_lorentz - udens

  enddo

!!$  Calculate primitive variables from root


  !if (rhonew .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
  IF_BELOW_ATMO(rhonew, GRHydro_rho_min, GRHydro_atmo_tolerance, r) then
    SET_ATMO_MIN(rhonew, GRHydro_rho_min, r) !GRHydro_rho_min
    udens = rhonew
    ! before 2009/10/07 dens was not reset and was used with its negative 
    ! value below; this has since been changed, but the change produces 
    ! significant changes in the results
    dens = sdetg * rhonew

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,1.0d0,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

    ! w_lorentz=1, so the expression for utau reduces to:
    tau  = rhonew + rhonew*epsilon - udens
    sx = 0.d0
    sy = 0.d0
    sz = 0.d0
    s2 = 0.d0
    usx = 0.d0
    usy = 0.d0
    usz = 0.d0
    w_lorentz = 1.d0
  end if

50  rho = rhonew

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,epsilon,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

  enthalpy = 1.0d0 + epsilon + press / rhonew

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,epsilon,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

  tau = sdetg * ((rho * enthalpy) * w_lorentz**2 - press) - dens

  if (epsilon .lt. 0.0d0) then
    GRHydro_C2P_failed = 1

    !$OMP CRITICAL
    call CCTK_WARN(1, 'epsilon < 0! ')
    write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
    call CCTK_WARN(1,warnline)
    write(warnline,'(a20,3g16.7)') 'xyz location: ',x,y,z
    call CCTK_WARN(1,warnline)
    write(warnline,'(a20,g16.7)') 'radius: ',r
    call CCTK_WARN(1,warnline)
    call CCTK_WARN(1,"Setting the point to atmosphere")
    !$OMP END CRITICAL
    
    rho = GRHydro_rho_min
    dens = sdetg * rho

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rhonew,1.d0,xtemp,xye,press,keyerr,anyerr)
    call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rhonew,xeps,xtemp,xye,press,epsilon,keyerr,anyerr)

    ! w_lorentz=1, so the expression for tau reduces to:
    tau  = sdetg * (rho+rho*epsilon) - dens
    usx = 0.d0
    usy = 0.d0
    usz = 0.d0
    w_lorentz = 1.d0

  end if

  invfac = 1.d0 / ( (rho + rho*epsilon + press) * w_lorentz**2)
  vlowx = usx * invfac
  vlowy = usy * invfac
  vlowz = usz * invfac
  velx = uxx * vlowx + uxy * vlowy + uxz * vlowz
  vely = uxy * vlowx + uyy * vlowy + uyz * vlowz
  velz = uxz * vlowx + uyz * vlowy + uzz * vlowz
  
  return

end subroutine Con2Prim_ptPolytype


 /*@@
   @routine    Cons2PrimBoundsPolytype
   @date       Tue Mar 12 18:04:40 2002
   @author     The GRHydro Developers
   @desc 
        This routine is used only if the reconstruction is performed on the conserved variables. 
        It computes the primitive variables on cell boundaries.
        Since reconstruction on conservative had not proved to be very successful, 
        some of the improvements to the C2P routines (e.g. the check about 
        whether a failure happens in a point that will be restriced anyway) are not implemented here yet.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Con2PrimBoundsPolytype(CCTK_ARGUMENTS)
  
  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k, nx, ny, nz
  CCTK_REAL :: uxxl, uxyl, uxzl, uyyl, uyzl, uzzl,&
       uxxr, uxyr, uxzr, uyyr, uyzr, uzzr
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
  end if
                                                                               
  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  do k = GRHydro_stencil, nz - GRHydro_stencil + 1
    do j = GRHydro_stencil, ny - GRHydro_stencil + 1
      do i = GRHydro_stencil, nx - GRHydro_stencil + 1
        
        !do not compute if in atmosphere or in an excised region
        if ((atmosphere_mask(i,j,k) .ne. 0) .or. &
            GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle
        
        gxxl = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        gxyl = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        gxzl = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        gyyl = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        gyzl = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        gzzl = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        gxxr = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        gxyr = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        gxzr = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        gyyr = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        gyzr = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        gzzr = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_detl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
        avg_detr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
        call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl*avg_detl,&
             gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
        call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr*avg_detr,&
             gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        

        call Con2Prim_ptPolytype(GRHydro_eos_handle, densminus(i,j,k),&
             sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k),&
             tauminus(i,j,k),rhominus(i,j,k),velxminus(i,j,k),&
             velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),&
             pressminus(i,j,k),w_lorentzminus(i,j,k),&
             uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl,&
             x(i,j,k)-0.5d0*CCTK_DELTA_SPACE(1),&
             y(i,j,k)-0.5d0*CCTK_DELTA_SPACE(2), &
             z(i,j,k)-0.5d0*CCTK_DELTA_SPACE(3),&
             r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))
        call Con2Prim_ptPolytype(GRHydro_eos_handle, densplus(i,j,k),&
             sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k),&
             tauplus(i,j,k),rhoplus(i,j,k),velxplus(i,j,k),&
             velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),&
             pressplus(i,j,k),w_lorentzplus(i,j,k),&
             uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr,&
             x(i,j,k)+0.5d0*CCTK_DELTA_SPACE(1),&
             y(i,j,k)+0.5d0*CCTK_DELTA_SPACE(2), &
             z(i,j,k)+0.5d0*CCTK_DELTA_SPACE(3),r(i,j,k),GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed(i,j,k))

        if(evolve_Y_e.ne.0) then
           Y_e(i,j,k) = Y_e_con(i,j,k) / dens(i,j,k)
        endif
        
      end do
    end do
  end do
  
end subroutine Con2PrimBoundsPolytype


 /*@@
   @routine    Con2PrimBoundsTracer
   @date       Mon Mar  8 13:41:55 2004
   @author     Ian Hawke
   @desc 
   
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Con2PrimBoundsTracer(CCTK_ARGUMENTS)
  
  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k, itracer, nx, ny, nz
  CCTK_REAL :: uxxl, uxyl, uxzl, uyyl, uyzl, uzzl,&
       uxxr, uxyr, uxzr, uyyr, uyzr, uzzr
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
  end if
 
  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  
  do k = GRHydro_stencil, nz - GRHydro_stencil + 1
    do j = GRHydro_stencil, ny - GRHydro_stencil + 1
      do i = GRHydro_stencil, nx - GRHydro_stencil + 1
        
        gxxl = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        gxyl = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        gxzl = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        gyyl = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        gyzl = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        gzzl = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        gxxr = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        gxyr = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        gxzr = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        gyyr = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        gyzr = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        gzzr = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_detl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
        avg_detr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
        call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl*avg_detl,&
             gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
        call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr*avg_detr,&
               gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        

        do itracer=1,number_of_tracers
           call Con2Prim_ptBoundsTracer(cons_tracerplus(i,j,k,itracer), &
                tracerplus(i,j,k,itracer), &
                rhoplus(i,j,k), sqrt(1.d0 - &
                (gxxr * velxplus(i,j,k)**2 + &
                gyyr * velyplus(i,j,k)**2 + &
                gzzr * velzplus(i,j,k)**2 + &
                2.d0 * (gxyr * velxplus(i,j,k) * velyplus(i,j,k) + &
                gxzr * velxplus(i,j,k) * velzplus(i,j,k) + &
                gyzr * velyplus(i,j,k) * velzplus(i,j,k) ) ) ), &
                avg_detr)
           call Con2Prim_ptBoundsTracer(cons_tracerminus(i,j,k,itracer), &
                tracerminus(i,j,k,itracer), &
                rhominus(i,j,k), sqrt(1.d0 - &
                (gxxr * velxminus(i,j,k)**2 + &
                gyyr * velyminus(i,j,k)**2 + &
                gzzr * velzminus(i,j,k)**2 + &
                2.d0 * (gxyr * velxminus(i,j,k) * velyminus(i,j,k) + &
                gxzr * velxminus(i,j,k) * velzminus(i,j,k) + &
                gyzr * velyminus(i,j,k) * velzminus(i,j,k) ) ) ), &
                avg_detl)
        enddo

!!$        tracerplus(i,j,k) = cons_tracerplus(i,j,k) / &
!!$             sqrt(avg_detr) / rhoplus(i,j,k) * &
!!$             sqrt(1.d0 - &
!!$                   (gxxr * velxplus(i,j,k)**2 + &
!!$                    gyyr * velyplus(i,j,k)**2 + &
!!$                    gzzr * velzplus(i,j,k)**2 + &
!!$                    2.d0 * (gxyr * velxplus(i,j,k) * velyplus(i,j,k) + &
!!$                            gxzr * velxplus(i,j,k) * velzplus(i,j,k) + &
!!$                            gyzr * velyplus(i,j,k) * velzplus(i,j,k) ) ) )
!!$        tracerminus(i,j,k) = cons_tracerminus(i,j,k) / &
!!$             sqrt(avg_detl) / rhominus(i,j,k) * &
!!$             sqrt(1.d0 - &
!!$                   (gxxl * velxminus(i,j,k)**2 + &
!!$                    gyyl * velyminus(i,j,k)**2 + &
!!$                    gzzl * velzminus(i,j,k)**2 + &
!!$                    2.d0 * (gxyl * velxminus(i,j,k) * velyminus(i,j,k) + &
!!$                            gxzl * velxminus(i,j,k) * velzminus(i,j,k) + &
!!$                            gyzl * velyminus(i,j,k) * velzminus(i,j,k) ) ) )
        
      end do
    end do
  end do
  
end subroutine Con2PrimBoundsTracer


 /*@@
   @routine    Con2Prim_ptTracer
   @date       Mon Mar  8 14:26:29 2004
   @author     Ian Hawke
   @desc 
   
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Con2Prim_ptTracer(cons_tracer, tracer, dens) 
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL cons_tracer, tracer, dens

  tracer = cons_tracer / dens

end subroutine Con2Prim_ptTracer


 /*@@
   @routine    Con2Prim_ptTracerBounds
   @date       Mon Mar  8 14:26:29 2004
   @author     Ian Hawke
   @desc 
   
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Con2Prim_ptBoundsTracer(cons_tracer, tracer, rho, one_over_w_lorentz, sdet)
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL cons_tracer, tracer, rho, one_over_w_lorentz, sdet

  tracer = cons_tracer / sdet / rho * one_over_w_lorentz

end subroutine Con2Prim_ptBoundsTracer


! subroutines to manage the C2P failure mask
subroutine reset_GRHydro_C2P_failed(CCTK_ARGUMENTS)
  
  use Con2Prim_fortran_interfaces

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  GRHydro_C2P_failed = 0

  return

end subroutine reset_GRHydro_C2P_failed


subroutine sync_GRHydro_C2P_failed(CCTK_ARGUMENTS)
! a dummy routine to syncronise GRHydro_C2P_failed
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  return

end subroutine sync_GRHydro_C2P_failed


subroutine check_GRHydro_C2P_failed(CCTK_ARGUMENTS)
  
  use Con2Prim_fortran_interfaces
  use GRHydro_EvolutionMask

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  integer :: i, j, k, nx, ny, nz
  character(len=300) warnline
  CCTK_REAL :: dummy1, dummy2
  
  ! we skip points where evolution_mask vanishes
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: evolution_mask
  pointer (evolution_mask_ptr, evolution_mask)
  CCTK_INT :: check_evolution_mask

  call GRHydro_DeclareEvolutionMask(cctkGH, evolution_mask_ptr, &
                                    check_evolution_mask)

!  call CCTK_INFO("Checking the C2P failure mask.")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  ! do not check if told not to
  if(GRHydro_reflevel .lt. GRHydro_c2p_warn_from_reflevel) return

  !$OMP PARALLEL DO PRIVATE(i,j,k, dummy1, dummy2)
  do k = 1, nz 
    do j = 1, ny 
      do i = 1, nx

        if (GRHydro_C2P_failed(i,j,k) .ge. 1) then

           if(con2prim_oct_hack.ne.0.and.&
                (x(i,j,k) .lt. -1.0d-12 .or.&
                y(i,j,k) .lt. -1.0d-12 .or.&
                z(i,j,k) .lt. -1.0d-12)) then
              cycle
           endif

           !if ( rho(i,j,k) .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
           IF_BELOW_ATMO(rho(i,j,k), GRHydro_rho_min, GRHydro_atmo_tolerance, r(i,j,k)) then
               cycle
           end if 

          ! do not collapse conditions since Fortran does not guarantee an order
          if (check_evolution_mask.ne.0) then
            if (abs(evolution_mask(i,j,k)).le.0.5d0) then 
              cycle
            end if
          end if

          !$OMP CRITICAL
          call CCTK_WARN(1,'Con2Prim failed; stopping the code.')
          call CCTK_WARN(1,'Even with mesh refinement, this point is not restricted from a finer level, so this is really an error')
          write(warnline,'(a32,i2)') 'on carpet reflevel: ',GRHydro_reflevel
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,3g16.7)') 'xyz location: ',&
               x(i,j,k),y(i,j,k),z(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,g16.7)') 'radius: ',r(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,i3,1g16.7)') 'hydro_excision_mask, C2Pfailed: ', hydro_excision_mask(i,j,k), GRHydro_C2P_failed(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,4g16.7)') 'rho eps press w_lorentz: ',&
               rho(i,j,k),eps(i,j,k),press(i,j,k),w_lorentz(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,3g16.7)') 'velocities: ',&
               vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,2g16.7)') 'dens tau: ',&
               dens(i,j,k),tau(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,3g16.7)') 'scon: ',&
               scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3)
          call CCTK_WARN(1,warnline)
          if (evolve_mhd.ne.0) then
            write(warnline,'(a32,3g16.7)') 'magnetic field: ',&
                 Bvec(i,j,k,1),Bvec(i,j,k,2),Bvec(i,j,k,3)
            call CCTK_WARN(1,warnline)
            write(warnline,'(a32,3g16.7)') 'cons magnetic field: ',&
                 Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3)
            call CCTK_WARN(1,warnline)
            if (calculate_bcom.ne.0) then
              write(warnline,'(a32,6g16.7)') 'com magnetic field, b0, b^2: ', bcom(i,j,k,1), bcom(i,j,k,2), bcom(i,j,k,3), bcom0(i,j,k), bcom_sq(i,j,k)
              call CCTK_WARN(1,warnline)
            end if
            if (clean_divergence.ne.0) then
              write(warnline,'(a32,g16.7)') 'psidc: ',psidc(i,j,k)
              call CCTK_WARN(1,warnline)
            end if
            if (track_divB.ne.0) then
              write(warnline,'(a32,g16.7)') 'divB: ',divB(i,j,k)
              call CCTK_WARN(1,warnline)
            end if
          end if
          if (evolve_temper.ne.0) then
            write(warnline,'(a32,2g16.7)') 'temperature, entropy: ',&
                  temperature(i,j,k),entropy(i,j,k)
            call CCTK_WARN(1,warnline)
          end if
          if (evolve_entropy.ne.0) then
            write(warnline,'(a32,2g16.7)') 'entropy: ', entropy(i,j,k)
            call CCTK_WARN(1,warnline)
          end if
          if (evolve_Y_e.ne.0) then
            write(warnline,'(a32,2g16.7)') 'Y_e, Y_e_con: ',&
                  Y_e(i,j,k),Y_e_con(i,j,k)
            call CCTK_WARN(1,warnline)
          end if
          write(warnline,'(a32,6g16.7)') '3-metric: ',&
               gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)
          call CCTK_WARN(1,warnline)
          write(warnline,'(a32,4g16.7)') 'lapse, shift: ',&
               alp(i,j,k),betax(i,j,k),betay(i,j,k),betaz(i,j,k)
          call CCTK_WARN(1,warnline)
          if (CCTK_EQUALS(GRHydro_c2p_failed_action, "terminate")) then
            call CCTK_TerminateNext(cctkGH)
          else if (CCTK_EQUALS(GRHydro_c2p_failed_action, "abort")) then
            call CCTK_ERROR("Aborting.")
            STOP
          else
            call CCTK_ERROR("Internal error, unknown action")
            STOP
          end if
          !$OMP END CRITICAL

        end if

      end do
    end do
  end do
  !$OMP END PARALLEL DO

  return

end subroutine check_GRHydro_C2P_failed

```

GRHydro_Macros.h:
```
#define SPATIAL_DETERMINANT(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_) \
  (-(gxz_)**2*(gyy_) + 2.0d0*(gxy_)*(gxz_)*(gyz_) - (gxx_)*(gyz_)**2 - (gxy_)**2*(gzz_) \
   + (gxx_)*(gyy_)*(gzz_))

#define DOTP(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_,x1_,y1_,z1_,x2_,y2_,z2_) \
 ( (gxx_)*(x1_)*(x2_)+(gyy_)*(y1_)*(y2_)+(gzz_)*(z1_)*(z2_)+ \
   (gxy_)*( (x1_)*(y2_)+(y1_)*(x2_) )+(gxz_)*( (x1_)*(z2_)+(z1_)*(x2_) )+\
   (gyz_)*( (y1_)*(z2_)+(z1_)*(y2_) ) )

#define DOTP2(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_,x_,y_,z_)        \
 ( (gxx_)*(x_)**2+(gyy_)*(y_)**2+(gzz_)*(z_)**2+ \
  2.0*( (gxy_)*(x_)*(y_)+(gxz_)*(x_)*(z_)+(gyz_)*(y_)*(z_) ) )


#define IF_BELOW_ATMO(rho, rho_min, rho_tol, r)  \
  dummy1 = atmo_tolerance_radius &&\
  dummy2 = atmo_falloff_radius &&\
  if (r .gt. atmo_tolerance_radius) then &&\
     dummy1 = r &&\
  endif &&\
  if (r .gt. atmo_falloff_radius) then &&\
     dummy2 = r &&\
  endif &&\
  if (rho .le. rho_min*(1.0d0 + rho_tol * (dummy1/atmo_tolerance_radius)**atmo_tolerance_power) * (atmo_falloff_radius/dummy2)**atmo_falloff_power)



!#define ATMOCHECK(rho, rho_min, rho_tol, r)  \
!  (atmo_type .eq. 0 .and. rho .le. rho_min*(1.0d0 + rho_tol)) .or. \
!  (atmo_type .eq. 1 .and. rho .le. rho_min*(1.0d0 + rho_tol * (atmo_tolerance_radius/r)**atmo_tolerance_power)) .or. \
!  (atmo_type .eq. 2 .and. rho .le. rho_min*(1.d00 + rho_tol) * (atmo_falloff_radius/r)**atmo_falloff_power) .or. \
!  (atmo_type .eq. 3 .and. rho .le. rho_min*(1.0d0 + rho_tol * (r/atmo_tolerance_radius)**atmo_tolerance_power) * (r/atmo_falloff_radius)**atmo_falloff_power)


#define SET_ATMO_MIN(rho_, rho_min, r) &&\
  dummy1 = atmo_falloff_radius &&\
  if (r .gt. atmo_falloff_radius) then &&\
     dummy1 = r &&\
  endif &&\
  rho_ = rho_min * (atmo_falloff_radius/dummy1)**atmo_falloff_power


```

GRHydro_Jacobian_state.c:
```
#include <assert.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"




/**
   Checks states for Jacobians
*/
void
GRHydro_check_Jacobian_state (CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS

  static CCTK_INT idxJacobian_state = -1, idxiJacobian_state = -1;

  if (!CCTK_IsImplementationActive("Coordinates"))
     return; /* Multipatch infrastructure not active */

  if (idxJacobian_state == -1)
  {
     idxJacobian_state = CCTK_VarIndex("Coordinates::jacobian_state");
     assert(idxJacobian_state >= 0);
  }

  if (idxiJacobian_state == -1)
  {
     idxiJacobian_state = CCTK_VarIndex("Coordinates::inverse_jacobian_state");
     assert(idxiJacobian_state >= 0);
  }

  if (*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxJacobian_state) == 0)
  {
     CCTK_WARN(0, "GRHydro requires storage for Jacobians. Please tell your Coordinates implementation to store the Jacobians!");
  }
  
  if (*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian_state) == 0)
  {
     CCTK_WARN(0, "GRHydro requires storage for inverse Jacobians. Please tell your Coordinates implementation to store the inverse Jacobians!");
  }
  
}




```

GRHydro_Reconstruct_drv_cxx.hh:
```
#ifndef _GRHYDRO_RECONSTRUCT_DRV_CXX_H
#define _GRHYDRO_RECONSTRUCT_DRV_CXX_H

#include "cctk.h"

/*
  Cases that must be considered:
  * basic hydro
  * hydro + temperature + ye
  * hydro + ye
  * basic mhd
  * mhd + temperature + ye 
  * mhd + ye 
 */

template <bool do_mhd,
          bool do_Ye,
          bool do_temp,
          bool do_reconstruct_Wv,
          bool do_clean_divergence,
          class RECONSTRUCT>                   // the reconstruction operator
void GRHydro_Reconstruct_drv_cxx(cGH const * const restrict cctkGH);

// helper macro to instantiate all required permuations of the template options
// this must match GRHydro_Reconstruct's reconstruct::select routine
#define INSTANTIATE_RECONSTRUCTION_OPERATOR(RECONSTRUCT)                       \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <false, false, false, true, false, RECONSTRUCT> (  \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, false, false, true, false, RECONSTRUCT> (   \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, true, true, true, false, RECONSTRUCT> (     \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, false, false, true, true, RECONSTRUCT> (    \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, true, true, true, true, RECONSTRUCT> (      \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <false, true, true, true, false, RECONSTRUCT> (    \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <false, false, false, false, false, RECONSTRUCT> ( \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, false, false, false, false, RECONSTRUCT> (  \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, true, true, false, false, RECONSTRUCT> (    \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, false, false, false, true, RECONSTRUCT> (   \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <true, true, true, false, true, RECONSTRUCT> (     \
  cGH const * const restrict cctkGH);                                          \
template void                                                                  \
GRHydro_Reconstruct_drv_cxx <false, true, true, false, false, RECONSTRUCT> (   \
  cGH const * const restrict cctkGH);

#endif // _GRHYDRO_RECONSTRUCT_DRV_CXX_H

```

GRHydro_HLLE.F90:
```
 /*@@
   @file      GRHydro_HLLE.F90
   @date      Sat Jan 26 01:40:14 2002
   @author    Ian Hawke, Pedro Montero, Toni Font
   @desc 
   The HLLE solver. Called from the wrapper function, so works in 
   all directions.
   @enddesc 
 @@*/
   
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Macros.h"
#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_HLLE
   @date       Sat Jan 26 01:41:02 2002
   @author     Ian Hawke, Pedro Montero, Toni Font
   @desc 
   The HLLE solver. Sufficiently simple that its just one big routine.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Altered from Cactus 3 routines originally written by Toni Font.
   @endhistory 

@@*/

! eta across face in x-direction
#define etaX(i,j,k, v, c) \
  (0.5d0*(abs(v((i)+1,j,k,1)-v(i,j,k,1)) + abs(c((i)+1,j,k)-c(i,j,k))))

! eta across face in x-direction
#define etaY(i,j,k, v, c) \
  (0.5d0*(abs(v(i,(j)+1,k,2)-v(i,j,k,2)) + abs(c(i,(j)+1,k)-c(i,j,k))))
  
! eta across face in x-direction
#define etaZ(i,j,k, v, c) \
  (0.5d0*(abs(v(i,j,(k)+1,3)-v(i,j,k,3)) + abs(c(i,j,(k)+1)-c(i,j,k))))

  

subroutine H_viscosity(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k, nx, ny, nz
  CCTK_REAL dpdrho,dpdeps, cs2
  character*256 :: warnline
  
  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)
  
! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1)
  n = 1;keytemp = 0;anyerr = 0;keyerr(1) = 0
  xpress = 0.0d0;xeps = 0.0d0;xtemp = 0.0d0;xye = 0.0d0
! end EOS Omni vars

  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)   

  !$OMP PARALLEL DO PRIVATE(i,j,k,&
  !$OMP anyerr, keyerr, keytemp,&
  !$OMP warnline, xpress,xeps,xtemp,xye, dpdrho, dpdeps, cs2)
  do k = 1, nz 
    do j = 1, ny 
      do i = 1, nx

        ! set to zero initially
        eos_c(i,j,k) = 0.0d0
      
        !do not compute if in atmosphere or in excised region
        if ((atmosphere_mask(i,j,k) .ne. 0) .or. &
            (GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .gt. 0))) cycle

!!$  Set required fluid quantities
        if (evolve_temper.ne.1) then

           call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
              rho(i,j,k),eps(i,j,k),xtemp,xye,xpress,keyerr,anyerr)

            call EOS_Omni_DPressByDEps(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
              rho(i,j,k),eps(i,j,k),xtemp,xye,dpdeps,keyerr,anyerr)

           call EOS_Omni_DPressByDRho(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
              rho(i,j,k),eps(i,j,k),xtemp,xye,dpdrho,keyerr,anyerr)

           cs2 = (dpdrho + xpress(1) * dpdeps / (rho(i,j,k)**2))/ &
              (1.0d0 + eps(i,j,k) + xpress(1)/rho(i,j,k))

           eos_c(i,j,k) = sqrt(cs2)
         
         else
           
           call EOS_Omni_cs2(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
              rho(i,j,k),eps(i,j,k),temperature(i,j,k),Y_e(i,j,k),cs2,keyerr,anyerr)
  
           eos_c(i,j,k) = sqrt(cs2)
         
         end if
  
       end do
    end do
  end do
  
end subroutine H_viscosity
  
  
subroutine GRHydro_HLLE(CCTK_ARGUMENTS)
  USE GRHydro_Eigenproblem

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  integer :: i, j, k, m
  CCTK_INT :: keytemp
  CCTK_REAL, dimension(5) :: consp,consm_i,fplus,fminus,lamplus
  CCTK_REAL, dimension(5) :: f1,lamminus
  CCTK_REAL, dimension(5) :: qdiff
  CCTK_REAL ::  charmin, charmax, charpm,avg_alp,avg_det, etabar
  CCTK_REAL :: gxxh, gxyh, gxzh, gyyh, gyzh, gzzh, uxxh, uxyh, &
       uxzh, uyyh, uyzh, uzzh, avg_beta, usendh
    
  CCTK_INT :: type_bits, trivial

  ! sign requires its arguments to be of identical KIND
  CCTK_REAL, parameter :: one = 1d0
  
  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)
  
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
    pvup = loc(vel)
  end if

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if

  if(evolve_temper.eq.1.and.reconstruct_temper.eq.1) then
     keytemp = 1
  else
     keytemp = 0
  endif

  !$OMP PARALLEL DO PRIVATE(k,j,i,f1,lamminus,lamplus,consp,consm_i, &
  !$OMP                     fplus,fminus,qdiff,avg_beta,avg_alp,   &
  !$OMP                     avg_det,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
  !$OMP                     uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,         &
  !$OMP                     usendh, charmin, charmax, charpm, &
  !$OMP                     m,etabar)
  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil
        
        f1 = 0.d0
        lamminus = 0.d0
        lamplus = 0.d0
        consp = 0.d0
        consm_i = 0.d0
        fplus = 0.d0
        fminus = 0.d0
        qdiff = 0.d0
        
!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        consp(1)   = densplus(i,j,k) 
        consp(2)   = sxplus(i,j,k)
        consp(3)   = syplus(i,j,k)
        consp(4)   = szplus(i,j,k)
        consp(5)   = tauplus(i,j,k)
        
        consm_i(1) = densminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(2) = sxminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(3) = syminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(4) = szminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(5) = tauminus(i+xoffset,j+yoffset,k+zoffset) 
          
!!$        Calculate various metric terms here.
!!$        Note also need the average of the lapse at the 
!!$        left and right points.

        if (flux_direction == 1) then
           avg_beta = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
               beta1(i,j,k))
        else if (flux_direction == 2) then
           avg_beta = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
               beta2(i,j,k))
        else if (flux_direction == 3) then
           avg_beta = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
               beta3(i,j,k))
        else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
         end if

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gxyh = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gxzh = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gyyh = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gyzh = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gzzh = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))

        avg_det =  SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,\
             gyyh,gyzh,gzzh)

!!$ If the Riemann problem is trivial, just calculate the fluxes from the 
!!$ left state and skip to the next cell
          
        if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then

          if (flux_direction == 1) then
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                 f1(1),f1(2),f1(3),&
                 f1(4),f1(5),&
                 velxplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                 f1(1),f1(3),f1(4),&
                 f1(2),f1(5),&
                 velyplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                 f1(1),f1(4),f1(2),&
                 f1(3),f1(5),&
                 velzplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
        else !!! The end of this branch is right at the bottom of the routine
            
          call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
               avg_det,gxxh, gxyh, gxzh, &
               gyyh, gyzh, gzzh)
          
          if (flux_direction == 1) then
            usendh = uxxh
          else if (flux_direction == 2) then
            usendh = uyyh
          else if (flux_direction == 3) then
            usendh = uzzh
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
!!$        Calculate the jumps in the conserved variables
          
          qdiff(1) = consm_i(1) - consp(1)
          qdiff(2) = consm_i(2) - consp(2)
          qdiff(3) = consm_i(3) - consp(3)
          qdiff(4) = consm_i(4) - consp(4)
          qdiff(5) = consm_i(5) - consp(5)
          
!!$        Eigenvalues and fluxes either side of the cell interface
          
          if (flux_direction == 1) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velxplus(i,j,k),velyplus(i,j,k),&
                     velzplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velxplus(i,j,k),velyplus(i,j,k),&
                     velzplus(i,j,k),epsplus(i,j,k), &
                     tempplus(i,j,k),&
                     y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gxxh,gxyh,gxzh,gyyh,&
                     gyzh,gzzh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                 fplus(1),fplus(2),fplus(3),fplus(4),&
                 fplus(5),velxplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(2),consm_i(3),&
                 consm_i(4),consm_i(5),fminus(1),fminus(2),fminus(3),&
                 fminus(4), fminus(5),&
                 velxminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velyplus(i,j,k),velzplus(i,j,k),&
                     velxplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velyplus(i,j,k),velzplus(i,j,k),&
                     velxplus(i,j,k),epsplus(i,j,k),&
                     tempplus(i,j,k),y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gyyh,gyzh,gxyh,gzzh,&
                     gxzh,gxxh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                 fplus(1),fplus(3),fplus(4),fplus(2),&
                 fplus(5),velyplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(3),consm_i(4),&
                 consm_i(2),consm_i(5),fminus(1),fminus(3),fminus(4),&
                 fminus(2), fminus(5),&
                 velyminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
             if(evolve_temper.ne.1) then
                call eigenvalues(GRHydro_eos_handle,&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
                     velzplus(i,j,k),velxplus(i,j,k),&
                     velyplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
                     lamplus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
             else
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,int(i,ik),int(j,ik),int(k,ik),&
                     rhominus(i+xoffset,j+yoffset,k+zoffset),&
                     velzminus(i+xoffset,j+yoffset,k+zoffset),&
                     velxminus(i+xoffset,j+yoffset,k+zoffset),&
                     velyminus(i+xoffset,j+yoffset,k+zoffset),&
                     epsminus(i+xoffset,j+yoffset,k+zoffset),&
                     tempminus(i+xoffset,j+yoffset,k+zoffset),&
                     y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                     w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
                     lamminus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
                call eigenvalues_hot(GRHydro_eos_handle,keytemp,&
                     int(i,ik),int(j,ik),int(k,ik),&
                     rhoplus(i,j,k),&
                     velzplus(i,j,k),velxplus(i,j,k),&
                     velyplus(i,j,k),epsplus(i,j,k),&
                     tempplus(i,j,k),y_e_plus(i,j,k),&
                     w_lorentzplus(i,j,k),&
                     lamplus,gzzh,gxzh,gyzh,&
                     gxxh,gxyh,gyyh,&
                     usendh,avg_alp,avg_beta)
             endif
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                 fplus(1),fplus(4),fplus(2),fplus(3),&
                 fplus(5),velzplus(i,j,k),pressplus(i,j,k),avg_det,&
                 avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(4),consm_i(2),&
                 consm_i(3),consm_i(5),fminus(1),fminus(4),fminus(2),&
                 fminus(3), fminus(5),&
                 velzminus(i+xoffset,j+yoffset,k+zoffset),&
                 pressminus(i+xoffset,j+yoffset,k+zoffset),&
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if

!!$        Compute H viscosity if requested
          
          if (apply_H_viscosity .ne. 0) then
          
            if (flux_direction == 1) then
              etabar = max(etaX(i,j,k, vup, eos_c),&
                           etaY(i,j,k, vup, eos_c),&
                           etaY(i+1,j,k, vup, eos_c),&
                           etaY(i,j-1,k, vup, eos_c),&
                           etaY(i+1,j-1,k, vup, eos_c),&
                           etaZ(i,j,k, vup, eos_c),&
                           etaZ(i+1,j,k, vup, eos_c),&
                           etaZ(i,j,k-1, vup, eos_c),&
                           etaZ(i+1,j,k-1, vup, eos_c))
            else if (flux_direction == 2) then
              etabar = max(etaY(i,j,k, vup, eos_c),&
                           etaX(i,j,k, vup, eos_c),&
                           etaX(i,j+1,k, vup, eos_c),&
                           etaX(i-1,j,k, vup, eos_c),&
                           etaX(i-1,j+1,k, vup, eos_c),&
                           etaZ(i,j,k, vup, eos_c),&
                           etaZ(i,j+1,k, vup, eos_c),&
                           etaZ(i,j,k-1, vup, eos_c),&
                           etaZ(i,j+1,k-1, vup, eos_c))
            else if (flux_direction == 3) then
              etabar = max(etaZ(i,j,k, vup, eos_c),&
                           etaX(i,j,k, vup, eos_c),&
                           etaX(i,j,k+1, vup, eos_c),&
                           etaX(i-1,j,k, vup, eos_c),&
                           etaX(i-1,j,k+1, vup, eos_c),&
                           etaY(i,j,k, vup, eos_c),&
                           etaY(i,j,k+1, vup, eos_c),&
                           etaY(i,j-1,k, vup, eos_c),&
                           etaY(i,j-1,k+1, vup, eos_c))
            else
              call CCTK_ERROR("Flux direction not x,y,z")
              STOP
            end if
            
            ! modify eigenvalues of Roe's matrix by computed H viscosity
            do m = 1,5
               lamplus(m) = sign(one, lamplus(m))*max(abs(lamplus(m)), etabar)
               lamminus(m) = sign(one, lamminus(m))*max(abs(lamminus(m)), etabar)
            end do
          endif
          
          
!!$        Find minimum and maximum wavespeeds
      
          charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), &
               lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
               lamminus(4),lamminus(5))  
          
          charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), &
               lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
               lamminus(4),lamminus(5))
          
          charpm = charmax - charmin
          
!!$        Calculate flux by standard formula
          
          do m = 1,5 
            
            qdiff(m) = consm_i(m) - consp(m)
            
            f1(m) = (charmax * fplus(m) - charmin * fminus(m) + &
                 charmax * charmin * qdiff(m)) / charpm
            
          end do

        end if !!! The end of the SpaceMask check for a trivial RP.
            
        densflux(i, j, k) = f1(1)
        sxflux(i, j, k) = f1(2)
        syflux(i, j, k) = f1(3)
        szflux(i, j, k) = f1(4)
        tauflux(i, j, k) = f1(5)

        if(evolve_Y_e.ne.0) then
           if (densflux(i, j, k) > 0.d0) then
              Y_e_con_flux(i, j, k) = &
                   Y_e_plus(i, j, k) * &
                   densflux(i, j, k)
           else
              Y_e_con_flux(i, j, k) = &
                   Y_e_minus(i + xoffset, j + yoffset, k + zoffset) * &
                   densflux(i, j, k)
           endif
        endif

      end do
    end do
  end do
  !$OMP END PARALLEL DO
      
end subroutine GRHydro_HLLE

 /*@@
   @routine    GRHydro_HLLE_Tracer
   @date       Mon Mar  8 13:47:13 2004
   @author     Ian Hawke
   @desc 
   HLLE just for the tracer.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_HLLE_Tracer(CCTK_ARGUMENTS)

  USE GRHydro_Eigenproblem

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k,  m
  CCTK_REAL, dimension(number_of_tracers) :: consp,consm_i,fplus,fminus,f1
  CCTK_REAL, dimension(5) :: lamminus,lamplus
  CCTK_REAL, dimension(number_of_tracers) :: qdiff
  CCTK_REAL ::  charmin, charmax, charpm,avg_alp,avg_det
  CCTK_REAL :: gxxh, gxyh, gxzh, gyyh, gyzh, gzzh, uxxh, uxyh, &
       uxzh, uyyh, uyzh, uzzh, avg_beta, usendh
    
  CCTK_INT :: type_bits, trivial

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
  end if

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if

  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil
        
        f1 = 0.d0
        lamminus = 0.d0
        lamplus = 0.d0
        consp = 0.d0
        consm_i = 0.d0
        fplus = 0.d0
        fminus = 0.d0
        qdiff = 0.d0
        
!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        do m=1,number_of_tracers
           consp(m)   = cons_tracerplus(i,j,k,m)         
           consm_i(m) = cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,m)
        enddo
!!$        Calculate various metric terms here.
!!$        Note also need the average of the lapse at the 
!!$        left and right points.

        if (flux_direction == 1) then
           avg_beta = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
               beta1(i,j,k))
        else if (flux_direction == 2) then
           avg_beta = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
               beta2(i,j,k))
        else if (flux_direction == 3) then
           avg_beta = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
               beta3(i,j,k))
        else
           call CCTK_ERROR("Flux direction not x,y,z")
           STOP
        end if

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gxyh = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gxzh = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gyyh = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gyzh = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gzzh = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))

        avg_det =  SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,\
             gyyh,gyzh,gzzh)

        call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
             avg_det,gxxh, gxyh, gxzh, &
             gyyh, gyzh, gzzh)
        
        if (flux_direction == 1) then
          usendh = uxxh
        else if (flux_direction == 2) then
          usendh = uyyh
        else if (flux_direction == 3) then
          usendh = uzzh
        else
          call CCTK_ERROR("Flux direction not x,y,z")
          STOP
        end if
          
!!$        Calculate the jumps in the conserved variables
          
        qdiff = consm_i - consp
          
!!$        Eigenvalues and fluxes either side of the cell interface
          
        if (flux_direction == 1) then
          call eigenvalues(GRHydro_eos_handle,&
               rhominus(i+xoffset,j+yoffset,k+zoffset),&
               velxminus(i+xoffset,j+yoffset,k+zoffset),&
               velyminus(i+xoffset,j+yoffset,k+zoffset),&
               velzminus(i+xoffset,j+yoffset,k+zoffset),&
               epsminus(i+xoffset,j+yoffset,k+zoffset),&
               w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
               lamminus,gxxh,gxyh,gxzh,gyyh,&
               gyzh,gzzh,&
               usendh,avg_alp,avg_beta)
          call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
               velxplus(i,j,k),velyplus(i,j,k),&
               velzplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
               lamplus,gxxh,gxyh,gxzh,gyyh,&
               gyzh,gzzh,&
               usendh,avg_alp,avg_beta)
          fplus(:)  = (velxplus(i,j,k)  - avg_beta / avg_alp) * &
               cons_tracerplus(i,j,k,:)
          fminus(:) = (velxminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
               cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else if (flux_direction == 2) then
          call eigenvalues(GRHydro_eos_handle,&
               rhominus(i+xoffset,j+yoffset,k+zoffset),&
               velyminus(i+xoffset,j+yoffset,k+zoffset),&
               velzminus(i+xoffset,j+yoffset,k+zoffset),&
               velxminus(i+xoffset,j+yoffset,k+zoffset),&
               epsminus(i+xoffset,j+yoffset,k+zoffset),&
               w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
               lamminus,gyyh,gyzh,gxyh,gzzh,&
               gxzh,gxxh,&
               usendh,avg_alp,avg_beta)
          call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
               velyplus(i,j,k),velzplus(i,j,k),&
               velxplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
               lamplus,gyyh,gyzh,gxyh,gzzh,&
               gxzh,gxxh,&
               usendh,avg_alp,avg_beta)
          fplus(:)  = (velyplus(i,j,k)  - avg_beta / avg_alp) * &
               cons_tracerplus(i,j,k,:)
          fminus(:) = (velyminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
               cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else if (flux_direction == 3) then
          call eigenvalues(GRHydro_eos_handle,&
               rhominus(i+xoffset,j+yoffset,k+zoffset),&
               velzminus(i+xoffset,j+yoffset,k+zoffset),&
               velxminus(i+xoffset,j+yoffset,k+zoffset),&
               velyminus(i+xoffset,j+yoffset,k+zoffset),&
               epsminus(i+xoffset,j+yoffset,k+zoffset),&
               w_lorentzminus(i+xoffset,j+yoffset,k+zoffset),&
               lamminus,gzzh,gxzh,gyzh,&
               gxxh,gxyh,gyyh,&
               usendh,avg_alp,avg_beta)
          call eigenvalues(GRHydro_eos_handle,rhoplus(i,j,k),&
               velzplus(i,j,k),velxplus(i,j,k),&
               velyplus(i,j,k),epsplus(i,j,k),w_lorentzplus(i,j,k),&
               lamplus,gzzh,gxzh,gyzh,&
               gxxh,gxyh,gyyh,&
               usendh,avg_alp,avg_beta)
          fplus(:)  = (velzplus(i,j,k) - avg_beta / avg_alp) * &
               cons_tracerplus(i,j,k,:)
          fminus(:) = (velzminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
               cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else
          call CCTK_ERROR("Flux direction not x,y,z")
          STOP
        end if
        
!!$        Find minimum and maximum wavespeeds
      
        charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), &
             lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
             lamminus(4),lamminus(5))  
          
        charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), &
             lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
             lamminus(4),lamminus(5))
        
        charpm = charmax - charmin
          
!!$        Calculate flux by standard formula
          
        do m = 1,number_of_tracers
            
          qdiff(m) = consm_i(m) - consp(m)
          
          f1(m) = (charmax * fplus(m) - charmin * fminus(m) + &
               charmax * charmin * qdiff(m)) / charpm
          
        end do
            
        cons_tracerflux(i, j, k,:) = f1(:)
!!$
!!$        if ( ((flux_direction.eq.3).and.(i.eq.4).and.(j.eq.4)).or.&
!!$             ((flux_direction.eq.2).and.(i.eq.4).and.(k.eq.4)).or.&
!!$             ((flux_direction.eq.1).and.(j.eq.4).and.(k.eq.4))&
!!$             ) then
!!$          write(*,*) flux_direction, i, j, k, f1(1), consm_i(1), consp(1)
!!$        end if
        
      end do
    end do
  end do

      
end subroutine GRHydro_HLLE_Tracer


```

GRHydro_Con2PrimHot.F90:
```
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"
#include "GRHydro_Macros.h"


subroutine Conservative2PrimitiveHot(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  integer :: i, j, k, itracer, nx, ny, nz, myproc
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, sdet, pmin, epsmin, dummy1, dummy2
  CCTK_REAL :: vlowx, vlowy, vlowz
  logical :: epsnegative
  character*512 :: warnline
  
  CCTK_REAL :: local_min_tracer
  CCTK_REAL :: local_perc_ptol
  integer :: reflevel

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1), reset_to_atmo
  CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1),xrho(1)
  n = 1;keytemp = 0;anyerr = 0;keyerr(1) = 0
  xpress = 0.0d0;xeps = 0.0d0;xtemp = 0.0d0;xye = 0.0d0
! end EOS Omni vars

  myproc = CCTK_MyProc(cctkGH)
  reflevel = int(log10(dble(cctk_levfac(1)))/log10(2.0d0))

  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  
  if (use_min_tracer .ne. 0) then
    local_min_tracer = min_tracer
  else
    local_min_tracer = 0.0d0
  end if

  ! this is a poly call
  xrho(1) = GRHydro_rho_min
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,xeps,xtemp,xye,xpress,xeps,keyerr,anyerr)
  pmin = xpress(1)
  epsmin = xeps(1)

  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz, sdet, epsnegative, anyerr, keyerr, keytemp,&
  !$OMP warnline, dummy1, dummy2,reset_to_atmo)
  do k = 1, nz 
    do j = 1, ny 
      do i = 1, nx


        !do not compute if in atmosphere
        if (atmosphere_mask(i,j,k) .gt. 0) cycle
         
        epsnegative = .false.

        sdet = sdetg(i,j,k)

        call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdet*sdet,&
             g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),&
             g23(i,j,k),g33(i,j,k))        

        if (evolve_tracer .ne. 0) then
           do itracer=1,number_of_tracers
              call Con2Prim_ptTracer(cons_tracer(i,j,k,itracer), tracer(i,j,k,itracer), &
                   dens(i,j,k))

              if (use_min_tracer .ne. 0) then
                if (tracer(i,j,k,itracer) .le. local_min_tracer) then
                  tracer(i,j,k,itracer) = local_min_tracer
                end if
              end if

           enddo
           
        endif
        
        if(evolve_Y_e.ne.0) then
           Y_e(i,j,k) = max(min(Y_e_con(i,j,k) / dens(i,j,k),GRHydro_Y_e_max),&
                GRHydro_Y_e_min)
        endif

        reset_to_atmo = 0
        IF_BELOW_ATMO(dens(i,j,k), sdet*GRHydro_rho_min, GRHydro_atmo_tolerance, r(i,j,k)) then
           reset_to_atmo = 1
        endif

        if (reset_to_atmo .gt. 0 .or. (GRHydro_enable_internal_excision /= 0 .and. hydro_excision_mask(i,j,k) .gt. 0)) then
           SET_ATMO_MIN(dens(i,j,k), sdet*GRHydro_rho_min, r(i,j,k)) 
           SET_ATMO_MIN(rho(i,j,k), GRHydro_rho_min, r(i,j,k)) 
           scon(i,j,k,:) = 0.d0
           vup(i,j,k,:) = 0.d0
           w_lorentz(i,j,k) = 1.d0

           ! set hot atmosphere values
           temperature(i,j,k) = grhydro_hot_atmo_temp
           y_e(i,j,k) = grhydro_hot_atmo_Y_e
           y_e_con(i,j,k) = y_e(i,j,k) * dens(i,j,k)
           keytemp = 1
           call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                rho(i,j,k),eps(i,j,k),temperature(i,j,k),y_e(i,j,k),&
                press(i,j,k),keyerr,anyerr)
           keytemp = 0
           ! w_lorentz=1, so the expression for tau reduces to:
           tau(i,j,k)  = sdet * (rho(i,j,k)+rho(i,j,k)*eps(i,j,k)) - dens(i,j,k)
           
           cycle

          end if

          call Con2Prim_pt_hot3(int(cctk_iteration,ik),myproc,int(i,ik),int(j,ik),int(k,ik),GRHydro_eos_handle,&
               dens(i,j,k),scon(i,j,k,1),&
               scon(i,j,k,2),scon(i,j,k,3),tau(i,j,k),Y_e_con(i,j,k),rho(i,j,k),vup(i,j,k,1),&
               vup(i,j,k,2),vup(i,j,k,3),eps(i,j,k),temperature(i,j,k),y_e(i,j,k),&
               press(i,j,k),w_lorentz(i,j,k), &
               uxx,uxy,uxz,uyy,uyz,uzz,sdet,x(i,j,k),y(i,j,k), &
               z(i,j,k),r(i,j,k),epsnegative,GRHydro_rho_min,pmin, epsmin, & 
               int(reflevel,ik), GRHydro_C2P_failed(i,j,k), GRHydro_perc_ptol)

          if(temperature(i,j,k).gt.GRHydro_max_temp) then
             !$OMP CRITICAL
             call CCTK_WARN(1,"C2P: Temperature too high")
             write(warnline,"(i8)") cctk_iteration
             call CCTK_WARN(1,warnline)
             write(warnline,"(4i5,1P10E15.6)") GRHydro_Reflevel,i,j,k,x(i,j,k),y(i,j,k),z(i,j,k)
             call CCTK_WARN(1,warnline)
             write(warnline,"(1P10E15.6)") dens(i,j,k),scon(i,j,k,1:3),&
                  tau(i,j,k),w_lorentz(i,j,k)
             call CCTK_WARN(1,warnline)
             write(warnline,"(1P10E15.6)") rho(i,j,k),eps(i,j,k),&
                  temperature(i,j,k),Y_e(i,j,k)
             call CCTK_WARN(1,warnline)
             write(warnline,"(A7,i8)") "code: ",keyerr(1)
             call CCTK_WARN(1,warnline)
             write(warnline,"(A10,i5)") "reflevel: ", reflevel
             call CCTK_WARN(1,warnline)
             call CCTK_ERROR("Aborting!!!")
             STOP
             !$OMP END CRITICAL
          endif


          if( abs(GRHydro_C2P_failed(i,j,k)-2.0d0) .lt. 1.0d-10) then
             ! this means c2p did not converge.
             ! In this case, we attempt to call c2p with a reduced
             ! accuracy requirement; if it fails again, we abort
             GRHydro_C2P_failed(i,j,k) = 0
             if(temperature(i,j,k) .gt. GRHydro_hot_atmo_temp) then
                local_perc_ptol = GRHydro_perc_ptol*100.0d0
             else
                ! If we are in the extrapolation regime for the EOS,
                ! we accept a larger c2p error, since we will be resetting
                ! the temperature anyway. The error scale here is chosen 
                ! somewhat arbitrarily to be 0.01% in pressnew/pressold.
                local_perc_ptol = 1.0d-4
             endif
             call Con2Prim_pt_hot3(int(cctk_iteration,ik),myproc,int(i,ik),int(j,ik),int(k,ik),GRHydro_eos_handle,&
                  dens(i,j,k),scon(i,j,k,1),&
                  scon(i,j,k,2),scon(i,j,k,3),tau(i,j,k),Y_e_con(i,j,k),rho(i,j,k),&
                  vup(i,j,k,1),vup(i,j,k,2), vup(i,j,k,3),eps(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k),press(i,j,k),w_lorentz(i,j,k), &
                  uxx,uxy,uxz,uyy,uyz,uzz,sdet,x(i,j,k),y(i,j,k), &
                  z(i,j,k),r(i,j,k),epsnegative,GRHydro_rho_min,pmin, epsmin, & 
                  int(reflevel,ik), GRHydro_C2P_failed(i,j,k), local_perc_ptol)
             if( abs(GRHydro_C2P_failed(i,j,k)-2.0d0) .lt. 1.0d-10) then
                !$OMP CRITICAL
                if (reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
                   call CCTK_WARN(1,"Convergence problem in c2p")
                   write(warnline,"(A10,i5)") "reflevel: ",reflevel
                   call CCTK_WARN(1,warnline)
                   write(warnline,"(A10,i10)") "iteration: ",cctk_iteration
                   call CCTK_WARN(1,warnline)
                   write(warnline,"(A10,F5.2)") "error: ", GRHydro_C2P_failed(i,j,k)
                   call CCTK_WARN(1,warnline)
                   write(warnline,"(3i5,1P10E15.6)") i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k)
                   call CCTK_WARN(1,warnline)
                   write(warnline,"(1P10E15.6)") rho(i,j,k),dens(i,j,k),eps(i,j,k),&
                        temperature(i,j,k),y_e(i,j,k)
                   call CCTK_WARN(1,warnline)
                   call CCTK_ERROR("Aborting!!!")
                   STOP
                endif
                !$OMP END CRITICAL
             endif
          endif

          if( abs(GRHydro_C2P_failed(i,j,k)-3.0d0) .lt. 1.0d-10 .or. &
               temperature(i,j,k).lt.GRHydro_hot_atmo_temp) then
             ! dropped out off the EOS table in temperature or below
             ! the temperature of the atmosphere.
             ! Now reset this point to minimum temperature.
             GRHydro_C2P_failed(i,j,k) = 0
             if (reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
                !$OMP CRITICAL
                write(warnline,"(A10,i7,4i5,1P10E15.6)") "reset T:",&
                     cctk_iteration,GRHydro_Reflevel,&
                     i,j,k,rho(i,j,k),&
                     eps(i,j,k),temperature(i,j,k),y_e(i,j,k)
                call CCTK_WARN(1,warnline)
                write(warnline,"(A10,i7,4i5,1P10E15.6)") "reset T:",&
                     cctk_iteration,GRHydro_Reflevel,&
                     i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k)
                call CCTK_WARN(1,warnline)
                !$OMP END CRITICAL
             endif
             temperature(i,j,k) = GRHydro_hot_atmo_temp
             keytemp = 1
             call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                  rho(i,j,k),eps(i,j,k),temperature(i,j,k),y_e(i,j,k),&
                  press(i,j,k),keyerr,anyerr)
             keytemp = 0
             if(anyerr.ne.0) then
                !$OMP CRITICAL
                call CCTK_ERROR("EOS Problem in C2P hot!!!")
                STOP
                !$OMP END CRITICAL
             endif
             ! prim2con
             w_lorentz(i,j,k) = &
                  1.d0 / sqrt(1.d0 - (gxx(i,j,k)*vel(i,j,k,1)**2 &
                  + gyy(i,j,k)*vel(i,j,k,2)**2 &
                  + gzz(i,j,k) *vel(i,j,k,3)**2 &
                  + 2.0d0*gxy(i,j,k)*vel(i,j,k,1)*vel(i,j,k,2) &
                  + 2.0d0*gxz(i,j,k)*vel(i,j,k,1)*vel(i,j,k,3)  &
                  + 2.0d0*gyz(i,j,k)*vel(i,j,k,2)*vel(i,j,k,3)))
             vlowx = gxx(i,j,k)*vel(i,j,k,1) &
                  + gxy(i,j,k)*vel(i,j,k,2)  &
                  + gxz(i,j,k)*vel(i,j,k,3)
             vlowy = gxy(i,j,k)*vel(i,j,k,1) &
                  + gyy(i,j,k)*vel(i,j,k,2)  &
                  + gyz(i,j,k)*vel(i,j,k,3)
             vlowz = gxz(i,j,k)*vel(i,j,k,1) &
                  + gyz(i,j,k)*vel(i,j,k,2)  &
                  + gzz(i,j,k)*vel(i,j,k,3)
             scon(i,j,k,1) = sdet * (rho(i,j,k)*(1.0d0+eps(i,j,k)) &
                  + press(i,j,k))*w_lorentz(i,j,k)**2 * vlowx
             scon(i,j,k,2) = sdet * (rho(i,j,k)*(1.0d0+eps(i,j,k)) &
                  +press(i,j,k))*w_lorentz(i,j,k)**2 * vlowy
             scon(i,j,k,3) = sdet * (rho(i,j,k)*(1.0d0+eps(i,j,k)) &
                  + press(i,j,k))*w_lorentz(i,j,k)**2 * vlowz
             tau(i,j,k) = sdet * ((rho(i,j,k)*(1.0d0+eps(i,j,k)) &
                  + press(i,j,k))*w_lorentz(i,j,k)**2 - press(i,j,k)) &
                  - dens(i,j,k)
          endif

      end do
    end do
  end do
  !$OMP END PARALLEL DO

  return
  
end subroutine Conservative2PrimitiveHot


subroutine Con2Prim_pt_hot3(cctk_iteration, myproc, ii,jj,kk,handle, dens, &
     sx, sy, sz, tau, ye_con, rho, velx, vely, &
     velz, epsilon, temp, ye, press, w_lorentz, uxx, uxy, uxz, uyy, &
     uyz, uzz, sdet, x, y, z, r, epsnegative, GRHydro_rho_min, pmin, epsmin, &
     GRHydro_reflevel, GRHydro_C2P_failed, local_perc_ptol)
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL dens, sx, sy, sz, tau, ye_con, rho, velx, vely, velz, epsilon, &
       press, uxx, uxy, uxz, uyy, uyz, uzz, invsdet, sdet, w_lorentz, x, &
       y, z, r, GRHydro_rho_min
  CCTK_REAL temp, ye
  CCTK_REAL s2, f, df, vlowx, vlowy, vlowz
  CCTK_INT cctk_iteration, ii,jj,kk,count, i, handle, GRHydro_reflevel
  CCTK_REAL GRHydro_C2P_failed
  CCTK_REAL udens, usx, usy, usz, utau, pold, pnew, &
            temp1, drhobydpress, depsbydpress, dpressbydeps, dpressbydrho, pmin, epsmin
  CCTK_REAL pminl,plow,tmp, dummy1, dummy2
  CCTK_REAL local_perc_ptol
  CCTK_REAL dpf

  integer :: myproc

  character(len=256) warnline
  logical epsnegative, mustbisect

  integer :: failwarnmode 
  integer :: failinfomode 

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,temp0
  CCTK_INT  :: nfudgemax,nf
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  temp0 = 0.0d0;xpress = 0.0d0
  nf=0;nfudgemax=30
! end EOS Omni vars

  mustbisect = .false.

  failinfomode = 1
  failwarnmode = 0

! set pmin to something sensible:
  pminl = 1.0d-28

  if(con2prim_oct_hack.ne.0.and.&
       (x .lt. -1.0d-12 .or.&
        y .lt. -1.0d-12 .or.&
        z .lt. -1.0d-12)) then
     failwarnmode = 2
     failinfomode = 2  
  endif

!!$  Undensitize the variables 
  invsdet = 1.0d0/sdet
  udens = dens * invsdet
  usx = sx * invsdet
  usy = sy * invsdet
  usz = sz * invsdet
  utau = tau * invsdet
  s2 = usx*usx*uxx + usy*usy*uyy + usz*usz*uzz + 2.*usx*usy*uxy + &
       2.*usx*usz*uxz + 2.*usy*usz*uyz

!!$  Set initial guess for pressure:
  temp0 = temp
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
                      rho,epsilon,temp,ye,xpress,keyerr,anyerr)
  ! This is the lowest admissible pressure, otherwise we are off the physical regime
  ! Sometimes, we may end up with bad initial guesses. 
  ! In that case we need to start off with something
  ! reasonable at least
  plow = max(pminl, sqrt(s2) - utau - udens)
  ! Start out with some reasonable initial guess
  pold = max(plow+1.d-10,xpress)
  ! error handling
  if(anyerr.ne.0) then
     if(keyerr(1).eq.668) then
        continue
!        GRHydro_C2P_failed = 3.0d0
!        write(warnline,"(A3,3i3,1P10E15.6)") "*1", ii,jj,kk,rho,epsilon,temp,ye,xpress
!        call CCTK_WARN(1,warnline)
     else 
        !$OMP CRITICAL
        call CCTK_WARN(failinfomode,"EOS error in c2p 0")
        write(warnline,"(4i5,1P10E15.6)") GRHydro_Reflevel,ii,jj,kk,x,y,z
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(1P10E15.6)") rho,dens,epsilon,temp,temp0,ye
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(A7,i8)") "code: ",keyerr(1)
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
        call CCTK_WARN(failinfomode,warnline)
        call CCTK_WARN(failwarnmode,"Aborting!!!")
        !$OMP END CRITICAL
     endif
  endif

!!$  Check that the variables have a chance of being physical

  if( (utau + pold + udens)**2 - s2 .le. 0.0d0) then

    if (c2p_reset_pressure .ne. 0) then
      pold = sqrt(s2 + c2p_reset_pressure_to_value) - utau - udens
    else 
      !$OMP CRITICAL
!!!!      call CCTK_WARN(GRHydro_NaN_verbose, "c2p failed and being told not to reset the pressure")
      GRHydro_C2P_failed = 1.0d0
      !$OMP END CRITICAL
    endif
    
  endif
  
!!$  Calculate rho and epsilon 

!define temporary variables to speed up

  rho = udens * sqrt( (utau + pold + udens)**2 - s2)/(utau + pold + udens)
  w_lorentz = (utau + pold + udens) / sqrt( (utau + pold + udens)**2 - s2)
  epsilon = (sqrt( (utau + pold + udens)**2 - s2) - pold * w_lorentz - &
       udens)/udens
  
!!$  Calculate the function

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
                      rho,epsilon,temp,ye,xpress,keyerr,anyerr)
  ! error handling
  if(anyerr.ne.0) then
     if(keyerr(1).eq.668) then
        continue
!        GRHydro_C2P_failed = 3.0d0
!        write(warnline,"(A3,3i3,1P10E15.6)") "*2", ii,jj,kk,rho,epsilon,temp,ye,xpress
!        call CCTK_WARN(1,warnline)
     else 
        !$OMP CRITICAL
        call CCTK_WARN(failinfomode,"EOS error in c2p 1")
        write(warnline,"(4i5,1P10E15.6)") GRHydro_Reflevel,ii,jj,kk,x,y,z
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(1P10E15.6)") rho,dens,epsilon,temp,temp0,ye
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(A7,i8)") "code: ",keyerr(1)
        call CCTK_WARN(failinfomode,warnline)
        write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
        call CCTK_WARN(failinfomode,warnline)
        call CCTK_WARN(failwarnmode,"Aborting!!!")
        !$OMP END CRITICAL
     endif
  endif

  f = pold - xpress

  if (f .ne. f) then 
     ! Ok, this yielded nonsense, let's enforce bisection!
     mustbisect = .true.
  endif

!!$Find the root
  
  count = 0
  pnew = pold
  do while ( ((abs(pnew - pold)/abs(pnew) .gt. local_perc_ptol) .and. &
       (abs(pnew - pold) .gt. GRHydro_del_ptol))  .or. &
       (count .lt. GRHydro_countmin))
    count = count + 1

#if 0
    if(myproc.eq.3.and.&
         cctk_iteration.eq.11929.and.ii.eq.64.and.jj.eq.19.and.kk.eq.29) then
       !$OMP CRITICAL
       write(warnline,"(i5,1P10E18.9)") count, (abs(pnew - pold)/abs(pnew)), epsilon, temp, press
       call CCTK_WARN(1,warnline)
       !$OMP END CRITICAL
    endif
#endif

    if (count > GRHydro_countmax) then
      ! non-convergence is now handled outside of this
      ! routine
      GRHydro_C2P_failed = 2.0d0
      temp = temp0
      return
    end if

    call EOS_Omni_dpderho_dpdrhoe(handle,keytemp,GRHydro_eos_rf_prec,&
         n,rho,epsilon,temp,ye,dpressbydeps,dpressbydrho,keyerr,anyerr)

    temp1 = (utau+udens+pnew)**2 - s2
    drhobydpress = udens * s2 / (sqrt(temp1)*(udens+utau+pnew)**2)
    depsbydpress = pnew * s2 / (rho * (udens + utau + pnew) * temp1)
    df = 1.0d0 - dpressbydrho*drhobydpress - &
         dpressbydeps*depsbydpress

    pold = pnew
    
    ! Try to obtain new pressure via Newton-Raphson.
    
    pnew = pold - f/df 
    
    ! Check if Newton-Raphson resulted in something reasonable!
    if (c2p_resort_to_bisection.ne.0) then 
    
      tmp = (utau + pnew + udens)**2 - s2
      plow = max(pminl, sqrt(s2) - utau - udens)
      
      if (pnew .lt. plow .or. tmp .le. 0.0d0 .or. mustbisect) then
      
         ! Ok, Newton-Raphson ended up finding something unphysical.
         ! Let's try to find our root via bisection (which converges slower but is more robust)
      
         pnew = (plow + pold) / 2
         tmp = (utau + pnew + udens)**2 - s2
         
         mustbisect = .false.
      end if
    
    else
      
      ! This is the standard algorithm without resorting to bisection.
    
      pnew = max(pminl, pnew)
      tmp = (utau + pnew + udens)**2 - s2
    
    endif
    
    ! Check if we are still in the physical range now.
    ! If not, we set the C2P failed mask, and set pnew = pold (which will exit the loop).
    
    if ((tmp .le. 0.0d0) .and. GRHydro_C2P_failed .eq. 0) then
      GRHydro_C2P_failed = 1.0d0
      pnew = pold
    endif
    
!!$    Recalculate primitive variables and function
       
    rho = udens * sqrt( (utau + pnew + udens)**2 - s2)/(utau + pnew + udens)
    w_lorentz = (utau + pnew + udens) / sqrt( (utau + pnew + udens)**2 - &
         s2)
    epsilon = (sqrt( (utau + pnew + udens)**2 - s2) - pnew * w_lorentz - &
         udens)/udens

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,temp,ye,xpress,keyerr,anyerr)
    ! error handling
    if(anyerr.ne.0) then
       if(keyerr(1).eq.668) then
          continue
!          GRHydro_C2P_failed = 3.0d0
!          write(warnline,"(A3,3i3,1P10E15.6)") "*3", ii,jj,kk,rho,epsilon,temp,ye,xpress
!          call CCTK_WARN(1,warnline)
       else 
          !$OMP CRITICAL
          call CCTK_WARN(failinfomode,"EOS error in c2p 2")
          write(warnline,"(4i5,1P10E15.6)") GRHydro_Reflevel,ii,jj,kk,x,y,z
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(1P10E15.6)") rho,dens,epsilon,temp,temp0,ye
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(A7,i8)") "code: ",keyerr(1)
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
          call CCTK_WARN(failinfomode,warnline)
          call CCTK_WARN(failwarnmode,"Aborting!!!")
          !$OMP END CRITICAL
       endif
    endif

    f = pnew - xpress

    if (f .ne. f) then 
      ! Ok, this yielded nonsense, let's enforce bisection!
      mustbisect = .true.
    endif

  enddo

  
!!$  Polish the root

  do i=1,GRHydro_polish

    call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,temp,ye,dpressbydrho,keyerr,anyerr)

    call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
         rho,epsilon,temp,ye,dpressbydeps,keyerr,anyerr)

    temp1 = (utau+udens+pnew)**2 - s2
    drhobydpress = udens * s2 / (sqrt(temp1)*(udens+utau+pnew)**2)
    depsbydpress = pnew * s2 / (rho * (udens + utau + pnew) * temp1)
    df = 1.0d0 - dpressbydrho*drhobydpress - &
         dpressbydeps*depsbydpress
    pold = pnew
    pnew = pold - f/df
    
!!$    Recalculate primitive variables and function

    rho = udens * sqrt( (utau + pnew + udens)**2 - s2)/(utau + pnew + udens)
    w_lorentz = (utau + pnew + udens) / sqrt( (utau + pnew + udens)**2 - &
         s2)
    epsilon = (sqrt( (utau + pnew + udens)**2 - s2) - pnew * w_lorentz - &
         udens)/udens

    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n, &
         rho,epsilon,temp,ye,xpress,keyerr,anyerr)

    ! error handling
    if(anyerr.ne.0) then
       if(keyerr(1).eq.668) then
          continue
!          GRHydro_C2P_failed = 3.0d0
!          write(warnline,"(A3,3i3,1P10E15.6)") "*4", ii,jj,kk,rho,epsilon,temp,ye,xpress
!          call CCTK_WARN(1,warnline)
       else 
          !$OMP CRITICAL
          call CCTK_WARN(failinfomode,"EOS error in c2p 3")
          write(warnline,"(4i5,1P10E15.6)") GRHydro_Reflevel,ii,jj,kk,x,y,z
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(1P10E15.6)") rho,dens,epsilon,temp,temp0,ye
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(A7,i8)") "code: ",keyerr(1)
          call CCTK_WARN(failinfomode,warnline)
          write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
          call CCTK_WARN(failinfomode,warnline)
          call CCTK_WARN(failwarnmode,"Aborting!!!")
          !$OMP END CRITICAL
       endif
    endif
    
    f = pold - xpress

  enddo

!!$  Calculate primitive variables from root

  !if (rho .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
  IF_BELOW_ATMO(rho, GRHydro_rho_min, GRHydro_atmo_tolerance, r) then
    SET_ATMO_MIN(rho, GRHydro_rho_min, r) !GRHydro_rho_min
    udens = rho
    dens = sdet * rho
    temp = GRHydro_hot_atmo_temp
    ye = GRHydro_hot_atmo_Y_e
    ye_con = dens * ye
    keytemp=1
    call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n, &
         rho,epsilon,temp,ye,xpress,keyerr,anyerr)
    keytemp=0
    ! w_lorentz=1, so the expression for utau reduces to:
    utau  = rho + rho*epsilon - udens
    sx = 0.d0
    sy = 0.d0
    sz = 0.d0
    s2 = 0.d0
    usx = 0.d0
    usy = 0.d0
    usz = 0.d0
    w_lorentz = 1.d0
  end if

  press = pnew
  vlowx = usx / ( (rho + rho*epsilon + press) * w_lorentz**2)
  vlowy = usy / ( (rho + rho*epsilon + press) * w_lorentz**2)
  vlowz = usz / ( (rho + rho*epsilon + press) * w_lorentz**2)
  velx = uxx * vlowx + uxy * vlowy + uxz * vlowz
  vely = uxy * vlowx + uyy * vlowy + uyz * vlowz
  velz = uxz * vlowx + uyz * vlowy + uzz * vlowz

  ! indicate to wrapper routine that we dropped out of the
  ! EOS table
  if(keyerr(1).eq.668) then
     GRHydro_C2P_failed = 3.0d0
  endif

end subroutine Con2Prim_pt_hot3


```

GRHydro_PPMReconstruct_drv_opt.F90:
```
 /*@@
   @file      GRHydro_PPMReconstruct_drv.F90
   @date      Tue Jul 19 13:22:03 EDT 2011
   @author    Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   Driver routine to perform the PPM reconstructions.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define velx(i,j,k) vup(i,j,k,1)
#define vely(i,j,k) vup(i,j,k,2)
#define velz(i,j,k) vup(i,j,k,3)
#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)


 /*@@
   @routine    GRHydro_PPMReconstruct_drv
   @date       Tue Jul 19 13:24:34 EDT 2011
   @author     Luca Baiotti, Ian Hawke, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   A driver routine to do PPM reconstructions. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_PPMReconstruct_drv(CCTK_ARGUMENTS)
  
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  integer :: nx, ny, nz, i, j, k

  logical, dimension(:,:,:), allocatable :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_INT :: ierr

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup
  pointer (pvup,vup)

  logical :: apply_enhanced_ppm

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
    pvup = loc(lvel)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
    pvup = loc(vel)
  end if

  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
    
  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  ! if use_enhanced_ppm, allow old PPM on one level
  if (GRHydro_oppm_reflevel .eq. (-1) .or. &
       GRHydro_reflevel .ne. GRHydro_oppm_reflevel) then
     apply_enhanced_ppm = use_enhanced_ppm .ne. 0
  else
     apply_enhanced_ppm = .false.
  end if



!!$ PPM starts:
    if (flux_direction == 1) then
         !$OMP PARALLEL DO PRIVATE(i, j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
           do j = GRHydro_stencil, ny - GRHydro_stencil + 1

           trivial_rp(:,j,k) = .false.
           call PPMtyc(nx,CCTK_DELTA_SPACE(1),rho(:,j,k),velx(:,j,k),&
                vely(:,j,k),velz(:,j,k),eps(:,j,k),temperature(:,j,k),Y_e(:,j,k),&
                press(:,j,k),rhominus(:,j,k),&
                velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                epsminus(:,j,k),tempminus(:,j,k), y_e_minus(:,j,k),&
                rhoplus(:,j,k),&
                velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                epsplus(:,j,k),tempplus(:,j,k),y_e_plus(:,j,k))
             do i = 1, nx
                if (trivial_rp(i,j,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
                else
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
                end if
             end do
           end do
         end do
         !$OMP END PARALLEL DO
      else if (flux_direction == 2) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, nz - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
           trivial_rp(j,:,k) = .false.
           call PPMtyc(ny,CCTK_DELTA_SPACE(2),rho(j,:,k),&
                vely(j,:,k),velz(j,:,k),velx(j,:,k),&
                eps(j,:,k),temperature(j,:,k),Y_e(j,:,k), &
                press(j,:,k),rhominus(j,:,k),&
                velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                epsminus(j,:,k),tempminus(j,:,k), y_e_minus(j,:,k),rhoplus(j,:,k),&
                velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                epsplus(j,:,k),tempplus(j,:,k),y_e_plus(j,:,k))
            do i = 1, ny
              if (trivial_rp(j,i,k)) then
                 SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
              else
                 SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO

    else if (flux_direction == 3) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, ny - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
           trivial_rp(j,k,:) = .false.
           call PPMtyc(nz,CCTK_DELTA_SPACE(3),rho(j,k,:),&
                velz(j,k,:),velx(j,k,:),vely(j,k,:),&
                eps(j,k,:),temperature(j,k,:),Y_e(j,k,:), press(j,k,:),rhominus(j,k,:),&
                velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                epsminus(j,k,:),tempminus(j,k,:),y_e_minus(j,k,:),rhoplus(j,k,:),&
                velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                epsplus(j,k,:),tempplus(j,k,:),y_e_plus(j,k,:))
            do i = 1, nz
              if (trivial_rp(j,k,i)) then
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
              else
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
!!$ PPM ends.

  deallocate(trivial_rp)

end subroutine GRHydro_PPMReconstruct_drv


```

GRHydro_Particle.F90:
```
 /*@@
   @file      GRHydro_Particle.F90
   @date      Wed Mar 31 11:10:52 2004
   @author    Ian Hawke
   @desc 
   Track coordinates of particles.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydroParticleRHS
   @date       Wed Mar 31 11:11:26 2004
   @author     Ian Hawke
   @desc 
   Track particles.
   Most of this code is taken from Peter Dieners EHFinder - generator tracking.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydroParticleRHS(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i
  CCTK_INT :: interp_handle, table_handle, status, coord_system_handle

  character(len=200) :: particle_interp
  character(len=128) :: warn_message
  CCTK_INT :: particle_interp_len
  character(len=7) :: particle_order

  CCTK_INT, dimension(1) :: lsh
  CCTK_POINTER, dimension(3) :: interp_coords
  CCTK_POINTER, dimension(7) :: out_arrays
  CCTK_INT, dimension(7) :: in_arrays
  CCTK_INT, dimension(7), parameter :: op_indices = (/ 0, 1, 2, 3, 4, &
                                                        5, 6 /), &
                                        op_codes = (/ 0, 0, 0, 0, 0, &
                                                      0, 0 /)
  CCTK_INT, dimension(7) :: out_types

  out_types = CCTK_VARIABLE_REAL

! Convert the particle_interpolator string parameter to a Fortran string.
  call CCTK_FortranString ( particle_interp_len, particle_interpolator, &
       particle_interp )

! Get the corresponding interpolator handle.
  call CCTK_InterpHandle ( interp_handle, particle_interp )

  if ( interp_handle .lt. 0 ) then
    warn_message = 'Cannot get handle for interpolation.'
    warn_message = trim(warn_message)//' Forgot to activate an implementation'
    warn_message = trim(warn_message)//' providing interpolation operators?'
    call CCTK_ERROR ( trim(warn_message) )
    STOP
  end if

! Convert the interpolation order parameter to a Fortran string to be placed
! in the interpolator table. Note that the order is assumed to contain only
! 1 digit.
  write(particle_order,'(a6,i1)') 'order=', particle_interpolation_order

! Create the table directly from the string.
  call Util_TableCreateFromString ( table_handle, particle_order )
  if ( table_handle .lt. 0 ) then
    call CCTK_ERROR ( 'Cannot create parameter table for interpolator' )
    STOP
  end if

! Get the 3D coordinate system handle.
  call CCTK_CoordSystemHandle ( coord_system_handle, 'cart3d' )
  if ( coord_system_handle .lt. 0) then
    warn_message = 'Cannot get handle for cart3d coordinate system.'
    warn_message = trim(warn_message)//' Forgot to activate an implementation'
    warn_message = trim(warn_message)//' providing coordinates?'
    call CCTK_ERROR ( trim(warn_message) )
    STOP
  endif

! Find out how many interpolation points are located on this processor.
  call CCTK_GrouplshGN ( status, cctkGH, 1, lsh, 'GRHydro::particles' )
  if ( status .lt. 0 ) then
    call CCTK_ERROR( 'cannot get local size for particles')
    STOP
  end if

! Set the pointers to the output arrays.
  out_arrays(1) = CCTK_PointerTo(particle_vx)
  out_arrays(2) = CCTK_PointerTo(particle_vy)
  out_arrays(3) = CCTK_PointerTo(particle_vz)
  out_arrays(4) = CCTK_PointerTo(particle_alp)
  out_arrays(5) = CCTK_PointerTo(particle_betax)
  out_arrays(6) = CCTK_PointerTo(particle_betay)
  out_arrays(7) = CCTK_PointerTo(particle_betaz)

!   Set the pointers to the points to be interpolated to.
  interp_coords(1) = CCTK_PointerTo(particle_x)
  interp_coords(2) = CCTK_PointerTo(particle_y)
  interp_coords(3) = CCTK_PointerTo(particle_z)

!   Set the indices to the input grid functions.
  call CCTK_VarIndex ( in_arrays(1), 'GRHydro::velx' )
  call CCTK_VarIndex ( in_arrays(2), 'GRHydro::vely' )
  call CCTK_VarIndex ( in_arrays(3), 'GRHydro::velz' )
  call CCTK_VarIndex ( in_arrays(4), 'admbase::alp' )
  call CCTK_VarIndex ( in_arrays(5), 'admbase::betax' )
  call CCTK_VarIndex ( in_arrays(6), 'admbase::betay' )
  call CCTK_VarIndex ( in_arrays(7), 'admbase::betaz' )

!     Set the operand indices table entry
  call Util_TableSetIntArray ( status, table_handle, 7, &
       op_indices(1:7), 'operand_indices' )
  if ( status .lt. 0 ) then
    warn_message = 'Cannot set operand indices array in parameter table'
    call CCTK_ERROR ( trim(warn_message) )
    STOP
  endif

!     Set the corresponding table entry for the operation codes.
  call Util_TableSetIntArray ( status, table_handle, 7, &
       op_codes(1:7), 'operation_codes' )
  if ( status .lt. 0 ) then
    warn_message = 'Cannot set operation codes array in parameter table'
    call CCTK_ERROR ( trim(warn_message) )
  endif

!     Call the interpolator.
  call CCTK_InterpGridArrays ( status, cctkGH, 3, interp_handle, &
       table_handle, coord_system_handle, &
       lsh(1), CCTK_VARIABLE_REAL, &
       interp_coords, 7, in_arrays(1:7), &
       7, out_types(1:7), out_arrays(1:7) )

  if ( status .lt. 0 ) then
    call CCTK_INFO ( 'Interpolation failed.' )
  end if

!     For each point on this processor calculate the right hand side of the
!     characteristic evolution equation.
  do i = 1, lsh(1)

    particle_x_rhs(i) = particle_alp(i) * particle_vx(i) - &
         particle_betax(i)
    particle_y_rhs(i) = particle_alp(i) * particle_vy(i) - &
         particle_betay(i)
    particle_z_rhs(i) = particle_alp(i) * particle_vz(i) - &
         particle_betaz(i)

  end do
  
  return

end subroutine GRHydroParticleRHS

/*@@
   @routine    GRHydroParticleInitial
   @date       Wed Mar 31 11:53:25 2004
   @author     Ian Hawke
   @desc 
   Sets up the initial coordinates of the particles. Can be overwritten
   by something scheduled in HydroBase_Initial.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydroParticleInitial(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, dimension(1) :: lsh, lbnd
  CCTK_INT :: i, status
  CCTK_REAL :: radius, angle, xmin, xmax, ymin, ymax, zmin, zmax, twopi

  twopi = 4.d0 * atan(1.d0)

  if (number_of_particles .gt. 0) then

! Find out how many interpolation points are located on this processor.
    call CCTK_GrouplshGN ( status, cctkGH, 1, lsh, 'GRHydro::particles' )
    if ( status .lt. 0 ) then
      call CCTK_ERROR ( 'cannot get local size for particles' )
      STOP
    end if
    call CCTK_GrouplbndGN ( status, cctkGH, 1, lbnd, 'GRHydro::particles' )
    if ( status .lt. 0 ) then
      call CCTK_ERROR ( 'cannot get lower bounds for particles' )
      STOP
    end if

    call CCTK_CoordRange(status,cctkGH,xmin,xmax,-1,"x","cart3d")
    call CCTK_CoordRange(status,cctkGH,ymin,ymax,-1,"y","cart3d")
    call CCTK_CoordRange(status,cctkGH,zmin,zmax,-1,"z","cart3d")


    radius = 0.1d0 * min(xmax, ymax, zmax)

    do i = 1, lsh(1)

      angle = dble(lbnd(1)+i-1) / dble(number_of_particles) * twopi 

      particle_x(i) = radius * sin(angle)
      particle_y(i) = radius * cos(angle)
      particle_z(i) = 0.d0

      particle_x_p(i) = particle_x(i)
      particle_y_p(i) = particle_y(i)
      particle_z_p(i) = particle_z(i)

      particle_x_p_p(i) = particle_x(i)
      particle_y_p_p(i) = particle_y(i)
      particle_z_p_p(i) = particle_z(i)

      particle_x_rhs(i) = 0.d0
      particle_y_rhs(i) = 0.d0
      particle_z_rhs(i) = 0.d0
      
      particle_vx(i) = 0.d0
      particle_vy(i) = 0.d0
      particle_vz(i) = 0.d0
      particle_alp(i) = 0.d0
      particle_betax(i) = 0.d0
      particle_betay(i) = 0.d0
      particle_betaz(i) = 0.d0

    end do
    
  end if
  
end subroutine GRHydroParticleInitial

```

GRHydro_Shift.F90:
```
/*@@
  @file      GRHydro_Shift.F90
  @date      Fri Mar 14 17:36:37 2003
  @author    Ian Hawke
  @desc 
  Set the shift so that it is approximately comoving with the
  velocity.
  @enddesc 
@@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydro_ComovingShift
   @date       Fri Mar 14 17:37:30 2003
   @author     Ian Hawke
   @desc 
   Implements the comoving shift
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_ComovingShift(CCTK_ARGUMENTS)
      
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: ierr, Reduction_Handle, VarIndex
  CCTK_REAL :: rho_max
  CCTK_REAL, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: attenuate

  call CCTK_ReductionHandle(Reduction_Handle, "maximum")
  call CCTK_VarIndex(VarIndex, "HydroBase::rho")

  call CCTK_Reduce(ierr, cctkGH, -1, Reduction_Handle, &
       1, CCTK_VARIABLE_REAL, rho_max, 1, VarIndex)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Failed to find rho_max")
    STOP
  end if

!!$  Hard wire in nuclear density

  if (CCTK_EQUALS(comoving_attenuate,"sqrt")) then
    attenuate = sqrt(rho / rho_max)
  else if (CCTK_EQUALS(comoving_attenuate,"tanh")) then
    attenuate = 0.5d0*(tanh(comoving_tanh_factor*&
         (rho/rho_max - comoving_tanh_offset)) + 1.d0 )
  else
    attenuate = 1.d0
  end if
  
  if (rho_max < 0.000324d0) then
    
    if (CCTK_EQUALS(comoving_v_method,"projected")) then
      
      where (rho > 10.d0 * GRHydro_rho_min)
        
        betax = -comoving_factor*x*alp*(x*vel(:,:,:,1) + y*vel(:,:,:,2) + z*vel(:,:,:,3)) / &
             (r**2 + 1.d-10) * attenuate
        betay = -comoving_factor*y*alp*(x*vel(:,:,:,1) + y*vel(:,:,:,2) + z*vel(:,:,:,3)) / &
             (r**2 + 1.d-10) * attenuate
        betaz = -comoving_factor*z*alp*(x*vel(:,:,:,1) + y*vel(:,:,:,2) + z*vel(:,:,:,3)) / &
             (r**2 + 1.d-10) * attenuate
        
      elsewhere
        
        betax = 0.d0
        betay = 0.d0
        betaz = 0.d0
        
      end where
      
    else if (CCTK_EQUALS(comoving_v_method,"components")) then
      
      where (rho > 10.d0 * GRHydro_rho_min)
        
        betax = comoving_factor * alp * x / (r + 1.d-10) * sqrt( (&
             (vel_p(:,:,:,1) - betax_p / alp_p)**2 + &
             (vel_p(:,:,:,2) - betay_p / alp_p)**2 + &
             (vel_p(:,:,:,3) - betaz_p / alp_p)**2) ) * attenuate
        betay = comoving_factor * alp * y / (r + 1.d-10) * sqrt( (&
             (vel_p(:,:,:,1) - betax_p / alp_p)**2 + &
             (vel_p(:,:,:,2) - betay_p / alp_p)**2 + &
             (vel_p(:,:,:,3) - betaz_p / alp_p)**2) ) * attenuate
        betaz = comoving_factor * alp * z / (r + 1.d-10) * sqrt( (&
             (vel_p(:,:,:,1) - betax_p / alp_p)**2 + &
             (vel_p(:,:,:,2) - betay_p / alp_p)**2 + &
             (vel_p(:,:,:,3) - betaz_p / alp_p)**2) ) * attenuate
        
      elsewhere
        
        betax = 0.d0
        betay = 0.d0
        betaz = 0.d0
        
      end where
      
    end if
    
  else
    
    betax = 0.d0
    betay = 0.d0
    betaz = 0.d0
    
  end if
  
end subroutine GRHydro_ComovingShift

 /*@@
   @routine    GRHydro_SetUpCoords
   @date       Fri Mar 14 19:11:13 2003
   @author     Ian Hawke
   @desc 
   Initializes the coordinates that are evolved with the
   comoving shift
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_SetUpCoords(CCTK_ARGUMENTS)
      
  implicit none
  
  DECLARE_CCTK_ARGUMENTS

  GRHydro_x = x
  GRHydro_y = y
  GRHydro_z = z

end subroutine GRHydro_SetUpCoords

 /*@@
   @routine    GRHydro_EvolveCoords
   @date       Wed Mar 19 12:04:20 2003
   @author     Ian Hawke
   @desc 
   Evolve the coordinate system
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_EvolveCoords(CCTK_ARGUMENTS)
      
  implicit none
  
  DECLARE_CCTK_ARGUMENTS

  GRHydro_x_rhs = -betax
  GRHydro_y_rhs = -betay
  GRHydro_z_rhs = -betaz

end subroutine GRHydro_EvolveCoords

```

GRHydro_Wrappers.F90:
```
 /*@@
   @file      GRHydro_Wrappers.F90
   @date      Sat Jun 29 18:57:07 PDT 2013
   @author    Roland Haas
   @desc
      Wrapper routines to provide a consistent interface to the aliased
      functions even if the interface to the underlying implementation changes.
   @enddesc
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

subroutine Con2PrimPolyWrapper(handle, dens, sx, sy, sz, tau, rho, &
     velx, vely, velz, epsilon, press, w_lorentz, uxx, uxy, uxz, uyy, &
     uyz, uzz, detg, x, y, z, r, GRHydro_rho_min, GRHydro_reflevel, GRHydro_C2P_failed)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL, INTENT(INOUT) :: dens, sx, sy, sz
  CCTK_REAL, INTENT(OUT) :: tau
  CCTK_REAL, INTENT(INOUT) :: rho
  CCTK_REAL, INTENT(INOUT) :: velx, vely, velz, epsilon, press, w_lorentz
  CCTK_REAL, INTENT(IN) :: uxx, uxy, uxz, uyy, uyz, uzz, detg
  CCTK_REAL, INTENT(IN) :: x, y, z, r, GRHydro_rho_min

  CCTK_INT, INTENT(IN) :: handle, GRHydro_reflevel
  CCTK_REAL, INTENT(OUT) :: GRHydro_C2P_failed

  CCTK_REAL :: sdetg

  sdetg = sqrt(detg)

  call Con2Prim_ptPolytype(handle, dens, sx, sy, sz, tau, rho, &
     velx, vely, velz, epsilon, press, w_lorentz, uxx, uxy, uxz, uyy, &
     uyz, uzz, sdetg, x, y, z, r, GRHydro_rho_min, GRHydro_reflevel, &
     GRHydro_C2P_failed)

end subroutine

subroutine Con2PrimGenWrapper(handle, dens, sx, sy, sz, tau, rho, velx, vely, &
                              velz, epsilon, pressure, w_lorentz, uxx, uxy, &
                              uxz, uyy, uyz, uzz, det, x, y, z, r, epsnegative, &
                              GRHydro_rho_min, pmin, epsmin, GRHydro_reflevel, &
                              retval)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(INOUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(INOUT) :: rho, velx, vely, velz, epsilon, pressure
  CCTK_REAL, INTENT(INOUT) :: w_lorentz
  CCTK_REAL, INTENT(IN) :: uxx, uxy, uxz, uyy, uyz, uzz, det
  CCTK_REAL, INTENT(IN) :: x, y, z, r
  CCTK_INT, INTENT(OUT) :: epsnegative
  CCTK_REAL, INTENT(IN) :: GRHydro_rho_min, pmin, epsmin
  CCTK_INT, INTENT(IN) :: GRHydro_reflevel
  CCTK_REAL, INTENT(OUT) :: retval

  CCTK_REAL :: sdetg
  CCTK_INT, parameter :: cctk_iteration = -1, ii = -1, jj = -1, kk = -1
  logical :: log_epsnegative

  sdetg = sqrt(det)

  call Con2Prim_pt(cctK_iteration, ii, jj, kk, &
                   handle, dens, sx, sy, sz, tau, rho, velx, vely, &
                   velz, epsilon, pressure, w_lorentz, uxx, uxy, &
                   uxz, uyy, uyz, uzz, sdetg, x, y, z, r, log_epsnegative, &
                   GRHydro_rho_min, pmin, epsmin, GRHydro_reflevel, &
                   retval)
  if(log_epsnegative) then
    epsnegative = 1
  else
    epsnegative = 0
  end if

end subroutine

subroutine Con2PrimGenMWrapper(handle, keytemp, prec, gamma_eos, dens, sx, sy, sz, &
                               tau, Bconsx, Bconsy, Bconsz, y_e, temp, rho, velx, &
                               vely, velz, epsilon, pressure, Bvecx, Bvecy, Bvecz, &
                               Bvecsq, w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx, &
                               uxy, uxz, uyy, uyz, uzz, det, epsnegative, retval)

  use Con2PrimM_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle, keytemp
  CCTK_REAL, INTENT(IN) :: prec, gamma_eos
  CCTK_REAL, INTENT(INOUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(IN) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(INOUT) :: y_e,  temp
  CCTK_REAL, INTENT(INOUT) :: rho, velx, vely, velz, epsilon, pressure
  CCTK_REAL, INTENT(OUT) :: Bvecx, Bvecy, Bvecz, Bvecsq
  CCTK_REAL, INTENT(INOUT) :: w_lorentz
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: uxx, uxy, uxz, uyy, uyz, uzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_INT, INTENT(OUT) :: epsnegative
  CCTK_REAL, INTENT(OUT) :: retval

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  if(handle.eq.1 .or. handle.eq.2) then
    call GRHydro_Con2PrimM_ptold(handle, gamma_eos, dens, sx, sy, sz, &
                                 tau, Bconsx, Bconsy, Bconsz, rho, velx, &
                                 vely, velz, epsilon, pressure, Bvecx, Bvecy, Bvecz, &
                                 Bvecsq, w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx, &
                                 uxy, uxz, uyy, uyz, uzz, sdetg, epsnegative, retval)
  else
    call GRHydro_Con2PrimM_pt2(handle, keytemp, prec, prec, gamma_eos, dens, sx, sy, sz, &
                               tau, Bconsx, Bconsy, Bconsz, y_e, temp, rho, velx, &
                               vely, velz, epsilon, pressure, Bvecx, Bvecy, Bvecz, &
                               Bvecsq, w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx, &
                               uxy, uxz, uyy, uyz, uzz, sdetg, epsnegative, retval)
  end if

end subroutine

subroutine Con2PrimPolyMWrapper(handle, gamma_eos, dens, sx, sy, sz, sc,&
                                Bconsx, Bconsy, Bconsz, rho, velx, vely, velz,&
                                epsilon, pressure, Bvecx, Bvecy, Bvecz, Bvecsq,&
                                w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx,&
                                uxy, uxz, uyy, uyz, uzz, det, epsnegative,&
                                retval)

  use Con2PrimM_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(IN) :: gamma_eos
  CCTK_REAL, INTENT(INOUT) :: dens, sx, sy, sz, sc
  CCTK_REAL, INTENT(INOUT) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(INOUT) :: rho, velx, vely, velz, epsilon, pressure
  CCTK_REAL, INTENT(OUT) :: Bvecx, Bvecy, Bvecz
  CCTK_REAL, INTENT(OUT) :: Bvecsq
  CCTK_REAL, INTENT(INOUT) :: w_lorentz
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: uxx, uxy, uxz, uyy, uyz, uzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_INT, INTENT(OUT) :: epsnegative
  CCTK_REAL, INTENT(OUT) :: retval

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call GRHydro_Con2PrimM_Polytype_pt(handle, gamma_eos, dens, sx, sy, sz, sc, &
                                     Bconsx, Bconsy, Bconsz, rho, velx, vely, velz, &
                                     epsilon, pressure, Bvecx, Bvecy, Bvecz, Bvecsq, &
                                     w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx, &
                                     uxy, uxz, uyy, uyz, uzz, sdetg, epsnegative, &
                                     retval)
end subroutine

subroutine Prim2ConGenWrapper(handle, gxx, gxy, gxz, gyy, gyz, gzz, det, dens,&
                              sx, sy, sz, tau, rho, velx, vely, velz, epsilon,&
                              press, w_lorentz)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_REAL, INTENT(OUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(IN) :: rho, velx, vely, velz, epsilon
  CCTK_REAL, INTENT(OUT) :: press, w_lorentz

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call prim2con(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdetg, dens,&
                sx, sy, sz, tau, rho, velx, vely, velz, epsilon,&
                press, w_lorentz)
end subroutine

subroutine Prim2ConPolyWrapper(handle, gxx, gxy, gxz, gyy, gyz, gzz, det, dens,&
                               sx, sy, sz, tau, rho, velx, vely, velz, epsilon,&
                               press, w_lorentz)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_REAL, INTENT(OUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(IN) :: rho, velx, vely, velz
  CCTK_REAL, INTENT(OUT) :: epsilon, press, w_lorentz

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call prim2conpolytype(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdetg, dens,&
                        sx, sy, sz, tau, rho, velx, vely, velz, epsilon,&
                        press, w_lorentz)
end subroutine

subroutine Prim2ConGenMWrapper(handle, gxx, gxy, gxz, gyy, gyz, gzz, det, dens,&
                               sx, sy, sz, tau, Bconsx, Bconsy, Bconsz, rho,&
                               velx, vely, velz, epsilon, press, Bvecx, Bvecy,&
                               Bvecz, w_lorentz)

  use Con2PrimM_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_REAL, INTENT(OUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(OUT) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(IN) :: rho, velx, vely, velz, epsilon
  CCTK_REAL, INTENT(OUT) :: press
  CCTK_REAL, INTENT(IN) :: Bvecx, Bvecy, Bvecz
  CCTK_REAL, INTENT(OUT) :: w_lorentz

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call prim2conM(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdetg, dens,&
                 sx, sy, sz, tau, Bconsx, Bconsy, Bconsz, rho,&
                 velx, vely, velz, epsilon, press, Bvecx, Bvecy,&
                 Bvecz, w_lorentz)
end subroutine

subroutine Prim2ConGenM_hotWrapper(handle, GRHydro_reflevel, i, j, k, x, y, z,&
                                   gxx, gxy, gxz, gyy, gyz, gzz, det, dens, sx,&
                                   sy, sz, tau, Bconsx, Bconsy, Bconsz, rho,&
                                   velx, vely, velz, epsilon, press, Bvecx,&
                                   Bvecy, Bvecz, w_lorentz, temperature, Y_e)

  use Con2PrimM_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle, GRHydro_reflevel
  CCTK_INT, INTENT(IN) :: i, j, k
  CCTK_REAL, INTENT(IN) :: x, y, z
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_REAL, INTENT(OUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(OUT) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(IN) :: rho, velx, vely, velz, epsilon
  CCTK_REAL, INTENT(OUT) :: press
  CCTK_REAL, INTENT(IN) :: Bvecx, Bvecy, Bvecz
  CCTK_REAL, INTENT(OUT) :: w_lorentz
  CCTK_REAL, INTENT(INOUT) :: temperature
  CCTK_REAL, INTENT(IN) :: Y_e

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call prim2conM_hot(handle, GRHydro_reflevel, i, j, k, x, y, z, gxx,&
                     gxy, gxz, gyy, gyz, gzz, sdetg, dens, sx, sy, sz,&
                     tau, Bconsx, Bconsy, Bconsz, rho, velx, vely, velz,&
                     epsilon, press, Bvecx, Bvecy, Bvecz, w_lorentz,&
                     temperature, Y_e)
end subroutine

subroutine Prim2ConPolyMWrapper(handle, gxx, gxy, gxz, gyy, gyz, gzz, det,&
                                dens, sx, sy, sz, tau, Bconsx, Bconsy, Bconsz,&
                                rho, velx, vely, velz, epsilon, press, Bvecx,&
                                Bvecy, Bvecz, w_lorentz)

  use Con2PrimM_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_REAL, INTENT(OUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(OUT) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(IN) :: rho, velx, vely, velz
  CCTK_REAL, INTENT(OUT) :: epsilon
  CCTK_REAL, INTENT(OUT) :: press
  CCTK_REAL, INTENT(IN) :: Bvecx, Bvecy, Bvecz
  CCTK_REAL, INTENT(OUT) :: w_lorentz

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call prim2conpolytypeM(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdetg,&
                         dens, sx, sy, sz, tau, Bconsx, Bconsy, Bconsz,&
                         rho, velx, vely, velz, epsilon, press, Bvecx,&
                         Bvecy, Bvecz, w_lorentz)
end subroutine

subroutine Con2PrimGenMeeWrapper(handle, keytemp, prec, gamma_eos, dens, sx, sy,&
                                 sz, tau, Bconsx, Bconsy, Bconsz, entropycons,&
                                 y_e, temp, rho, velx, vely, velz, epsilon,&
                                 pressure, Bvecx, Bvecy, Bvecz, Bvecsq,&
                                 w_lorentz, gxx, gxy, gxz, gyy, gyz, gzz, uxx,&
                                 uxy, uxz, uyy, uyz, uzz, det, epsnegative,&
                                 retval)

  use Con2Prim_fortran_interfaces

  implicit none

  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, INTENT(IN) :: handle, keytemp
  CCTK_REAL, INTENT(IN) :: prec, gamma_eos
  CCTK_REAL, INTENT(INOUT) :: dens, sx, sy, sz, tau
  CCTK_REAL, INTENT(IN) :: Bconsx, Bconsy, Bconsz
  CCTK_REAL, INTENT(INOUT) :: entropycons, y_e, temp
  CCTK_REAL, INTENT(INOUT) :: rho, velx, vely, velz, epsilon, pressure
  CCTK_REAL, INTENT(OUT) :: Bvecx, Bvecy, Bvecz
  CCTK_REAL, INTENT(OUT) :: Bvecsq
  CCTK_REAL, INTENT(INOUT) :: w_lorentz
  CCTK_REAL, INTENT(IN) :: gxx, gxy, gxz, gyy, gyz, gzz
  CCTK_REAL, INTENT(IN) :: uxx, uxy, uxz, uyy, uyz, uzz
  CCTK_REAL, INTENT(IN) :: det
  CCTK_INT, INTENT(OUT) :: epsnegative
  CCTK_REAL, INTENT(OUT) :: retval

  CCTK_REAL :: sdetg

  sdetg = sqrt(det)

  call GRHydro_Con2PrimM_ptee(handle, keytemp, prec, gamma_eos, dens, sx, sy, sz,&
                              tau, Bconsx, Bconsy, Bconsz, entropycons, y_e, temp,&
                              rho, velx, vely, velz, epsilon, pressure, Bvecx,&
                              Bvecy, Bvecz, Bvecsq, w_lorentz, gxx, gxy, gxz, gyy,&
                              gyz, gzz, uxx, uxy, uxz, uyy, uyz, uzz, sdetg,&
                              epsnegative, retval)
end subroutine

```

GRHydro_Set_TP_GF.c:
```
 /*@@
   @file      Set_Trivial_Riemann_Problem_Grid_Function
   @date      Thu May 08
   @author    Frank Loeffler
   @desc 
   This routine sets the grid function for the trivial rieman problem
   bits. This is only done for debugging purposes

   @enddesc 
 @@*/
   
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"

#include "SpaceMask.h"

void Set_Trivial_Riemann_Problem_Grid_Function(CCTK_ARGUMENTS)
{
  
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  int nx, ny, nz, i, j, k, point;
  int type, state;

  nx = cctk_lsh[0];
  ny = cctk_lsh[1];
  nz = cctk_lsh[2];

  if (flux_direction[0]==1)
  {
    type =SpaceMask_GetTypeBits("Hydro_RiemannProblemX");
    state=SpaceMask_GetStateBits("Hydro_RiemannProblemX", "trivial");
    for (k=0 ; k<nz ; k++)
      for (j=0 ; j<ny ; j++)
        for (i=0 ; i<nx ; i++)
        {
          point = CCTK_GFINDEX3D(cctkGH,i,j,k);
          if (SpaceMask_CheckStateBits(space_mask, point, type, state))
          {
            GRHydro_trivial_rp_gf_x[point]=1;
          }
          else
          {
            GRHydro_trivial_rp_gf_x[point]=0;
          }
        }
  }
  if (flux_direction[0]==2)
  {
    type =SpaceMask_GetTypeBits("Hydro_RiemannProblemY");
    state=SpaceMask_GetStateBits("Hydro_RiemannProblemY", "trivial");
    for (k=0 ; k<nz ; k++)
      for (j=0 ; j<ny ; j++)
        for (i=0 ; i<nx ; i++)
        {
          point = CCTK_GFINDEX3D(cctkGH,i,j,k);
          if (SpaceMask_CheckStateBits(space_mask, point, type, state))
          {
            GRHydro_trivial_rp_gf_y[point]=1;
          }
          else
          {
            GRHydro_trivial_rp_gf_y[point]=0;
          }
        }
  }
  if (flux_direction[0]==3)
  {
    type =SpaceMask_GetTypeBits("Hydro_RiemannProblemZ");
    state=SpaceMask_GetStateBits("Hydro_RiemannProblemZ", "trivial");
    for (k=0 ; k<nz ; k++)
      for (j=0 ; j<ny ; j++)
        for (i=0 ; i<nx ; i++)
        {
          point = CCTK_GFINDEX3D(cctkGH,i,j,k);
          if (SpaceMask_CheckStateBits(space_mask, point, type, state))
          {
            GRHydro_trivial_rp_gf_z[point]=1;
          }
          else
          {
            GRHydro_trivial_rp_gf_z[point]=0;
          }
        }
  }
  return;
}

```

GRHydro_PPMMReconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_PPMMReconstruct_drv.F90
   @date      Wed Jul 27 15:17:03 EDT 2011
   @author    Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   Driver routine to perform the magnetic version of PPM reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)
#define Bconsx(i,j,k) Bcons(i,j,k,1)
#define Bconsy(i,j,k) Bcons(i,j,k,2)
#define Bconsz(i,j,k) Bcons(i,j,k,3)


 /*@@
   @routine    GRHydro_PPMMReconstruct_drv
   @date       Wed Jul 27 15:17:55 EDT 2011
   @author     Luca Baiotti, Ian Hawke, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   A driver routine to do magnetic version of PPM reconstructions. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_PPMMReconstruct_drv(CCTK_ARGUMENTS)
  
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates

  integer :: nx, ny, nz, i, j, k

  logical, dimension(:,:,:), allocatable :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_REAL, dimension(:,:,:),allocatable :: &
       dum, dump, dumm

  CCTK_INT :: ierr

  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
  
!!$ The dum variables are used as dummies if MHD on but divergence cleaning off
  allocate(dum(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dump(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dumm(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)

  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  !initialize trivial_rp to false                                               
  !$OMP PARALLEL DO PRIVATE(i,j,k)
  do k=1,nz
     do j=1,ny
        do i=1,nx
           trivial_rp(i,j,k) = .false.
        enddo
     enddo
  enddo
  !$OMP END PARALLEL DO 

!!$ PPM starts:
    if (flux_direction == 1) then
            ! constraint transport needs to be able to average fluxes in the directions
            ! other that flux_direction, which in turn need the primitives on interfaces
            !$OMP PARALLEL DO PRIVATE(i, j, k)
            do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + transport_constraints
              do j = GRHydro_stencil, ny - GRHydro_stencil + 1 + transport_constraints
               if(clean_divergence.ne.0) then
                 if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                   call SimplePPM_1dM(GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                        rho(:,j,k),vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3),&
                        Bvec(:,j,k,1),Bvec(:,j,k,2),Bvec(:,j,k,3),psidc(:,j,k),eps(:,j,k),press(:,j,k),&
                        rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                        Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),psidcminus(:,j,k),epsminus(:,j,k),&
                        rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                        Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),psidcplus(:,j,k),epsplus(:,j,k),&
                        1,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                        gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                        gzz(:,j,k), betax(:,j,k), alp(:,j,k),&
                        w_lorentz(:,j,k), &
                        1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                        GRHydro_mppm_eigenvalue_x_right, &
                        GRHydro_mppm_xwind)
                 else
                   call SimplePPM_1dM(GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                        rho(:,j,k),lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3),&
                        lBvec(:,j,k,1),lBvec(:,j,k,2),lBvec(:,j,k,3),psidc(:,j,k),eps(:,j,k),press(:,j,k),&
                        rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                        Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),psidcminus(:,j,k),epsminus(:,j,k),&
                        rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                        Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),psidcplus(:,j,k),epsplus(:,j,k),&
                        1,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                        gaa(:,j,k), gab(:,j,k), gac(:,j,k), gbb(:,j,k), gbc(:,j,k), &
                        gcc(:,j,k), betaa(:,j,k), alp(:,j,k),&
                        w_lorentz(:,j,k), &
                        1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                        GRHydro_mppm_eigenvalue_x_right, &
                        GRHydro_mppm_xwind)
                 end if
               else  !clean_divergence
                 if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                   call SimplePPM_1dM(GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                        rho(:,j,k),vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3),&
                        Bvec(:,j,k,1),Bvec(:,j,k,2),Bvec(:,j,k,3),dum(:,j,k),eps(:,j,k),press(:,j,k),&
                        rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                        Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),dumm(:,j,k),epsminus(:,j,k),&
                        rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                        Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),dump(:,j,k),epsplus(:,j,k),&
                        0,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                        gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                        gzz(:,j,k), betax(:,j,k), alp(:,j,k),&
                        w_lorentz(:,j,k), &
                        1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                        GRHydro_mppm_eigenvalue_x_right, &
                        GRHydro_mppm_xwind)
                 else
                   call SimplePPM_1dM(GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                        rho(:,j,k),lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3),&
                        lBvec(:,j,k,1),lBvec(:,j,k,2),lBvec(:,j,k,3),dum(:,j,k),eps(:,j,k),press(:,j,k),&
                        rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                        Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),dumm(:,j,k),epsminus(:,j,k),&
                        rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                        Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),dump(:,j,k),epsplus(:,j,k),&
                        0,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                        gaa(:,j,k), gab(:,j,k), gac(:,j,k), gbb(:,j,k), gbc(:,j,k), &
                        gcc(:,j,k), betaa(:,j,k), alp(:,j,k),&
                        w_lorentz(:,j,k), &
                        1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                        GRHydro_mppm_eigenvalue_x_right, &
                        GRHydro_mppm_xwind)
                 end if
               endif  !clean_divergence
                do i = 1, nx
                   if (trivial_rp(i,j,k)) then
                     SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
                   else
                     SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
                   end if
                end do
              end do
            end do
            !$OMP END PARALLEL DO

      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_tracer_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3), &
                      tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), &
                      press(:,j,k))
               else
                 call SimplePPM_tracer_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3), &
                      tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), &
                      press(:,j,k))
              end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + transport_constraints
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1 + transport_constraints
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3), &
                      Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k), &
                      press(:,j,k))
               else
                 call SimplePPM_ye_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3), &
                      Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k), &
                      press(:,j,k))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else if (flux_direction == 2) then
          ! constraint transport needs to be able to average fluxes in the directions
          ! other that flux_direction, which in turn need the primitives on interfaces
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + transport_constraints
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + transport_constraints
             if(clean_divergence.ne.0) then
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_1dM(GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                     rho(j,:,k),vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1),&
                     Bvec(j,:,k,2),Bvec(j,:,k,3),Bvec(j,:,k,1),psidc(j,:,k),eps(j,:,k),press(j,:,k),&
                     rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                     Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),psidcminus(j,:,k),epsminus(j,:,k),&
                     rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                     Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),psidcplus(j,:,k),epsplus(j,:,k),&
                     1,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                     gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                     gxx(j,:,k), betay(j,:,k), alp(j,:,k),&
                     w_lorentz(j,:,k), &
                     2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                     GRHydro_mppm_eigenvalue_y_right, &
                     GRHydro_mppm_xwind)
              else
                call SimplePPM_1dM(GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                     rho(j,:,k),lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1),&
                     lBvec(j,:,k,2),lBvec(j,:,k,3),lBvec(j,:,k,1),psidc(j,:,k),eps(j,:,k),press(j,:,k),&
                     rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                     Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),psidcminus(j,:,k),epsminus(j,:,k),&
                     rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                     Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),psidcplus(j,:,k),epsplus(j,:,k),&
                     1,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                     gbb(j,:,k), gbc(j,:,k), gab(j,:,k), gcc(j,:,k), gac(j,:,k), &
                     gaa(j,:,k), betab(j,:,k), alp(j,:,k),&
                     w_lorentz(j,:,k), &
                     2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                     GRHydro_mppm_eigenvalue_y_right, &
                     GRHydro_mppm_xwind)
              end if
             else  !clean_divergence
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_1dM(GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                     rho(j,:,k),vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1),&
                     Bvec(j,:,k,2),Bvec(j,:,k,3),Bvec(j,:,k,1),dum(j,:,k),eps(j,:,k),press(j,:,k),&
                     rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                     Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),dumm(j,:,k),epsminus(j,:,k),&
                     rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                     Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),dump(j,:,k),epsplus(j,:,k),&
                     0,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                     gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                     gxx(j,:,k), betay(j,:,k), alp(j,:,k),&
                     w_lorentz(j,:,k), &
                     2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                     GRHydro_mppm_eigenvalue_y_right, &
                     GRHydro_mppm_xwind)
              else
                call SimplePPM_1dM(GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                     rho(j,:,k),lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1),&
                     lBvec(j,:,k,2),lBvec(j,:,k,3),lBvec(j,:,k,1),dum(j,:,k),eps(j,:,k),press(j,:,k),&
                     rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                     Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),dumm(j,:,k),epsminus(j,:,k),&
                     rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                     Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),dump(j,:,k),epsplus(j,:,k),&
                     0,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                     gbb(j,:,k), gbc(j,:,k), gab(j,:,k), gcc(j,:,k), gac(j,:,k), &
                     gaa(j,:,k), betab(j,:,k), alp(j,:,k),&
                     w_lorentz(j,:,k), &
                     2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                     GRHydro_mppm_eigenvalue_y_right, &
                     GRHydro_mppm_xwind)
              end if
             endif  !clean_divergence
              do i = 1, ny
                if (trivial_rp(j,i,k)) then
                   SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
                else
                   SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_tracer_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                     vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1), &
                     tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), &
                     press(j,:,k))
              else
                call SimplePPM_tracer_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                     lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1), &
                     tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), &
                     press(j,:,k))
              end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + transport_constraints
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + transport_constraints
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                      vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1), &
                      Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k), &
                      press(j,:,k))
               else
                 call SimplePPM_ye_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                      lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1), &
                      Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k), &
                      press(j,:,k))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else if (flux_direction == 3) then
          ! constraint transport needs to be able to average fluxes in the directions
          ! other that flux_direction, which in turn need the primitives on interfaces
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, ny - GRHydro_stencil + 1 + transport_constraints
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + transport_constraints
             if(clean_divergence.ne.0) then
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_1dM(GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                     rho(j,k,:),vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2),&
                     Bvec(j,k,:,3),Bvec(j,k,:,1),Bvec(j,k,:,2),psidc(j,k,:),eps(j,k,:),press(j,k,:),&
                     rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                     Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),psidcminus(j,k,:),epsminus(j,k,:),&
                     rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                     Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),psidcplus(j,k,:),epsplus(j,k,:),&
                     1,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                     gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                     gyy(j,k,:), betaz(j,k,:), alp(j,k,:),&
                     w_lorentz(j,k,:), &
                     3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                     GRHydro_mppm_eigenvalue_z_right, &
                     GRHydro_mppm_xwind)
              else
                call SimplePPM_1dM(GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                     rho(j,k,:),lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2),&
                     lBvec(j,k,:,3),lBvec(j,k,:,1),lBvec(j,k,:,2),psidc(j,k,:),eps(j,k,:),press(j,k,:),&
                     rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                     Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),psidcminus(j,k,:),epsminus(j,k,:),&
                     rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                     Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),psidcplus(j,k,:),epsplus(j,k,:),&
                     1,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                     gcc(j,k,:), gac(j,k,:), gbc(j,k,:), gaa(j,k,:), gab(j,k,:), &
                     gbb(j,k,:), betac(j,k,:), alp(j,k,:),&
                     w_lorentz(j,k,:), &
                     3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                     GRHydro_mppm_eigenvalue_z_right, &
                     GRHydro_mppm_xwind)
              end if
             else  !clean_divergence
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_1dM(GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                     rho(j,k,:),vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2),&
                     Bvec(j,k,:,3),Bvec(j,k,:,1),Bvec(j,k,:,2),dum(j,k,:),eps(j,k,:),press(j,k,:),&
                     rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                     Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),dumm(j,k,:),epsminus(j,k,:),&
                     rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                     Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),dump(j,k,:),epsplus(j,k,:),&
                     0,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                     gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                     gyy(j,k,:), betaz(j,k,:), alp(j,k,:),&
                     w_lorentz(j,k,:), &
                     3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                     GRHydro_mppm_eigenvalue_z_right, &
                     GRHydro_mppm_xwind)
              else
                call SimplePPM_1dM(GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                     rho(j,k,:),lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2),&
                     lBvec(j,k,:,3),lBvec(j,k,:,1),lBvec(j,k,:,2),dum(j,k,:),eps(j,k,:),press(j,k,:),&
                     rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                     Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),dumm(j,k,:),epsminus(j,k,:),&
                     rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                     Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),dump(j,k,:),epsplus(j,k,:),&
                     0,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                     gcc(j,k,:), gac(j,k,:), gbc(j,k,:), gaa(j,k,:), gab(j,k,:), &
                     gbb(j,k,:), betac(j,k,:), alp(j,k,:),&
                     w_lorentz(j,k,:), &
                     3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                     GRHydro_mppm_eigenvalue_z_right, &
                     GRHydro_mppm_xwind)
              end if
             endif  !clean_divergence
              do i = 1, nz
                if (trivial_rp(j,k,i)) then
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
                else
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1

               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_tracer_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2), &
                      tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), &
                      press(j,k,:))
               else
                 call SimplePPM_tracer_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2), &
                      tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), &
                      press(j,k,:))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
          do k = GRHydro_stencil, ny - GRHydro_stencil + 1 + transport_constraints
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + transport_constraints
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2), &
                      Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:), &
                      press(j,k,:))
               else
                 call SimplePPM_ye_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2), &
                      Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:), &
                      press(j,k,:))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
!!$ PPM ends.

  deallocate(trivial_rp)
  deallocate(dum,dump,dumm)

end subroutine GRHydro_PPMMReconstruct_drv


```

GRHydro_WENOReconstruct.cc:
```
#include <cmath>
#include <iostream>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Reconstruct_drv_impl.hh"
#include "GRHydro_WENOReconstruct.hh"

using namespace std;

template <typename T> static inline T SQR (T const & x) { return x*x; }

/**
   WENO5 reconstruction operator.
   Supports standard WENO5 (with and without adaptive epsilon), and WENO-z.
*/
template <bool do_wenoz, bool do_adaptive_epsilon>
template <int dir>
void GRHydro_WENOReconstruct1d_cxx<do_wenoz,do_adaptive_epsilon>::
apply(const int nx, const CCTK_REAL* const restrict a,
      CCTK_REAL* const restrict aminus, CCTK_REAL* const restrict aplus,
      const cGH* const cctkGH, const int j, const int k)
{
   DECLARE_CCTK_PARAMETERS;
   
#define A(i_) (a[ijk[i_]])
#define Aplus(i_) (aplus[ijk[i_]])
#define Aminus(i_) (aminus[ijk[i_]])
   
   for (int i=GRHydro_stencil-1; i < nx-GRHydro_stencil+1; ++i)
   {
      const int ijk[5] = {
                            dir ==0 ? CCTK_GFINDEX3D(cctkGH, i-2, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i-2, k) : CCTK_GFINDEX3D(cctkGH, j, k, i-2), 
                            dir ==0 ? CCTK_GFINDEX3D(cctkGH, i-1, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i-1, k) : CCTK_GFINDEX3D(cctkGH, j, k, i-1),
                            dir ==0 ? CCTK_GFINDEX3D(cctkGH, i  , j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i  , k) : CCTK_GFINDEX3D(cctkGH, j, k, i  ),
                            dir ==0 ? CCTK_GFINDEX3D(cctkGH, i+1, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i+1, k) : CCTK_GFINDEX3D(cctkGH, j, k, i+1),
                            dir ==0 ? CCTK_GFINDEX3D(cctkGH, i+2, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i+2, k) : CCTK_GFINDEX3D(cctkGH, j, k, i+2)
                         };
                       
   
         
   
      static_assert (! (do_wenoz && do_adaptive_epsilon), "Adaptive_epsilon not supported for WENO-Z");

      if (do_wenoz)
      {
         static const CCTK_REAL 
                         weno_coeffs[3][5] = { { 2.0/6.0, -7.0/6.0, 11.0/6.0, 0,        0 }, 
                                               { 0,       -1.0/6.0, 5.0/6.0,  2.0/6.0,  0 },
                                               { 0,        0,       2.0/6.0,  5.0/6.0, -1.0/6.0 } };
      
         const CCTK_REAL beta1 = 13.0/12.0*SQR(A(0)-2.0*A(1)+A(2)) + 1.0/4.0*SQR(A(0)-4.0*A(1)+3.0*A(2));
         const CCTK_REAL beta2 = 13.0/12.0*SQR(A(1)-2.0*A(2)+A(3)) + 1.0/4.0*SQR(A(1)-A(3));
         const CCTK_REAL beta3 = 13.0/12.0*SQR(A(2)-2.0*A(3)+A(4)) + 1.0/4.0*SQR(3.0*A(2)-4.0*A(3)+A(4));
            
            
         //    Compute weights according to weno-z alorithm
         const CCTK_REAL wbarplus1 = 1.0/10.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta1));
         const CCTK_REAL wbarplus2 = 3.0/5.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta2));
         const CCTK_REAL wbarplus3 = 3.0/10.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta3));

         const CCTK_REAL wbarminus1 = 3.0/10.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta1));
         const CCTK_REAL wbarminus2 = 3.0/5.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta2));
         const CCTK_REAL wbarminus3 = 1.0/10.0 * (1.0 + abs(beta1-beta3) / (weno_eps + beta3));
         
         const CCTK_REAL iwbarplussum = 1.0 / (wbarplus1 + wbarplus2 + wbarplus3);
         
         const CCTK_REAL wplus1 = wbarplus1 * iwbarplussum;
         const CCTK_REAL wplus2 = wbarplus2 * iwbarplussum;
         const CCTK_REAL wplus3 = wbarplus3 * iwbarplussum;
         
         const CCTK_REAL iwbarminussum = 1.0 / (wbarminus1 + wbarminus2 + wbarminus3);
         
         const CCTK_REAL wminus1 = wbarminus1 * iwbarminussum;
         const CCTK_REAL wminus2 = wbarminus2 * iwbarminussum;
         const CCTK_REAL wminus3 = wbarminus3 * iwbarminussum;
         
         //    Calculate the reconstruction
         Aplus(2) = 0;
         Aminus(2) = 0;
         for (int n=0; n < 5; ++n) {
               Aplus(2) += (wplus1 * weno_coeffs[0][n]
                          + wplus2 * weno_coeffs[1][n]
                          + wplus3 * weno_coeffs[2][n]) * A(n);
               Aminus(2) += (wminus1 * weno_coeffs[2][4-n]
                           + wminus2 * weno_coeffs[1][4-n]
                           + wminus3 * weno_coeffs[0][4-n]) * A(n);
         }
      } else {
         
         static const CCTK_REAL beta_shu[3][6] = { { 4.0/3.0,  -19.0/3.0, 25.0/3.0, 11.0/3.0, -31.0/3.0, 10.0/3.0 },
                                      { 4.0/3.0,  -13.0/3.0, 13.0/3.0, 5.0/3.0,  -13.0/3.0, 4.0/3.0 },
                                      { 10.0/3.0, -31.0/3.0, 25.0/3.0, 11.0/3.0, -19.0/3.0, 4.0/3.0 } };
         static const CCTK_REAL weno_coeffs[3][5] = { { 3.0/8.0, -5.0/4.0, 15.0/8.0, 0,      0 },
                                         { 0,       -1.0/8.0, 3.0/4.0,  3.0/8.0, 0 },
                                         { 0,       0,        3.0/8.0,  3.0/4.0, -1.0/8.0 } };
                                      
         //    Compute smoothness indicators
         //    This is from Tchekhovskoy et al 2007 (WHAM code paper).
         CCTK_REAL beta1  = beta_shu[0][0]*SQR(A(0))
                  + beta_shu[0][1]*A(0)*A(1)
                  + beta_shu[0][2]*SQR(A(1))
                  + beta_shu[0][3]*A(0)*A(2)
                  + beta_shu[0][4]*A(1)*A(2)
                  + beta_shu[0][5]*SQR(A(2));
         
         CCTK_REAL beta2  = beta_shu[1][0]*SQR(A(1))
                  + beta_shu[1][1]*A(1)*A(2)
                  + beta_shu[1][2]*SQR(A(2))
                  + beta_shu[1][3]*A(1)*A(3)
                  + beta_shu[1][4]*A(2)*A(3)
                  + beta_shu[1][5]*SQR(A(3));
         
         CCTK_REAL beta3  = beta_shu[2][0]*SQR(A(2))
                  + beta_shu[2][1]*A(2)*A(3)
                  + beta_shu[2][2]*SQR(A(3))
                  + beta_shu[2][3]*A(2)*A(4)
                  + beta_shu[2][4]*A(3)*A(4)
                  + beta_shu[2][5]*SQR(A(4));
         
         
         if (do_adaptive_epsilon) {
            const CCTK_REAL vnorm = (SQR(A(0)) + SQR(A(1)) + SQR(A(2)) + SQR(A(3)) + SQR(A(4)));
               
            beta1 += 100.0*weno_eps*(vnorm + 1.0);
            beta2 += 100.0*weno_eps*(vnorm + 1.0);
            beta3 += 100.0*weno_eps*(vnorm + 1.0);
               
            const CCTK_REAL ibetanorm = 1.0 / (beta1 + beta2 + beta3);
               
            beta1 *= ibetanorm;
            beta2 *= ibetanorm;
            beta3 *= ibetanorm;
         }
         
         const CCTK_REAL wbarplus1 = 1.0/16.0 / SQR(weno_eps + beta1);
         const CCTK_REAL wbarplus2 = 5.0/8.0 / SQR(weno_eps + beta2);
         const CCTK_REAL wbarplus3 = 5.0/16.0 / SQR(weno_eps + beta3);
         
         const CCTK_REAL iwbarplussum = 1.0 / (wbarplus1 + wbarplus2 + wbarplus3);
         
         const CCTK_REAL wplus1 = wbarplus1 * iwbarplussum;
         const CCTK_REAL wplus2 = wbarplus2 * iwbarplussum;
         const CCTK_REAL wplus3 = wbarplus3 * iwbarplussum;

         const CCTK_REAL wbarminus1 = 5.0/16.0 / SQR(weno_eps + beta1);
         const CCTK_REAL wbarminus2 = 5.0/8.0 / SQR(weno_eps + beta2);
         const CCTK_REAL wbarminus3 = 1.0/16.0 / SQR(weno_eps + beta3);
         
         const CCTK_REAL iwbarminussum = 1.0 / (wbarminus1 + wbarminus2 + wbarminus3);
         
         const CCTK_REAL wminus1 = wbarminus1 * iwbarminussum;
         const CCTK_REAL wminus2 = wbarminus2 * iwbarminussum;
         const CCTK_REAL wminus3 = wbarminus3 * iwbarminussum;
                                         
         //    Calculate the reconstruction
         Aplus(2) = 0;
         Aminus(2) = 0;
         for (int n=0; n < 5; ++n) {
               Aplus(2) += (wplus1 * weno_coeffs[0][n]
                          + wplus2 * weno_coeffs[1][n]
                          + wplus3 * weno_coeffs[2][n]) * A(n);
               Aminus(2) += (wminus1 * weno_coeffs[2][4-n]
                           + wminus2 * weno_coeffs[1][4-n]
                           + wminus3 * weno_coeffs[0][4-n]) * A(n);
         }
      }
   }
}

// the typedefs are required since the preprocessor chokes on the comma in the
// template specialization. Alternative:
// #define COMMA ,
// or #define / #undef a la Carpet's typecase.hh
typedef GRHydro_WENOReconstruct1d_cxx<false,false>
  GRHydro_WENOReconstruct1d_cxx00;
typedef GRHydro_WENOReconstruct1d_cxx<false,true >
  GRHydro_WENOReconstruct1d_cxx01;
typedef GRHydro_WENOReconstruct1d_cxx<true ,false>
  GRHydro_WENOReconstruct1d_cxx10;

INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_WENOReconstruct1d_cxx00)
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_WENOReconstruct1d_cxx01)
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_WENOReconstruct1d_cxx10)

```

GRHydro_TVDReconstruct.hh:
```
#ifndef _GRHYDRO_TVDRECONSTRUCT_HH
#define _GRHYDRO_TVDRECONSTRUCT_HH

#include "cctk.h"

/**
   TVD reconstruction operator.
   limiter_type: 0 = minmod
                 1 = mc2
                 2 = superbee
*/
namespace tvd {
  enum limiter_type {minmod = 0, mc2 = 1, superbee = 2, numlimiters};
}
template <tvd::limiter_type limiter>
struct GRHydro_TVDReconstruct1d {

  static inline CCTK_REAL minmod_func(const CCTK_REAL dupw, 
				    const CCTK_REAL dloc);
  static inline CCTK_REAL min3(const CCTK_REAL a, 
			    const CCTK_REAL b,
			    const CCTK_REAL c);
  template <int dir>
  static inline void apply(const int nx,
                           const CCTK_REAL* const restrict a,
                           CCTK_REAL* const restrict aminus,
                           CCTK_REAL* const restrict aplus,
                           const cGH* const cctkGH,
                           const int j, const int k
                          );
}; // end struct

#endif // _GRHYDRO_TVDRECONSTRUCT_HH

```

GRHydro_Analysis.F90:
```

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"

subroutine GRHydro_CalcDivB(CCTK_ARGUMENTS)
    
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k,itracer
  CCTK_REAL :: idx, idy, idz, Bcons_l1, Bcons_r1, Bcons_l2, Bcons_r2, Bcons_l3, Bcons_r3
  logical :: do_Avec, do_Bcons

  ! for boundary conditions
  integer :: ierr
  CCTK_INT, parameter :: faces=CCTK_ALL_FACES
  CCTK_INT, parameter :: ione=1

  idx = 1.d0 / CCTK_DELTA_SPACE(1)
  idy = 1.d0 / CCTK_DELTA_SPACE(2)
  idz = 1.d0 / CCTK_DELTA_SPACE(3)

  do_Avec = CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec")
  do_Bcons = CCTK_EQUALS(Bvec_evolution_method,"GRHydro")

  divB = 0d0

  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,Bcons_l1,Bcons_r1,Bcons_l2,Bcons_r2,Bcons_l3,Bcons_r3)
  do k = 2, cctk_lsh(3)-1
    do j = 2, cctk_lsh(2)-1
      do i = 2, cctk_lsh(1)-1

        if(transport_constraints.ne.0) then
          ! edge based divergence (see WhiskyMHD & Bruno's thesis, Eq. 7.27)
          divB(i,j,k) = &
            0.25d0*(Bcons(i+1,j,k,1)-Bcons(i,j,k,1)+ &
                    Bcons(i+1,j+1,k,1)-Bcons(i,j+1,k,1)+ &
                    Bcons(i+1,j,k+1,1)-Bcons(i,j,k+1,1)+ &
                    Bcons(i+1,j+1,k+1,1)-Bcons(i,j+1,k+1,1))*idx + &
            0.25d0*(Bcons(i,j+1,k,2)-Bcons(i,j,k,2)+ &
                    Bcons(i+1,j+1,k,2)-Bcons(i+1,j,k,2)+ &
                    Bcons(i,j+1,k+1,2)-Bcons(i,j,k+1,2)+ &
                    Bcons(i+1,j+1,k+1,2)-Bcons(i+1,j,k+1,2))*idy + &
            0.25d0*(Bcons(i,j,k+1,3)-Bcons(i,j,k,3)+ &
                    Bcons(i+1,j,k+1,3)-Bcons(i+1,j,k,3)+ &
                    Bcons(i,j+1,k+1,3)-Bcons(i,j+1,k,3)+ &
                    Bcons(i+1,j+1,k+1,3)-Bcons(i+1,j+1,k,3))*idz
        else if(do_Avec) then
          Bcons_l1 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,1) + &
                   sdetg(i-1,j,k)*Bvec(i-1,j,k,1))
          Bcons_l2 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,2) + &
                   sdetg(i,j-1,k)*Bvec(i,j-1,k,2))
          Bcons_l3 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,3) + &
                   sdetg(i,j,k-1)*Bvec(i,j,k-1,3))
          Bcons_r1 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,1) + &
                   sdetg(i+1,j,k)*Bvec(i+1,j,k,1))
          Bcons_r2 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,2) + &
                   sdetg(i,j+1,k)*Bvec(i,j+1,k,2))
          Bcons_r3 = 0.5d0 * (sdetg(i,j,k)*Bvec(i,j,k,3) + &
                   sdetg(i,j,k+1)*Bvec(i,j,k+1,3))

          divB(i,j,k) = (Bcons_l1 - Bcons_r1) * idx + (Bcons_l2 - Bcons_r2) * idy + (Bcons_l3 - Bcons_r3) * idz

        else if(do_Bcons) then
          Bcons_l1 = 0.5d0 * (Bcons(i,j,k,1) + &
                   Bcons(i-1,j,k,1))
          Bcons_l2 = 0.5d0 * (Bcons(i,j,k,2) + &
                   Bcons(i,j-1,k,2))
          Bcons_l3 = 0.5d0 * (Bcons(i,j,k,3) + &
                   Bcons(i,j,k-1,3))
          Bcons_r1 = 0.5d0 * (Bcons(i,j,k,1) + &
                   Bcons(i+1,j,k,1))
          Bcons_r2 = 0.5d0 * (Bcons(i,j,k,2) + &
                   Bcons(i,j+1,k,2))
          Bcons_r3 = 0.5d0 * (Bcons(i,j,k,3) + &
                   Bcons(i,j,k+1,3))

          divB(i,j,k) = (Bcons_l1 - Bcons_r1) * idx + (Bcons_l2 - Bcons_r2) * idy + (Bcons_l3 - Bcons_r3) * idz

        else
          call CCTK_ERROR("Internal error. Do now know how to compute divB")
          STOP

        endif

      enddo
    enddo
  enddo
  !$OMP END PARALLEL DO
 
!!$Flat boundaries if required
  if (CCTK_EQUALS(bound,"flat")) then
    ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
         "GRHydro::divB", "Flat")
  endif

!!$None boundaries if required
  if (CCTK_EQUALS(bound,"none")) then
    ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
         "GRHydro::divB", "None")
  endif

!!$Scalar boundaries if required
  if (CCTK_EQUALS(bound,"scalar")) then
    call CCTK_ERROR("Until somebody uses this I see no reason to support it")
    STOP
  end if

  if (ierr < 0) then
    call CCTK_ERROR("problems with applying the chosen boundary condition")
    STOP
  end if

end subroutine GRHydro_CalcDivB 


```

GRHydro_SourceAM.F90:
```
 /*@@
   @file      GRHydro_SourceM.F90
   @date      Oct 11, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   The geometric source terms for the matter evolution
   @enddesc 
 @@*/

! Second order f.d.

#define DIFF_X_2(q) (0.5d0 * (q(i+1,j,k) - q(i-1,j,k)) * idx)
#define DIFF_Y_2(q) (0.5d0 * (q(i,j+1,k) - q(i,j-1,k)) * idy)
#define DIFF_Z_2(q) (0.5d0 * (q(i,j,k+1) - q(i,j,k-1)) * idz)

! Fourth order f.d.

#define DIFF_X_4(q) ((-q(i+2,j,k) + 8.d0 * q(i+1,j,k) - 8.d0 * q(i-1,j,k) + \
                      q(i-2,j,k)) / 12.d0 * idx)
#define DIFF_Y_4(q) ((-q(i,j+2,k) + 8.d0 * q(i,j+1,k) - 8.d0 * q(i,j-1,k) + \
                      q(i,j-2,k)) / 12.d0 * idy)
#define DIFF_Z_4(q) ((-q(i,j,k+2) + 8.d0 * q(i,j,k+1) - 8.d0 * q(i,j,k-1) + \
                      q(i,j,k-2)) / 12.d0 * idz)

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.h"

#define velx(i,j,k) vup(i,j,k,1)
#define vely(i,j,k) vup(i,j,k,2)
#define velz(i,j,k) vup(i,j,k,3)
#define Bvecx(i,j,k) Bprim(i,j,k,1)
#define Bvecy(i,j,k) Bprim(i,j,k,2)
#define Bvecz(i,j,k) Bprim(i,j,k,3)
#define Avecx(i,j,k) Avec(i,j,k,1)
#define Avecy(i,j,k) Avec(i,j,k,2)
#define Avecz(i,j,k) Avec(i,j,k,3)
#define Avecrhsx(i,j,k) Avecrhs(i,j,k,1)
#define Avecrhsy(i,j,k) Avecrhs(i,j,k,2)
#define Avecrhsz(i,j,k) Avecrhs(i,j,k,3)

 /*@@
   @routine    SourceTermsAM
   @date       Aug 30, 2010
   @author     Tanja Bode, Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   Calculate the geometric source terms and add to the update GFs
   @enddesc 
   @calls     
   @calledby   
   @history 
   Minor alterations of routine from GR3D.
   @endhistory 
   
@@*/

subroutine SourceTermsAM(CCTK_ARGUMENTS)
      
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k, nx, ny, nz
  CCTK_REAL :: one, two, half
  CCTK_REAL :: t00, t0x, t0y, t0z, txx, txy, txz, tyy, tyz, tzz
  CCTK_REAL :: sqrtdet, uxx, uxy, uxz, uyy, uyz, uzz
  CCTK_REAL :: shiftx, shifty, shiftz, velxshift, velyshift, velzshift 
  CCTK_REAL :: vlowx, vlowy, vlowz
  CCTK_REAL :: dx_betax, dx_betay, dx_betaz, dy_betax, dy_betay,&
       dy_betaz, dz_betax, dz_betay, dz_betaz
  CCTK_REAL :: dx_alp, dy_alp, dz_alp
  CCTK_REAL :: tau_source, sx_source, sy_source, sz_source
  CCTK_REAL :: localgxx,localgxy,localgxz,localgyy,localgyz,localgzz
  CCTK_REAL :: dx_gxx, dx_gxy, dx_gxz, dx_gyy, dx_gyz, dx_gzz
  CCTK_REAL :: dy_gxx, dy_gxy, dy_gxz, dy_gyy, dy_gyz, dy_gzz
  CCTK_REAL :: dz_gxx, dz_gxy, dz_gxz, dz_gyy, dz_gyz, dz_gzz
  CCTK_REAL :: dx, dy, dz, idx, idy, idz
  CCTK_REAL :: shiftshiftk, shiftkx, shiftky, shiftkz
  CCTK_REAL :: sumTK
  CCTK_REAL :: halfshiftdgx, halfshiftdgy, halfshiftdgz
  CCTK_REAL :: halfTdgx, halfTdgy, halfTdgz
  CCTK_REAL :: invalp, invalp2
  CCTK_REAL :: Avcx_source, Avcy_source, Avcz_source
  CCTK_REAL :: dx_det_bydet, dy_det_bydet, dz_det_bydet
  CCTK_REAL :: gdg_x, gdg_y, gdg_z !! g^{ik} d_k g_{ij}
  CCTK_INT  :: local_spatial_order

  CCTK_REAL :: Bvecxlow,Bvecylow,Bveczlow,bdotv,b2,dum1,dum2,bxlow,bylow,bzlow
  CCTK_REAL :: bt,bx,by,bz,rhohstarW2,pstar

  logical, allocatable, dimension (:,:,:) :: force_spatial_second_order

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: k11, k12, k13, k22, k23, k33
  pointer (pk11,k11), (pk12,k12), (pk13,k13), (pk22,k22), (pk23,k23), (pk33,k33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup, Bprim
  pointer (pvup,vup), (pBprim,Bprim)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pk11 = loc(kaa)
    pk12 = loc(kab)
    pk13 = loc(kac)
    pk22 = loc(kbb)
    pk23 = loc(kbc)
    pk33 = loc(kcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
    pvup = loc(lvel)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pk11 = loc(kxx)
    pk12 = loc(kxy)
    pk13 = loc(kxz)
    pk22 = loc(kyy)
    pk23 = loc(kyz)
    pk33 = loc(kzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
#define gxx faulty_gxx
#define gxy faulty_gxy
#define gxz faulty_gxz
#define gyy faulty_gyy
#define gyz faulty_gyz
#define gzz faulty_gzz
#define kxx faulty_kxx
#define kxy faulty_kxy
#define kxz faulty_kxz
#define kyy faulty_kyy
#define kyz faulty_kyz
#define kzz faulty_kzz
#define betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define gaa faulty_gaa
#define gab faulty_gab
#define gac faulty_gac
#define gbb faulty_gbb
#define gbc faulty_gbc
#define gcc faulty_gcc
#define kaa faulty_kaa
#define kab faulty_kab
#define kac faulty_kac
#define kbb faulty_kbb
#define kbc faulty_kbc
#define kcc faulty_kcc
#define betaa faulty_betaa
#define betab faulty_betab
#define betac faulty_betac
#define vel faulty_vel
#define Bvec faulty_Bvec

  one = 1.0d0
  two = 2.0d0
  half = 0.5d0
  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)
  dx = CCTK_DELTA_SPACE(1)
  dy = CCTK_DELTA_SPACE(2)
  dz = CCTK_DELTA_SPACE(3)
  idx = 1.d0/dx
  idy = 1.d0/dy
  idz = 1.d0/dz
 
!!$  Initialize the update terms to be zero.
!!$  This will guarantee that no garbage in the boundaries is updated.

  densrhs = 0.d0
  srhs = 0.d0
  taurhs = 0.d0
  Avecrhs = 0.d0

  if (evolve_tracer .ne. 0) then
    cons_tracerrhs = 0.d0
  end if

  if (evolve_Y_e .ne. 0) then
     Y_e_con_rhs = 0.0d0
  endif
  
  if (clean_divergence .ne. 0) then
     psidcrhs=0.d0
  endif

  if (track_divB .ne. 0) then
     divB=0.d0
  endif

  if (transport_constraints .ne. 0) then
     Evec = 0.d0
  endif
  

!!$  Set up the array for checking the order. We switch to second order
!!$  differencing at boundaries and near excision regions.
!!$  Copied straight from BSSN.

  allocate (force_spatial_second_order(nx,ny,nz))
  force_spatial_second_order = .FALSE.
  
  if (sources_spatial_order > 2) then
    !$OMP PARALLEL DO PRIVATE(i, j, k)
    do k = 1 + GRHydro_stencil, nz - GRHydro_stencil
      do j = 1 + GRHydro_stencil, ny - GRHydro_stencil
        do i = 1 + GRHydro_stencil, nx - GRHydro_stencil
          if ((i < 3).or.(i > cctk_lsh(1) - 2).or. &
               (j < 3).or.(j > cctk_lsh(2) - 2).or. &
               (k < 3).or.(k > cctk_lsh(3) - 2) ) then
            force_spatial_second_order(i,j,k) = .TRUE.
          else if ( use_mask > 0 ) then
            if (minval(emask(i-2:i+2,j-2:j+2,k-2:k+2)) < 0.75d0) then
              force_spatial_second_order(i,j,k) = .TRUE.
            end if
          end if
        end do
      end do
    end do
    !$OMP END PARALLEL DO
  end if

  !$OMP PARALLEL DO PRIVATE(i, j, k, local_spatial_order,&
  !$OMP localgxx,localgxy,localgxz,localgyy,localgyz,localgzz,&
  !$OMP sqrtdet,shiftx,shifty,shiftz,&
  !$OMP dx_betax,dx_betay,dx_betaz,dy_betax,dy_betay,dy_betaz,&
  !$OMP dz_betax,dz_betay,dz_betaz,velxshift,velyshift,velzshift,&
  !$OMP vlowx,vlowy,vlowz,Bvecxlow,Bvecylow,Bveczlow, &
  !$OMP  bdotv,b2,dum1,dum2,bxlow,bylow,bzlow,bt,bx,by,bz,rhohstarW2,pstar,&
  !$OMP t00,t0x,t0y,t0z,txx,txy,txz,tyy,tyz,tzz,&
  !$OMP dx_alp,dy_alp,dz_alp,&
  !$OMP tau_source,sx_source,sy_source,sz_source,&
  !$OMP dx_det_bydet,dy_det_bydet,dz_det_bydet,&
  !$OMP gdg_x,gdg_y,gdg_z,&
  !$OMP Avcx_source,Avcy_source,Avcz_source,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz,&
  !$OMP dx_gxx, dx_gxy, dx_gxz, dx_gyy, dx_gyz, dx_gzz,&
  !$OMP dy_gxx, dy_gxy, dy_gxz, dy_gyy, dy_gyz, dy_gzz,&
  !$OMP dz_gxx, dz_gxy, dz_gxz, dz_gyy, dz_gyz, dz_gzz,&
  !$OMP shiftshiftk,shiftkx,shiftky,shiftkz,&
  !$OMP sumTK,halfshiftdgx,halfshiftdgy,halfshiftdgz,&
  !$OMP halfTdgx,halfTdgy,halfTdgz,invalp,invalp2)
  do k=1 + GRHydro_stencil,nz - GRHydro_stencil
    do j=1 + GRHydro_stencil,ny - GRHydro_stencil
      do i=1 + GRHydro_stencil,nx - GRHydro_stencil

        local_spatial_order = sources_spatial_order
        if (force_spatial_second_order(i,j,k)) then
          local_spatial_order = 2
        end if
        
!!$        Set the metric terms.
        
        localgxx = g11(i,j,k)
        localgxy = g12(i,j,k)
        localgxz = g13(i,j,k)
        localgyy = g22(i,j,k)
        localgyz = g23(i,j,k)
        localgzz = g33(i,j,k)

        sqrtdet = sdetg(i,j,k)
        call UpperMetric(uxx, uxy, uxz, uyy, uyz, uzz, sqrtdet*sqrtdet, localgxx,&
             localgxy, localgxz, localgyy, localgyz, localgzz)
        

        shiftx = beta1(i,j,k)
        shifty = beta2(i,j,k)
        shiftz = beta3(i,j,k)
        
        if (local_spatial_order .eq. 2) then
           
           dx_betax = DIFF_X_2(beta1)
           dx_betay = DIFF_X_2(beta2)
           dx_betaz = DIFF_X_2(beta3)
           
           dy_betax = DIFF_Y_2(beta1)
           dy_betay = DIFF_Y_2(beta2)
           dy_betaz = DIFF_Y_2(beta3)
            
           dz_betax = DIFF_Z_2(beta1)
           dz_betay = DIFF_Z_2(beta2)
           dz_betaz = DIFF_Z_2(beta3)

        else

           dx_betax = DIFF_X_4(beta1)
           dx_betay = DIFF_X_4(beta2)
           dx_betaz = DIFF_X_4(beta3)
           
           dy_betax = DIFF_Y_4(beta1)
           dy_betay = DIFF_Y_4(beta2)
           dy_betaz = DIFF_Y_4(beta3)
           
           dz_betax = DIFF_Z_4(beta1)
           dz_betay = DIFF_Z_4(beta2)
           dz_betaz = DIFF_Z_4(beta3)
           
        end if
          
        invalp = 1.0d0 / alp(i,j,k)
        invalp2 = invalp**2
        velxshift = velx(i,j,k) - shiftx*invalp
        velyshift = vely(i,j,k) - shifty*invalp
        velzshift = velz(i,j,k) - shiftz*invalp

        call calc_vlow_blow(localgxx,localgxy,localgxz,localgyy,localgyz,localgzz, &
             velx(i,j,k),vely(i,j,k),velz(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(i,j,k), &
             vlowx,vlowy,vlowz,Bvecxlow,Bvecylow,Bveczlow, &
             bdotv,b2,dum1,dum2,bxlow,bylow,bzlow)

!!$ These are the contravariant components
        bt = w_lorentz(i,j,k)/alp(i,j,k)*bdotv
        bx = Bvecx(i,j,k)/w_lorentz(i,j,k)+w_lorentz(i,j,k)*bdotv*velxshift
        by = Bvecy(i,j,k)/w_lorentz(i,j,k)+w_lorentz(i,j,k)*bdotv*velyshift
        bz = Bvecz(i,j,k)/w_lorentz(i,j,k)+w_lorentz(i,j,k)*bdotv*velzshift

        rhohstarW2 = (rho(i,j,k)*(one + eps(i,j,k)) + press(i,j,k)+ b2)*&
             w_lorentz(i,j,k)**2
        pstar = press(i,j,k)+0.5d0*b2

!!$        For a change, these are T^{ij}

        t00 = (rhohstarW2 - pstar)*invalp2-bt**2
        t0x = rhohstarW2*velxshift*invalp +&
             pstar*shiftx*invalp2-bt*bx
        t0y = rhohstarW2*velyshift*invalp +&
             pstar*shifty*invalp2-bt*by
        t0z = rhohstarW2*velzshift*invalp +&
             pstar*shiftz*invalp2-bt*bz
        txx = rhohstarW2*velxshift*velxshift +&
             pstar*(uxx - shiftx*shiftx*invalp2)-bx**2
        txy = rhohstarW2*velxshift*velyshift +&
             pstar*(uxy - shiftx*shifty*invalp2)-bx*by
        txz = rhohstarW2*velxshift*velzshift +&
             pstar*(uxz - shiftx*shiftz*invalp2)-bx*bz
        tyy = rhohstarW2*velyshift*velyshift +&
             pstar*(uyy - shifty*shifty*invalp2)-by**2
        tyz = rhohstarW2*velyshift*velzshift +&
             pstar*(uyz - shifty*shiftz*invalp2)-by*bz
        tzz = rhohstarW2*velzshift*velzshift +&
             pstar*(uzz - shiftz*shiftz*invalp2)-bz**2

!!$        Derivatives of the lapse, metric and shift

        if (local_spatial_order .eq. 2) then

          dx_alp = DIFF_X_2(alp)
          dy_alp = DIFF_Y_2(alp)
          dz_alp = DIFF_Z_2(alp)

        else

          dx_alp = DIFF_X_4(alp)
          dy_alp = DIFF_Y_4(alp)
          dz_alp = DIFF_Z_4(alp)

        end if
        
        if (local_spatial_order .eq. 2) then

           dx_gxx = DIFF_X_2(g11)
           dx_gxy = DIFF_X_2(g12)
           dx_gxz = DIFF_X_2(g13)
           dx_gyy = DIFF_X_2(g22)
           dx_gyz = DIFF_X_2(g23)
           dx_gzz = DIFF_X_2(g33)
           dy_gxx = DIFF_Y_2(g11)
           dy_gxy = DIFF_Y_2(g12)
           dy_gxz = DIFF_Y_2(g13)
           dy_gyy = DIFF_Y_2(g22)
           dy_gyz = DIFF_Y_2(g23)
           dy_gzz = DIFF_Y_2(g33)
           dz_gxx = DIFF_Z_2(g11)
           dz_gxy = DIFF_Z_2(g12)
           dz_gxz = DIFF_Z_2(g13)
           dz_gyy = DIFF_Z_2(g22)
           dz_gyz = DIFF_Z_2(g23)
           dz_gzz = DIFF_Z_2(g33)
           
        else

           dx_gxx = DIFF_X_4(g11)
           dx_gxy = DIFF_X_4(g12)
           dx_gxz = DIFF_X_4(g13)
           dx_gyy = DIFF_X_4(g22)
           dx_gyz = DIFF_X_4(g23)
           dx_gzz = DIFF_X_4(g33)
           dy_gxx = DIFF_Y_4(g11)
           dy_gxy = DIFF_Y_4(g12)
           dy_gxz = DIFF_Y_4(g13)
           dy_gyy = DIFF_Y_4(g22)
           dy_gyz = DIFF_Y_4(g23)
           dy_gzz = DIFF_Y_4(g33)
           dz_gxx = DIFF_Z_4(g11)
           dz_gxy = DIFF_Z_4(g12)
           dz_gxz = DIFF_Z_4(g13)
           dz_gyy = DIFF_Z_4(g22)
           dz_gyz = DIFF_Z_4(g23)
           dz_gzz = DIFF_Z_4(g33)

        end if
          
!!$        Contract the shift with the extrinsic curvature

        shiftshiftk = shiftx*shiftx*k11(i,j,k) + &
                      shifty*shifty*k22(i,j,k) + &
                      shiftz*shiftz*k33(i,j,k) + &
             two*(shiftx*shifty*k12(i,j,k) + &
                  shiftx*shiftz*k13(i,j,k) + &
                  shifty*shiftz*k23(i,j,k))

        shiftkx = shiftx*k11(i,j,k) + shifty*k12(i,j,k) + shiftz*k13(i,j,k)
        shiftky = shiftx*k12(i,j,k) + shifty*k22(i,j,k) + shiftz*k23(i,j,k)
        shiftkz = shiftx*k13(i,j,k) + shifty*k23(i,j,k) + shiftz*k33(i,j,k)

!!$        Contract the matter terms with the extrinsic curvature

        sumTK = txx*k11(i,j,k) + tyy*k22(i,j,k) + tzz*k33(i,j,k) &
             + two*(txy*k12(i,j,k) + txz*k13(i,j,k) + tyz*k23(i,j,k))

!!$        Update term for tau
        
        tau_source = t00* &
             (shiftshiftk - (shiftx*dx_alp + shifty*dy_alp + shiftz*dz_alp) )&
             + t0x*(-dx_alp + two*shiftkx) &
             + t0y*(-dy_alp + two*shiftky) &
             + t0z*(-dz_alp + two*shiftkz) &
             + sumTK

!!$        The following looks very little like the terms in the
!!$        standard papers. Take a look in the ThornGuide to see why
!!$        it is really the same thing.

!!$        Contract the shift with derivatives of the metric

        halfshiftdgx = half*(shiftx*shiftx*dx_gxx + &
             shifty*shifty*dx_gyy + shiftz*shiftz*dx_gzz) + &
             shiftx*shifty*dx_gxy + shiftx*shiftz*dx_gxz + &
             shifty*shiftz*dx_gyz
        halfshiftdgy = half*(shiftx*shiftx*dy_gxx + &
             shifty*shifty*dy_gyy + shiftz*shiftz*dy_gzz) + &
             shiftx*shifty*dy_gxy + shiftx*shiftz*dy_gxz + &
             shifty*shiftz*dy_gyz
        halfshiftdgz = half*(shiftx*shiftx*dz_gxx + &
             shifty*shifty*dz_gyy + shiftz*shiftz*dz_gzz) + &
             shiftx*shifty*dz_gxy + shiftx*shiftz*dz_gxz + &
             shifty*shiftz*dz_gyz

!!$        Contract the matter with derivatives of the metric

        halfTdgx = half*(txx*dx_gxx + tyy*dx_gyy + tzz*dx_gzz) +&
             txy*dx_gxy + txz*dx_gxz + tyz*dx_gyz
        halfTdgy = half*(txx*dy_gxx + tyy*dy_gyy + tzz*dy_gzz) +&
             txy*dy_gxy + txz*dy_gxz + tyz*dy_gyz
        halfTdgz = half*(txx*dz_gxx + tyy*dz_gyy + tzz*dz_gzz) +&
             txy*dz_gxy + txz*dz_gxz + tyz*dz_gyz

     


       sx_source = t00*&
             (halfshiftdgx - alp(i,j,k)*dx_alp) + halfTdgx + &
             t0x*(shiftx*dx_gxx + shifty*dx_gxy + shiftz*dx_gxz) +&
             t0y*(shiftx*dx_gxy + shifty*dx_gyy + shiftz*dx_gyz) +&
             t0z*(shiftx*dx_gxz + shifty*dx_gyz + shiftz*dx_gzz) +&
             rhohstarW2*invalp*(vlowx*dx_betax + vlowy*dx_betay + vlowz*dx_betaz) -&
             bt*(bxlow*dx_betax + bylow*dx_betay + bzlow*dx_betaz)
        
       sy_source = t00*&
             (halfshiftdgy - alp(i,j,k)*dy_alp) + halfTdgy + &
             t0x*(shiftx*dy_gxx + shifty*dy_gxy + shiftz*dy_gxz) +&
             t0y*(shiftx*dy_gxy + shifty*dy_gyy + shiftz*dy_gyz) +&
             t0z*(shiftx*dy_gxz + shifty*dy_gyz + shiftz*dy_gzz) +&
             rhohstarW2*invalp*(vlowx*dy_betax + vlowy*dy_betay + vlowz*dy_betaz) -&
             bt*(bxlow*dy_betax + bylow*dy_betay + bzlow*dy_betaz)

       sz_source = t00*&
             (halfshiftdgz - alp(i,j,k)*dz_alp) + halfTdgz + &
             t0x*(shiftx*dz_gxx + shifty*dz_gxy + shiftz*dz_gxz) +&
             t0y*(shiftx*dz_gxy + shifty*dz_gyy + shiftz*dz_gyz) +&
             t0z*(shiftx*dz_gxz + shifty*dz_gyz + shiftz*dz_gzz) +&
             rhohstarW2*invalp*(vlowx*dz_betax + vlowy*dz_betay + vlowz*dz_betaz) -&
             bt*(bxlow*dz_betax + bylow*dz_betay + bzlow*dz_betaz)

        !! B^i and A^i both live in cell centers currently
        Avcx_source = sqrtdet*(vely(i,j,k)*Bvecz(i,j,k) - velz(i,j,k)*Bvecy(i,j,k))
        Avcy_source = sqrtdet*(velz(i,j,k)*Bvecx(i,j,k) - velx(i,j,k)*Bvecz(i,j,k))
        Avcz_source = sqrtdet*(velx(i,j,k)*Bvecy(i,j,k) - vely(i,j,k)*Bvecx(i,j,k))

        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = 0.d0 
        end if

        densrhs(i,j,k) = 0.d0
        srhs(i,j,k,1)  = alp(i,j,k)*sqrtdet*sx_source
        srhs(i,j,k,2)  = alp(i,j,k)*sqrtdet*sy_source
        srhs(i,j,k,3)  = alp(i,j,k)*sqrtdet*sz_source
        taurhs(i,j,k)  = alp(i,j,k)*sqrtdet*tau_source
        Avecrhsx(i,j,k) = Avcx_source
        Avecrhsy(i,j,k) = Avcy_source
        Avecrhsz(i,j,k) = Avcz_source

      enddo
    enddo
  enddo
  !$OMP END PARALLEL DO

  deallocate(force_spatial_second_order)

#if(0) /* poison edges of domain */
  if(last_iteration_seen .ne. cctk_iteration .or. reflevel .ne. grhydro_reflevel) then
    last_iteration_seen = cctk_iteration
    reflevel = grhydro_reflevel
    mol_substep = 0
  else
    mol_substep = mol_substep + 1
  end if
  do k = 1, GRHydro_stencil*mol_substep
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
  do k = cctk_lsh(3)-GRHydro_stencil*mol_substep+1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
  do i = 1, GRHydro_stencil*mol_substep
    do k = 1, cctk_lsh(3)
      do j = 1, cctk_lsh(2)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
  do i = cctk_lsh(1)-GRHydro_stencil*mol_substep+1, cctk_lsh(1)
    do k = 1, cctk_lsh(3)
      do j = 1, cctk_lsh(2)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
  do j = 1, GRHydro_stencil*mol_substep
    do i = 1, cctk_lsh(1)
      do k = 1, cctk_lsh(3)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
  do j = cctk_lsh(2)-GRHydro_stencil*mol_substep+1, cctk_lsh(2)
    do i = 1, cctk_lsh(1)
      do k = 1, cctk_lsh(3)
        dens(i,j,k) = -1d100
        Scon(i,j,k,1) = -1d100
        Scon(i,j,k,2) = -1d100
        Scon(i,j,k,3) = -1d100
        tau(i,j,k) = -1d100
        Avecx(i,j,k) = -1d100
        Avecy(i,j,k) = -1d100
        Avecz(i,j,k) = -1d100
        if ( evolve_Lorenz_gge.gt.0 ) then
           Aphi(i,j,k) = -1d100
        end if
      end do
    end do
  end do
#endif

#undef faulty_gxx
#undef faulty_gxy
#undef faulty_gxz
#undef faulty_gyy
#undef faulty_gyz
#undef faulty_gzz
#undef faulty_vel
#undef faulty_Bvec
#undef faulty_gxx_p
#undef faulty_gxy_p
#undef faulty_gxz_p
#undef faulty_gyy_p
#undef faulty_gyz_p
#undef faulty_gzz_p
#undef faulty_vel_p
#undef faulty_Bvec_p
#undef faulty_gxx_p_p
#undef faulty_gxy_p_p
#undef faulty_gxz_p_p
#undef faulty_gyy_p_p
#undef faulty_gyz_p_p
#undef faulty_gzz_p_p
#undef faulty_vel_p_p
#undef faulty_Bvec_p_p
end subroutine SourceTermsAM




```

GRHydro_MP5Reconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_MP5Reconstruct_drv.F90
   @date      Fri Jan 3 2013
   @author    Christian Reisswig, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   Driver routine to perform the MP5 reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)
#define Bconsx(i,j,k) Bcons(i,j,k,1)
#define Bconsy(i,j,k) Bcons(i,j,k,2)
#define Bconsz(i,j,k) Bcons(i,j,k,3)



  

 /*@@
   @routine    GRHydro_MP5Reconstruct_drv
   @date       Fri Jan 3 2013
   @author     Christian Reisswig, Luca Baiotti, Ian Hawke, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   A driver routine to do MP5 reconstruction. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_MP5Reconstruct_drv(CCTK_ARGUMENTS)
  
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates

  integer :: nx, ny, nz, i, j, k, itracer

  logical, dimension(:,:,:), allocatable :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_REAL, dimension(:,:,:),allocatable :: &
       &dum, dump, dumm

  CCTK_INT :: ierr


  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
  
!!$ The dum variables are used as dummies if MHD on but divergence cleaning off
  allocate(dum(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dump(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dumm(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)

  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with dum dump dumm")
    STOP
  end if
  
  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  !initialize trivial_rp to false
  !$OMP PARALLEL DO PRIVATE(i,j,k)
  do k=1,nz
     do j=1,ny
        do i=1,nx
           trivial_rp(i,j,k) = .false.
        enddo
     enddo
  enddo
  !$OMP END PARALLEL DO


!!$ MP5 starts:
     if (evolve_tracer .ne. 0) then
        do itracer=1,number_of_tracers
           call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
                tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), &
                tracerminus(:,:,:,itracer), trivial_rp, &
                hydro_excision_mask)
        enddo
     end if

    if (flux_direction == 1) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    vel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    vel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    vel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call undo_Wv(nx, velxminus(:,j,k), velyminus(:,j,k), velzminus(:,j,k),&
                                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                                  gxx(:,j,k),gxy(:,j,k),gxz(:,j,k),gyy(:,j,k),gyz(:,j,k),gzz(:,j,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    lvel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call undo_Wv(nx, velxminus(:,j,k), velyminus(:,j,k), velzminus(:,j,k),&
                                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                                  gaa(:,j,k),gab(:,j,k),gac(:,j,k),gbb(:,j,k),gbc(:,j,k),gcc(:,j,k))
               end if
            endif
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 eps(:,j,k),epsminus(:,j,k),epsplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_Y_e.ne.0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    temperature(:,j,k),tempminus(:,j,k),tempplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      Bvec(:,j,k,1),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      Bvec(:,j,k,2),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      Bvec(:,j,k,3),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      lBvec(:,j,k,1),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      lBvec(:,j,k,2),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                      lBvec(:,j,k,3),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    entropy(:,j,k),entropyminus(:,j,k),entropyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 dens(:,j,k),densminus(:,j,k),densplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 sx(:,j,k),sxminus(:,j,k),sxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 sy(:,j,k),syminus(:,j,k),syplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 sz(:,j,k),szminus(:,j,k),szplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                 tau(:,j,k),tauminus(:,j,k),tauplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    Bconsx(:,j,k),Bconsxminus(:,j,k),Bconsxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    Bconsy(:,j,k),Bconsyminus(:,j,k),Bconsyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    Bconsz(:,j,k),Bconszminus(:,j,k),Bconszplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                    entropycons(:,j,k),entropyconsminus(:,j,k),entropyconsplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_MP5Reconstruct1d(cctk_lsh(1),&
                  psidc(:,j,k),psidcminus(:,j,k),psidcplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
          endif

          do i = 1, cctk_lsh(1)
            if (trivial_rp(i,j,k)) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
            else
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 2) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    vel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    vel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    vel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    lvel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    lvel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    lvel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call undo_Wv(ny, velyminus(j,:,k), velzminus(j,:,k), velxminus(j,:,k),&
                                  velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                                  gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), gxx(j,:,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call undo_Wv(ny, velyminus(j,:,k), velzminus(j,:,k), velxminus(j,:,k),&
                                  velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                                  gbb(j,:,k), gbc(j,:,k), gab(j,:,k), gcc(j,:,k), gac(j,:,k), gaa(j,:,k))
               end if
            endif
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 eps(j,:,k),epsminus(j,:,k),epsplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if(evolve_Y_e.ne.0) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    temperature(j,:,k),tempminus(j,:,k),tempplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      Bvec(j,:,k,1),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      Bvec(j,:,k,2),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      Bvec(j,:,k,3),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      lBvec(j,:,k,1),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      lBvec(j,:,k,2),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                      lBvec(j,:,k,3),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    entropy(j,:,k),entropyminus(j,:,k),entropyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
         else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 dens(j,:,k),densminus(j,:,k),densplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 sx(j,:,k),sxminus(j,:,k),sxplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 sy(j,:,k),syminus(j,:,k),syplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 sz(j,:,k),szminus(j,:,k),szplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 tau(j,:,k),tauminus(j,:,k),tauplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    Bconsx(j,:,k),Bconsxminus(j,:,k),Bconsxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    Bconsy(j,:,k),Bconsyminus(j,:,k),Bconsyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    Bconsz(j,:,k),Bconszminus(j,:,k),Bconszplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    entropycons(j,:,k),entropyconsminus(j,:,k),entropyconsplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                 psidc(j,:,k),psidcminus(j,:,k),psidcplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
          endif

          do i = 1, cctk_lsh(2)
            if (trivial_rp(j,i,k)) then
              SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 3) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    vel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    vel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    vel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    lvel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    lvel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    lvel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call undo_Wv(nz, velzminus(j,k,:), velxminus(j,k,:), velyminus(j,k,:),&
                                  velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                                  gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:),gyy(j,k,:))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call undo_Wv(nz, velzminus(j,k,:), velxminus(j,k,:), velyminus(j,k,:),&
                                  velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                                  gcc(j,k,:), gac(j,k,:), gbc(j,k,:), gaa(j,k,:), gab(j,k,:),gbb(j,k,:))
               end if
            endif
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 eps(j,k,:),epsminus(j,k,:),epsplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_Y_e.ne.0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    temperature(j,k,:),tempminus(j,k,:),tempplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      Bvec(j,k,:,1),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      Bvec(j,k,:,2),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      Bvec(j,k,:,3),Bveczminus(j,k,:),Bveczplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               else
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      lBvec(j,k,:,1),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      lBvec(j,k,:,2),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                      lBvec(j,k,:,3),Bveczminus(j,k,:),Bveczplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(2),&
                    entropy(j,k,:),entropyminus(j,k,:),entropyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 dens(j,k,:),densminus(j,k,:),densplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 sx(j,k,:),sxminus(j,k,:),sxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 sy(j,k,:),syminus(j,k,:),syplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 sz(j,k,:),szminus(j,k,:),szplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                 tau(j,k,:),tauminus(j,k,:),tauplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    Bconsx(j,k,:),Bconsxminus(j,k,:),Bconsxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    Bconsy(j,k,:),Bconsyminus(j,k,:),Bconsyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    Bconsz(j,k,:),Bconszminus(j,k,:),Bconszplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                    entropycons(j,k,:),entropyconsminus(j,k,:),entropyconsplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_MP5Reconstruct1d(cctk_lsh(3),&
                  psidc(j,k,:),psidcminus(j,k,:),psidcplus(j,k,:),&
                  trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
          endif

          do i = 1, cctk_lsh(3)
            if (trivial_rp(j,k,i)) then
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
!!$ MP5 ends.


  deallocate(trivial_rp)
  deallocate(dum,dump,dumm)


end subroutine GRHydro_MP5Reconstruct_drv


```

GRHydro_ReconstructPoly.F90:
```
 /*@@
   @file      GRHydro_ReconstructPoly.F90
   @date      Sat Jan 26 02:13:25 2002
   @author    
   @desc 
   Wrapper routine to perform the reconstruction for polytropes.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define velx(i,j,k) vel(i,j,k,1)
#define vely(i,j,k) vel(i,j,k,2)
#define velz(i,j,k) vel(i,j,k,3)
#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)
#define Bvecx(i,j,k) Bvec(i,j,k,1)
#define Bvecy(i,j,k) Bvec(i,j,k,2)
#define Bvecz(i,j,k) Bvec(i,j,k,3)
#define Bconsx(i,j,k) Bcons(i,j,k,1)
#define Bconsy(i,j,k) Bcons(i,j,k,2)
#define Bconsz(i,j,k) Bcons(i,j,k,3)


 /*@@
   @routine    ReconstructionPolytype
   @date       Tue Mar 19 11:36:55 2002
   @author     Ian Hawke  
   @desc 
   If using a polytropic type EOS, we do not have to reconstruct all the 
   variables.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine ReconstructionPolytype(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  logical :: apply_enhanced_ppm

  integer :: nx, ny, nz, i, j, k, itracer

  logical, dimension(:,:,:), allocatable :: trivial_rp
!!$  logical, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_REAL, dimension(:,:,:),allocatable :: &
       &lbetax, lbetay, lbetaz, dum, dump, dumm
!!$  CCTK_REAL, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: &
!!$       &lbetax, lbetay, lbetaz

  CCTK_INT :: ierr

  CCTK_REAL :: local_min_tracer

  CCTK_INT :: GRHydro_UseGeneralCoordinates

  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
  
  allocate(lbetax(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       lbetay(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       lbetaz(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dum(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dump(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dumm(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)

  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with lbeta")
    STOP
  end if
  
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    call CCTK_ERROR("MP not yet supported in GRHydro_ReconstructionPolytype")
    STOP
  end if

  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  ! if use_enhanced_ppm, allow old PPM on one level
  if (GRHydro_oppm_reflevel .eq. (-1) .or. &
       GRHydro_reflevel .ne. GRHydro_oppm_reflevel) then
     apply_enhanced_ppm = use_enhanced_ppm .ne. 0
  else
     apply_enhanced_ppm = .false.
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

!!$  Currently only option is reconstruction on primitive variables.
!!$  Should change this.

  ! Initialize plus and minus states
  !$OMP PARALLEL DO PRIVATE(i,j,k)
  do k=1,cctk_lsh(3)
     do j=1,cctk_lsh(2)
        do i=1,cctk_lsh(1)
           lbetax(i,j,k) = betax(i,j,k)
           lbetay(i,j,k) = betay(i,j,k)
           lbetaz(i,j,k) = betaz(i,j,k)
           trivial_rp(i,j,k) = .false.
           ! must initialize rho and eps plus minus
           ! to cell average in order to have sane values
           ! in the boundary zones for EOS call
           rhoplus(i,j,k) = rho(i,j,k)
           rhominus(i,j,k)= rho(i,j,k)
           epsplus(i,j,k) = eps(i,j,k)
           epsminus(i,j,k) = eps(i,j,k)
           velxplus(i,j,k) = 0.0d0
           velxminus(i,j,k) = 0.0d0
           velyplus(i,j,k) = 0.0d0
           velyminus(i,j,k) = 0.0d0
           velzplus(i,j,k) = 0.0d0
           velzminus(i,j,k) = 0.0d0

           if(evolve_mhd.ne.0) then
              Bvecxplus(i,j,k) = 0.0d0
              Bvecxminus(i,j,k) = 0.0d0
              Bvecyplus(i,j,k) = 0.0d0
              Bvecyminus(i,j,k) = 0.0d0
              Bveczplus(i,j,k) = 0.0d0
              Bveczminus(i,j,k) = 0.0d0
              if(clean_divergence.ne.0) then
                 psidcplus(i,j,k) = 0.0d0
                 psidcminus(i,j,k) = 0.0d0
              endif
           endif
           if (evolve_entropy .ne. 0) then
              entropyplus(i,j,k) = 0.0d0
              entropyminus(i,j,k) = 0.0d0
           endif

           if (evolve_tracer .ne. 0) then
              tracerplus(i,j,k,:) = 0.0d0
              tracerminus(i,j,k,:) = 0.0d0
           endif

           if (evolve_Y_e .ne. 0) then
              ! set this to the cell center values
              ! to make sure we have good Y_e even in
              ! the boundary region (for full GF EOS calls)
              Y_e_plus(i,j,k) = Y_e(i,j,k)
              Y_e_minus(i,j,k) = Y_e(i,j,k)
           endif
          if(evolve_temper .ne. 0) then
              ! set this to cell center value to have
              ! good initial guesses at interfaces
              ! in case we don't reconstruct temp
              tempplus(i,j,k) = temperature(i,j,k)
              tempminus(i,j,k) = temperature(i,j,k)
           endif
        enddo
     enddo
  enddo
  !$OMP END PARALLEL DO             



  if (CCTK_EQUALS(recon_method,"tvd")) then

     if (evolve_tracer .ne. 0) then
        do itracer=1,number_of_tracers
           call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
                tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), &
                tracerminus(:,:,:,itracer), &
                trivial_rp, hydro_excision_mask)
        enddo
     end if
     
     if (evolve_Y_e .ne. 0) then
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             Y_e(:,:,:), Y_e_plus(:,:,:), &
             Y_e_minus(:,:,:), &
             trivial_rp, hydro_excision_mask)
     endif

    if (CCTK_EQUALS(recon_vars,"primitive")) then
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           rho, rhoplus, rhominus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           vel(:,:,:,1), velxplus, velxminus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           vel(:,:,:,2), velyplus, velyminus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           vel(:,:,:,3), velzplus, velzminus, trivial_rp, hydro_excision_mask)
      if(evolve_mhd.ne.0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bvec(:,:,:,1), Bvecxplus, Bvecxminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bvec(:,:,:,2), Bvecyplus, Bvecyminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bvec(:,:,:,3), Bveczplus, Bveczminus, trivial_rp, hydro_excision_mask)
      endif
    else if (CCTK_EQUALS(recon_vars,"conservative")) then
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           dens, densplus, densminus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           scon(:,:,:,1), sxplus, sxminus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           scon(:,:,:,2), syplus, syminus, trivial_rp, hydro_excision_mask)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           scon(:,:,:,3), szplus, szminus, trivial_rp, hydro_excision_mask)
      if(evolve_mhd.ne.0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bcons(:,:,:,1), Bconsxplus, Bconsxminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bcons(:,:,:,2), Bconsyplus, Bconsyminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bcons(:,:,:,3), Bconszplus, Bconszminus, trivial_rp, hydro_excision_mask)
      endif
    else
      call CCTK_ERROR("Variable type to reconstruct not recognized.")
      STOP
    end if

    if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
       call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
            psidc, psidcplus, psidcminus, trivial_rp, hydro_excision_mask)
    endif

    !$OMP PARALLEL DO PRIVATE(i, j, k)
    do k = 1, nz
      do j = 1, ny
        do i = 1, nx
          if (trivial_rp(i,j,k)) then
            if (flux_direction == 1) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
            else if (flux_direction == 2) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, trivialy)
            else if (flux_direction == 3) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, trivialz)
            end if
          else
            if (flux_direction == 1) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
            else if (flux_direction == 2) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, not_trivialy)
            else if (flux_direction == 3) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, not_trivialz)
            end if
          end if
        end do
      end do
    end do
    !$OMP END PARALLEL DO

  else if (CCTK_EQUALS(recon_method,"ppm")) then

    if (flux_direction == 1) then
      if(evolve_mhd.ne.0) then
        if(clean_divergence.ne.0) then
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,nx,CCTK_DELTA_SPACE(1),&
                   rho(:,j,k),velx(:,j,k),vely(:,j,k),velz(:,j,k),&
                   Bvecx(:,j,k),Bvecy(:,j,k),Bvecz(:,j,k),psidc(:,j,k),eps(:,j,k),press(:,j,k),&
                   rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                   Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),psidcminus(:,j,k),epsminus(:,j,k),&
                   rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                   Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),psidcplus(:,j,k),epsplus(:,j,k),&
                   1,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                   gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                   gzz(:,j,k), lbetax(:,j,k), alp(:,j,k),&
                   w_lorentz(:,j,k), &
                   1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                   GRHydro_mppm_eigenvalue_x_right, &
                   GRHydro_mppm_xwind)
              do i = 1, nx
                if (trivial_rp(i,j,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
                else
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        else  !clean_divergence
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,nx,CCTK_DELTA_SPACE(1),&
                   rho(:,j,k),velx(:,j,k),vely(:,j,k),velz(:,j,k),&
                   Bvecx(:,j,k),Bvecy(:,j,k),Bvecz(:,j,k),dum(:,j,k),eps(:,j,k),press(:,j,k),&
                   rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),&
                   Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),dumm(:,j,k),epsminus(:,j,k),&
                   rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                   Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),dump(:,j,k),epsplus(:,j,k),&
                   0,trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                   gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                   gzz(:,j,k), lbetax(:,j,k), alp(:,j,k),&
                   w_lorentz(:,j,k), &
                   1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                   GRHydro_mppm_eigenvalue_x_right, &
                   GRHydro_mppm_xwind)
              do i = 1, nx
                if (trivial_rp(i,j,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
                else
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        endif  !clean_divergence
      else  !evolve_mhd
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, nz - GRHydro_stencil + 1
          do j = GRHydro_stencil, ny - GRHydro_stencil + 1
            call SimplePPM_1d(apply_enhanced_ppm,&
                 GRHydro_eos_handle,1,nx,CCTK_DELTA_SPACE(1),&
                 rho(:,j,k),velx(:,j,k),vely(:,j,k),velz(:,j,k),eps(:,j,k),&
                 press(:,j,k),rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),&
                 velzminus(:,j,k),epsminus(:,j,k),rhoplus(:,j,k),&
                 velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),epsplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                 gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                 gzz(:,j,k), lbetax(:,j,k), alp(:,j,k),&
                 w_lorentz(:,j,k), &
                 1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                 GRHydro_mppm_eigenvalue_x_right, &
                 GRHydro_mppm_xwind)
            do i = 1, nx
              if (trivial_rp(i,j,k)) then
                SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
              else
                SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      endif  !evolve_mhd
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                    nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                    velx(:,j,k),vely(:,j,k),velz(:,j,k), &
                    tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), &
                    press(:,j,k))
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                    nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                    velx(:,j,k),vely(:,j,k),velz(:,j,k), &
                    Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k), &
                    press(:,j,k))
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else if (flux_direction == 2) then
      if(evolve_mhd.ne.0) then
        if(clean_divergence.ne.0) then
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,ny,CCTK_DELTA_SPACE(2),&
                   rho(j,:,k),vely(j,:,k),velz(j,:,k),velx(j,:,k),&
                   Bvecy(j,:,k),Bvecz(j,:,k),Bvecx(j,:,k),psidc(j,:,k),eps(j,:,k),press(j,:,k),&
                   rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                   Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),psidcminus(j,:,k),epsminus(j,:,k),&
                   rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                   Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),psidcplus(j,:,k),epsplus(j,:,k),&
                   1,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                   gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                   gxx(j,:,k), lbetay(j,:,k), alp(j,:,k),&
                   w_lorentz(j,:,k), &
                   2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                   GRHydro_mppm_eigenvalue_y_right, &
                   GRHydro_mppm_xwind)
              do i = 1, ny
                if (trivial_rp(j,i,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
                else
                  SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        else  !clean_divergence
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,ny,CCTK_DELTA_SPACE(2),&
                   rho(j,:,k),vely(j,:,k),velz(j,:,k),velx(j,:,k),&
                   Bvecy(j,:,k),Bvecz(j,:,k),Bvecx(j,:,k),dum(j,:,k),eps(j,:,k),press(j,:,k),&
                   rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),&
                   Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),dumm(j,:,k),epsminus(j,:,k),&
                   rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                   Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),dump(j,:,k),epsplus(j,:,k),&
                   0,trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                   gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                   gxx(j,:,k), lbetay(j,:,k), alp(j,:,k),&
                   w_lorentz(j,:,k), &
                   2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                   GRHydro_mppm_eigenvalue_y_right, &
                   GRHydro_mppm_xwind)
              do i = 1, ny
                if (trivial_rp(j,i,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
                else
                  SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        endif  !clean_divergence
      else  !evolve_mhd
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, nz - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
            call SimplePPM_1d(apply_enhanced_ppm,&
                 GRHydro_eos_handle,1,ny,CCTK_DELTA_SPACE(2),&
                 rho(j,:,k),vely(j,:,k),velz(j,:,k),velx(j,:,k),eps(j,:,k),&
                 press(j,:,k),rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),&
                 velxminus(j,:,k),epsminus(j,:,k),rhoplus(j,:,k),&
                 velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),epsplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                 gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                 gxx(j,:,k), lbetay(j,:,k), alp(j,:,k),&
                 w_lorentz(j,:,k), &
                 2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                 GRHydro_mppm_eigenvalue_y_right, &
                 GRHydro_mppm_xwind)
            do i = 1, ny
              if (trivial_rp(j,i,k)) then
                SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
              else
                SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      endif  !evolve_mhd
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                   ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                   vely(j,:,k),velz(j,:,k),velx(j,:,k), &
                   tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), &
                   press(j,:,k))
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                    ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                    velx(j,:,k),vely(j,:,k),velz(j,:,k), &
                    Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k), &
                    press(j,:,k))
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      
    else if (flux_direction == 3) then
      if(evolve_mhd.ne.0) then
        if(clean_divergence.ne.0) then
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,nz,CCTK_DELTA_SPACE(3),&
                   rho(j,k,:),velz(j,k,:),velx(j,k,:),vely(j,k,:),&
                   Bvecz(j,k,:),Bvecx(j,k,:),Bvecy(j,k,:),psidc(j,k,:),eps(j,k,:),press(j,k,:),&
                   rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                   Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),psidcminus(j,k,:),epsminus(j,k,:),&
                   rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                   Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),psidcplus(j,k,:),epsplus(j,k,:),&
                   1,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                   gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                   gyy(j,k,:), lbetaz(j,k,:), alp(j,k,:),&
                   w_lorentz(j,k,:), &
                   3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                   GRHydro_mppm_eigenvalue_z_right, &
                   GRHydro_mppm_xwind)
              do i = 1, nz
                if (trivial_rp(j,k,i)) then
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
                else
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        else  !clean_divergence
          !$OMP PARALLEL DO PRIVATE(i, j, k)
          do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              call SimplePPM_1dM(GRHydro_eos_handle,1,nz,CCTK_DELTA_SPACE(3),&
                   rho(j,k,:),velz(j,k,:),velx(j,k,:),vely(j,k,:),&
                   Bvecz(j,k,:),Bvecx(j,k,:),Bvecy(j,k,:),dum(:,j,k),eps(j,k,:),press(j,k,:),&
                   rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),&
                   Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),dumm(j,k,:),epsminus(j,k,:),&
                   rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                   Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),dump(j,k,:),epsplus(j,k,:),&
                   0,trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                   gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                   gyy(j,k,:), lbetaz(j,k,:), alp(j,k,:),&
                   w_lorentz(j,k,:), &
                   3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                   GRHydro_mppm_eigenvalue_z_right, &
                   GRHydro_mppm_xwind)
              do i = 1, nz
                if (trivial_rp(j,k,i)) then
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
                else
                  SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
                end if
              end do
            end do
          end do
          !$OMP END PARALLEL DO
        endif  !clean_divergence
      else  !evolve_mhd
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, ny - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
            call SimplePPM_1d(apply_enhanced_ppm,&
                 GRHydro_eos_handle,1,nz,CCTK_DELTA_SPACE(3),&
                 rho(j,k,:),velz(j,k,:),velx(j,k,:),vely(j,k,:),eps(j,k,:),&
                 press(j,k,:),rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),&
                 velyminus(j,k,:),epsminus(j,k,:),rhoplus(j,k,:),&
                 velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),epsplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                 gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                 gyy(j,k,:), lbetaz(j,k,:), alp(j,k,:),&
                 w_lorentz(j,k,:), &
                 3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                 GRHydro_mppm_eigenvalue_z_right, &
                 GRHydro_mppm_xwind)
            do i = 1, nz
              if (trivial_rp(j,k,i)) then
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
              else
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      endif  !evolve_mhd
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1

               call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                    nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                    velz(j,k,:),velx(j,k,:),vely(j,k,:), &
                    tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), &
                    press(j,k,:))
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                    nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                    velx(j,k,:),vely(j,k,:),velz(j,k,:), &
                    Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:), &
                    press(j,k,:))
            end do
         end do
         !$OMP END PARALLEL DO
      end if
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
  else if (CCTK_EQUALS(recon_method,"eno")) then

     if (evolve_tracer .ne. 0) then
        do itracer=1,number_of_tracers
           call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
                tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), &
                tracerminus(:,:,:,itracer), trivial_rp, &
                hydro_excision_mask)
        enddo
     end if

     if (evolve_Y_e .ne. 0) then
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             Y_e(:,:,:), Y_e_plus(:,:,:), &
             Y_e_minus(:,:,:), &
             trivial_rp, hydro_excision_mask)
     endif

    if (flux_direction == 1) then
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 velx(:,j,k),velxminus(:,j,k),velxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 vely(:,j,k),velyminus(:,j,k),velyplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 velz(:,j,k),velzminus(:,j,k),velzplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                    Bvecx(:,j,k),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                    Bvecy(:,j,k),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                    Bvecz(:,j,k),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 dens(:,j,k),densminus(:,j,k),densplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 sx(:,j,k),sxminus(:,j,k),sxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 sy(:,j,k),syminus(:,j,k),syplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 sz(:,j,k),szminus(:,j,k),szplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                      Bconsx(:,j,k),Bconsxminus(:,j,k),Bconsxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                      Bconsy(:,j,k),Bconsyminus(:,j,k),Bconsyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                      Bconsz(:,j,k),Bconszminus(:,j,k),Bconszplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                  psidc(:,j,k),psidcminus(:,j,k),psidcplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
          endif

          do i = 1, cctk_lsh(1)
            if (trivial_rp(i,j,k)) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
            else
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
            end if
          end do
        end do
       end do
        !$OMP END PARALLEL DO
     else if (flux_direction == 2) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1
           do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1
              if (CCTK_EQUALS(recon_vars,"primitive")) then
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      velx(j,:,k),velxminus(j,:,k),velxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      vely(j,:,k),velyminus(j,:,k),velyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      velz(j,:,k),velzminus(j,:,k),velzplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 if(evolve_mhd.ne.0) then
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bvecx(j,:,k),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bvecy(j,:,k),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bvecz(j,:,k),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 end if

              else if (CCTK_EQUALS(recon_vars,"conservative")) then
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      dens(j,:,k),densminus(j,:,k),densplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      sx(j,:,k),sxminus(j,:,k),sxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      sy(j,:,k),syminus(j,:,k),syplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      sz(j,:,k),szminus(j,:,k),szplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 if(evolve_mhd.ne.0) then
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bconsx(j,:,k),Bconsxminus(j,:,k),Bconsxplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bconsy(j,:,k),Bconsyminus(j,:,k),Bconsyplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                         Bconsz(j,:,k),Bconszminus(j,:,k),Bconszplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 end if
              else
                 !$OMP CRITICAL
                 call CCTK_ERROR("Variable type to reconstruct not recognized.")
                 STOP
                 !$OMP END CRITICAL
              end if

              if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                      psidc(j,:,k),psidcminus(j,:,k),psidcplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
              endif

              do i = 1, cctk_lsh(2)
                 if (trivial_rp(j,i,k)) then
                    SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
                 else
                    SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
                 end if
              end do
           end do
        end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 3) then
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 velx(j,k,:),velxminus(j,k,:),velxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 vely(j,k,:),velyminus(j,k,:),velyplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 velz(j,k,:),velzminus(j,k,:),velzplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bvecx(j,k,:),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bvecy(j,k,:),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bvecz(j,k,:),Bveczminus(j,k,:),Bveczplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 dens(j,k,:),densminus(j,k,:),densplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 sx(j,k,:),sxminus(j,k,:),sxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 sy(j,k,:),syminus(j,k,:),syplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 sz(j,k,:),szminus(j,k,:),szplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bconsx(j,k,:),Bconsxminus(j,k,:),Bconsxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bconsy(j,k,:),Bconsyminus(j,k,:),Bconsyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    Bconsz(j,k,:),Bconszminus(j,k,:),Bconszplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                  psidc(j,k,:),psidcminus(j,k,:),psidcplus(j,k,:),&
                  trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
          endif

          do i = 1, cctk_lsh(3)
            if (trivial_rp(j,k,i)) then
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
  else if (CCTK_EQUALS(recon_method,"weno")) then

     if (evolve_tracer .ne. 0) then
        do itracer=1,number_of_tracers
           call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
                tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), &
                tracerminus(:,:,:,itracer), trivial_rp, &
                hydro_excision_mask)
        enddo
     end if

     if (evolve_Y_e .ne. 0) then
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             Y_e(:,:,:), Y_e_plus(:,:,:), &
             Y_e_minus(:,:,:), &
             trivial_rp, hydro_excision_mask)
     endif

    if (flux_direction == 1) then
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 velx(:,j,k),velxminus(:,j,k),velxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 vely(:,j,k),velyminus(:,j,k),velyplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 velz(:,j,k),velzminus(:,j,k),velzplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bvecx(:,j,k),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bvecy(:,j,k),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bvecz(:,j,k),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 dens(:,j,k),densminus(:,j,k),densplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sx(:,j,k),sxminus(:,j,k),sxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sy(:,j,k),syminus(:,j,k),syplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sz(:,j,k),szminus(:,j,k),szplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bconsx(:,j,k),Bconsxminus(:,j,k),Bconsxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bconsy(:,j,k),Bconsyminus(:,j,k),Bconsyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bconsz(:,j,k),Bconszminus(:,j,k),Bconszplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_WARN(0, "Variable type to reconstruct not recognized.")
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                  psidc(:,j,k),psidcminus(:,j,k),psidcplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
          endif

          do i = 1, cctk_lsh(1)
            if (trivial_rp(i,j,k)) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
            else
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
            end if
          end do
        end do
       end do
        !$OMP END PARALLEL DO
     else if (flux_direction == 2) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1
           do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1
              if (CCTK_EQUALS(recon_vars,"primitive")) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      velx(j,:,k),velxminus(j,:,k),velxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      vely(j,:,k),velyminus(j,:,k),velyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      velz(j,:,k),velzminus(j,:,k),velzplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 if(evolve_mhd.ne.0) then
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bvecx(j,:,k),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bvecy(j,:,k),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bvecz(j,:,k),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 end if

              else if (CCTK_EQUALS(recon_vars,"conservative")) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      dens(j,:,k),densminus(j,:,k),densplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      sx(j,:,k),sxminus(j,:,k),sxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      sy(j,:,k),syminus(j,:,k),syplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      sz(j,:,k),szminus(j,:,k),szplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 if(evolve_mhd.ne.0) then
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bconsx(j,:,k),Bconsxminus(j,:,k),Bconsxplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bconsy(j,:,k),Bconsyminus(j,:,k),Bconsyplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                    call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                         Bconsz(j,:,k),Bconszminus(j,:,k),Bconszplus(j,:,k),&
                         trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 end if
              else
                 !$OMP CRITICAL
                 call CCTK_WARN(0, "Variable type to reconstruct not recognized.")
                 !$OMP END CRITICAL
              end if

              if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      psidc(j,:,k),psidcminus(j,:,k),psidcplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
              endif

              do i = 1, cctk_lsh(2)
                 if (trivial_rp(j,i,k)) then
                    SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
                 else
                    SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
                 end if
              end do
           end do
        end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 3) then
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 velx(j,k,:),velxminus(j,k,:),velxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 vely(j,k,:),velyminus(j,k,:),velyplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 velz(j,k,:),velzminus(j,k,:),velzplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bvecx(j,k,:),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bvecy(j,k,:),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bvecz(j,k,:),Bveczminus(j,k,:),Bveczplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 dens(j,k,:),densminus(j,k,:),densplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sx(j,k,:),sxminus(j,k,:),sxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sy(j,k,:),syminus(j,k,:),syplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sz(j,k,:),szminus(j,k,:),szplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsx(j,k,:),Bconsxminus(j,k,:),Bconsxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsy(j,k,:),Bconsyminus(j,k,:),Bconsyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsz(j,k,:),Bconszminus(j,k,:),Bconszplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else
            !$OMP CRITICAL
            call CCTK_WARN(0, "Variable type to reconstruct not recognized.")
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                  psidc(j,k,:),psidcminus(j,k,:),psidcplus(j,k,:),&
                  trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
          endif

          do i = 1, cctk_lsh(3)
            if (trivial_rp(j,k,i)) then
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else
      call CCTK_WARN(0, "Flux direction not x,y,z")
    end if
  else
    call CCTK_ERROR("Reconstruction method not recognized!")
    STOP
  end if

  deallocate(trivial_rp)
  deallocate(lbetax, lbetay, lbetaz)
  deallocate(dum, dump, dumm)

  !$OMP PARALLEL WORKSHARE
  where ( (rhoplus < GRHydro_rho_min).or.(rhominus < GRHydro_rho_min).or.&
          (epsplus < 0.d0).or.(epsminus < 0.d0) )
    rhoplus = rho
    rhominus = rho
    velxplus = vel(:,:,:,1)
    velxminus = vel(:,:,:,1)
    velyplus = vel(:,:,:,2)
    velyminus = vel(:,:,:,2)
    velzplus = vel(:,:,:,3)
    velzminus = vel(:,:,:,3)
    epsplus = eps
    epsminus = eps
  end where
  !$OMP END PARALLEL WORKSHARE

  if (evolve_tracer .ne. 0) then
    if (use_min_tracer .ne. 0) then
      local_min_tracer = min_tracer
    else
      local_min_tracer = 0d0
    end if
   
    !$OMP PARALLEL WORKSHARE
    where( (tracerplus  .le. local_min_tracer).or.&
           (tracerminus .le. local_min_tracer) )
      tracerplus = tracer
      tracerminus = tracer
    end where
    !$OMP END PARALLEL WORKSHARE
    ! Call the conserved tracer routine in any case because (accord. to
    ! Christian Ott) this is the only way this works
    call Prim2ConservativeTracer(CCTK_PASS_FTOF)
  endif

  if (CCTK_EQUALS(recon_vars,"primitive").or.&
       CCTK_EQUALS(recon_method,"ppm")) then
     if(evolve_mhd.ne.0) then
        call Prim2ConservativePolytypeM(CCTK_PASS_FTOF)
     else
        call Prim2ConservativePolytype(CCTK_PASS_FTOF)
     endif
  else if (CCTK_EQUALS(recon_vars,"conservative")) then
     if(evolve_mhd.ne.0) then
        call Con2PrimBoundsPolytype(CCTK_PASS_FTOF)
     else
        call Con2PrimBoundsPolytype(CCTK_PASS_FTOF)
     endif
  else
     call CCTK_ERROR("Variable type to reconstruct not recognized.")
     STOP
  end if
  
  return
  
end subroutine ReconstructionPolytype


```

GRHydro_Con2PrimM_polytype_pt.c:
```
/***********************************************************************************
    Copyright 2006 Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, 
                   and Luca Del Zanna.

                        PVS_GRMHD

    This file was derived from PVS_GRMHD.  The authors of PVS_GRMHD include 
    Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, and Luca Del Zanna.
    PVS_GRMHD is available under the GPL from:
    http://rainman.astro.uiuc.edu/codelib/  

    You are morally obligated to cite the following  paper in his/her 
    scientific literature that results from use of this file:

    [1] Noble, S. C., Gammie, C. F., McKinney, J. C., \& Del Zanna, L. \ 2006, 
        Astrophysical Journal, 641, 626.

    PVS_GRMHD 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.

    PVS_GRMHD 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 PVS_GRMHD; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

    If the user has any questions, please direct them to Scott C. Noble at 
    scn@astro.rit.edu  . 

***********************************************************************************/



#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <float.h>
#include <complex.h>

#include "cctk.h"

/* Set this to be 1 if you want debug output */
#define DEBUG_CON2PRIMM (0)


/* Adiabatic index used for the state equation */

#define MAX_NEWT_ITER   (30)       /* Max. # of Newton-Raphson iterations for find_root_2D(); */
#define NEWT_TOL        (1.0e-10)  /* Min. of tolerance allowed for Newton-Raphson iterations */
#define MIN_NEWT_TOL    (1.0e-10)  /* Max. of tolerance allowed for Newton-Raphson iterations */
#define EXTRA_NEWT_ITER (2)

#define NEWT_TOL2       (1.0e-15)  /* TOL of new 1D^*_{v^2} gnr2 method */
#define MIN_NEWT_TOL2   (1.0e-10)  /* TOL of new 1D^*_{v^2} gnr2 method */

#define W_TOO_BIG        (1.e20)    /* \gamma^2 (\rho_0 + u + p) is assumed
                                      to always be smaller than this.  This
                                      is used to detect solver failures */

#define FAIL_VAL        (1.e30)    /* Generic value to which we set variables when a problem arises */

/**************************************************
  The following functions assume a Gamma-law EOS:
***************************************************/

/* Local Globals */
struct LocGlob {
  CCTK_REAL Bsq,QdotBsq,Qtsq,D;
  CCTK_REAL W_for_gnr2, rho_for_gnr2, W_for_gnr2_old, rho_for_gnr2_old;
  CCTK_REAL t4,t7,t24,two_Bsq,t300,t400,s200,s100;
} ;


// Declarations: 
static CCTK_INT oned_newton_raphson( CCTK_REAL x[], CCTK_INT n, CCTK_REAL gammaeos, struct LocGlob *lgp,
                                     void (*funcd) (CCTK_REAL [], CCTK_REAL [], 
                                                    CCTK_REAL [], CCTK_REAL [][1], 
                                                    CCTK_REAL *, CCTK_REAL *, CCTK_INT, CCTK_REAL, 
                                                    struct LocGlob *lgp) );

static  void func_W( CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], CCTK_REAL [][1], 
                     CCTK_REAL *f, CCTK_REAL *df, CCTK_INT n, CCTK_REAL gammaeos, 
                     struct LocGlob * lgp);

static CCTK_INT gnr2( CCTK_REAL x[], CCTK_INT n, CCTK_REAL gammaeos, struct LocGlob *lgp,
                            void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                           CCTK_REAL [][1],CCTK_REAL *,CCTK_REAL *,CCTK_INT, CCTK_REAL,
                                           struct LocGlob *lgp) );

static void func_rho(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                     CCTK_REAL jac[][1], CCTK_REAL *f, CCTK_REAL *df, CCTK_INT n, CCTK_REAL gammaeos, 
                     struct LocGlob *lgp);

void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_Polytype_pt) (
    CCTK_INT  *handle, CCTK_REAL *gamma_eos, 
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *sc_in, 
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *det,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval);

/**********************************************************************/
/**********************************************************************************

  Con2PrimM_Polytype_pt():
  -----------------------------

   -- Attempts an inversion from GRMHD conserved variables to primitive variables assuming a guess.

   -- Uses the 2D method of Noble et al. (2006): 
       -- Solves for two independent variables (W,v^2) via a 2D
          Newton-Raphson method 
       -- Can be used (in principle) with a general equation of state. 

   -- Minimizes two residual functions using a homemade Newton-Raphson routine. 
       -- It is homemade so that it can catch exceptions and handle them correctly, plus it is 
          optimized for this particular  problem. 

  -- Note that the notation used herein is that of Noble et al. (2006) except for the argument 
     list. 


INPUT:  (using GRHydro variable defintions)

   s[x,y,z]   =  scons[0,1,2]  = \alpha \sqrt(\gamma) T^0_i 
   dens       =  as defined in GRHydro and are assumed to be densitized (i.e. with sqrt(\gamma))   
   dens       =  D = \sqrt(\gamma) W \rho    
   sc_in      =  K D, where K is the polytropic constant
   g[x,y,z][x,y,x] = spatial metric corresponding to \gamma 
   u[x,y,z][x,y,z] = inverse of the spatial metric, g[x,y,z][x,y,x]
   det        =  sqrt(\gamma)
   B[x,y,z]   =  Bvec[0,1,2] 
   bsq        = b^\mu b_\mu  

   epsnegative = (integer)
               = 0  if rho and epsilon are positive
              != 0  otherwise 


  --  (users should set B[x,y,z] = 0  for hydrodynamic runs) 


OUTPUT:  (using GRHydro variable defintions)
   rho, eps   =  as defined in GRHydro, primitive variables
   vel[x,y,z] =  as defined in GRHydro, primitive variables


RETURN VALUE: of retval = (i*100 + j)  where 
         i = 0 ->  Newton-Raphson solver either was not called (yet or not used) 
                   or returned successfully;
             1 ->  Newton-Raphson solver did not converge to a solution with the 
                   given tolerances;
             2 ->  Newton-Raphson procedure encountered a numerical divergence 
                   (occurrence of "nan" or "+/-inf" ;
             
         j = 0 -> success 
             1 -> failure: some sort of failure in Newton-Raphson; 
             2 -> failure: unphysical vsq = v^2  value at initial guess;
             3 -> failure: W<0 or W>W_TOO_BIG
             4 -> failure: v^2 > 1 
             ( used to be  5 -> failure: rho,uu <= 0   but now sets epsnegative to non-zero )

**********************************************************************************/
void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_Polytype_pt)  ( 
    CCTK_INT  *handle, CCTK_REAL *gamma_eos, 
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *sc_in,
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval)

{
  CCTK_REAL x_1d[1];
  CCTK_REAL sx, sy, sz;
  CCTK_REAL usx, usy, usz;
  CCTK_REAL dens, gammaeos;
  CCTK_REAL QdotB,utsq,gamma_sq;
  CCTK_REAL rho0,u,p,w,gammasq,gamma,W_last,W,vsq;
  CCTK_REAL g_o_WBsq, QdB_o_W;
  CCTK_REAL rho_g, x_rho[1];
  CCTK_REAL sqrt_detg = *sdet;
  CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; 
  CCTK_REAL t2, rho_gm1;
  CCTK_INT  i_increase,ntries ;

  struct LocGlob lg;


  /* Assume ok initially: */
  *retval = 0.;
  *epsnegative = 0; 

  gammaeos = *gamma_eos;

#if(DEBUG_CON2PRIMM)
  fprintf(stdout," *dens        = %26.16e \n", *dens_in         );
  fprintf(stdout," *sx                 = %26.16e \n", *sx_in           );    
  fprintf(stdout," *sy          = %26.16e \n", *sy_in            );    
  fprintf(stdout," *sz                 = %26.16e \n", *sz_in           );    
  fprintf(stdout," *Sc                 = %26.16e \n", *sc_in           );    
  fprintf(stdout," *Bconsx         = %26.16e \n", *Bconsx_in );    
  fprintf(stdout," *Bconsy         = %26.16e \n", *Bconsy_in );    
  fprintf(stdout," *Bconsz         = %26.16e \n", *Bconsz_in );    
  fprintf(stdout," *rho         = %26.16e \n", *rho           );    
  fprintf(stdout," *velx        = %26.16e \n", *velx           );    
  fprintf(stdout," *vely        = %26.16e \n", *vely          );    
  fprintf(stdout," *velz        = %26.16e \n", *velz          );    
  fprintf(stdout," *epsilon     = %26.16e \n", *epsilon     );
  fprintf(stdout," *pressure    = %26.16e \n", *pressure    );
  fprintf(stdout," *Bx                 = %26.16e \n", *Bx           );    
  fprintf(stdout," *By                 = %26.16e \n", *By           );    
  fprintf(stdout," *Bz                 = %26.16e \n", *Bz           );    
  fprintf(stdout," *bsq                = %26.16e \n", *bsq          );    
  fprintf(stdout," *w_lorentz   = %26.16e \n", *w_lorentz   );
  fprintf(stdout," *gxx         = %26.16e \n", *gxx           );    
  fprintf(stdout," *gxy         = %26.16e \n", *gxy           );    
  fprintf(stdout," *gxz         = %26.16e \n", *gxz           );    
  fprintf(stdout," *gyy         = %26.16e \n", *gyy           );    
  fprintf(stdout," *gyz         = %26.16e \n", *gyz           );    
  fprintf(stdout," *gzz         = %26.16e \n", *gzz           );    
  fprintf(stdout," *uxx         = %26.16e \n", *uxx           );    
  fprintf(stdout," *uxy         = %26.16e \n", *uxy           );    
  fprintf(stdout," *uxz                = %26.16e \n", *uxz          );    
  fprintf(stdout," *uyy         = %26.16e \n", *uyy           );    
  fprintf(stdout," *uyz         = %26.16e \n", *uyz           );    
  fprintf(stdout," *uzz                = %26.16e \n", *uzz          );    
  fprintf(stdout," *sdet                = %26.16e \n", *sdet          );    
  fprintf(stdout," *epsnegative = %10d    \n", *epsnegative );
  fprintf(stdout," *retval      = %26.16e \n", *retval      );
  fflush(stdout);
#endif

  /* First undensitize all conserved variables : */
  sx   = (  *sx_in)   * inv_sqrt_detg;
  sy   = (  *sy_in)   * inv_sqrt_detg;
  sz   = (  *sz_in)   * inv_sqrt_detg;
  dens = (*dens_in)   * inv_sqrt_detg;

  usx  =  (*uxx)*sx + (*uxy)*sy + (*uxz)*sz;
  usy  =  (*uxy)*sx + (*uyy)*sy + (*uyz)*sz;
  usz  =  (*uxz)*sx + (*uyz)*sy + (*uzz)*sz;

  *Bx = (*Bconsx_in) * inv_sqrt_detg; 
  *By = (*Bconsy_in) * inv_sqrt_detg; 
  *Bz = (*Bconsz_in) * inv_sqrt_detg; 

  // Calculate various scalars (Q.B, Q^2, etc)  from the conserved variables:
  
  lg.Bsq = 
    (*gxx) * (*Bx) * (*Bx) + 
    (*gyy) * (*By) * (*By) + 
    (*gzz) * (*Bz) * (*Bz) + 
    2*( 
       (*gxy) * (*Bx) * (*By) +
       (*gxz) * (*Bx) * (*Bz) +
       (*gyz) * (*By) * (*Bz) );
    
  QdotB = (sx * (*Bx) + sy * (*By) + sz * (*Bz)) ;
  lg.QdotBsq = QdotB*QdotB ;

  lg.Qtsq = (usx * sx  +  usy * sy  +  usz * sz) ;

  lg.D = dens;

  t2 = lg.D*lg.D;
  lg.t4 = lg.QdotBsq*t2;
  lg.t7 = lg.Bsq*lg.Bsq;
  lg.t24 = 1/t2;
  lg.two_Bsq = lg.Bsq + lg.Bsq;
  lg.t300 = lg.QdotBsq*lg.Bsq*t2;
  lg.t400 = lg.Qtsq*t2;

  lg.s200 = lg.D*gammaeos*(*sc_in);
  CCTK_REAL g_o_gm1 = (gammaeos/(gammaeos-1.));
  lg.s100 = g_o_gm1*(*sc_in);

  /* calculate W from last timestep and use for guess */
  vsq = 
    (*gxx) * (*velx) * (*velx) + 
    (*gyy) * (*vely) * (*vely) + 
    (*gzz) * (*velz) * (*velz) + 
    2*( 
       (*gxy) * (*velx) * (*vely) +
       (*gxz) * (*velx) * (*velz) +
       (*gyz) * (*vely) * (*velz) );

  if( (vsq < 0.) && (fabs(vsq) < 1.0e-13) ) { 
    vsq = fabs(vsq);
  }
  if(vsq < 0. || vsq > 1. ) {
    *retval = 2.;
    return;
  }

  gammasq = 1. / (1. - vsq);
  gamma  = sqrt(gammasq);
        
  // Always calculate rho from D and gamma so that using D in EOS remains consistent
  //   i.e. you don't get positive values for dP/d(vsq) . 
  rho0 = lg.D / gamma ;
  CCTK_REAL gm1 = gammaeos-1.;
  rho_gm1 = pow(rho0,gm1);
  p = (*sc_in) * rho_gm1 / gamma; 
  u = p / gm1;
  w = rho0 + u + p ;

  W_last = w*gammasq ;


  // Make sure that W is large enough so that v^2 < 1 : 
  i_increase = 0;
  while( (( W_last*W_last*W_last * ( W_last + 2.*lg.Bsq ) 
            - lg.QdotBsq*(2.*W_last + lg.Bsq) ) <= W_last*W_last*(lg.Qtsq-lg.Bsq*lg.Bsq))
         && (i_increase < 10) ) {
    W_last *= 10.;
    i_increase++;
  }

  lg.W_for_gnr2 = lg.W_for_gnr2_old = W_last;
  lg.rho_for_gnr2 = lg.rho_for_gnr2_old = rho0;

  // Calculate W: 
  x_1d[0] = W_last;

  *retval = 1.0*oned_newton_raphson( x_1d, 1, gammaeos, &lg, func_W ) ;  

  W = x_1d[0];
        
  /* Problem with solver, so return denoting error before doing anything further */
  if( ((*retval) != 0.) || (W == FAIL_VAL) ) {
    *retval = *retval*100.+1.;
    return;
  }
  else{
    if(W <= 0. || W > W_TOO_BIG) {
      *retval = 3.;
      return;
    }
  }

  rho_g = x_rho[0] = lg.rho_for_gnr2; 

  ntries = 0;
  while (  (*retval = gnr2( x_rho, 1, gammaeos, &lg, func_rho)) &&  ( ntries++ < 10 )  ) { 
    rho_g *= 10.;
    x_rho[0] = rho_g;
  }

  lg.rho_for_gnr2 = x_rho[0];

  if( (*retval != 0) ) {
    *retval = 10;
    return;
  }

  // Calculate v^2 : 
  rho0 = lg.rho_for_gnr2;
  rho_gm1 = pow(rho0,gm1);

  utsq = (lg.D-rho0)*(lg.D+rho0)/(rho0*rho0);

  gamma_sq = 1.+utsq;
  gamma = sqrt(gamma_sq);

  // Calculate v^2:
  if( vsq >= 1. ) {
    *retval = 4.;
    return;
  }

  // Recover the primitive variables from the scalars and conserved variables:
  
  w = W / gamma_sq;
  
  //  printf("doublecheck - S, rho, gamma: %e %e %e\n",*sc_in, rho_gm1,gamma);

  p = (*sc_in) * inv_sqrt_detg * rho_gm1 / gamma;

  u = p / gm1;

  // User may want to handle this case differently, e.g. do NOT return upon 
  // a negative rho/u, calculate v^i so that rho/u can be floored by other routine:
  if( (rho0 <= 0.) || (u <= 0.) ) { 
    *epsnegative = 1; 
    return;
  }

  *rho = rho0;
  *epsilon = u / rho0;
  *w_lorentz = gamma; 
  *pressure = p ; 

  g_o_WBsq = 1./(W+lg.Bsq);
  QdB_o_W  = QdotB / W; 
  *bsq = lg.Bsq * (1.-vsq) + QdB_o_W*QdB_o_W;

  *velx = g_o_WBsq * ( usx + QdB_o_W*(*Bx) ) ;
  *vely = g_o_WBsq * ( usy + QdB_o_W*(*By) ) ;
  *velz = g_o_WBsq * ( usz + QdB_o_W*(*Bz) ) ;


#if(DEBUG_CON2PRIMM)
  fprintf(stdout,"rho          = %26.16e \n",*rho      );
  fprintf(stdout,"epsilon      = %26.16e \n",*epsilon  );
  fprintf(stdout,"pressure     = %26.16e \n",*pressure );
  fprintf(stdout,"w_lorentz    = %26.16e \n",*w_lorentz);
  fprintf(stdout,"bsq          = %26.16e \n",*bsq      );
  fprintf(stdout,"velx         = %26.16e \n",*velx     );
  fprintf(stdout,"vely         = %26.16e \n",*vely     );
  fprintf(stdout,"velz         = %26.16e \n",*velz     );
  fprintf(stdout,"gam          = %26.16e \n",gammaeos       );
  fflush(stdout);
#endif

  /* done! */
  return;

}


#if(DEBUG_CON2PRIMM)
/********************************************************************

  validate_x(): 
           
    -- makes sure that x[0,1] have physical values, based upon 
       their definitions:
    
*********************************************************************/

static void validate_x(CCTK_REAL x[2], CCTK_REAL x0[2] ) 
{
  
  const CCTK_REAL dv = 1.e-15;

  /* Always take the absolute value of x[0] and check to see if it's too big:  */ 
  x[0] = fabs(x[0]);
  x[0] = (x[0] > W_TOO_BIG) ?  x0[0] : x[0];
  
  x[1] = (x[1] < 0.) ?   0.       : x[1];  /* if it's too small */
  x[1] = (x[1] > 1.) ?  (1. - dv) : x[1];  /* if it's too big   */

  return;

}
#endif

/************************************************************

  oned_newton_raphson(): 

    -- performs Newton-Rapshon method on an 2d system.

    -- inspired in part by Num. Rec.'s routine newt();

*****************************************************************/
static CCTK_INT oned_newton_raphson( CCTK_REAL x[], CCTK_INT n, CCTK_REAL gammaeos, struct LocGlob *lgp,
                                   void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                                  CCTK_REAL [][1], CCTK_REAL *, 
                                                  CCTK_REAL *, CCTK_INT, CCTK_REAL, struct LocGlob *) )
{
  CCTK_REAL f, df, dx[1], x_old[1], resid[1], 
    jac[1][1];
  CCTK_REAL errx, x_orig[1];
  CCTK_INT    n_iter, i_extra, doing_extra;

  CCTK_INT   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ; 
  df = f = 1.;
  i_extra = doing_extra = 0;
  //-fast  for( id = 0; id < n ; id++)  x_old[id] = x_orig[id] = x[id] ;
  x_old[0] = x_orig[0] = x[0] ;

  n_iter = 0;


  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) { 

    (*funcd) (x, dx, resid, jac, &f, &df, n, gammaeos, lgp);  /* returns with new dx, f, df */

    /* Save old values before calculating the new: */
    errx = 0.;

    //-fast    for( id = 0; id < n ; id++) { x_old[id] = x[id] ;  }
    x_old[0] = x[0] ;

    /* don't use line search : */
    //-fast    for( id = 0; id < n ; id++) { x[id] += dx[id]  ;  }
    x[0] += dx[0]  ;

//    //METHOD specific:
//    i_increase = 0;
//    while( (( x[0]*x[0]*x[0] * ( x[0] + 2.*lgp->Bsq ) - 
//              lgp->QdotBsq*(2.*x[0] + lgp->Bsq) ) <= x[0]*x[0]*(lgp->Qtsq-lgp->Bsq*lgp->Bsq))
//           && (i_increase < 10) ) {
//      x[0] -= (1.*i_increase) * dx[0] / 10. ;
//      i_increase++;
//    }

    /****************************************/
    /* Calculate the convergence criterion */
    /****************************************/

    /* For the new criterion, always look at error in "W" : */
    // METHOD specific:
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]);


    /****************************************/
    /* Make sure that the new x[] is physical : */
    /****************************************/
    x[0] = fabs(x[0]);


    /*****************************************************************************/
    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*  before stopping                                                          */
    /*****************************************************************************/
    
    if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 1;
    }

    if( doing_extra == 1 ) i_extra++ ;

    if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) || 
        (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }   // END of while(keep_iterating)


  /*  Check for bad untrapped divergences : */
  if( (!finite(f)) || (!finite(df)) || (!finite(x[0]))  ) {
#if(DEBUG_CON2PRIMM)
    fprintf(stderr,"\ngnr not finite, f,df,x_o,x,W_o,W,rho_o,rho = %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e \n",
                f,df,x[0],x_old[0],lgp->W_for_gnr2_old,lgp->W_for_gnr2,lgp->rho_for_gnr2_old,lgp->rho_for_gnr2); fflush(stderr); 
#endif
    return(2);
  }

  if( fabs(errx) <= NEWT_TOL ){
    return(0);
  }
  else if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){
    return(0);
  }
  else {
    return(1);
  } 

  

}


/**********************************************************************/
/*********************************************************************************
   func_W()

        -- calculates the residuals, and Newton step for general_newton_raphson();
        -- for this method, x=W here;

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/
static void func_W(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                   CCTK_REAL jac[][1], CCTK_REAL *f, CCTK_REAL *df, CCTK_INT n, CCTK_REAL gammaeos, 
                   struct LocGlob *lgp)
{
  CCTK_INT retval, ntries;
  CCTK_REAL  W, x_rho[1], rho, rho_g ;
  CCTK_REAL  t15,   t200,t1000, drho_dW, rho_gm1 ;
  
  W  = x[0];
  lgp->W_for_gnr2_old = lgp->W_for_gnr2;
  lgp->W_for_gnr2 = W;

  // get rho from NR:
  rho_g = x_rho[0] = lgp->rho_for_gnr2;
  
  ntries = 0;
  while (  (retval = gnr2( x_rho, 1, gammaeos, lgp, func_rho)) &&  ( ntries++ < 10 )  ) { 
    rho_g *= 10.;
    x_rho[0] = rho_g;
  }

#if(DEBUG_CON2PRIMM)
  if( x_rho[0] <= 0. ) { 
    fprintf(stderr,"gnr2 neg rho = %d ,rho_n,rho,rho_o,W,W_o = %26.20e %26.20e %26.20e %26.20e %26.20e \n", retval, x_rho[0], lgp->rho_for_gnr2, lgp->rho_for_gnr2_old, x[0], lgp->W_for_gnr2_old);
    fflush(stderr);
  }
  
  if( retval ) { 
    fprintf(stderr,"gnr2 retval = %d ,rho_n,rho,rho_o,W,W_o = %26.20e %26.20e %26.20e %26.20e %26.20e \n", retval, x_rho[0], lgp->rho_for_gnr2, lgp->rho_for_gnr2_old, x[0], lgp->W_for_gnr2_old);
    fflush(stderr);
  }
#endif 

  lgp->rho_for_gnr2_old = lgp->rho_for_gnr2; 
  rho = lgp->rho_for_gnr2 = x_rho[0];

  CCTK_REAL gm1 = gammaeos-1.;

  rho_gm1 = pow(rho,gm1);
  drho_dW = -rho*rho/( -rho_gm1*lgp->s200 + W*rho);

  t15 = -(lgp->D-rho)*(lgp->D+rho);  // t6-t2
  t200 = W + lgp->two_Bsq;
  t1000 = rho*drho_dW;
  resid[0] = (lgp->t300+(lgp->t4+lgp->t4+(lgp->t400+t15*(lgp->t7+(t200)*W))*W)*W)*lgp->t24;
  jac[0][0] = 2*(lgp->t4+(lgp->t400+t15*lgp->t7+(3.0*t15*lgp->Bsq+lgp->t7*t1000+(t15+t15+t1000*(t200))*W)*W)*W)*lgp->t24;

  dx[0] = -resid[0]/jac[0][0];

  *df = - resid[0]*resid[0];
  *f = -0.5*(*df);


//  fprintf(stdout,"QdotBsq = %28.18e ; \n",lgp->QdotBsq );
//  fprintf(stdout,"Sc      = %28.18e ; \n",Sc     );
//  fprintf(stdout,"Bsq     = %28.18e ; \n",lgp->Bsq     );
//  fprintf(stdout,"Qtsq    = %28.18e ; \n",lgp->Qtsq    );
//  fprintf(stdout,"Dc      = %28.18e ; \n",lgp->D       );
//  fprintf(stdout,"drhodW  = %28.18e ; \n",drho_dW  );
//  fprintf(stdout,"W       = %28.18e ; \n",W       );
//  fprintf(stdout,"rho     = %28.18e ; \n",rho     );
//  fprintf(stdout,"resid_W = %28.18e ; \n",resid[0] );
//  fprintf(stdout,"jac_W   = %28.18e ; \n",jac[0][0]);
//  fprintf(stdout,"deriv1 %g %g %g %g \n",W,resid[0],jac[0][0],dx[0]);

  return;

}


/***********************************************************/
/********************************************************************** 

  gnr2()

    -- used to calculate rho from W

*****************************************************************/
static CCTK_INT gnr2( CCTK_REAL x[], CCTK_INT n, CCTK_REAL gammaeos, struct LocGlob *lgp,
                            void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                           CCTK_REAL [][1],CCTK_REAL *,CCTK_REAL *,CCTK_INT,CCTK_REAL, struct LocGlob *lgp) )
{
  CCTK_REAL f, df, dx[1], x_old[1], resid[1], 
    jac[1][1];
  CCTK_REAL errx, x_orig[1];
  CCTK_INT    n_iter, i_extra, doing_extra;
  

  CCTK_INT   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ; 
  df = f = 1.;
  i_extra = doing_extra = 0;
  //-fast  for( id = 0; id < n ; id++)  x_old[id] = x_orig[id] = x[id] ;
  x_old[0] = x_orig[0] = x[0] ;

  n_iter = 0;


  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) { 

    (*funcd) (x, dx, resid, jac, &f, &df, n,gammaeos, lgp);  /* returns with new dx, f, df */

    /* Save old values before calculating the new: */
    //-fast  errx = 0.;
    //-fast    for( id = 0; id < n ; id++) { x_old[id] = x[id] ;  }
    x_old[0] = x[0] ;  

    /* Make the newton step: */
    //-fast    for( id = 0; id < n ; id++) { x[id] += dx[id] ;  }
    x[0] += dx[0] ;

    /* Calculate the convergence criterion */
    //-fast    for( id = 0; id < n ; id++) { errx  += (x[id]==0.) ?  fabs(dx[id]) : fabs(dx[id]/x[id]); }
    //-fast    errx /= 1.*n;
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]); 

    /* Make sure that the new x[] is physical : */
    // METHOD specific:
    x[0] = fabs(x[0]);


    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*   before stopping                                                         */
    if( (fabs(errx) <= NEWT_TOL2) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 0;
    }

    if( doing_extra == 1 ) i_extra++ ;

    // See if we've done the extra iterations, or have done too many iterations:
    if( ((fabs(errx) <= NEWT_TOL2)&&(doing_extra == 0)) || 
        (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }  


  /*  Check for bad untrapped divergences : */
  if( (!finite(f)) || (!finite(df)) || (!finite(x[0]))  ) {
#if(DEBUG_CON2PRIMM)
    fprintf(stderr,"\ngnr2 not finite, f,df,x_o,x,W_o,W,rho_o,rho = %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e %26.20e \n",
                f,df,x[0],x_old[0],lgp->W_for_gnr2_old,lgp->W_for_gnr2,lgp->rho_for_gnr2_old,lgp->rho_for_gnr2); fflush(stderr); 
#endif
    return(2);
  }
  
  // Return in different ways depending on whether a solution was found:
  if( fabs(errx) <= NEWT_TOL ){
    return(0);
  }
  else if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){
    return(0);
  }
  else {
    return(1);
  } 

  

}

/*********************************************************************************
   func_rho():

        -- residual/jacobian routine to calculate rho from W via the polytrope:

        W  =  ( 1 + GAMMA * K_atm * rho^(GAMMA-1)/(GAMMA-1) ) D^2 / rho

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/
// for the isentropic version:   eq.  (27)
static void func_rho(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                     CCTK_REAL jac[][1], CCTK_REAL *f, CCTK_REAL *df, CCTK_INT n, CCTK_REAL gammaeos, 
                     struct LocGlob *lgp)
{

  CCTK_REAL rho, W;
  CCTK_REAL t40,t14;
  
  CCTK_REAL gm1 = gammaeos-1.;

  rho = x[0];
  W = lgp->W_for_gnr2;

  t40 = pow(rho,gm1);

  resid[0] = (rho*W+(-t40*lgp->s100-lgp->D)*lgp->D);
  t14 = t40/rho;  // rho^(g-2)
  jac[0][0] = -t14*lgp->s200 + W;
  //  drho_dW = -rho/jac[0][0];

  dx[0] = -resid[0]/jac[0][0];
  *df = - resid[0]*resid[0];
  *f = -0.5*(*df);

  //  fprintf(stdout,"deriv3 %g %g %g %g %g \n",rho,W,resid[0],jac[0][0],dx[0]);
//  fprintf(stdout,"Dc        := %28.18e ; \n",lgp->D);
//  fprintf(stdout,"Sc        := %28.18e ; \n",Sc);
//  fprintf(stdout,"rho       := %28.18e ; \n",rho);
//  fprintf(stdout,"W         := %28.18e ; \n",W);
//  fprintf(stdout,"resid_rho := %28.18e ; \n",resid[0] );
//  fprintf(stdout,"jac_rho   := %28.18e ; \n",jac[0][0] );

  return;

}


/****************************************************************************** 
             END   
 ******************************************************************************/


#undef DEBUG_CON2PRIMM

```

Utils.F90:
```
 /*@@
   @file      Utils.F
   @date      Sat Jan 26 02:28:46 2002
   @author    
   @desc 
   Utility functions for other thorns. Calculation of the determinant
   of the spatial metric and the upper metric.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.h"

 /*@@
   @routine    GRHydro_RefinementLevel
   @date       July 2005
   @author     
   @desc 
   Calculates the current refinement level from flesh data
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 
@@*/

subroutine GRHydro_Debug(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  integer i,j,k
  integer nx, ny, nz

  GRHydro_reflevel = int(log10(dble(cctk_levfac(1)))/log10(2.0d0))
  
  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  if (GRHydro_reflevel .lt. 3) return
 
  do i=4,nx
     do j=4,ny
        do k=4,4
           if( r(i,j,k)-4.0d0 .lt. 96.0d0 .and. &
                r(i,j,k)+4.0d0 .gt. 96.0d0) then
              write(6,"(4i4,1P10E15.6)") GRHydro_reflevel, i,j,k,&
                   r(i,j,k),rho(i,j,k),eps(i,j,k),y_e(i,j,k),temperature(i,j,k)
           endif
        enddo
     enddo
  enddo

!  call flush(6)
!  if(GRHydro_reflevel.eq.4.and.temperature(1,1,1).lt.0.1d0) then
!     call CCTK_EROR("stop")
!     STOP
!  endif

end subroutine GRHydro_Debug


subroutine GRHydro_RefinementLevel(CCTK_ARGUMENTS)

  implicit none
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  GRHydro_reflevel = int(log10(dble(cctk_levfac(1)))/log10(2.0d0))

end subroutine GRHydro_RefinementLevel

subroutine GRHydro_SqrtSpatialDeterminant(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  integer i,j,k
  integer nx, ny, nz

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)

  ! save memory when MP is not used
  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
  end if

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  !$OMP PARALLEL DO PRIVATE(i,j,k)
  do k=1,nz
     do j=1,ny
        do i=1,nx
           sdetg(i,j,k) = -(g13(i,j,k)**2)*g22(i,j,k) + & 
                2.0d0*g12(i,j,k)*g13(i,j,k)*g23(i,j,k) - &
                g11(i,j,k)*(g23(i,j,k)**2) - &
                (g12(i,j,k)**2)*g33(i,j,k)  + &
                (g11(i,j,k)*g22(i,j,k))*g33(i,j,k)
           sdetg(i,j,k) = sqrt(sdetg(i,j,k))
        enddo
     enddo
  enddo
  !$OMP END PARALLEL DO

end subroutine GRHydro_SqrtSpatialDeterminant


subroutine SpatialDeterminant(gxx,gxy,gxz,gyy,gyz,gzz,det)

  implicit none
  
  CCTK_REAL :: det
  CCTK_REAL :: gxx,gxy,gxz,gyy,gyz,gzz

  det = -gxz**2*gyy + 2*gxy*gxz*gyz - gxx*gyz**2 - gxy**2*gzz + gxx*gyy*gzz


!!$  Why is this weird order necessary? Search me. It just seemed 
!!$  to make a really odd NaN go away.

!!$  det =  -gxz**2*gyy + 2*gxy*gxz*gyz 
!!$  det = det - gxx*gyz**2 - gxy**2*gzz
!!$  det = det + gxx*gyy*gzz
  
  return
  
end subroutine SpatialDeterminant



/*@@
@routine    UpperMetric
@date       Sat Jan 26 02:32:26 2002
@author     
@desc 
Calculates the upper metric. The determinant is given, not
calculated.
@enddesc 
@calls     
@calledby   
@history 

@endhistory 
@@*/

subroutine UpperMetric(uxx, uxy, uxz, uyy, uyz, uzz, &
     det, gxx, gxy, gxz, gyy, gyz, gzz)
  
  implicit none
  
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, det, &
       gxx, gxy, gxz, gyy, gyz, gzz, invdet
  
  invdet = 1.d0 / det
  uxx=(-gyz**2 + gyy*gzz)*invdet
  uxy=(gxz*gyz - gxy*gzz)*invdet
  uyy=(-gxz**2 + gxx*gzz)*invdet
  uxz=(-gxz*gyy + gxy*gyz)*invdet
  uyz=(gxy*gxz - gxx*gyz)*invdet
  uzz=(-gxy**2 + gxx*gyy)*invdet
  
  return
  
end subroutine UpperMetric



```

GRHydro_ParamCheck.F90:
```
 /*@@
   @file      GRHydro_ParamCheck.F90
   @date      Sat Feb  9 23:48:01 2002
   @author    
   @desc 
   Parameter checking routine.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydro_ParamCheck
   @date       Sat Feb  9 23:48:43 2002
   @author     Ian Hawke
   @desc 
   Checks the parameters.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_ParamCheck(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  integer :: coordinates_is_active, evolution_mask_idx

  if (GRHydro_stencil > minval(cctk_nghostzones)) then
    call CCTK_PARAMWARN("The stencil is larger than the number of ghost zones. Answer will be dependent on processor number...")
  end if

  if (CCTK_EQUALS(recon_method,"tvd").and.(GRHydro_stencil < 2)) then
    call CCTK_PARAMWARN("The stencil size must be at least 2 to use TVD reconstruction")
  end if
  
  if (CCTK_EQUALS(recon_method,"ppm")) then
    if (CCTK_EQUALS(ppm_flatten,"stencil_3").and.(GRHydro_stencil < 3)) then
      call CCTK_PARAMWARN("The stencil size must be at least 3 to use PPM reconstruction with the stencil-3 variant of the flattening procedure")
    else if (CCTK_EQUALS(ppm_flatten,"stencil_4").and.(GRHydro_stencil < 4)) then
      call CCTK_PARAMWARN("The stencil size must be at least 4 to use PPM reconstruction with the stencil-4 (original) flattening procedure")
    end if
  end if

  if (CCTK_EQUALS(recon_method,"weno").and.(GRHydro_stencil < 3)) then
    call CCTK_PARAMWARN("The stencil size must be at least 3 to use WENO reconstruction.")
  end if

  if (CCTK_EQUALS(recon_method,"mp5").and.(GRHydro_stencil < 3)) then
    call CCTK_PARAMWARN("The stencil size must be at least 3 to use MP5 reconstruction.")
  end if

  if (CCTK_EQUALS(recon_method,"eno").and.(GRHydro_stencil < eno_order)) then
    call CCTK_PARAMWARN("The stencil size must be at least the order of the reconstruction to use ENO reconstruction")
  end if

  if (CCTK_EQUALS(GRHydro_eos_table,"2D_Polytrope").and.&
       (.not.CCTK_EQUALS(GRHydro_eos_type,"Polytype"))) then
    call CCTK_PARAMWARN("When using the 2D_Polytrope EOS you need to set eos_type to Polytype")
  end if

  if (CCTK_EQUALS(GRHydro_eos_table,"Ideal_Fluid").and.&
       (.not.CCTK_EQUALS(GRHydro_eos_type,"General"))) then
    call CCTK_PARAMWARN("When using the Ideal_Fluid EOS you need to set eos_type to General")
  end if

  if (.not.(CCTK_EQUALS(metric_type, "Physical").or.&
       CCTK_EQUALS(metric_type, "Static Conformal"))) then
    call CCTK_ERROR("GRHydro only knows how to deal with physical metric type at the moment. Complain to the maintainers...")
    STOP
  end if
  
  
  if (use_mask .eq. 0) then
    call CCTK_PARAMWARN("GRHydro now requires you to set SpaceMask::use_mask = ""yes""")
  end if

  if (number_of_particles .gt. 0) then
    if (number_of_arrays .ne. 3) then
      call CCTK_PARAMWARN("If tracking particles then you must have number_of_arrays = 3")
    end if
  end if
  ! This check and 'static' as valid keyword option can be removed after the
  ! year 2010
  if (CCTK_EQUALS(bound,"static")) then
    call CCTK_PARAMWARN("GRHydro::bound = 'static' is no longer supported, use 'none' instead");
  end if

  if (CCTK_EQUALS(Bvec_evolution_method,"GRHydro").or.CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec")) then
     evolve_MHD = 1
  else
     evolve_MHD = 0
  endif

  if ( CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec") ) then 
     if ( CCTK_EQUALS(Avec_gauge,"Lorenz") ) then
        evolve_Lorenz_gge = 1
     else
        evolve_Lorenz_gge = 0
     endif
  endif

  if (CCTK_EQUALS(Y_e_evolution_method,"GRHydro")) then
     evolve_Y_e = 1
  else
     evolve_Y_e = 0
  endif

  if (CCTK_EQUALS(temperature_evolution_method,"GRHydro")) then
     evolve_temper = 1
  else
     evolve_temper = 0
  endif

  if (CCTK_EQUALS(entropy_evolution_method,"GRHydro")) then
     evolve_entropy = 1
  else
     evolve_entropy = 0
  endif

  call CCTK_IsImplementationActive(coordinates_is_active, "Coordinates")
  ! this test is somewhat overzealous but we cannot access
  ! coordinates::general_coordinates yet since it is only set in BaseGrid
  if (CCTK_Equals(riemann_solver,"HLLE").eq.0.and.coordinates_is_active.ne.0) then
    call CCTK_ERROR("There is currently no Riemann solver other than HLLE compatible with multipatch!")
    STOP
  end if
  
  if (constrain_to_1D .eq. 1 .and. coordinates_is_active.eq.1) then
    call CCTK_ERROR("Constrain to 1D option does not work with other than Cartesian coordinates. Ask Christian R. to implement it if required!")
    STOP
  endif

  if (CCTK_EQUALS(riemann_solver,"Roe").and.CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then
    call CCTK_PARAMWARN("Roe solver is not implemented yet for MHD")
  end if

  if (CCTK_EQUALS(riemann_solver,"Marquina").and.CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then
    call CCTK_PARAMWARN("Marquina solver is not implemented yet for MHD")
  end if

  
  if(evolve_MHD.ne.0 .and. clean_divergence.ne.0) then
    if (CCTK_EQUALS(psidcspeed,"char speed")) then
      whichpsidcspeed = 0
    else if (CCTK_EQUALS(psidcspeed,"light speed")) then
      whichpsidcspeed = 1
    else if (CCTK_EQUALS(psidcspeed,"set speed")) then
      whichpsidcspeed = 2
    else
      call CCTK_PARAMWARN("Unknown type of speed setting for psidc (psidcspeed)")
    end if
  end if

  if(use_cxx_code.ne.0 .and. evolve_MHD.ne.0) then
    ! C++ code supports only a subset of MHD DC options.
    if(clean_divergence.ne.0) then
      if(whichpsidcspeed.ne.1) then
        call CCTK_PARAMWARN("C++ code only supports psidcspeed == 'light speed'")
      end if
      if(decouple_normal_Bfield.eq.0) then
        call CCTK_PARAMWARN("C++ code requires decouple_normal_Bfield == true")
      end if
    end if
    ! this really should go into RiemannSolverM.F90
    if(.not. CCTK_EQUALS(riemann_solver,"HLLE")) then
        call CCTK_PARAMWARN("C++ code only supports riemnna_solver == 'HLLE'")
    end if
  end if

  if(CCTK_EQUALS(use_evolution_mask, "always")) then
    call CCTK_VarIndex(evolution_mask_idx, "CarpetEvolutionMask::evolution_mask")
    if(evolution_mask_idx .lt.  0) then
      call CCTK_PARAMWARN("You set use_evolution_mask='always' but I cannot find 'CarpetEvolutionMask::evolution_mask'. If you use Carpet, then you should activate thorn 'CarpetEvolutionMask', if using PUGH then evolution_mask makes no sense and you should disable this option.")
    end if
  end if

  if(clean_divergence.ne.0 .and. evolve_MHD.eq.0) then
    call CCTK_WARN(1, "You activated divergence cleaning but do not evolve a magnetic field. At best, nothing should happen, be preapered for a segfault otherwise.")
  end if

  if (Tmunu_damping_radius_min .gt. Tmunu_damping_radius_max) then
     call CCTK_ERROR("Minimum damping radius is greater than maximum damping radius!")
     STOP
  end if

  if(evolve_entropy.ne.0) then
    if(evolve_MHD.eq.0) then
      call CCTK_PARAMWARN("Entropy evolution not properly implemented yet for unmagnetized fluids!")
    end if
    if (CCTK_EQUALS(recon_method,"ppm")) then
      call CCTK_PARAMWARN("Entropy evolution not implemented yet with PPM reconstruction!")
    end if 
  end if

end subroutine GRHydro_ParamCheck


```

GRHydro_PPM.cc:
```
#include <cmath>
#include <algorithm>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#define MIN(a,b) (((a)<(b))?(a):(b))
#define MAX(a,b) (((a)>(b))?(a):(b))

using namespace std;

/*
  Cases that must be considered:
  * basic hydro
  * hydro + temperature + ye
  * hydro + ye
  * basic mhd
  * mhd + temperature + ye 
  * mhd + ye 
  * mppm (not supported right now)
  * not supporting trivial_rp
  * with or without divergence cleaning
 */


static inline void steep(const double * const restrict x, 
			 const double * const restrict dx, 
			 double * const restrict dmx, 
			 const int i) {
  if ( (x[i+1] - x[i]) * (x[i]-x[i-1]) > 0.0 ) {
    dmx[i] = copysign(1.0,dx[i]) * MIN(fabs(dx[i]),
					MIN(2.0*fabs(x[i]-x[i-1]),
					     2.0*fabs(x[i+1]-x[i])));
  } else {
    dmx[i] = 0.0;
  }
}


static inline void monotonize(double* const restrict xminus,
			      const double* const restrict x,
			      double* const restrict xplus,
			      const int i) {

  if (  !(xplus[i]==x[i] && x[i]==xminus[i]) 
	&& ( (xplus[i]-x[i])*(x[i]-xminus[i]) <= 0.0 ) ) 
    {
      xminus[i] = x[i];
      xplus[i] = x[i];
    }  else if( 6.0 * (xplus[i]-xminus[i]) * 
		(x[i]-0.5*(xplus[i]+xminus[i])) >
		(xplus[i]-xminus[i])*(xplus[i]-xminus[i]) )
    {
      xminus[i] = 3.0*x[i]-2.0*xplus[i]; 
    } else if( 6.0 * (xplus[i]-xminus[i]) * 
	       (x[i]-0.5*(xplus[i]+xminus[i])) <
	       -(xplus[i]-xminus[i])*(xplus[i]-xminus[i]) ) 
    {
      xplus[i] = 3.0*x[i]-2.0*xminus[i]; 
    }
  
  return;
}



template<bool do_temp, bool do_ye, bool do_mhd, 
	 bool dc_flag, bool do_ppm_detect>
void GRHydro_ppm1d_cxx(const int nx, 
		      const double dx, 
		      const double* const restrict rho, 
		      const double* const restrict velx,
		      const double* const restrict vely, 
		      const double* const restrict velz, 
		      const double* const restrict eps, 
		      const double* const restrict press,
		      const double* const restrict temp,
		      const double* const restrict ye,
		      const double* const restrict Bvcx,
		      const double* const restrict Bvcy,
		      const double* const restrict Bvcz,
		      const double* const restrict psidc,
		      double* const restrict rhominus, 
		      double* const restrict velxminus, 
		      double* const restrict velyminus,
		      double* const restrict velzminus, 
		      double* const restrict epsminus, 
		      double* const restrict tempminus, 
		      double* const restrict yeminus, 
		      double* const restrict Bvcxminus,
		      double* const restrict Bvcyminus,
		      double* const restrict Bvczminus,
		      double* const restrict psidcminus,
		      double* const restrict rhoplus, 
		      double* const restrict velxplus, 
		      double* const restrict velyplus,
		      double* const restrict velzplus, 
		      double* const restrict epsplus,
		      double* const restrict tempplus, 
		      double* const restrict yeplus,
		      double* const restrict Bvcxplus,
		      double* const restrict Bvcyplus,
		      double* const restrict Bvczplus,
		      double* const restrict psidcplus)
{
  DECLARE_CCTK_PARAMETERS;

  double drho[nx], dpress[nx], deps[nx], d2rho[nx]; 
  double dmrho[nx], dmeps[nx];
  double dmtemp[nx], dmye[nx];
  double dtemp[nx], dye[nx];
  double dvelx[nx], dvely[nx], dvelz[nx];
  double dmvelx[nx], dmvely[nx], dmvelz[nx];
  double dBvcx[nx], dBvcy[nx], dBvcz[nx], dpsidc[nx];
  double dmBvcx[nx], dmBvcy[nx], dmBvcz[nx], dmpsidc[nx];
  double tilde_flatten[nx];
  
  const double onesixth = 1.0/6.0;

  //  Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178
  //  This is the expression for an even grid.
  for(int i=1; i < nx-1; ++i) {
    drho[i]   = 0.5 * (rho[i+1]-rho[i-1]);
    d2rho[i]  = rho[i+1] - 2.0 * rho[i] + rho[i-1];
    dpress[i] = (press[i+1]-press[i-1]);
    deps[i]   = 0.5 * (eps[i+1]-eps[i-1]);
    dvelx[i]  = 0.5 * (velx[i+1]-velx[i-1]);
    dvely[i]  = 0.5 * (vely[i+1]-vely[i-1]);
    dvelz[i]  = 0.5 * (velz[i+1]-velz[i-1]);
    if(do_ye) {
      if(do_temp) {
	dtemp[i]  = 0.5 * (temp[i+1]-temp[i-1]);
      }
      dye[i]    = 0.5 * (ye[i+1]-ye[i-1]);
    }
    if(do_mhd) {
      dBvcx[i]  = 0.5 * (Bvcx[i+1]-Bvcx[i-1]);
      dBvcy[i]  = 0.5 * (Bvcy[i+1]-Bvcy[i-1]);
      dBvcz[i]  = 0.5 * (Bvcz[i+1]-Bvcz[i-1]);
      if(dc_flag) {
	dpsidc[i] = 0.5 * (psidc[i+1]-psidc[i-1]);
      }
    }
  }

  //  Steepened slope. See (1.8) of Colella and Woodward, p.178
  for(int i=1; i<nx-1; ++i) {
    steep(rho,drho,dmrho,i);
    steep(eps,deps,dmeps,i);
    steep(velx,dvelx,dmvelx,i);
    steep(vely,dvely,dmvely,i);
    steep(velz,dvelz,dmvelz,i);
    if(do_ye) {
      if(do_temp) {
	steep(temp,dtemp,dmtemp,i);
      }
      steep(ye,dye,dmye,i);
    }
    if(do_mhd) {
      steep(Bvcx,dBvcx,dmBvcx,i);
      steep(Bvcy,dBvcy,dmBvcy,i);
      steep(Bvcz,dBvcz,dmBvcz,i);
      if(dc_flag) {
	steep(psidc,dpsidc,dmpsidc,i);
      }
    }
  }

  // Initial boundary states. See (1.9) of Colella and Woodward, p.178
  for(int i=1; i<nx-2; ++i) {
    rhoplus[i] = 0.5 * (rho[i] + rho[i+1]) + 
      (dmrho[i] - dmrho[i+1]) * onesixth;
    epsplus[i] = 0.5 * (eps[i] + eps[i+1]) + 
      (dmeps[i] - dmeps[i+1]) * onesixth;
    velxplus[i] = 0.5 * (velx[i] + velx[i+1]) + 
      (dmvelx[i] - dmvelx[i+1]) * onesixth;
    velyplus[i] = 0.5 * (vely[i] + vely[i+1]) + 
      (dmvely[i] - dmvely[i+1]) * onesixth;
    velzplus[i] = 0.5 * (velz[i] + velz[i+1]) + 
      (dmvelz[i] - dmvelz[i+1]) * onesixth;
    if(do_ye) {
      if(do_temp) {
	tempplus[i] = 0.5 * (temp[i] + temp[i+1]) + 
	  (dmtemp[i] - dmtemp[i+1]) * onesixth;
      }
      yeplus[i] = 0.5 * (ye[i] + ye[i+1]) + 
	(dmye[i] - dmye[i+1]) * onesixth;
    }
    if(do_mhd) {
      Bvcxplus[i] = 0.5 * (Bvcx[i] + Bvcx[i+1]) + 
	(dmBvcx[i] - dmBvcx[i+1]) * onesixth;
      Bvcyplus[i] = 0.5 * (Bvcy[i] + Bvcy[i+1]) + 
	(dmBvcy[i] - dmBvcy[i+1]) * onesixth;
      Bvczplus[i] = 0.5 * (Bvcz[i] + Bvcz[i+1]) + 
	(dmBvcz[i] - dmBvcz[i+1]) * onesixth;
      if(dc_flag) {
	psidcplus[i] = 0.5 * (psidc[i] + psidc[i+1]) + 
	  (dmpsidc[i] - dmpsidc[i+1]) * onesixth;
      }
    }
  }

  // fill minus states
  for(int i=1; i<nx-2; ++i) {
    rhominus[i+1] = rhoplus[i];
    epsminus[i+1] = epsplus[i];
    velxminus[i+1] = velxplus[i];
    velyminus[i+1] = velyplus[i];
    velzminus[i+1] = velzplus[i];
    if(do_ye) {
      if(do_temp) {
	tempminus[i+1] = tempplus[i];
      }
      yeminus[i+1] = yeplus[i];
    }
    if(do_mhd) {
      Bvcxminus[i+1] = Bvcxplus[i];
      Bvcyminus[i+1] = Bvcyplus[i];
      Bvczminus[i+1] = Bvczplus[i];
      if(dc_flag) {
	psidcminus[i+1] = psidcplus[i];
      }
    }
  }

  /*
    Discontinuity steepening. See (1.14-17) of C&W.
    This is the detect routine which mat be 
    activated with the ppm_detect parameter
    Note that this part really also depends on the grid being even. 
    Note also that we don''t have access to the gas constant gamma.
    So this is just dropped from eq. (3.2) of C&W.
    We can get around this by just rescaling the constant k0 (ppm_k0 here).
  */

  if(do_ppm_detect) {
    for(int i=2; i<nx-2; ++i) {
      double etatilde = 0.0;
      if ( d2rho[i+1]*d2rho[i-1] < 0.0 
	   && ( fabs(rho[i+1]-rho[i-1]) - ppm_epsilon_shock 
		* MIN(fabs(rho[i+1]), 
		      fabs(rho[i-1])) > 0.0) )
	{
	  etatilde = (rho[i-2] - rho[i+2] + 4.0 * drho[i]) / (drho[i] * 12.0);
	}
      double eta = MAX(0.0, MIN(1.0, ppm_eta1 * (etatilde - ppm_eta2)));
      if (ppm_k0 * fabs(drho[i]) * MIN(press[i-1],press[i+1]) 
	  < fabs(dpress[i]) * MIN(rho[i-1], rho[i+1])) 
	{
	  eta = 0.0;
	}
      rhominus[i] = rhominus[i] * (1.0 - eta) + 
	(rho[i-1] + 0.5 * dmrho[i-1]) * eta;
      rhoplus[i] = rhoplus[i] * (1.0 - eta) + 
	(rho[i+1] - 0.5 * dmrho[i+1]) * eta;
    }
  } 
  
  // flattening
  for(int i=2; i<nx-2; ++i) {
    const double dpress2 = press[i+2] - press[i-2];
    const double dvel = velx[i+1] - velx[i-1];
    double w=0.0;
    if ( (fabs(dpress[i]) >  ppm_epsilon * MIN(press[i-1],press[i+1])) 
	 && (dvel < 0.0) ) 
      {
	w = 1.0;
      } 
    if (fabs(dpress2) < ppm_small) 
      {
	tilde_flatten[i] = 1.0;
      } 
    else
      {
	tilde_flatten[i] = MAX(0.0, 1.0 - w * MAX(0.0, 
			   ppm_omega2 * (dpress[i] / dpress2 - ppm_omega1)));
      }
  } 
  
  for(int i=2; i<nx-2; ++i) {
    const double flatten = tilde_flatten[i];
    rhoplus[i] = flatten * rhoplus[i] + (1.0 - flatten) * rho[i];
    rhominus[i] = flatten * rhominus[i] + (1.0 - flatten) * rho[i];
    epsplus[i] = flatten * epsplus[i] + (1.0 - flatten) * eps[i];
    epsminus[i] = flatten * epsminus[i] + (1.0 - flatten) * eps[i];
    velxplus[i] = flatten * velxplus[i] + (1.0 - flatten) * velx[i];
    velxminus[i] = flatten * velxminus[i] + (1.0 - flatten) * velx[i];
    velyplus[i] = flatten * velyplus[i] + (1.0 - flatten) * vely[i];
    velyminus[i] = flatten * velyminus[i] + (1.0 - flatten) * vely[i];
    velzplus[i] = flatten * velzplus[i] + (1.0 - flatten) * velz[i];
    velzminus[i] = flatten * velzminus[i] + (1.0 - flatten) * velz[i];

    if(do_ye) {
      if(do_temp) {
	tempplus[i] = flatten * tempplus[i] + (1.0 - flatten) * temp[i];
	tempminus[i] = flatten * tempminus[i] + (1.0 - flatten) * temp[i];
      }
      yeplus[i] = flatten * yeplus[i] + (1.0 - flatten) * ye[i];
      yeminus[i] = flatten * yeminus[i] + (1.0 - flatten) * ye[i];
    }

    if(do_mhd) {
      Bvcxplus[i] = flatten * Bvcxplus[i] + (1.0 - flatten) * Bvcx[i];
      Bvcxminus[i] = flatten * Bvcxminus[i] + (1.0 - flatten) * Bvcx[i];
      Bvcyplus[i] = flatten * Bvcyplus[i] + (1.0 - flatten) * Bvcy[i];
      Bvcyminus[i] = flatten * Bvcyminus[i] + (1.0 - flatten) * Bvcy[i];
      Bvczplus[i] = flatten * Bvczplus[i] + (1.0 - flatten) * Bvcz[i];
      Bvczminus[i] = flatten * Bvczminus[i] + (1.0 - flatten) * Bvcz[i];
      if(dc_flag) {
	psidcplus[i] = flatten * psidcplus[i] + (1.0 - flatten) * psidc[i];
	psidcminus[i] = flatten * psidcminus[i] + (1.0 - flatten) * psidc[i];
      }
    }
  } // flattening

  for(int i=GRHydro_stencil-1; i<nx-GRHydro_stencil+1; ++i) {
    monotonize(rhominus,rho,rhoplus,i);
    monotonize(epsminus,eps,epsplus,i);
    monotonize(velxminus,velx,velxplus,i);
    monotonize(velyminus,vely,velyplus,i);
    monotonize(velzminus,velz,velzplus,i);
    if(do_ye) {
      if(do_temp) {
	monotonize(tempminus,temp,tempplus,i);
      }
      monotonize(yeminus,ye,yeplus,i);
    }
    if(do_mhd) {
      monotonize(Bvcxminus,Bvcx,Bvcxplus,i);
      monotonize(Bvcyminus,Bvcy,Bvcyplus,i);
      monotonize(Bvczminus,Bvcz,Bvczplus,i);
      if(dc_flag) {
	monotonize(psidcminus,psidc,psidcplus,i);
      }
    }
  }

  return;
}

//template template<bool do_temp, bool do_ye, bool do_mhd, bool dc_flag, bool do_ppm_detect>
#define INSTANTIATE(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect)			\
template void GRHydro_ppm1d_cxx<do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect>(const int nx, \
		      const double dx,					\
		      const double* restrict rho,			\
		      const double* restrict velx,			\
		      const double* restrict vely,			\
		      const double* restrict velz,			\
		      const double* restrict eps,			\
		      const double* restrict press,			\
		      const double* restrict temp,			\
		      const double* restrict ye,			\
		      const double* restrict Bvcx,			\
		      const double* restrict Bvcy,			\
		      const double* restrict Bvcz,			\
		      const double* restrict psidc,			\
		      double* restrict rhominus,			\
		      double* restrict velxminus,			\
		      double* restrict velyminus,			\
		      double* restrict velzminus,			\
		      double* restrict epsminus,			\
		      double* restrict tempminus,			\
		      double* restrict yeminus,				\
		      double* restrict Bvcxminus,			\
		      double* restrict Bvcyminus,			\
		      double* restrict Bvczminus,			\
		      double* restrict psidcminus,			\
		      double* restrict rhoplus,				\
		      double* restrict velxplus,			\
		      double* restrict velyplus,			\
		      double* restrict velzplus,			\
		      double* restrict epsplus,				\
		      double* restrict tempplus,			\
		      double* restrict yeplus,				\
		      double* restrict Bvcxplus,			\
		      double* restrict Bvcyplus,			\
		      double* restrict Bvczplus,			\
		      double* restrict psidcplus);

//template template<bool do_temp, bool do_ye, bool do_mhd, bool dc_flag, bool do_ppm_detect>


// first stuff without MHD
INSTANTIATE(false,false,false,false,false)
INSTANTIATE(false,false,false,false,true)
// do_temp can only be true of do_ye is also true
INSTANTIATE(true,true,false,false,false)
INSTANTIATE(true,true,false,false,true)
// but do_ye can be true and do_temp can be false
INSTANTIATE(false,true,false,false,false)
INSTANTIATE(false,true,false,false,true)

// with MHD, but dc_flag false
INSTANTIATE(false,false,true,false,false)
INSTANTIATE(false,false,true,false,true)
// do_temp can only be true of do_ye is also true
INSTANTIATE(true,true,true,false,false)
INSTANTIATE(true,true,true,false,true)
// but do_ye can be true and do_temp can be false
INSTANTIATE(false,true,true,false,false)
INSTANTIATE(false,true,true,false,true)

// with MHD, dc_flag true
INSTANTIATE(false,false,true,true,false)
INSTANTIATE(false,false,true,true,true)
// do_temp can only be true of do_ye is also true
INSTANTIATE(true,true,true,true,false)
INSTANTIATE(true,true,true,true,true)
// but do_ye can be true and do_temp can be false
INSTANTIATE(false,true,true,true,false)
INSTANTIATE(false,true,true,true,true)

```

GRHydro_Functions.h:
```
#ifndef _GRHYDRO_FUNCTIONS_H_
#define _GRHYDRO_FUNCTIONS_H_

#include "cctk.h"

#ifdef __cplusplus
extern "C" {
#endif

void GRHydro_Primitive2Conservative_CC(CCTK_ARGUMENTS);

#ifdef __cplusplus
}
#endif

#endif // _GRHYDRO_FUNCTIONS_H_

```

GRHydro_HLLE_AM.F90:
```
 /*@@
   @file      GRHydro_HLLEPolyM.F90
   @date      Aug 30, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke, Pedro Montero, Toni Font
   @desc 
   The HLLE solver. Called from the wrapper function, so works in 
   all directions.
   @enddesc 
 @@*/
   
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Macros.h"
#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_HLLE_AM
   @date       Aug 30, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke, Pedro Montero, Toni Font
   @desc 
   The HLLE solver. Sufficiently simple that its just one big routine.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Altered from Cactus 3 routines originally written by Toni Font.
   @endhistory 

@@*/

subroutine GRHydro_HLLE_AM(CCTK_ARGUMENTS)
  USE GRHydro_EigenproblemM
  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  integer :: i, j, k, m
  CCTK_REAL, dimension(8) :: cons_p,cons_m,fplus,fminus,f1,qdiff
  CCTK_REAL, dimension(10) :: prim_p, prim_m
  CCTK_REAL, dimension(5) :: lamminus,lamplus
  CCTK_REAL ::  charmin, charmax, charpm,chartop,avg_alp,avg_det, sdet
  CCTK_REAL :: gxxh, gxyh, gxzh, gyyh, gyzh, gzzh, uxxh, uxyh, &
       uxzh, uyyh, uyzh, uzzh, avg_beta, usendh
  CCTK_REAL :: rhoenth_p, rhoenth_m, avg_betax, avg_betay, avg_betaz
  CCTK_REAL :: vxtp,vytp,vztp,vxtm,vytm,vztm,ab0p,ab0m,b2p,b2m,bdotvp,bdotvm
  CCTK_REAL :: wp,wm,v2p,v2m,bxlowp,bxlowm,bylowp,bylowm,bzlowp,bzlowm,vA2m,vA2p
  CCTK_REAL :: Bvecxlowp,Bvecxlowm,Bvecylowp,Bvecylowm,Bveczlowp,Bveczlowm
  CCTK_REAL :: pressstarp,pressstarm,velxlowp,velxlowm,velylowp,velylowm,velzlowp,velzlowm

  CCTK_INT :: type_bits, trivial
  CCTK_REAL :: xtemp

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
  end if
#define gxx faulty_gxx
#define gxy faulty_gxy
#define gxz faulty_gxz
#define gyy faulty_gyy
#define gyz faulty_gyz
#define gzz faulty_gzz
#define betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
  end if

  ! constraint transport needs to be able to average fluxes in the directions
  ! other that flux_direction

  !$OMP PARALLEL DO PRIVATE(k,j,i,f1,lamminus,lamplus,cons_p,cons_m,fplus,fminus,qdiff,prim_p,prim_m,&
  !$OMP avg_betax,avg_betay,avg_betaz,avg_beta,avg_alp,&
  !$OMP gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,avg_det,sdet,uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,&
  !$OMP vxtp,vxtm,vytp,vytm,vztp,vztm,&
  !$OMP velxlowp,velxlowm,Bvecxlowp,Bvecxlowm,&
  !$OMP velylowp,velylowm,Bvecylowp,Bvecylowm,&
  !$OMP velzlowp,velzlowm,Bveczlowp,Bveczlowm,&
  !$OMP bdotvp,bdotvm,b2p,b2m,v2p,v2m,wp,wm,&
  !$OMP bxlowp,bxlowm,bylowp,bylowm,bzlowp,bzlowm,&
  !$OMP rhoenth_p,rhoenth_m,ab0p,ab0m,vA2p,vA2m,pressstarp,pressstarm,usendh,charmin,charmax,chartop,charpm,m,xtemp)
  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + transport_constraints*(1-zoffset)
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + transport_constraints*(1-yoffset)
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + transport_constraints*(1-xoffset)
        
        f1 = 0.d0
        lamminus = 0.d0
        lamplus = 0.d0
        cons_p = 0.d0
        cons_m = 0.d0
        fplus = 0.d0
        fminus = 0.d0
        qdiff = 0.d0

!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        cons_p(1)   = densplus(i,j,k) 
        cons_p(2)   = sxplus(i,j,k)
        cons_p(3)   = syplus(i,j,k)
        cons_p(4)   = szplus(i,j,k)
        cons_p(5)   = tauplus(i,j,k)
        cons_p(6)   = Avecxplus(i,j,k)
        cons_p(7)   = Avecyplus(i,j,k)
        cons_p(8)   = Aveczplus(i,j,k)
        
        cons_m(1) = densminus(i+xoffset,j+yoffset,k+zoffset)
        cons_m(2) = sxminus(i+xoffset,j+yoffset,k+zoffset)
        cons_m(3) = syminus(i+xoffset,j+yoffset,k+zoffset)
        cons_m(4) = szminus(i+xoffset,j+yoffset,k+zoffset)
        cons_m(5) = tauminus(i+xoffset,j+yoffset,k+zoffset) 
        cons_m(6) = Avecxminus(i+xoffset,j+yoffset,k+zoffset) 
        cons_m(7) = Avecyminus(i+xoffset,j+yoffset,k+zoffset) 
        cons_m(8) = Aveczminus(i+xoffset,j+yoffset,k+zoffset) 

        prim_p(1)   = rhoplus(i,j,k) 
        prim_p(2)   = velxplus(i,j,k)
        prim_p(3)   = velyplus(i,j,k) 
        prim_p(4)   = velzplus(i,j,k)
        prim_p(5)   = epsplus(i,j,k)
        prim_p(6)   = pressplus(i,j,k)
        prim_p(7)   = w_lorentzplus(i,j,k)
        prim_p(8)   = Bvecxplus(i,j,k)
        prim_p(9)   = Bvecyplus(i,j,k) 
        prim_p(10)  = Bveczplus(i,j,k)
        
        prim_m(1) = rhominus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(2) = velxminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(3) = velyminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(4) = velzminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(5) = epsminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(6) = pressminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(7) = w_lorentzminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(8) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(9) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(10)= Bveczminus(i+xoffset,j+yoffset,k+zoffset) 
          
!!$        Calculate various metric terms here.
!!$        Note also need the average of the lapse at the 
!!$        left and right points.
!!$        
!!$        In MHD, we need all three shift components regardless of the flux direction

        avg_betax = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
             beta1(i,j,k))
        avg_betay = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
             beta2(i,j,k))
        avg_betaz = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
             beta3(i,j,k))
        if (flux_direction == 1) then
           avg_beta=avg_betax
        else if (flux_direction == 2) then
           avg_beta=avg_betay
        else if (flux_direction == 3) then
           avg_beta=avg_betaz
        else
           call CCTK_ERROR("Flux direction not x,y,z")
        end if

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gxyh = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gxzh = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gyyh = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gyzh = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gzzh = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))

        avg_det =  SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh)
        sdet = sqrt(avg_det)

        call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
             avg_det,gxxh, gxyh, gxzh, &
             gyyh, gyzh, gzzh)
          

        vxtp = prim_p(2)-avg_betax/avg_alp
        vytp = prim_p(3)-avg_betay/avg_alp
        vztp = prim_p(4)-avg_betaz/avg_alp
        vxtm = prim_m(2)-avg_betax/avg_alp
        vytm = prim_m(3)-avg_betay/avg_alp
        vztm = prim_m(4)-avg_betaz/avg_alp

        call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
             prim_p(2),prim_p(3),prim_p(4),prim_p(8),prim_p(9),prim_p(10), &
             velxlowp,velylowp,velzlowp,Bvecxlowp,Bvecylowp,Bveczlowp, &
             bdotvp,b2p,v2p,wp,bxlowp,bylowp,bzlowp)
        call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
             prim_m(2),prim_m(3),prim_m(4),prim_m(8),prim_m(9),prim_m(10), &
             velxlowm,velylowm,velzlowm,Bvecxlowm,Bvecylowm,Bveczlowm, &
             bdotvm,b2m,v2m,wm,bxlowm,bylowm,bzlowm)

        rhoenth_p = prim_p(1)*(1.d0+prim_p(5))+prim_p(6)
        rhoenth_m = prim_m(1)*(1.d0+prim_m(5))+prim_m(6)
        
        ab0p = wp*bdotvp
        ab0m = wm*bdotvm

        vA2p = b2p/(rhoenth_p+b2p)
        vA2m = b2m/(rhoenth_m+b2m)

!!$ p^*  = p+b^2/2  in Anton et al.
        pressstarp = prim_p(6)+0.5d0*b2p
        pressstarm = prim_m(6)+0.5d0*b2m        


!!$ If the Riemann problem is trivial, just calculate the fluxes from the 
!!$ left state and skip to the next cell
          
        if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then
          
!!$ we now pass in the B-field as conserved and flux, the vtilde's instead of v's,
!!$ pressstar instead of P, b_i, alp b^0, w, metric determinant, 
!!$ alp, and beta in the flux dir

          if (flux_direction == 1) then
            call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),&
                 cons_p(6),cons_p(7),cons_p(8),&
                 f1(1),f1(2),f1(3),f1(4),f1(5),f1(6),f1(7),f1(8),&
                 vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)

          else if (flux_direction == 2) then
            call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),&
                 cons_p(7),cons_p(8),cons_p(6),&
                 f1(1),f1(3),f1(4),f1(2),f1(5),f1(7),f1(8),f1(6),&
                 vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)

          else if (flux_direction == 3) then
            call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),&
                 cons_p(8),cons_p(6),cons_p(7),&
                 f1(1),f1(4),f1(2),f1(3),f1(5),f1(8),f1(6),f1(7), &
                 vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)
            
          else
            call CCTK_ERROR("Flux direction not x,y,z")
          end if
          
        else !!! The end of this branch is right at the bottom of the routine
            
          if (flux_direction == 1) then
            usendh = uxxh
          else if (flux_direction == 2) then
            usendh = uyyh
          else if (flux_direction == 3) then
            usendh = uzzh
          else
            call CCTK_ERROR("Flux direction not x,y,z")
          end if
          
!!$        Calculate the jumps in the conserved variables
          
          qdiff(1) = cons_m(1) - cons_p(1)
          qdiff(2) = cons_m(2) - cons_p(2)
          qdiff(3) = cons_m(3) - cons_p(3)
          qdiff(4) = cons_m(4) - cons_p(4)
          qdiff(5) = cons_m(5) - cons_p(5)
          qdiff(6) = cons_m(6) - cons_p(6)
          qdiff(7) = cons_m(7) - cons_p(7)
          qdiff(8) = cons_m(8) - cons_p(8)

!!$        Eigenvalues and fluxes either side of the cell interface
          
          if (flux_direction == 1) then
            if(evolve_temper.ne.1) then
              call eigenvaluesM(GRHydro_eos_handle,&
                   prim_m(1),prim_m(2),prim_m(3),prim_m(4),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(8),prim_m(9),prim_m(10),&
                   lamminus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                   usendh,avg_alp,avg_beta)                                    
              call eigenvaluesM(GRHydro_eos_handle, &
                   prim_p(1),prim_p(2),prim_p(3),prim_p(4),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(8),prim_p(9),prim_p(10),&
                   lamplus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                   usendh,avg_alp,avg_beta)
            else
              xtemp = temperature(i,j,k)
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_m(1),prim_m(2),prim_m(3),prim_m(4),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(8),prim_m(9),prim_m(10),&
                   xtemp,y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                   lamminus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                   usendh,avg_alp,avg_beta)
              xtemp = temperature(i,j,k)
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_p(1),prim_p(2),prim_p(3),prim_p(4),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(8),prim_p(9),prim_p(10),&
                   xtemp,y_e_plus(i,j,k),&
                   lamplus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                   usendh,avg_alp,avg_beta)
            endif 

            call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),&
                 cons_p(6),cons_p(7),cons_p(8),&
                 fplus(1),fplus(2),fplus(3),fplus(4),fplus(5),fplus(6),fplus(7),fplus(8),&
                 vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)
            call num_x_fluxM(cons_m(1),cons_m(2),cons_m(3),cons_m(4),cons_m(5),&
                 cons_m(6),cons_m(7),cons_m(8),&
                 fminus(1),fminus(2),fminus(3),fminus(4),fminus(5),&
                 fminus(6),fminus(7),fminus(8),&
                 vxtm,vytm,vztm,pressstarm,bxlowm,bylowm,bzlowm,ab0m,wm, &
                 avg_det,avg_alp,avg_beta)

          else if (flux_direction == 2) then
            if(evolve_temper.ne.1) then
              call eigenvaluesM(GRHydro_eos_handle,&
                   prim_m(1),prim_m(3),prim_m(4),prim_m(2),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(9),prim_m(10),prim_m(8),&
                   lamminus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                   usendh,avg_alp,avg_beta)                                    
              call eigenvaluesM(GRHydro_eos_handle, &
                   prim_p(1),prim_p(3),prim_p(4),prim_p(2),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(9),prim_p(10),prim_p(8),&
                   lamplus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                   usendh,avg_alp,avg_beta)
            else
              xtemp = temperature(i,j,k)
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_m(1),prim_m(3),prim_m(4),prim_m(2),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(9),prim_m(10),prim_m(8),&
                   xtemp,y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                   lamminus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                   usendh,avg_alp,avg_beta)                                    
              xtemp = temperature(i,j,k)                                       
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_p(1),prim_p(3),prim_p(4),prim_p(2),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(9),prim_p(10),prim_p(8),&
                   xtemp,y_e_plus(i,j,k),&
                   lamplus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                   usendh,avg_alp,avg_beta)
            endif 

            call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),&
                 cons_p(7),cons_p(8),cons_p(6),&
                 fplus(1),fplus(3),fplus(4),fplus(2),fplus(5),fplus(7),fplus(8),fplus(6),&
                 vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)
            call num_x_fluxM(cons_m(1),cons_m(3),cons_m(4),cons_m(2),cons_m(5),&
                 cons_m(7),cons_m(8),cons_m(6),&
                 fminus(1),fminus(3),fminus(4),fminus(2),fminus(5),&
                 fminus(7),fminus(8),fminus(6),&
                 vytm,vztm,vxtm,pressstarm,bylowm,bzlowm,bxlowm,ab0m,wm, &
                 avg_det,avg_alp,avg_beta)

          else if (flux_direction == 3) then
            if(evolve_temper.ne.1) then
              call eigenvaluesM(GRHydro_eos_handle,&
                   prim_m(1),prim_m(4),prim_m(2),prim_m(3),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(10),prim_m(8),prim_m(9),&
                   lamminus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                   usendh,avg_alp,avg_beta)                                    
              call eigenvaluesM(GRHydro_eos_handle, &
                   prim_p(1),prim_p(4),prim_p(2),prim_p(3),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(10),prim_p(8),prim_p(9),&
                   lamplus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                   usendh,avg_alp,avg_beta)
            else
              xtemp = temperature(i,j,k)
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_m(1),prim_m(4),prim_m(2),prim_m(3),prim_m(5),prim_m(6),prim_m(7), &
                   prim_m(10),prim_m(8),prim_m(9),&
                   xtemp,y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                   lamminus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                   usendh,avg_alp,avg_beta)                                    
              xtemp = temperature(i,j,k)                                       
              call eigenvaluesM_hot(GRHydro_eos_handle,&
                   int(i,ik),int(j,ik),int(k,ik),&
                   prim_p(1),prim_p(4),prim_p(2),prim_p(3),prim_p(5),prim_p(6),prim_p(7), &
                   prim_p(10),prim_p(8),prim_p(9),&
                   xtemp,y_e_plus(i,j,k),&
                   lamplus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                   usendh,avg_alp,avg_beta)
            endif 

            call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),&
                 cons_p(8),cons_p(6),cons_p(7),&
                 fplus(1),fplus(4),fplus(2),fplus(3),fplus(5),fplus(8),fplus(6),fplus(7), &
                 vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, &
                 avg_det,avg_alp,avg_beta)
            call num_x_fluxM(cons_m(1),cons_m(4),cons_m(2),cons_m(3),cons_m(5),&
                 cons_m(8),cons_m(6),cons_m(7),&
                 fminus(1),fminus(4),fminus(2),fminus(3),fminus(5), &
                 fminus(8),fminus(6),fminus(7), &
                 vztm,vxtm,vytm,pressstarm,bzlowm,bxlowm,bylowm,ab0m,wm, &
                 avg_det,avg_alp,avg_beta)

          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
       
   
!!$        Find minimum and maximum wavespeeds
      
          charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), &
               lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
               lamminus(4),lamminus(5))  
          
          charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), &
               lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
               lamminus(4),lamminus(5))

          chartop = max(-charmin,charmax)
          
          charpm = charmax - charmin

!!$        Calculate flux by standard formula
          
          do m = 1,8 
             
             qdiff(m) = cons_m(m) - cons_p(m)
             
            if (HLLE) then
              f1(m) = (charmax * fplus(m) - charmin * fminus(m) + &
                       charmax * charmin * qdiff(m)) / charpm
            else if (LLF) then
              f1(m) = 0.5d0 * (fplus(m) + fminus(m) - chartop * qdiff(m)) 
            end if 
             
          end do

        end if !!! The end of the SpaceMask check for a trivial RP.
            
        densflux(i, j, k) = f1(1)
        sxflux(i, j, k) = f1(2)
        syflux(i, j, k) = f1(3)
        szflux(i, j, k) = f1(4)
        tauflux(i, j, k) = f1(5)

        if ( evolve_Lorenz_gge.gt.0 ) then
           !! FIX: These aren't zero
           Avecxflux(i,j,k) = 0.d0
           Avecyflux(i,j,k) = 0.d0
           Aveczflux(i,j,k) = 0.d0
           Aphiflux(i,j,k) = 0.d0
        else
           Avecxflux(i,j,k) = 0.d0
           Avecyflux(i,j,k) = 0.d0
           Aveczflux(i,j,k) = 0.d0
        end if

        if(evolve_Y_e.ne.0) then
           if (densflux(i, j, k) > 0.d0) then
              Y_e_con_flux(i, j, k) = &
                   Y_e_plus(i, j, k) * &
                   densflux(i, j, k)
            else
               Y_e_con_flux(i, j, k) = &
                    Y_e_minus(i + xoffset, j + yoffset, k + zoffset) * &
                    densflux(i, j, k)
            endif
         endif

      end do
    end do
  end do
  !$OMP END PARALLEL DO
#undef faulty_gxx
#undef faulty_gxy
#undef faulty_gxz
#undef faulty_gyy
#undef faulty_gyz
#undef faulty_gzz
#undef faulty_betax
#undef faulty_betay
#undef faulty_betaz
#undef faulty_vel
#undef faulty_Bvec
      
end subroutine GRHydro_HLLE_AM

 /*@@
   @routine    GRHydro_HLLE_TracerAM
   @date       Aug 30, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   HLLE just for the tracer.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_HLLE_TracerAM(CCTK_ARGUMENTS)

  USE GRHydro_EigenproblemM

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k,  m
  CCTK_REAL, dimension(number_of_tracers) :: cons_p,cons_m,fplus,fminus,f1
  CCTK_REAL, dimension(5) :: lamminus,lamplus
  CCTK_REAL, dimension(number_of_tracers) :: qdiff
  CCTK_REAL, dimension(7) :: prim_p, prim_m
  CCTK_REAL, dimension(3) :: mag_p, mag_m
  CCTK_REAL ::  charmin, charmax, charpm,avg_alp,avg_det
  CCTK_REAL :: gxxh, gxyh, gxzh, gyyh, gyzh, gzzh, uxxh, uxyh, &
       uxzh, uyyh, uyzh, uzzh, avg_beta, usendh
  CCTK_REAL :: b2p,b2m,vA2m,vA2p
    
  CCTK_INT :: type_bits, trivial

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  pointer (pg11,g11), (pg12,g12), (pg13,g13), (pg22,g22), (pg23,g23), (pg33,g33)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: beta1, beta2, beta3
  pointer (pbeta1,beta1), (pbeta2,beta2), (pbeta3,beta3)

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    pg11 = loc(gaa)
    pg12 = loc(gab)
    pg13 = loc(gac)
    pg22 = loc(gbb)
    pg23 = loc(gbc)
    pg33 = loc(gcc)
    pbeta1 = loc(betaa)
    pbeta2 = loc(betab)
    pbeta3 = loc(betac)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pbeta1 = loc(betax)
    pbeta2 = loc(betay)
    pbeta3 = loc(betaz)
  end if
#define gxx faulty_gxx
#define gxy faulty_gxy
#define gxz faulty_gxz
#define gyy faulty_gyy
#define gyz faulty_gyz
#define gzz faulty_gzz
#define betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
  end if

  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil
        
        f1 = 0.d0
        lamminus = 0.d0
        lamplus = 0.d0
        cons_p = 0.d0
        cons_m = 0.d0
        mag_p = 0.d0
        mag_m = 0.d0
        fplus = 0.d0
        fminus = 0.d0
        qdiff = 0.d0
        
!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        cons_p(:) = cons_tracerplus(i,j,k,:) 
        cons_m(:) = cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        
        mag_p(1) = Bvecxplus(i,j,k)
        mag_p(2) = Bvecyplus(i,j,k)
        mag_p(3) = Bveczplus(i,j,k)

        mag_m(1) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset)
        mag_m(2) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset)
        mag_m(3) = Bveczminus(i+xoffset,j+yoffset,k+zoffset)

        prim_p(1)   = rhoplus(i,j,k) 
        prim_p(2)   = velxplus(i,j,k)
        prim_p(3)   = velyplus(i,j,k) 
        prim_p(4)   = velzplus(i,j,k)
        prim_p(5)   = epsplus(i,j,k)
        prim_p(6)   = pressplus(i,j,k)
        prim_p(7)   = w_lorentzplus(i,j,k)
        
        prim_m(1) = rhominus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(2) = velxminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(3) = velyminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(4) = velzminus(i+xoffset,j+yoffset,k+zoffset)
        prim_m(5) = epsminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(6) = pressminus(i+xoffset,j+yoffset,k+zoffset) 
        prim_m(7) = w_lorentzminus(i+xoffset,j+yoffset,k+zoffset) 
        
!!$        Calculate various metric terms here.
!!$        Note also need the average of the lapse at the 
!!$        left and right points.

        if (flux_direction == 1) then
           avg_beta = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
               beta1(i,j,k))
        else if (flux_direction == 2) then
           avg_beta = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
               beta2(i,j,k))
        else if (flux_direction == 3) then
           avg_beta = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
               beta3(i,j,k))
        else
           call CCTK_ERROR("Flux direction not x,y,z")
        end if

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gxyh = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gxzh = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gyyh = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gyzh = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gzzh = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))

        avg_det =  SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh)

        call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
             avg_det,gxxh, gxyh, gxzh, &
             gyyh, gyzh, gzzh)
        
        if (flux_direction == 1) then
          usendh = uxxh
        else if (flux_direction == 2) then
          usendh = uyyh
        else if (flux_direction == 3) then
          usendh = uzzh
        else
          call CCTK_ERROR("Flux direction not x,y,z")
        end if

!!$        b^2 = (1-v^2)B^2+(B dot v)^2 
        b2p=DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_p(1),mag_p(2),mag_p(3))/prim_p(7)**2 + &
             (DOTP(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_p(2),prim_p(3),prim_p(4),mag_p(1),mag_p(2),mag_p(3)))**2
        b2m=DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_m(1),mag_m(2),mag_m(3))/prim_m(7)**2 + &
             (DOTP(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_m(2),prim_m(3),prim_m(4),mag_m(1),mag_m(2),mag_m(3)))**2
        
        vA2p = b2p/(prim_p(1)*(1.0d0+prim_p(5))+prim_p(6)+b2p)
        vA2m = b2m/(prim_m(1)*(1.0d0+prim_m(5))+prim_m(6)+b2m)
          
!!$        Calculate the jumps in the conserved variables
          
        qdiff = cons_m - cons_p
          
!!$        Eigenvalues and fluxes either side of the cell interface
          
        if (flux_direction == 1) then
           call eigenvaluesM(GRHydro_eos_handle,&
                prim_m(1),prim_m(2),prim_m(3),prim_m(4),prim_m(5),prim_m(6),prim_m(7), &
                mag_m(1),mag_m(2),mag_m(3),&
                lamminus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                usendh,avg_alp,avg_beta)                                    
           call eigenvaluesM(GRHydro_eos_handle, &
                prim_p(1),prim_p(2),prim_p(3),prim_p(4),prim_p(5),prim_p(6),prim_p(7), &
                mag_p(1),mag_p(2),mag_p(3),&
                lamplus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
                usendh,avg_alp,avg_beta)
           fplus(:)  = (velxplus(i,j,k)  - avg_beta / avg_alp) * &
                cons_tracerplus(i,j,k,:)
           fminus(:) = (velxminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
                cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else if (flux_direction == 2) then
           call eigenvaluesM(GRHydro_eos_handle,&
                prim_m(1),prim_m(3),prim_m(4),prim_m(2),prim_m(5),prim_m(6),prim_m(7), &
                mag_m(2),mag_m(3),mag_m(1),&
                lamminus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                usendh,avg_alp,avg_beta)                                    
           call eigenvaluesM(GRHydro_eos_handle, &
                prim_p(1),prim_p(3),prim_p(4),prim_p(2),prim_p(5),prim_p(6),prim_p(7), &
                mag_p(2),mag_p(3),mag_p(1),&
                lamplus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,&
                usendh,avg_alp,avg_beta)
           fplus(:)  = (velyplus(i,j,k)  - avg_beta / avg_alp) * &
                cons_tracerplus(i,j,k,:)
           fminus(:) = (velyminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
                cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else if (flux_direction == 3) then
           call eigenvaluesM(GRHydro_eos_handle,&
                prim_m(1),prim_m(4),prim_m(2),prim_m(3),prim_m(5),prim_m(6),prim_m(7), &
                mag_m(3),mag_m(1),mag_m(2),&
                lamminus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                usendh,avg_alp,avg_beta)                                    
           call eigenvaluesM(GRHydro_eos_handle,&
                prim_p(1),prim_p(4),prim_p(2),prim_p(3),prim_p(5),prim_p(6),prim_p(7), &
                mag_p(3),mag_p(1),mag_p(2),&
                lamplus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,&
                usendh,avg_alp,avg_beta)
           fplus(:)  = (velzplus(i,j,k) - avg_beta / avg_alp) * &
                cons_tracerplus(i,j,k,:)
           fminus(:) = (velzminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * &
                cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:)
        else
           call CCTK_ERROR("Flux direction not x,y,z")
        end if
        
!!$        Find minimum and maximum wavespeeds
        
        charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), &
             lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
             lamminus(4),lamminus(5))  
        
        charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), &
             lamplus(4),lamplus(5),  lamminus(1),lamminus(2),lamminus(3),&
             lamminus(4),lamminus(5))
        
        charpm = charmax - charmin
        
!!$        Calculate flux by standard formula
        
        do m = 1,number_of_tracers
           
           qdiff(m) = cons_m(m) - cons_p(m)
           
           f1(m) = (charmax * fplus(m) - charmin * fminus(m) + &
                charmax * charmin * qdiff(m)) / charpm
           
        end do
        
        cons_tracerflux(i, j, k,:) = f1(:)
!!$
!!$        if ( ((flux_direction.eq.3).and.(i.eq.4).and.(j.eq.4)).or.&
!!$             ((flux_direction.eq.2).and.(i.eq.4).and.(k.eq.4)).or.&
!!$             ((flux_direction.eq.1).and.(j.eq.4).and.(k.eq.4))&
!!$             ) then
!!$          write(*,*) flux_direction, i, j, k, f1(1), cons_m(1), cons_p(1)
!!$        end if
        
     end do
  end do
end do
#undef faulty_gxx
#undef faulty_gxy
#undef faulty_gxz
#undef faulty_gyy
#undef faulty_gyz
#undef faulty_gzz
#undef faulty_betax
#undef faulty_betay
#undef faulty_betaz
#undef faulty_vel
#undef faulty_Bvec


end subroutine GRHydro_HLLE_TracerAM


```

GRHydro_RoeSolver.F90:
```
 /*@@
   @file      GRHydro_RoeSolver.F90
   @date      Sat Jan 26 01:55:27 2002
   @author    
   @desc 
   Calculates the Roe flux
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.h"

#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_RoeSolve
   @date       Sat Jan 26 01:55:55 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   Wrapper routine to calculate the Roe fluxes and hence the update 
   terms.
   @enddesc 
   @calls     
   @calledby   
   @history 
   
   @endhistory 

@@*/

subroutine GRHydro_RoeSolve(CCTK_ARGUMENTS)
  
  USE GRHydro_Eigenproblem
  implicit none
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  CCTK_REAL, dimension(5) :: roeflux,roeave,qdiff,consp,consm_i,&
       fplus,fminus,f_roe,primp,primm_i
  CCTK_REAL :: avg_alp,avg_beta,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
       avg_det,uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,&
       rhoave, velxave, velyave, velzave, epsave, &
       w_lorentzave, usendh
  integer :: m
  integer :: i,j,k
  
  CCTK_INT :: type_bits, trivial

  if (flux_direction == 1) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
         &"trivial")
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if
  
  f_roe = 0.d0
  
  do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil

!!$        Set the left (p for plus) and right (m_i for minus, i+1) states
        
        consp(1)   = densplus(i,j,k) 
        consp(2)   = sxplus(i,j,k)
        consp(3)   = syplus(i,j,k)
        consp(4)   = szplus(i,j,k)
        consp(5)   = tauplus(i,j,k)
        
        consm_i(1) = densminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(2) = sxminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(3) = syminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(4) = szminus(i+xoffset,j+yoffset,k+zoffset)
        consm_i(5) = tauminus(i+xoffset,j+yoffset,k+zoffset) 
        
        primp(1)   = rhoplus(i,j,k) 
        primp(2)   = velxplus(i,j,k)
        primp(3)   = velyplus(i,j,k)
        primp(4)   = velzplus(i,j,k)
        primp(5)   = epsplus(i,j,k)
        
        primm_i(1) = rhominus(i+xoffset,j+yoffset,k+zoffset)
        primm_i(2) = velxminus(i+xoffset,j+yoffset,k+zoffset)
        primm_i(3) = velyminus(i+xoffset,j+yoffset,k+zoffset)
        primm_i(4) = velzminus(i+xoffset,j+yoffset,k+zoffset)
        primm_i(5) = epsminus(i+xoffset,j+yoffset,k+zoffset) 
        
        roeflux = 0.d0
        qdiff = 0.d0

!!$        Calculate jumps in conserved variables
        
        do m = 1,5
          qdiff(m) = consm_i(m) - consp(m)
        end do

!!$        Set metric terms at interface
        
        if (flux_direction == 1) then
           avg_beta = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + &
                betax(i,j,k))
        else if (flux_direction == 2) then
           avg_beta = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + &
                 betay(i,j,k))
        else if (flux_direction == 3) then
           avg_beta = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + &
                betaz(i,j,k))
        else
           call CCTK_ERROR("Flux direction not x,y,z")
           STOP
        end if
        
        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + &
             gxx(i,j,k))
        gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + &
             gxy(i,j,k))
        gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + &
             gxz(i,j,k))
        gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + &
             gyy(i,j,k))
        gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + &
             gyz(i,j,k))
        gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + &
             gzz(i,j,k))
        
        avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh)
        
!!$ If the Riemann problem is trivial, just calculate the fluxes from the 
!!$ left state and skip to the next cell
          
        if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then

          if (flux_direction == 1) then
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                 f_roe(1),f_roe(2),f_roe(3),&
                 f_roe(4),f_roe(5),&
                 velxplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                 f_roe(1),f_roe(3),f_roe(4),&
                 f_roe(2),f_roe(5),&
                 velyplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                 f_roe(1),f_roe(4),f_roe(2),&
                 f_roe(3),f_roe(5),&
                 velzplus(i,j,k),pressplus(i,j,k),&
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
            
        else !!! The end of this branch is right at the bottom of the routine

          call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
               avg_det,gxxh, gxyh, gxzh, gyyh, gyzh, gzzh)
        
          if (flux_direction == 1) then
            usendh = uxxh
          else if (flux_direction == 2) then
            usendh = uyyh
          else if (flux_direction == 3) then
            usendh = uzzh
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
!!$        Set the Roe average of the fluid variables
        
          call roeaverage(primp, primm_i, roeave)
        
          rhoave = roeave(1)
          velxave = roeave(2)
          velyave = roeave(3)
          velzave = roeave(4)
          epsave = roeave(5)

!!$        Convert to conserved variables and find the part of the Roe
!!$        flux that requires the spectral decomposition.
!!$        The conversion to conserved variables is just to set the 
!!$        pressure at this point (means this routine doesn''t need
!!$        the EOS interface).

!!$        The conversion routine is unnecessary (the pressure is set
!!$        inside the eigenproblem routine) so instead we just have
!!$        to set the average W.

          w_lorentzave = 1.d0 / &
               sqrt(1.d0 - &
                 (gxxh*velxave*velxave + gyyh*velyave*velyave + &
                  gzzh*velzave*velzave + 2*gxyh*velxave*velyave + &
                  2*gxzh*velxave *velzave + 2*gyzh*velyave*velzave))  

          if (flux_direction == 1) then
!!$            call prim2con(GRHydro_eos_handle,gxxh, gxyh, gxzh, gyyh, &
!!$                 gyzh, gzzh, avg_det, &
!!$                 consh(1), consh(2), consh(3), consh(4), consh(5), rhoave, &
!!$                 velxave, velyave, velzave, epsave, pressave, w_lorentzave)
            call eigenproblem(GRHydro_eos_handle,rhoave, velxave, &
                 velyave, velzave, epsave, w_lorentzave, &
                 gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
                 usendh, avg_alp,avg_beta,qdiff(1),qdiff(2), &
                 qdiff(3),qdiff(4),qdiff(5),roeflux(1),roeflux(2),&
                 roeflux(3),roeflux(4),roeflux(5))
          else if (flux_direction == 2) then
!!$            call prim2con(GRHydro_eos_handle,gyyh, gyzh, gxyh, gzzh, &
!!$                 gxzh, gxxh, avg_det, &
!!$                 consh(1), consh(3), consh(4), consh(2), consh(5), rhoave, &
!!$                 velyave, velzave, velxave, epsave, pressave, w_lorentzave)
            call eigenproblem(GRHydro_eos_handle,rhoave, velyave, &
                 velzave, velxave, epsave, w_lorentzave, &
                 gyyh,gyzh,gxyh,gzzh,gxzh,gxxh, &
                 usendh, avg_alp,avg_beta,qdiff(1),qdiff(3), &
                 qdiff(4),qdiff(2),qdiff(5),roeflux(1),roeflux(3),&
                 roeflux(4),roeflux(2),roeflux(5))
          else if (flux_direction == 3) then
!!$            call prim2con(GRHydro_eos_handle,gzzh, gxzh, gyzh, gxxh, &
!!$                 gxyh, gyyh, avg_det, &
!!$                 consh(1), consh(4), consh(2), consh(3), consh(5), rhoave, &
!!$                 velzave, velxave, velyave, epsave, pressave, w_lorentzave)
            call eigenproblem(GRHydro_eos_handle,rhoave, velzave, &
                 velxave, velyave, epsave, w_lorentzave, &
                 gzzh,gxzh,gyzh,gxxh,gxyh,gyyh, &
                 usendh, avg_alp,avg_beta,qdiff(1),qdiff(4), &
                 qdiff(2),qdiff(3),qdiff(5),roeflux(1),roeflux(4),&
                 roeflux(2),roeflux(3),roeflux(5))
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
          
          fplus = 0.d0
          fminus = 0.d0
        
!!$Calculate the fluxes of the original reconstructed data
        
          if (flux_direction == 1) then
            call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5), &
                 fplus(1),fplus(2),fplus(3),fplus(4), &
                 fplus(5),velxplus(i,j,k),pressplus(i,j,k), &
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(2),consm_i(3), &
                 consm_i(4),consm_i(5),fminus(1),fminus(2),fminus(3), &
                 fminus(4), fminus(5), &
                 velxminus(i+xoffset,j+yoffset,k+zoffset), &
                 pressminus(i+xoffset,j+yoffset,k+zoffset), &
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 2) then
            call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5), &
                 fplus(1),fplus(3),fplus(4),fplus(2), &
                 fplus(5),velyplus(i,j,k),pressplus(i,j,k), &
                 avg_det,avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(3),consm_i(4), &
                 consm_i(2),consm_i(5),fminus(1),fminus(3),fminus(4), &
                 fminus(2), fminus(5), &
                 velyminus(i+xoffset,j+yoffset,k+zoffset), &
                 pressminus(i+xoffset,j+yoffset,k+zoffset), &
                 avg_det,avg_alp,avg_beta)
          else if (flux_direction == 3) then
            call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5), &
                 fplus(1),fplus(4),fplus(2),fplus(3), &
                 fplus(5),velzplus(i,j,k),pressplus(i,j,k),avg_det, &
                 avg_alp,avg_beta)
            call num_x_flux(consm_i(1),consm_i(4),consm_i(2), &
                 consm_i(3),consm_i(5),fminus(1),fminus(4),fminus(2), &
                 fminus(3), fminus(5), &
                 velzminus(i+xoffset,j+yoffset,k+zoffset), &
                 pressminus(i+xoffset,j+yoffset,k+zoffset), &
                 avg_det,avg_alp,avg_beta)
          else
            call CCTK_ERROR("Flux direction not x,y,z")
            STOP
          end if
        
!!$The combined Roe flux          
        
          do m = 1,5
          
            f_roe(m) = 0.5d0 * (fplus(m) + fminus(m) - roeflux(m))
          
          end do

        end if !!! The end of the SpaceMask check for a trivial RP.
        
        densflux(i,j,k) = f_roe(1)
        sxflux(i,j,k)   = f_roe(2)
        syflux(i,j,k)   = f_roe(3)
        szflux(i,j,k)   = f_roe(4)
        tauflux(i,j,k)  = f_roe(5)

      enddo
    enddo
  enddo
    
end subroutine GRHydro_RoeSolve


```

GRHydro_Minima.F90:
```
 /*@@
   @file      GRHydro_Minima.F90
   @date      Mon Feb 25 11:43:36 2002
   @author    
   @desc 
   Sets up the scalars used for the atmosphere, before initial data.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Macros.h"

 /*@@
   @routine    GRHydro_Minima_Setup
   @date       Mon Feb 25 11:25:27 2002
   @author     Ian Hawke
   @desc 
   Before initial data, set up the scalar GRHydro_rho_min used for the atmosphere.
   This is computed only from parameters.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Modified 30 Aug 2006 by Luca Baiotti
   @endhistory 

@@*/

subroutine GRHydro_Rho_Minima_Setup(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (initial_rho_abs_min > 0.0) then
    GRHydro_rho_min = initial_rho_abs_min
  else if (initial_rho_rel_min > 0.0) then 
    GRHydro_rho_min = GRHydro_rho_central * initial_rho_rel_min
  else if (rho_abs_min > 0.d0) then
    GRHydro_rho_min = rho_abs_min
  else
    GRHydro_rho_min = GRHydro_rho_central * rho_rel_min
  end if

  if (initial_atmosphere_factor > 0.0) GRHydro_rho_min = GRHydro_rho_min * initial_atmosphere_factor

  GRHydro_tau_min = tau_rel_min

  return

end subroutine GRHydro_Rho_Minima_Setup


 /*@@
   @routine    GRHydro_Check_Rho_Minimum
   @date       Mon Jul 7 16:35:45 2008
   @author     Luca Baiotti 
   @desc 
   Check whether at some point rho < GRHydro_rho_min and print a warning in case.
   @enddesc 
   @calls     
   @calledby   
   @history 
   @endhistory 
@@*/

subroutine GRHydro_Check_Rho_Minimum(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT i,j,k
  CCTK_REAL dummy1
  character(len=100) warnline

  do i=1,cctk_lsh(1)
    do j=1,cctk_lsh(2)
      do k=1,cctk_lsh(3)

        SET_ATMO_MIN(dummy1, GRHydro_rho_min, r(i,j,k))
        if (rho(i,j,k) < dummy1) then
          call CCTK_WARN(2,"rho<GRHydro_rho_min!!!")
          write(warnline,'(a28,i2)') 'on carpet reflevel: ',GRHydro_reflevel
          call CCTK_WARN(2,warnline)
          write(warnline,'(a25,g15.6)') 'GRHydro_rho_min: ', dummy1
          call CCTK_WARN(2,warnline)
          write(warnline,'(a25,g15.6)') 'rho: ',rho(i,j,k)
          call CCTK_WARN(2,warnline)
          write(warnline,'(a25,4g15.6)') 'coordinates: x,y,z,r:',x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k)
          call CCTK_WARN(2,warnline)
        end if

      end do
    end do
  end do

  return

end subroutine GRHydro_Check_Rho_Minimum


 /*@@
   @routine    GRHydro__Change_Rho_Minimum_At_Recovery
   @date       Thu Aug 14 17:11:32 2008
   @author     Luca Baiotti 
   @desc 
   Change, via a parameter, the value of GRHydro_rho_min at recovery.
   @enddesc 
   @calls     
   @calledby   
   @history 
   @endhistory 
@@*/

subroutine GRHydro_Change_Rho_Minimum_At_Recovery(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  GRHydro_rho_min = rho_abs_min_after_recovery

  return

end subroutine GRHydro_Change_Rho_Minimum_At_Recovery

```

make.configuration.deps:
```
# Compile rules for the utilities

$(UTIL_DIR)$(DIRSEP)%: $(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%.o $(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%-main.o
	@echo 'Creating $* in $(UTIL_DIR) from $<'
	-$(MKDIR) $(MKDIRFLAGS) $(UTIL_DIR) 2>/dev/null
	$(CXX) $(CREATEEXE)$(OPTIONSEP)$@ $(DEBUG_LD) $(LDFLAGS) $(EXTRAFLAGS) $^ $(GENERAL_LIBRARIES)

$(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%.o: $(PACKAGE_DIR)$(DIRSEP)EinsteinEvolve$(DIRSEP)GRHydro$(DIRSEP)src$(DIRSEP)util$(DIRSEP)%.f90
	@echo 'Compiling $<'
	-$(MKDIR) $(MKDIRFLAGS) $(BUILD_DIR)$(DIRSEP)GRHydro 2>/dev/null
	$(F90) $< $(filter-out $(F90_OPENMP_FLAGS),$(F90FLAGS)) -I$(CONFIG) -I$(BINDINGS_DIR)$(DIRSEP)include -I$(FLESH_DIR)$(DIRSEP)include -I$(CCTK_HOME)$(DIRSEP)arrangements $(SYS_INC_DIRS:%=-I%) $(FCOMPILEONLY)$(OPTIONSEP)$@

$(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%.c: $(PACKAGE_DIR)$(DIRSEP)EinsteinEvolve$(DIRSEP)GRHydro$(DIRSEP)src$(DIRSEP)util$(DIRSEP)%.c
	@echo 'Preprocessing $<'
	-$(MKDIR) $(MKDIRFLAGS) $(BUILD_DIR)$(DIRSEP)GRHydro 2>/dev/null
	{ if test $(C_LINE_DIRECTIVES) = 'yes'; then echo '#line 1 "'$<'"'; fi; cat $<; } | $(PERL) -s $(C_FILE_PROCESSOR) -line_directives=$(C_LINE_DIRECTIVES) -source_file_name=$< $(CONFIG) > $@

$(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%.o: $(BUILD_DIR)$(DIRSEP)GRHydro$(DIRSEP)%.c
	@echo 'Compiling $<'
	-$(MKDIR) $(MKDIRFLAGS) $(BUILD_DIR)$(DIRSEP)GRHydro 2>/dev/null
	$(CC) $< $(filter-out $(C_OPENMP_FLAGS),$(CFLAGS)) -I$(CONFIG) -I$(BINDINGS_DIR)$(DIRSEP)include -I$(FLESH_DIR)$(DIRSEP)include -I$(CCTK_HOME)$(DIRSEP)arrangements $(SYS_INC_DIRS:%=-I%) $(CCOMPILEONLY)$(OPTIONSEP)$@

```

GRHydro_PPMReconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_PPMReconstruct_drv.F90
   @date      Tue Jul 19 13:22:03 EDT 2011
   @author    Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   Driver routine to perform the PPM reconstructions.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)


 /*@@
   @routine    GRHydro_PPMReconstruct_drv
   @date       Tue Jul 19 13:24:34 EDT 2011
   @author     Luca Baiotti, Ian Hawke, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   A driver routine to do PPM reconstructions. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_PPMReconstruct_drv(CCTK_ARGUMENTS)
  
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates

  integer :: nx, ny, nz, i, j, k

  logical, dimension(:,:,:), allocatable :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_INT :: ierr

  logical :: apply_enhanced_ppm

  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
    
  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  ! if use_enhanced_ppm, allow old PPM on one level
  if (GRHydro_oppm_reflevel .eq. (-1) .or. &
       GRHydro_reflevel .ne. GRHydro_oppm_reflevel) then
     apply_enhanced_ppm = use_enhanced_ppm .ne. 0
  else
     apply_enhanced_ppm = .false.
  end if


!!$ PPM starts:
    if (flux_direction == 1) then
         !$OMP PARALLEL DO PRIVATE(i, j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
           do j = GRHydro_stencil, ny - GRHydro_stencil + 1
           if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
             call SimplePPM_1d(apply_enhanced_ppm,&
                  GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                  rho(:,j,k),vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3),eps(:,j,k),&
                  press(:,j,k),rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),&
                  velzminus(:,j,k),epsminus(:,j,k),rhoplus(:,j,k),&
                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),epsplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                  gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), &
                  gzz(:,j,k), betax(:,j,k), alp(:,j,k),&
                  w_lorentz(:,j,k), &
                  1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                  GRHydro_mppm_eigenvalue_x_right, &
                  GRHydro_mppm_xwind)
           else
             call SimplePPM_1d(apply_enhanced_ppm,&
                  GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),&
                  rho(:,j,k),lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3),eps(:,j,k),&
                  press(:,j,k),rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),&
                  velzminus(:,j,k),epsminus(:,j,k),rhoplus(:,j,k),&
                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),epsplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k),&
                  gaa(:,j,k), gab(:,j,k), gac(:,j,k), gbb(:,j,k), gbc(:,j,k), &
                  gcc(:,j,k), betaa(:,j,k), alp(:,j,k),&
                  w_lorentz(:,j,k), &
                  1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, &
                  GRHydro_mppm_eigenvalue_x_right, &
                  GRHydro_mppm_xwind)
           end if
             do i = 1, nx
                if (trivial_rp(i,j,k)) then
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
                else
                  SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
                end if
             end do
           end do
         end do
         !$OMP END PARALLEL DO
      if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),vel(:,j,k,1), & 
                      temperature(:,j,k),press(:,j,k),&
                      tempminus(:,j,k),tempplus(:,j,k), hydro_excision_mask)
               else
                   call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),lvel(:,j,k,1), & 
                      temperature(:,j,k),press(:,j,k),&
                      tempminus(:,j,k),tempplus(:,j,k), hydro_excision_mask)
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      endif
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3), &
                      tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), &
                      press(:,j,k))
               else
                 call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3), &
                      tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), &
                      press(:,j,k))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, ny - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3), &
                      Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k), &
                      press(:,j,k))
               else
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      nx,CCTK_DELTA_SPACE(1),rho(:,j,k), &
                      lvel(:,j,k,1),lvel(:,j,k,2),lvel(:,j,k,3), &
                      Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k), &
                      press(:,j,k))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else if (flux_direction == 2) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, nz - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
            if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
              call SimplePPM_1d(apply_enhanced_ppm,&
                   GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                   rho(j,:,k),vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1),eps(j,:,k),&
                   press(j,:,k),rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),&
                   velxminus(j,:,k),epsminus(j,:,k),rhoplus(j,:,k),&
                   velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),epsplus(j,:,k),&
                   trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                   gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), &
                   gxx(j,:,k), betay(j,:,k), alp(j,:,k),&
                   w_lorentz(j,:,k), &
                   2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                   GRHydro_mppm_eigenvalue_y_right, &
                   GRHydro_mppm_xwind)
            else
              call SimplePPM_1d(apply_enhanced_ppm,&
                   GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),&
                   rho(j,:,k),lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1),eps(j,:,k),&
                   press(j,:,k),rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),&
                   velxminus(j,:,k),epsminus(j,:,k),rhoplus(j,:,k),&
                   velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),epsplus(j,:,k),&
                   trivial_rp(j,:,k), hydro_excision_mask(j,:,k),&
                   gbb(j,:,k), gbc(j,:,k), gab(j,:,k), gcc(j,:,k), gac(j,:,k), &
                   gaa(j,:,k), betab(j,:,k), alp(j,:,k),&
                   w_lorentz(j,:,k), &
                   2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, &
                   GRHydro_mppm_eigenvalue_y_right, &
                   GRHydro_mppm_xwind)
            end if
            do i = 1, ny
              if (trivial_rp(j,i,k)) then
                 SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
              else
                 SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      ny,CCTK_DELTA_SPACE(2),vel(j,:,k,2), & 
                      temperature(j,:,k),press(j,:,k),&
                      tempminus(j,:,k),tempplus(j,:,k), hydro_excision_mask)
               else
                 call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      ny,CCTK_DELTA_SPACE(2),lvel(j,:,k,2), & 
                      temperature(j,:,k),press(j,:,k),&
                      tempminus(j,:,k),tempplus(j,:,k), hydro_excision_mask)
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      endif
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
              if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                     ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                     vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1), &
                     tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), &
                     press(j,:,k))
              else
                call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                     ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                     lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1), &
                     tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), &
                     press(j,:,k))
              end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, nz - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                      vel(j,:,k,2),vel(j,:,k,3),vel(j,:,k,1), &
                      Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k), &
                      press(j,:,k))
               else
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      ny,CCTK_DELTA_SPACE(2),rho(j,:,k), &
                      lvel(j,:,k,2),lvel(j,:,k,3),lvel(j,:,k,1), &
                      Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k), &
                      press(j,:,k))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else if (flux_direction == 3) then
        !$OMP PARALLEL DO PRIVATE(i, j, k)
        do k = GRHydro_stencil, ny - GRHydro_stencil + 1
          do j = GRHydro_stencil, nx - GRHydro_stencil + 1
            if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
              call SimplePPM_1d(apply_enhanced_ppm,&
                   GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                   rho(j,k,:),vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2),eps(j,k,:),&
                   press(j,k,:),rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),&
                   velyminus(j,k,:),epsminus(j,k,:),rhoplus(j,k,:),&
                   velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),epsplus(j,k,:),&
                   trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                   gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), &
                   gyy(j,k,:), betaz(j,k,:), alp(j,k,:),&
                   w_lorentz(j,k,:), &
                   3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                   GRHydro_mppm_eigenvalue_z_right, &
                   GRHydro_mppm_xwind)
            else
              call SimplePPM_1d(apply_enhanced_ppm,&
                   GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),&
                   rho(j,k,:),lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2),eps(j,k,:),&
                   press(j,k,:),rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),&
                   velyminus(j,k,:),epsminus(j,k,:),rhoplus(j,k,:),&
                   velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),epsplus(j,k,:),&
                   trivial_rp(j,k,:), hydro_excision_mask(j,k,:),&
                   gcc(j,k,:), gac(j,k,:), gbc(j,k,:), gaa(j,k,:), gab(j,k,:), &
                   gbb(j,k,:), betac(j,k,:), alp(j,k,:),&
                   w_lorentz(j,k,:), &
                   3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, &
                   GRHydro_mppm_eigenvalue_z_right, &
                   GRHydro_mppm_xwind)
            end if
            do i = 1, nz
              if (trivial_rp(j,k,i)) then
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
              else
                SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
              end if
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),vel(j,k,:,3), & 
                      temperature(j,k,:),press(j,k,:),&
                      tempminus(j,k,:),tempplus(j,k,:), hydro_excision_mask)
               else
                 call SimplePPM_temperature_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),lvel(j,k,:,3), & 
                      temperature(j,k,:),press(j,k,:),&
                      tempminus(j,k,:),tempplus(j,k,:), hydro_excision_mask)
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      endif
      if(evolve_tracer.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1

               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2), &
                      tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), &
                      press(j,k,:))
               else
                 call SimplePPM_tracer_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2), &
                      tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), &
                      press(j,k,:))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if
      if(evolve_Y_e.ne.0) then
         !$OMP PARALLEL DO PRIVATE(j, k)
         do k = GRHydro_stencil, ny - GRHydro_stencil + 1
            do j = GRHydro_stencil, nx - GRHydro_stencil + 1
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      vel(j,k,:,3),vel(j,k,:,1),vel(j,k,:,2), &
                      Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:), &
                      press(j,k,:))
               else
                 call SimplePPM_ye_1d(apply_enhanced_ppm,&
                      nz,CCTK_DELTA_SPACE(3),rho(j,k,:), &
                      lvel(j,k,:,3),lvel(j,k,:,1),lvel(j,k,:,2), &
                      Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:), &
                      press(j,k,:))
               end if
            end do
         end do
         !$OMP END PARALLEL DO
      end if

    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
!!$ PPM ends.

  deallocate(trivial_rp)

end subroutine GRHydro_PPMReconstruct_drv

```

GRHydro_TVDReconstruct.cc:
```
#include <cmath>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_TVDReconstruct.hh"
#include "GRHydro_Reconstruct_drv_impl.hh"


using namespace std;

/**
   TVD reconstruction operator.
   limiter_type: 0 = minmod
                 1 = mc2
                 2 = superbee
*/
template <tvd::limiter_type limiter>
CCTK_REAL GRHydro_TVDReconstruct1d<limiter>::
minmod_func(const CCTK_REAL dupw, const CCTK_REAL dloc)
{
  return 0.5 * (copysign(1.0,dupw) + copysign(1.0,dloc)) *
    fmin(fabs(dupw),fabs(dloc));
}

template <tvd::limiter_type limiter>
CCTK_REAL GRHydro_TVDReconstruct1d<limiter>::
min3(const CCTK_REAL a, const CCTK_REAL b, const CCTK_REAL c)
{
  return fmin(a,fmin(b,c));
}

template <tvd::limiter_type limiter>
template <int dir>
void GRHydro_TVDReconstruct1d<limiter>::
apply(const int nx, const CCTK_REAL* const restrict a,
      CCTK_REAL* const restrict aminus, CCTK_REAL* const restrict aplus,
      const cGH* const cctkGH, const int j, const int k)
{
  DECLARE_CCTK_PARAMETERS;

#define A(i_) (a[ijk[i_]])
#define Aplus(i_) (aplus[ijk[i_]])
#define Aminus(i_) (aminus[ijk[i_]])


  for (int i=GRHydro_stencil-1; i < nx-GRHydro_stencil + 1; ++i)
   {

      const int ijk[3] = {
	dir ==0 ? CCTK_GFINDEX3D(cctkGH, i-1, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i-1, k) : CCTK_GFINDEX3D(cctkGH, j, k, i-1),
	dir ==0 ? CCTK_GFINDEX3D(cctkGH, i  , j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i  , k) : CCTK_GFINDEX3D(cctkGH, j, k, i  ),
	dir ==0 ? CCTK_GFINDEX3D(cctkGH, i+1, j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i+1, k) : CCTK_GFINDEX3D(cctkGH, j, k, i+1),
      };

      const CCTK_REAL dupw = A(1)-A(0);
      const CCTK_REAL dloc = A(2)-A(1);
      CCTK_REAL delta = 0.0;

      static_assert(limiter >= tvd::minmod && limiter < tvd::numlimiters,
                    "Unknown limiter");
      if(limiter == tvd::minmod) {
	// minmod
	delta = minmod_func(dupw,dloc);
      } else if (limiter == tvd::mc2) {
	// Van Leer MC slope limiter (mc2)
	if(dupw*dloc < 0.0)
	  delta = 0.0;
	else
	  delta = copysign(min3(2.0*fabs(dupw),2.0*fabs(dloc),
				0.5*(fabs(dupw)+fabs(dloc))),dupw+dloc);

      } else if (limiter == tvd::superbee) {
	// superbee
	if(dupw*dloc < 0.0)
	  delta = 0.0;
	else
	  delta = copysign(fmax(fmin(2.0*fabs(dupw),fabs(dloc)),
				fmin(2.0*fabs(dloc),fabs(dupw))),dupw+dloc);

      }
      Aminus(1) = A(1) - 0.5*delta;
      Aplus(1) = A(1) + 0.5*delta;
   }
}

// instantiate all copies we need, this way different operators can be compiled
// in parallel. This must match the select routine in GRHydro_Reconstruct.cc
template class GRHydro_TVDReconstruct1d<tvd::minmod>;
template class GRHydro_TVDReconstruct1d<tvd::mc2>;
template class GRHydro_TVDReconstruct1d<tvd::superbee>;

INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_TVDReconstruct1d<tvd::minmod>)
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_TVDReconstruct1d<tvd::mc2>)
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_TVDReconstruct1d<tvd::superbee>)


```

GRHydro_Differences.F90:
```
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_DiffRho
   @date       Fri Feb 18 10:02:31 2005
   @author     Ian Hawke
   @desc 
   Compute first differences in rho
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_DiffRho(CCTK_ARGUMENTS)
      
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k, nx, ny, nz
  CCTK_REAL :: idx, idy, idz

  CCTK_REAL :: dr_eps = 1.d-2

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

!!$  idx =  1.d0 / CCTK_DELTA_SPACE(1)
!!$  idy =  1.d0 / CCTK_DELTA_SPACE(2)
!!$  idz =  1.d0 / CCTK_DELTA_SPACE(3)

  idx = 1.d0
  idy = 1.d0
  idz = 1.d0

  DiffRho = 0.d0

  if (CCTK_EQUALS(gradient_method, "First diff")) then

!!$        Simple first differences

    do k = 2, nz - 1
      do j = 2, ny - 1
        do i = 2, nx - 1
          
          DiffRho(i,j,k) = 0.5d0 * ( &
                                   idx * abs(rho(i+1,j,k) - rho(i-1,j,k)) + &
                                   idy * abs(rho(i,j+1,k) - rho(i,j-1,k)) + &
                                   idz * abs(rho(i,j,k+1) - rho(i,j,k-1)) ) / &
                           rho(i,j,k)    
          
        end do
      end do
    end do
    
  else if (CCTK_EQUALS(gradient_method, "Curvature")) then

    do k = 2, nz - 1
      do j = 2, ny - 1
        do i = 2, nx - 1                 

!!$        Gradient as in Paramesh / Flash

          DiffRho(i,j,k) = &
               sqrt ( &
!!$             xx
             (abs(rho(i+1,j,k) - 2.d0 * rho(i,j,k) + rho(i-1,j,k)) / &
             ( abs(rho(i+1,j,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i-1,j,k)) + &
               dr_eps * (abs(rho(i+1,j,k)) + 2.d0 * abs(rho(i,j,k)) + &
                         abs(rho(i-1,j,k))) ))**2 + &
!!$                         xy
             (abs(rho(i+1,j+1,k) - rho(i+1,j-1,k) - &
                 rho(i-1,j+1,k) + rho(i-1,j-1,k)) / &
             ( abs(rho(i+1,j,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i-1,j,k)) + &
               dr_eps * (abs(rho(i+1,j+1,k)) + abs(rho(i+1,j-1,k)) + &
                         abs(rho(i-1,j+1,k)) + abs(rho(i-1,j-1,k))) ))**2 + &
!!$                         xz
             (abs(rho(i+1,j,k+1) - rho(i+1,j,k-1) - &
                 rho(i-1,j,k+1) + rho(i-1,j,k-1)) / &
             ( abs(rho(i+1,j,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i-1,j,k)) + &
               dr_eps * (abs(rho(i+1,j,k+1)) + abs(rho(i+1,j,k-1)) + &
                         abs(rho(i-1,j,k+1)) + abs(rho(i-1,j,k-1))) ))**2 + &
!!$             yx
             (abs(rho(i+1,j+1,k) - rho(i+1,j-1,k) - &
                 rho(i-1,j+1,k) + rho(i-1,j-1,k)) / &
             ( abs(rho(i,j+1,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j-1,k)) + &
               dr_eps * (abs(rho(i+1,j+1,k)) + abs(rho(i+1,j-1,k)) + &
                         abs(rho(i-1,j+1,k)) + abs(rho(i-1,j-1,k))) ))**2 + &
!!$                         yy
             (abs(rho(i,j+1,k) - 2.d0 * rho(i,j,k) + rho(i,j-1,k)) / &
             ( abs(rho(i,j+1,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j-1,k)) + &
               dr_eps * (abs(rho(i,j+1,k)) + 2.d0 * abs(rho(i,j,k)) + &
                         abs(rho(i,j-1,k))) ))**2 + &
!!$                         yz
             (abs(rho(i,j+1,k+1) - rho(i,j+1,k-1) - &
                 rho(i,j-1,k+1) + rho(i,j-1,k-1)) / &
             ( abs(rho(i,j+1,k) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j-1,k)) + &
               dr_eps * (abs(rho(i,j+1,k+1)) + abs(rho(i,j+1,k-1)) + &
                         abs(rho(i,j-1,k+1)) + abs(rho(i,j-1,k-1))) ))**2 + &
!!$             zx
             (abs(rho(i+1,j,k+1) - rho(i+1,j,k-1) - &
                 rho(i-1,j,k+1) + rho(i-1,j,k-1)) / &
             ( abs(rho(i,j,k+1) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j,k-1)) + &
               dr_eps * (abs(rho(i+1,j,k+1)) + abs(rho(i+1,j,k-1)) + &
                         abs(rho(i-1,j,k+1)) + abs(rho(i-1,j,k-1))) ))**2 + &
!!$                         zy
             (abs(rho(i,j+1,k+1) - rho(i,j-1,k+1) - &
                 rho(i,j+1,k-1) + rho(i,j-1,k-1)) / &
             ( abs(rho(i,j,k+1) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j,k-1)) + &
               dr_eps * (abs(rho(i,j+1,k+1)) + abs(rho(i,j-1,k+1)) + &
                         abs(rho(i,j+1,k-1)) + abs(rho(i,j-1,k-1))) ))**2 + &
!!$                         zz
             (abs(rho(i,j,k+1) - 2.d0 * rho(i,j,k) + rho(i,j,k-1)) / &
             ( abs(rho(i,j,k+1) - rho(i,j,k)) + &
               abs(rho(i,j,k) - rho(i,j,k-1)) + &
               dr_eps * (abs(rho(i,j,k+1)) + 2.d0 * abs(rho(i,j,k)) + &
                         abs(rho(i,j,k-1))) ))**2 &
          )
          
        end do
      end do
    end do
    
  else if (CCTK_EQUALS(gradient_method, "Rho weighted")) then

    DiffRho = &
         rho*(CCTK_DELTA_SPACE(1)*CCTK_DELTA_SPACE(2)*CCTK_DELTA_SPACE(3))**2

  else
    call CCTK_ERROR("Value of gradient_method not recognized")
    STOP
  end if

end subroutine GRHydro_DiffRho

```

GRHydro_WENOReconstruct.hh:
```
#ifndef _GRHYDRO_WENORECONSTRUCT_HH
#define _GRHYDRO_WENORECONSTRUCT_HH

#include "cctk.h"

using namespace std;

/**
   WENO5 reconstruction operator.
   Supports standard WENO5 (with and without adaptive epsilon), and WENO-z.
*/
template <bool do_wenoz, bool do_adaptive_epsilon>
struct GRHydro_WENOReconstruct1d_cxx {
template <int dir>
static inline void apply(const int nx,
                         const CCTK_REAL* const restrict a,
                         CCTK_REAL* const restrict aminus,
                         CCTK_REAL* const restrict aplus,
                         const cGH* const cctkGH,
                         const int j, const int k
                        );

}; // end struct

#endif // _GRHYDRO_WENORECONSTRUCT_HH

```

GRHydro_PPM_opt.h:
```
template<bool do_temp, bool do_ye, bool do_mhd, 
	 bool dc_flag, bool do_ppm_detect>
void GRHydro_ppm1d_cxx(const int nx, 
		      const double dx, 
		      const double* restrict rho, 
		      const double* restrict velx,
		      const double* restrict vely, 
		      const double* restrict velz, 
		      const double* restrict eps, 
		      const double* restrict press,
		      const double* restrict temp,
		      const double* restrict ye,
		      const double* restrict Bvcx,
		      const double* restrict Bvcy,
		      const double* restrict Bvcz,
		      const double* restrict psidc,
		      double* restrict rhominus, 
		      double* restrict velxminus, 
		      double* restrict velyminus,
		      double* restrict velzminus, 
		      double* restrict epsminus, 
		      double* restrict tempminus, 
		      double* restrict yeminus, 
		      double* restrict Bvcxminus,
		      double* restrict Bvcyminus,
		      double* restrict Bvczminus,
		      double* restrict psidcminus,
		      double* restrict rhoplus, 
		      double* restrict velxplus, 
		      double* restrict velyplus,
		      double* restrict velzplus, 
		      double* restrict epsplus,
		      double* restrict tempplus, 
		      double* restrict yeplus,
		      double* restrict Bvcxplus,
		      double* restrict Bvcyplus,
		      double* restrict Bvczplus,
		      double* restrict psidcplus);

template<bool do_temp, bool do_ye, bool do_mhd, 
         bool dc_flag, bool do_ppm_detect>
void GRHydro_eppm1d_cxx(const int nx, 
                      const double dx, 
                      const double* restrict rho, 
                      const double* restrict velx,
                      const double* restrict vely, 
                      const double* restrict velz, 
                      const double* restrict eps, 
                      const double* restrict press,
                      const double* restrict temp,
                      const double* restrict ye,
                      const double* restrict Bvcx,
                      const double* restrict Bvcy,
                      const double* restrict Bvcz,
                      const double* restrict psidc,
                      double* restrict rhominus, 
                      double* restrict velxminus, 
                      double* restrict velyminus,
                      double* restrict velzminus, 
                      double* restrict epsminus, 
                      double* restrict tempminus, 
                      double* restrict yeminus, 
                      double* restrict Bvcxminus,
                      double* restrict Bvcyminus,
                      double* restrict Bvczminus,
                      double* restrict psidcminus,
                      double* restrict rhoplus, 
                      double* restrict velxplus, 
                      double* restrict velyplus,
                      double* restrict velzplus, 
                      double* restrict epsplus,
                      double* restrict tempplus, 
                      double* restrict yeplus,
                      double* restrict Bvcxplus,
                      double* restrict Bvcyplus,
                      double* restrict Bvczplus,
                      double* restrict psidcplus);



```

GRHydro_WENOReconstruct.F90:
```
 /*@@
   @file      GRHydro_WENOReconstruct.F90
   @date      Fri Jan 3 2013
   @author    Ian Hawke, Christian Reisswig
   @desc 
   Routines to set up the coefficient array and to perform one dimensional 
   ENO reconstruction of arbitrary order.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydro_WENOSetup
   @date       Fri Jan 3 2013
   @author     Christian Reisswig
   @desc 
   Sets up the coefficient array for WENO reconstruction. 
   Uses the notation of Shu, equation (2.21), in 
   ''High Order ENO and WENO Schemes for CFD''
   (see ThornGuide for full reference).
   One exception: (Shu) r -> (Here) i: avoiding name clash.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_WENOSetup(CCTK_ARGUMENTS)

  USE GRHydro_WENOScalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: allocstat

  if(.not.allocated(weno_coeffs)) then ! uses weno_coeffs as a sentinel
     ! Right now we hardcode to 5th order
     allocate(weno_coeffs(3, 5), STAT=allocstat)
     if (allocstat .ne. 0) then
       call CCTK_ERROR("Failed to allocate WENO coefficient arrays!")
       STOP
     end if
     allocate(beta_shu(3, 6), STAT=allocstat)
     if (allocstat .ne. 0) then
       call CCTK_ERROR("Failed to allocate smoothness indicator stencil coefficient arrays!")
       STOP
     end if
  endif

  ! Set stencils
  if (CCTK_EQUALS(recon_method,"weno-z")) then
      weno_coeffs(1,1) =   2.0d0/6.0d0
      weno_coeffs(1,2) =  -7.0d0/6.0d0
      weno_coeffs(1,3) =  11.0d0/6.0d0
      weno_coeffs(1,4) =   0.0d0
      weno_coeffs(1,5) =   0.0d0
      
      weno_coeffs(2,1) =   0.0d0
      weno_coeffs(2,2) =  -1.0d0/6.0d0
      weno_coeffs(2,3) =   5.0d0/6.0d0
      weno_coeffs(2,4) =   2.0d0/6.0d0
      weno_coeffs(2,5) =   0.0d0
      
      weno_coeffs(3,1) =   0.0d0
      weno_coeffs(3,2) =   0.0d0
      weno_coeffs(3,3) =   2.0d0/6.0d0
      weno_coeffs(3,4) =   5.0d0/6.0d0
      weno_coeffs(3,5) =  -1.0d0/6.0d0
  else
      weno_coeffs(1,1) =   3.0d0/8.0d0
      weno_coeffs(1,2) =  -5.0d0/4.0d0
      weno_coeffs(1,3) =  15.0d0/8.0d0
      weno_coeffs(1,4) =   0.0d0
      weno_coeffs(1,5) =   0.0d0
      
      weno_coeffs(2,1) =   0.0d0
      weno_coeffs(2,2) =  -1.0d0/8.0d0
      weno_coeffs(2,3) =   3.0d0/4.0d0
      weno_coeffs(2,4) =   3.0d0/8.0d0
      weno_coeffs(2,5) =   0.0d0
      
      weno_coeffs(3,1) =   0.0d0
      weno_coeffs(3,2) =   0.0d0
      weno_coeffs(3,3) =   3.0d0/8.0d0
      weno_coeffs(3,4) =   3.0d0/4.0d0
      weno_coeffs(3,5) =  -1.0d0/8.0d0
  endif
   
  ! Shu smoothness indicator stencil coefficients
  beta_shu(1,1) =   4.0d0/3.0d0
  beta_shu(1,2) = -19.0d0/3.0d0
  beta_shu(1,3) =  25.0d0/3.0d0
  beta_shu(1,4) =  11.0d0/3.0d0
  beta_shu(1,5) = -31.0d0/3.0d0
  beta_shu(1,6) =  10.0d0/3.0d0
  
  beta_shu(2,1) =   4.0d0/3.0d0
  beta_shu(2,2) = -13.0d0/3.0d0
  beta_shu(2,3) =  13.0d0/3.0d0
  beta_shu(2,4) =   5.0d0/3.0d0
  beta_shu(2,5) = -13.0d0/3.0d0
  beta_shu(2,6) =   4.0d0/3.0d0
  
  beta_shu(3,1) =  10.0d0/3.0d0
  beta_shu(3,2) = -31.0d0/3.0d0
  beta_shu(3,3) =  25.0d0/3.0d0
  beta_shu(3,4) =  11.0d0/3.0d0
  beta_shu(3,5) = -19.0d0/3.0d0
  beta_shu(3,6) =   4.0d0/3.0d0
  
end subroutine GRHydro_WENOSetup

 /*@@
   @routine    GRHydro_ENOShutdown
   @date       Fri Jan  3 2013
   @author     Christian Reisswig
   @desc 
   Deallocates the coefficient arrays
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_WENOShutdown(CCTK_ARGUMENTS)

  USE GRHydro_WENOScalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: deallocstat

  if(allocated(weno_coeffs)) then
     deallocate(weno_coeffs, STAT = deallocstat)
     if (deallocstat .ne. 0) then
       call CCTK_ERROR("Failed to deallocate WENO coefficients.")
       STOP
     end if
     deallocate(beta_shu, STAT = deallocstat)
     if (deallocstat .ne. 0) then
       call CCTK_ERROR("Failed to deallocate shu smoothness indicator coefficients.")
       STOP
     end if
  endif

end subroutine GRHydro_WENOShutdown

 /*@@
   @routine    GRHydro_ENOReconstruct1d
   @date       Fri Jan 3 2013
   @author     Christian Reisswig
   @desc 
   Perform a one dimensional reconstruction of a given array using WENO.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

#define SpaceMask_CheckStateBitsF90_1D(mask,i,type_bits,state_bits) \
  (iand(mask((i)),(type_bits)).eq.(state_bits))

subroutine GRHydro_WENOReconstruct1d(order, nx, v, vminus, vplus, trivial_rp, &
     hydro_excision_mask)
  USE GRHydro_WENOScalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: order, nx, i, j
  CCTK_REAL, dimension(nx) :: v, vplus, vminus

  CCTK_INT, dimension(nx) :: hydro_excision_mask
  logical, dimension(nx) :: trivial_rp
  logical, dimension(nx) :: excise
  logical :: normal_weno
  logical :: wenoZ

  CCTK_REAL :: beta1, beta2, beta3, vnorm, betanorm
  CCTK_REAL :: wplus1, wplus2, wplus3, wbarplus1, wbarplus2, wbarplus3
  CCTK_REAL :: wminus1, wminus2, wminus3, wbarminus1, wbarminus2, wbarminus3

  vminus = 0.d0
  vplus = 0.d0

  excise = .false.
  trivial_rp = .false.

  if (CCTK_EQUALS(recon_method,"weno-z")) then
     wenoZ = .true.
  else
     wenoZ = .false.
  endif
  
!!$    Initialize excision
  do i = 1, nx
    if (GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i) .ne. 0)) then
      trivial_rp(i) = .true.
      excise(i) = .true.
      if (i > 1) then
        trivial_rp(i-1) = .true.
      end if
    end if
  end do

  do i = 3, nx-2
!!$    Handle excision
    normal_weno = .true.
    if (i < nx) then
     if (excise(i+1)) then
      vminus(i) = v(i)
      vplus(i) = v(i)
      normal_weno = .false.
     end if
    end if
    if (i > 1) then
     if (excise(i-1)) then
      vminus(i) = v(i)
      vplus(i) = v(i)
      normal_weno = .false.
     end if
    end if

    if (normal_weno) then

      if (wenoZ) then

         beta1 = 13.0d0/12.d0*(v(i-2)-2.0d0*v(i-1)+v(i))**2 + 1.0d0/4.d0*(v(i-2)-4.0d0*v(i-1)+3.0d0*v(i))**2
         beta2 = 13.0d0/12.d0*(v(i-1)-2.0d0*v(i)+v(i+1))**2 + 1.0d0/4.d0*(v(i-1)-v(i+1))**2
         beta3 = 13.0d0/12.d0*(v(i)-2.0d0*v(i+1)+v(i+2))**2 + 1.0d0/4.d0*(3.0d0*v(i)-4.0d0*v(i+1)+v(i+2))**2
      
      
      !!$    Compute weights according to weno-z alorithm
         wbarplus1 = 1.0d0/10.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta1))
         wbarplus2 = 3.0d0/5.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta2))
         wbarplus3 = 3.0d0/10.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta3))

         wbarminus1 = 3.0d0/10.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta1))
         wbarminus2 = 3.0d0/5.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta2))
         wbarminus3 = 1.0d0/10.0d0 * (1.0d0 + abs(beta1-beta3) / (weno_eps + beta3))

      
      else
      
   !!$    Compute smoothness indicators
         beta1  = beta_shu(1,1)*v(i-2)**2      &
               + beta_shu(1,2)*v(i-2)*v(i-1)  &
               + beta_shu(1,3)*v(i-1)**2      &
               + beta_shu(1,4)*v(i-2)*v(i)    &
               + beta_shu(1,5)*v(i-1)*v(i)    &
               + beta_shu(1,6)*v(i)**2
      
         beta2  = beta_shu(2,1)*v(i-1)**2      &
               + beta_shu(2,2)*v(i-1)*v(i)    &
               + beta_shu(2,3)*v(i)**2        &
               + beta_shu(2,4)*v(i-1)*v(i+1)  &
               + beta_shu(2,5)*v(i)*v(i+1)    &
               + beta_shu(2,6)*v(i+1)**2
      
         beta3  = beta_shu(3,1)*v(i)**2       &
               + beta_shu(3,2)*v(i)*v(i+1)   &
               + beta_shu(3,3)*v(i+1)**2     &
               + beta_shu(3,4)*v(i)*v(i+2)   &
               + beta_shu(3,5)*v(i+1)*v(i+2) &
               + beta_shu(3,6)*v(i+2)**2
      
   !!$    This is modification is suggested by Tchekhovskoy et al 2007 (WHAM code paper).
         if (weno_adaptive_epsilon.ne.0) then
            vnorm = (v(i-2)**2 + v(i-1)**2 + v(i)**2 + v(i+1)**2 + v(i+2)**2)
            
            beta1 = beta1 + 100.0d0*weno_eps*(vnorm + 1.0d0)
            beta2 = beta2 + 100.0d0*weno_eps*(vnorm + 1.0d0)
            beta3 = beta3 + 100.0d0*weno_eps*(vnorm + 1.0d0)
            
            betanorm = beta1 + beta2 + beta3
            
            beta1 = beta1 / betanorm
            beta2 = beta2 / betanorm
            beta3 = beta3 / betanorm
         endif
         
         wbarplus1 = 1.0d0/16.0d0 / (weno_eps + beta1)**2
         wbarplus2 = 5.0d0/8.0d0 / (weno_eps + beta2)**2
         wbarplus3 = 5.0d0/16.0d0 / (weno_eps + beta3)**2
      
         wbarminus1 = 5.0d0/16.0d0 / (weno_eps + beta1)**2
         wbarminus2 = 5.0d0/8.0d0 / (weno_eps + beta2)**2
         wbarminus3 = 1.0d0/16.0d0 / (weno_eps + beta3)**2

      endif
      
      wplus1 = wbarplus1 / (wbarplus1 + wbarplus2 + wbarplus3)
      wplus2 = wbarplus2 / (wbarplus1 + wbarplus2 + wbarplus3)
      wplus3 = wbarplus3 / (wbarplus1 + wbarplus2 + wbarplus3)
    
      wminus1 = wbarminus1 / (wbarminus1 + wbarminus2 + wbarminus3)
      wminus2 = wbarminus2 / (wbarminus1 + wbarminus2 + wbarminus3)
      wminus3 = wbarminus3 / (wbarminus1 + wbarminus2 + wbarminus3)
            
!!$    Calculate the reconstruction
      do j = 1, 5
         vplus(i) = vplus(i) + wplus1 * weno_coeffs(1,j)*v(i-3+j) &
                             + wplus2 * weno_coeffs(2,j)*v(i-3+j) &
                             + wplus3 * weno_coeffs(3,j)*v(i-3+j)
         vminus(i) = vminus(i) + wminus1 * weno_coeffs(3,6-j)*v(i-3+j) &
                               + wminus2 * weno_coeffs(2,6-j)*v(i-3+j) &
                               + wminus3 * weno_coeffs(1,6-j)*v(i-3+j)
      end do
      !vminus(i) = v(i)
      !vplus(i) = v(i)
            
    end if
  end do

  do i = 1, nx
    if (excise(i)) then
      if (i > 1) then
        if (.not. excise(i-1)) then
          vminus(i) = vplus(i-1)
        end if
      end if
      vplus(i) = vminus(i)
    end if
  end do
  do i = nx, 1, -1
    if (excise(i)) then
      if (i < nx) then
        if (.not. excise(i+1)) then
          vplus(i) = vminus(i+1)
        end if
      end if
      vminus(i) = vplus(i)
    end if
  end do

end subroutine GRHydro_WENOReconstruct1d

```

GRHydro_CalcUpdate.F90:
```
  /*@@
   @file      GRHydro_CalcUpdate.F90
   @date      Thu Jan  11 11:03:32 2002
   @author    Ian Hawke
   @desc 
   Calculates the update terms given the fluxes. Moved to here so that 
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"

 /*@@
   @routine    UpdateCalculation 
   @date       Wed Feb 13 11:03:32 2002
   @author     Ian Hawke
   @desc 
   Calculates the update terms from the fluxes.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Moved out of the Riemann solver routines to make the FishEye /
   weighted flux calculation easier.
   @endhistory 

@@*/


subroutine UpdateCalculation(CCTK_ARGUMENTS)
    
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k,itracer
  CCTK_REAL :: idx, idy, idz, alp_l, alp_r, Bcons_l, Bcons_r, alp_tmp

  idx = 1.d0 / CCTK_DELTA_SPACE(flux_direction)

  if (CCTK_EQUALS(method_type, "RSA FV")) then

    if (use_weighted_fluxes == 0) then

      if(evolve_mhd.ne.0 .and. transport_constraints.ne.0) then
        !$OMP PARALLEL DO PRIVATE(i,j,k,alp_l,alp_r,alp_tmp)
        do k = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(3) - GRHydro_stencil ! we need to compute Evec on all faces/edges where the fluxes are defined
          do j = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(2) - GRHydro_stencil
            do i = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(1) - GRHydro_stencil

              alp_l = 0.5d0 * (alp(i,j,k) + &
                   alp(i-xoffset,j-yoffset,k-zoffset))
              alp_r = 0.5d0 * (alp(i,j,k) + &
                   alp(i+xoffset,j+yoffset,k+zoffset))
             
              ! we have to first compute all components of v\crossB = E and
              ! combine them in the last substep into Bconshs
              ! Evec lives on edges of cell: Evec(i,j,k,1) is at edge i,j+1/2,k+1/2 ie. the lower-front edge of cell (i,j,k)
              if(flux_direction.eq.1) then
                 alp_tmp = 0.5d0 * (alp(i,j,k+1) + alp(i+xoffset,j+yoffset,k+zoffset+1))
                 Evec(i,j,k,2) = Evec(i,j,k,2) + 0.25d0 * (alp_r*Bconszflux(i,j,k) + alp_tmp*Bconszflux(i  ,j  ,k+1))
                 alp_tmp = 0.5d0 * (alp(i,j+1,k) + alp(i+xoffset,j+yoffset+1,k+zoffset))
                 Evec(i,j,k,3) = Evec(i,j,k,3) - 0.25d0 * (alp_r*Bconsyflux(i,j,k) + alp_tmp*Bconsyflux(i  ,j+1,k  ))
              elseif(flux_direction.eq.2) then
                 alp_tmp = 0.5d0 * (alp(i,j,k+1) + alp(i+xoffset,j+yoffset,k+zoffset+1))
                 Evec(i,j,k,1) = Evec(i,j,k,1) - 0.25d0 * (alp_r*Bconszflux(i,j,k) + alp_tmp*Bconszflux(i  ,j  ,k+1))
                 alp_tmp = 0.5d0 * (alp(i+1,j,k) + alp(i+xoffset+1,j+yoffset,k+zoffset))
                 Evec(i,j,k,3) = Evec(i,j,k,3) + 0.25d0 * (alp_r*Bconsxflux(i,j,k) + alp_tmp*Bconsxflux(i+1,j  ,k  ))
              elseif(flux_direction.eq.3) then
                 alp_tmp = 0.5d0 * (alp(i,j+1,k) + alp(i+xoffset,j+yoffset+1,k+zoffset))
                 Evec(i,j,k,1) = Evec(i,j,k,1) + 0.25d0 * (alp_r*Bconsyflux(i,j,k) + alp_tmp*Bconsyflux(i  ,j+1,k  ))
                 alp_tmp = 0.5d0 * (alp(i+1,j,k) + alp(i+xoffset+1,j+yoffset,k+zoffset))
                 Evec(i,j,k,2) = Evec(i,j,k,2) - 0.25d0 * (alp_r*Bconsxflux(i,j,k) + alp_tmp*Bconsxflux(i+1,j  ,k  ))
              end if
            enddo
          enddo
        enddo
        !$OMP END PARALLEL DO
      endif
 
      !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,alp_l,alp_r,alp_tmp,Bcons_l,Bcons_r)
      do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil ! we need to compute Evec on all faces/edges where the fluxes are defined
        do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil
          do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil

            alp_l = 0.5d0 * (alp(i,j,k) + &
                 alp(i-xoffset,j-yoffset,k-zoffset))
            alp_r = 0.5d0 * (alp(i,j,k) + &
                 alp(i+xoffset,j+yoffset,k+zoffset))
            
            densrhs(i,j,k) = densrhs(i,j,k) + &
                 (alp_l * densflux(i-xoffset,j-yoffset,k-zoffset) - &
                 alp_r * densflux(i,j,k)) * idx
            srhs(i,j,k,1) = srhs(i,j,k,1) + &
                 (alp_l * sxflux(i-xoffset,j-yoffset,k-zoffset) - &
                 alp_r * sxflux(i,j,k)) * idx
            srhs(i,j,k,2) = srhs(i,j,k,2) + &
                 (alp_l * syflux(i-xoffset,j-yoffset,k-zoffset) - &
                 alp_r * syflux(i,j,k)) * idx
            srhs(i,j,k,3) = srhs(i,j,k,3) + &
                 (alp_l * szflux(i-xoffset,j-yoffset,k-zoffset) - &
                 alp_r * szflux(i,j,k)) * idx
            taurhs(i,j,k) = taurhs(i,j,k) + &
                 (alp_l * tauflux(i-xoffset,j-yoffset,k-zoffset) - &
                 alp_r * tauflux(i,j,k)) * idx
            if(evolve_mhd.ne.0) then
              if(transport_constraints.eq.0) then
                 Bconsrhs(i,j,k,1) = Bconsrhs(i,j,k,1) + &
                      (alp_l * Bconsxflux(i-xoffset,j-yoffset,k-zoffset) - &
                      alp_r * Bconsxflux(i,j,k)) * idx
                 Bconsrhs(i,j,k,2) = Bconsrhs(i,j,k,2) + &
                      (alp_l * Bconsyflux(i-xoffset,j-yoffset,k-zoffset) - &
                      alp_r * Bconsyflux(i,j,k)) * idx
                 Bconsrhs(i,j,k,3) = Bconsrhs(i,j,k,3) + &
                      (alp_l * Bconszflux(i-xoffset,j-yoffset,k-zoffset) - &
                      alp_r * Bconszflux(i,j,k)) * idx
              endif
              if(clean_divergence.ne.0) then
                 psidcrhs(i,j,k) = psidcrhs(i,j,k) + &
                      (alp_l * psidcflux(i-xoffset,j-yoffset,k-zoffset) - &
                      alp_r * psidcflux(i,j,k)) * idx
              endif
            endif
    
            if (evolve_tracer .ne. 0) then
               do itracer=1,number_of_tracers
                  cons_tracerrhs(i,j,k,itracer) = cons_tracerrhs(i,j,k,itracer) + &
                       (alp_l * cons_tracerflux(i-xoffset,j-yoffset,k-zoffset,itracer) - &
                       alp_r * cons_tracerflux(i,j,k,itracer)) * idx
               enddo
            end if
            
            if (evolve_Y_e .ne. 0) then
               Y_e_con_rhs(i,j,k) = Y_e_con_rhs(i,j,k) + &
                    (alp_l * Y_e_con_flux(i-xoffset,j-yoffset,k-zoffset) - &
                    alp_r * Y_e_con_flux(i,j,k)) * idx
            end if
            
            if (evolve_entropy .ne. 0) then
               entropyrhs(i,j,k) = entropyrhs(i,j,k) + &
                    (alp_l * entropyflux(i-xoffset,j-yoffset,k-zoffset) - &
                    alp_r * entropyflux(i,j,k)) * idx
            end if

!            densrhs(i,j,k) = 0.0d0
!            taurhs(i,j,k)  = 0.0d0
!            srhs(i,j,k,:) = 0.0d0
!            y_e_con_rhs(i,j,k) = 0.0d0

            
            if (wk_atmosphere .eq. 1) then

              if (atmosphere_mask(i,j,k) .ne. 0) then

!!$                We are in the atmosphere so the momentum flux must vanish

                srhs(i,j,k,:) = 0.d0

                if ( (atmosphere_mask(i-1,j  ,k  ) .ne. 0) .and. &
                     (atmosphere_mask(i+1,j  ,k  ) .ne. 0) .and. &
                     (atmosphere_mask(i  ,j-1,k  ) .ne. 0) .and. &
                     (atmosphere_mask(i  ,j+1,k  ) .ne. 0) .and. &
                     (atmosphere_mask(i  ,j  ,k-1) .ne. 0) .and. &
                     (atmosphere_mask(i  ,j  ,k+1) .ne. 0) &
                   ) then

!!$                    All neighbours are also atmosphere so all rhs vanish

                    densrhs(i,j,k) = 0.d0
                    taurhs(i,j,k)  = 0.d0

                end if
              end if

            end if

          enddo
        enddo
      enddo
      !$OMP END PARALLEL DO
      
    else
      
      call CCTK_ERROR("Not supported")
      STOP
      
!!$    do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil
!!$      do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil
!!$        do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil
!!$          
!!$          alp_l = 0.5d0 * (alp(i,j,k) + &
!!$               alp(i-xoffset,j-yoffset,k-zoffset))
!!$          alp_r = 0.5d0 * (alp(i,j,k) + &
!!$               alp(i+xoffset,j+yoffset,k+zoffset))
!!$          
!!$          densrhs(i,j,k) = densrhs(i,j,k) + &
!!$               (alp_l * &
!!$               &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * &
!!$               &densflux(i-xoffset,j-yoffset,k-zoffset) - &
!!$               alp_r * &
!!$               &cell_surface(i,j,k,flux_direction) * &
!!$               &densflux(i,j,k)) * idx / cell_volume(i,j,k)
!!$          sxrhs(i,j,k) = sxrhs(i,j,k) + &
!!$               (alp_l * &
!!$               &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * &
!!$               &sxflux(i-xoffset,j-yoffset,k-zoffset) - &
!!$               alp_r * &
!!$               &cell_surface(i,j,k,flux_direction) * &
!!$               &sxflux(i,j,k)) * idx / cell_volume(i,j,k)
!!$          syrhs(i,j,k) = syrhs(i,j,k) + &
!!$               (alp_l * &
!!$               &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * &
!!$               &syflux(i-xoffset,j-yoffset,k-zoffset) - &
!!$               alp_r * &
!!$               &cell_surface(i,j,k,flux_direction) * &
!!$               &syflux(i,j,k)) * idx / cell_volume(i,j,k)
!!$          szrhs(i,j,k) = szrhs(i,j,k) + &
!!$               (alp_l * &
!!$               &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * &
!!$               &szflux(i-xoffset,j-yoffset,k-zoffset) - &
!!$               alp_r * &
!!$               &cell_surface(i,j,k,flux_direction) * &
!!$               &szflux(i,j,k)) * idx / cell_volume(i,j,k)
!!$          taurhs(i,j,k) = taurhs(i,j,k) + &
!!$               (alp_l * &
!!$               &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * &
!!$               &tauflux(i-xoffset,j-yoffset,k-zoffset) - &
!!$               alp_r * &
!!$               &cell_surface(i,j,k,flux_direction) * &
!!$               &tauflux(i,j,k)) * idx / cell_volume(i,j,k)
!!$          
!!$        enddo
!!$      enddo
!!$    enddo

    end if
  
  else if (CCTK_EQUALS(method_type, "Flux split FD")) then

    if (evolve_mhd.ne.0 .and. transport_constraints .ne. 0) then
      call CCTK_ERROR("Not supported")
      STOP
    end if

    do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil
      do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil
        do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil
          
          densrhs(i,j,k) = densrhs(i,j,k) + &
               (densflux(i-xoffset,j-yoffset,k-zoffset) - &
                densflux(i,j,k)) * idx
          srhs(i,j,k,1) = srhs(i,j,k,1) + &
               (sxflux(i-xoffset,j-yoffset,k-zoffset) - &
                sxflux(i,j,k)) * idx
          srhs(i,j,k,2) = srhs(i,j,k,2) + &
               (syflux(i-xoffset,j-yoffset,k-zoffset) - &
                syflux(i,j,k)) * idx
          srhs(i,j,k,3) = srhs(i,j,k,3) + &
               (szflux(i-xoffset,j-yoffset,k-zoffset) - &
                szflux(i,j,k)) * idx
          taurhs(i,j,k) = taurhs(i,j,k) + &
               (tauflux(i-xoffset,j-yoffset,k-zoffset) - &
               tauflux(i,j,k)) * idx
          
          if(evolve_mhd.ne.0) then
             Bconsrhs(i,j,k,1) = Bconsrhs(i,j,k,1) + &
                  (Bconsxflux(i-xoffset,j-yoffset,k-zoffset) - &
                  Bconsxflux(i,j,k)) * idx
             Bconsrhs(i,j,k,2) = Bconsrhs(i,j,k,2) + &
                  (Bconsyflux(i-xoffset,j-yoffset,k-zoffset) - &
                  Bconsyflux(i,j,k)) * idx
             Bconsrhs(i,j,k,3) = Bconsrhs(i,j,k,3) + &
                  (Bconszflux(i-xoffset,j-yoffset,k-zoffset) - &
                  Bconszflux(i,j,k)) * idx
             if(clean_divergence.ne.0) then
                psidcrhs(i,j,k) = psidcrhs(i,j,k) + &
                     (psidcflux(i-xoffset,j-yoffset,k-zoffset) - &
                     psidcflux(i,j,k)) * idx
             endif
             if(track_divB.ne.0) then
               Bcons_l = 0.5d0 * (Bcons(i,j,k,flux_direction) + &
                        Bcons(i-xoffset,j-yoffset,k-zoffset,flux_direction))
               Bcons_r = 0.5d0 * (Bcons(i,j,k,flux_direction) + &
                        Bcons(i+xoffset,j+yoffset,k+zoffset,flux_direction))
               divB(i,j,k) = divB(i,j,k) + ( Bcons_l - Bcons_r ) * idx 
             endif
          endif

        enddo
      enddo
    enddo
      
  end if

  if (evolve_mhd.ne.0 .and. transport_constraints.ne.0 .and. &
      flux_direction.eq.1) then ! HACK: x direction is last
    ! FIXME: I think one could wrap all of this into a single do loop and remove the
    !        Evec storage
    ! idx differs from idx which was 1d0/CCTK_DELTA_SPACE(flux_direction)
    idx = 1d0 / CCTK_DELTA_SPACE(1)
    idy = 1d0 / CCTK_DELTA_SPACE(2)
    idz = 1d0 / CCTK_DELTA_SPACE(3)
    !$OMP PARALLEL DO PRIVATE(i,j,k)
    do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil
      do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil
        do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil
          Bconsrhs(i,j,k,1) = - 0.5d0 * ((Evec(i-1,j  ,k-1,2)-Evec(i-1,j  ,k  ,2)) &
                                       + (Evec(i  ,j  ,k-1,2)-Evec(i  ,j  ,k  ,2))) * idz &
                              - 0.5d0 * ((Evec(i-1,j  ,k  ,3)-Evec(i-1,j-1,k  ,3)) &
                                       + (Evec(i  ,j  ,k  ,3)-Evec(i  ,j-1,k  ,3))) * idy
          Bconsrhs(i,j,k,2) = - 0.5d0 * ((Evec(i-1,j-1,k  ,3)-Evec(i  ,j-1,k  ,3)) &
                                       + (Evec(i-1,j  ,k  ,3)-Evec(i  ,j  ,k  ,3))) * idx &
                              - 0.5d0 * ((Evec(i  ,j-1,k  ,1)-Evec(i  ,j-1,k-1,1)) &
                                       + (Evec(i  ,j  ,k  ,1)-Evec(i  ,j  ,k-1,1))) * idz
          Bconsrhs(i,j,k,3) = - 0.5d0 * ((Evec(i  ,j-1,k-1,1)-Evec(i  ,j  ,k-1,1)) &
                                       + (Evec(i  ,j-1,k  ,1)-Evec(i  ,j  ,k  ,1))) * idy &
                              - 0.5d0 * ((Evec(i  ,j  ,k-1,2)-Evec(i-1,j  ,k-1,2)) &
                                       + (Evec(i  ,j  ,k  ,2)-Evec(i-1,j  ,k  ,2))) * idx
        enddo
      enddo
    enddo
    !$OMP END PARALLEL DO
  end if
  
  return

end subroutine UpdateCalculation
  




 /*@@
   @routine    ConstrainSconTo1D
   @date       Tue  24 14:12 2012
   @author     Christian Reisswig
   @desc 
   Constrains the conserved fluid velocity to radial direction
   @enddesc 
   @calls     
   @calledby   
   @history 
   @endhistory 

@@*/


subroutine ConstrainSconTo1D(CCTK_ARGUMENTS)
   implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k
  CCTK_REAL :: rnorm, rnormI, scon_tmp1, scon_tmp2, scon_tmp3

      !$OMP PARALLEL DO PRIVATE(i,j,k,rnorm,rnormI,scon_tmp1,scon_tmp2,scon_tmp3)
      do k = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(3) - GRHydro_stencil ! we need to compute Evec on all faces/edges where the fluxes are defined
        do j = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(2) - GRHydro_stencil
          do i = GRHydro_stencil + 1 - transport_constraints, cctk_lsh(1) - GRHydro_stencil

            
            ! Eliminate non-radial fluid velocities to obtain pseudo 1D scheme
               rnorm = (x(i,j,k)**2 + y(i,j,k)**2 + z(i,j,k)**2)
               if (rnorm.lt.1.0d-10) then
                  rnormI = 0.0d0
               else
                  rnormI = 1.0d0/rnorm
               endif
               
               scon_tmp1 = (x(i,j,k)*scon(i,j,k,1) &
                          + y(i,j,k)*scon(i,j,k,2) &
                          + z(i,j,k)*scon(i,j,k,3)) * rnormI * x(i,j,k)
               scon_tmp2 = (x(i,j,k)*scon(i,j,k,1) &
                          + y(i,j,k)*scon(i,j,k,2) &
                          + z(i,j,k)*scon(i,j,k,3)) * rnormI * y(i,j,k)
               scon_tmp3 = (x(i,j,k)*scon(i,j,k,1) &
                          + y(i,j,k)*scon(i,j,k,2) &
                          + z(i,j,k)*scon(i,j,k,3)) * rnormI * z(i,j,k)
               
               scon(i,j,k,1) = scon_tmp1
               scon(i,j,k,2) = scon_tmp2
               scon(i,j,k,3) = scon_tmp3
               
        end do
      end do
    end do
end subroutine ConstrainSconTo1D


```

GRHydro_Con2PrimM_pt_EOSOmni.c:
```
/***********************************************************************************
    Copyright 2006 Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, 
                   and Luca Del Zanna.

                        PVS_GRMHD

    This file was derived from PVS_GRMHD.  The authors of PVS_GRMHD include 
    Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, and Luca Del Zanna.
    PVS_GRMHD is available under the GPL from:
    http://rainman.astro.uiuc.edu/codelib/  

    You are morally obligated to cite the following  paper in his/her 
    scientific literature that results from use of this file:

    [1] Noble, S. C., Gammie, C. F., McKinney, J. C., \& Del Zanna, L. \ 2006, 
        Astrophysical Journal, 641, 626.

    PVS_GRMHD 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.

    PVS_GRMHD 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 PVS_GRMHD; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

    If the user has any questions, please direct them to Scott C. Noble at 
    scn@astro.rit.edu  . 

***********************************************************************************/



#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <float.h>
#include <complex.h>

#include "cctk.h"
#include "cctk_Parameters.h"

/* Set this to be 1 if you want debug output */
#define DEBUG_CON2PRIMM (0)


/* Adiabatic index used for the state equation */

#define MAX_NEWT_ITER   (30)       /* Max. # of Newton-Raphson iterations for find_root_2D(); */
#define NEWT_TOL        (1.0e-10)  /* Min. of tolerance allowed for Newton-Raphson iterations */
#define MIN_NEWT_TOL    (1.0e-10)  /* Max. of tolerance allowed for Newton-Raphson iterations */
#define EXTRA_NEWT_ITER (2)

#define NEWT_TOL2       (1.0e-15)  /* TOL of new 1D^*_{v^2} gnr2 method */
#define MIN_NEWT_TOL2   (1.0e-10)  /* TOL of new 1D^*_{v^2} gnr2 method */

#define W_TOO_BIG       (1.e20)    /* \gamma^2 (\rho_0 + u + p) is assumed
                                      to always be smaller than this.  This
                                      is used to detect solver failures */

#define FAIL_VAL        (1.e30)    /* Generic value to which we set variables when a problem arises */

/**************************************************
  The following functions assume a Gamma-law EOS:
***************************************************/

/* Local Globals */
struct LocGlob {
  CCTK_REAL Bsq,bsq,QdotBsq,VdotBsq,Qtsq,Qdotn,D,half_Bsq,tau ;
} ;

struct eosomnivars {
  CCTK_INT eoshandle,eoskeytemp;
  CCTK_REAL prec,eosprec,eos_y_e[1],eos_temp[1];
  CCTK_INT eoskeyerr[1],eosanyerr[1];
  CCTK_INT eosrl,eosit,eosi,eosj,eosk;
  CCTK_REAL eosx,eosy,eosz;
} ;

// Declarations: 
static CCTK_REAL vsq_calc(CCTK_REAL W, struct LocGlob *lgp);

static CCTK_INT twod_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos, struct LocGlob *lgp,
                                     void (*funcd) (CCTK_REAL [], CCTK_REAL [], 
                                                    CCTK_REAL [], CCTK_REAL [][2], 
                                                    CCTK_REAL *, CCTK_REAL *, CCTK_REAL, struct LocGlob *) );

static CCTK_INT threed_newton_raphson_omni( CCTK_REAL x[], struct eosomnivars *eosvars, struct LocGlob *lgp,
                                     void (*funcd) (CCTK_REAL [], CCTK_REAL [], 
                                                    CCTK_REAL [], CCTK_REAL [][3], 
                                                    CCTK_REAL *, CCTK_REAL *, 
                                                    struct eosomnivars *eosvars, struct LocGlob *) );

static  void func_vsq( CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], CCTK_REAL [][2], 
                       CCTK_REAL *f, CCTK_REAL *df, CCTK_REAL gammaeos, struct LocGlob *lgp);

static  void func_vsq_eosomni( CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], CCTK_REAL [][3], 
                       CCTK_REAL *f, CCTK_REAL *df, struct eosomnivars *eosvars, struct LocGlob *lgp);

static CCTK_REAL x1_of_x0(CCTK_REAL x0, struct LocGlob *lgp ) ;


// EOS STUFF:
static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq, CCTK_REAL gammaeos, struct LocGlob *lgp);
static CCTK_REAL eos_info_eosomni(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL eps0, struct LocGlob *lgp);

/* pressure as a function of rho0 and u */
//static CCTK_REAL pressure_rho0_u(CCTK_REAL rho0, CCTK_REAL u, CCTK_REAL gammaeos)
//{
//  return((gammaeos - 1.)*u) ;
//}

static CCTK_REAL pressure_rho0_eps_eosomni(CCTK_REAL rho0, CCTK_REAL eps, CCTK_REAL* dpdrho, CCTK_REAL* dpdeps, struct eosomnivars *eosvars);

/* Pressure as a function of rho0 and w = rho0 + u + p */
static CCTK_REAL pressure_rho0_w(CCTK_REAL rho0, CCTK_REAL w,CCTK_REAL gammaeos)
{
  return((gammaeos-1.)*(w - rho0)/gammaeos) ;
}
//CCTK_INT  *handle, CCTK_INT GRHydro_reflevel, CCTK_INT *keytemp, CCTK_REAL *prec, 
void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt) (
    CCTK_INT  *handle, CCTK_INT *rl, CCTK_INT *ii, CCTK_INT *jj, CCTK_INT *kk, CCTK_REAL *x, CCTK_REAL *y, CCTK_REAL *z, CCTK_INT *keytemp, CCTK_REAL *eos_prec, CCTK_REAL *prec,  
    CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in, CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *y_e_in, CCTK_REAL *temp_in,
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval);

/**********************************************************************/
/**********************************************************************************

  Con2PrimM_pt():
  -----------------------------

   -- Attempts an inversion from GRMHD conserved variables to primitive variables assuming a guess.

   -- Uses the 2D method of Noble et al. (2006): 
       -- Solves for two independent variables (W,v^2) via a 2D
          Newton-Raphson method 
       -- Can be used (in principle) with a general equation of state. 

   -- Minimizes two residual functions using a homemade Newton-Raphson routine. 
       -- It is homemade so that it can catch exceptions and handle them correctly, plus it is 
          optimized for this particular  problem. 

  -- Note that the notation used herein is that of Noble et al. (2006) except for the argument 
     list. 


INPUT:  (using GRHydro variable defintions)

   s[x,y,z]   =  scons[0,1,2]  = \alpha \sqrt(\gamma) T^0_i 
   dens, tau  =  as defined in GRHydro and are assumed to be densitized (i.e. with sqrt(\gamma))   
   dens       =  D = \sqrt(\gamma) W \rho    
   tau        =  \alpha^2 \sqrt(\gamma) T^{00} - D 
   g[x,y,z][x,y,x] = spatial metric corresponding to \gamma 
   u[x,y,z][x,y,z] = inverse of the spatial metric, g[x,y,z][x,y,x]
   det        =  sqrt(\gamma)
   B[x,y,z]   =  Bvec[0,1,2] 
   bsq        = b^\mu b_\mu  

   epsnegative = (integer)
               = 0  if rho and epsilon are positive
              != 0  otherwise 


  --  (users should set B[x,y,z] = 0  for hydrodynamic runs) 


OUTPUT:  (using GRHydro variable defintions)
   rho, eps   =  as defined in GRHydro, primitive variables
   vel[x,y,z] =  as defined in GRHydro, primitive variables


RETURN VALUE: of retval = (i*100 + j)  where 
         i = 0 ->  Newton-Raphson solver either was not called (yet or not used) 
                   or returned successfully;
             1 ->  Newton-Raphson solver did not converge to a solution with the 
                   given tolerances;
             2 ->  Newton-Raphson procedure encountered a numerical divergence 
                   (occurrence of "nan" or "+/-inf" ;
             
         j = 0 -> success 
             1 -> failure: some sort of failure in Newton-Raphson; 
             2 -> failure: unphysical vsq = v^2  value at initial guess;
             3 -> failure: W<0 or W>W_TOO_BIG
             4 -> failure: v^2 > 1 
             ( used to be  5 -> failure: rho,uu <= 0   but now sets epsnegative to non-zero )

**********************************************************************************/
void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt)  ( 
    CCTK_INT  *handle, CCTK_INT *rl, CCTK_INT *ii, CCTK_INT *jj, CCTK_INT *kk, CCTK_REAL *x, CCTK_REAL *y, CCTK_REAL *z, CCTK_INT *keytemp, CCTK_REAL *eos_prec, CCTK_REAL *prec,  
    CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in,     
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *y_e_in, CCTK_REAL* temp_in,
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval)

{
  CCTK_REAL x_3d[3];
  CCTK_REAL sx, sy, sz;
  CCTK_REAL usx, usy, usz;
  CCTK_REAL tau, dens, gammaeos;
  CCTK_REAL QdotB,VdotB;
  CCTK_REAL rho0,u,p,w,gammasq,gamma,gtmp,W_last,W,vsq;
  CCTK_REAL g_o_WBsq, QdB_o_W;
  CCTK_REAL sqrt_detg = *sdet;
  CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; 
  CCTK_INT i,j, i_increase ;
  CCTK_INT nf, nfudgemax, failwarnmode, failinfomode;
  DECLARE_CCTK_PARAMETERS;
  
  struct LocGlob lg; 
  struct eosomnivars eosvars;

  eosvars.eoshandle = *handle;
  //printf("handle = %i\n",*handle);
  eosvars.eoskeytemp = *keytemp;
  eosvars.eosprec = *eos_prec;
  eosvars.prec = *prec;
  eosvars.eos_y_e[0] = *y_e_in;
  eosvars.eos_temp[0] = *temp_in;
  eosvars.eoskeyerr[0] = 0;
  eosvars.eosanyerr[0] = 0;
  eosvars.eosrl = *rl;
  eosvars.eosit = 1;
  eosvars.eosi = *ii;
  eosvars.eosj = *jj;
  eosvars.eosk = *kk;
  eosvars.eosx = *x;
  eosvars.eosy = *y;
  eosvars.eosz = *z;
 
  gammaeos = *gamma_eos;

  nf =0;
  nfudgemax = 30; 
  failinfomode = 1;
  failwarnmode = 0;
  
  /* Assume ok initially: */
  *retval = 0.;
  *epsnegative = 0; 

#if(DEBUG_CON2PRIMM)
  fprintf(stdout," *x1        = %26.16e \n", *x        );
  fprintf(stdout," *y1        = %26.16e \n", *y         );
  fprintf(stdout," *z1        = %26.16e \n", *z         );
  fprintf(stdout," *dens        = %26.16e \n", *dens_in         );
  fprintf(stdout," *sx          = %26.16e \n", *sx_in     );    
  fprintf(stdout," *sy          = %26.16e \n", *sy_in     );    
  fprintf(stdout," *sz          = %26.16e \n", *sz_in     );    
  fprintf(stdout," *tau         = %26.16e \n", *tau_in    );    
  fprintf(stdout," *Bconsx      = %26.16e \n", *Bconsx_in );    
  fprintf(stdout," *Bconsy      = %26.16e \n", *Bconsy_in );    
  fprintf(stdout," *Bconsz      = %26.16e \n", *Bconsz_in );    
  fprintf(stdout," *rho         = %26.16e \n", *rho       );    
  fprintf(stdout," *velx        = %26.16e \n", *velx      );    
  fprintf(stdout," *vely        = %26.16e \n", *vely      );    
  fprintf(stdout," *velz        = %26.16e \n", *velz      );    
  fprintf(stdout," *epsilon     = %26.16e \n", *epsilon     );
  fprintf(stdout," *temp_in     = %26.16e \n", *temp_in     );
  fprintf(stdout," *y_e_in     = %26.16e \n", *y_e_in     );
  fprintf(stdout," *pressure    = %26.16e \n", *pressure    );
  fprintf(stdout," *Bx          = %26.16e \n", *Bx        );    
  fprintf(stdout," *By          = %26.16e \n", *By        );    
  fprintf(stdout," *Bz          = %26.16e \n", *Bz        );    
  fprintf(stdout," *bsq         = %26.16e \n", *bsq       );    
  fprintf(stdout," *w_lorentz   = %26.16e \n", *w_lorentz   );
  fprintf(stdout," *gxx         = %26.16e \n", *gxx       );    
  fprintf(stdout," *gxy         = %26.16e \n", *gxy       );    
  fprintf(stdout," *gxz         = %26.16e \n", *gxz       );    
  fprintf(stdout," *gyy         = %26.16e \n", *gyy       );    
  fprintf(stdout," *gyz         = %26.16e \n", *gyz       );    
  fprintf(stdout," *gzz         = %26.16e \n", *gzz       );    
  fprintf(stdout," *uxx         = %26.16e \n", *uxx       );    
  fprintf(stdout," *uxy         = %26.16e \n", *uxy       );    
  fprintf(stdout," *uxz         = %26.16e \n", *uxz       );    
  fprintf(stdout," *uyy         = %26.16e \n", *uyy       );    
  fprintf(stdout," *uyz         = %26.16e \n", *uyz       );    
  fprintf(stdout," *uzz         = %26.16e \n", *uzz       );    
  fprintf(stdout," *sdet        = %26.16e \n", *sdet       );    
  fprintf(stdout," *epsnegative = %10d    \n", *epsnegative );
  fprintf(stdout," *retval      = %26.16e \n", *retval      );
  fflush(stdout);
#endif

  /* First undensitize all conserved variables : */
  sx   = (  *sx_in)   * inv_sqrt_detg;
  sy   = (  *sy_in)   * inv_sqrt_detg;
  sz   = (  *sz_in)   * inv_sqrt_detg;
  tau  = ( *tau_in)   * inv_sqrt_detg;
  dens = (*dens_in)   * inv_sqrt_detg;

  usx  =  (*uxx)*sx + (*uxy)*sy + (*uxz)*sz;
  usy  =  (*uxy)*sx + (*uyy)*sy + (*uyz)*sz;
  usz  =  (*uxz)*sx + (*uyz)*sy + (*uzz)*sz;

  *Bx = (*Bconsx_in) * inv_sqrt_detg;
  *By = (*Bconsy_in) * inv_sqrt_detg;
  *Bz = (*Bconsz_in) * inv_sqrt_detg;

  // Calculate various scalars (Q.B, Q^2, etc)  from the conserved variables:
  
  lg.Bsq = 
    (*gxx) * (*Bx) * (*Bx) + 
    (*gyy) * (*By) * (*By) + 
    (*gzz) * (*Bz) * (*Bz) + 
    2*( 
       (*gxy) * (*Bx) * (*By) +
       (*gxz) * (*Bx) * (*Bz) +
       (*gyz) * (*By) * (*Bz) );
    
  QdotB = (sx * (*Bx) + sy * (*By) + sz * (*Bz)) ;

  VdotB = ((*gxx) * (*velx) + (*gxy) * (*vely) + (*gxz) * (*velz))* (*Bx) + 
           ((*gxy) * (*velx) + (*gyy) * (*vely) + (*gyz) * (*velz))* (*By) +
           ((*gxz) * (*velx) + (*gyz) * (*vely) + (*gzz) * (*velz))* (*Bz); 

  lg.VdotBsq = VdotB*VdotB;

  lg.QdotBsq = QdotB*QdotB ;

  lg.Qdotn = -(tau + dens) ;

  lg.Qtsq = (usx * sx  +  usy * sy  +  usz * sz) ;

  lg.D = dens;

  lg.half_Bsq = 0.5*lg.Bsq;
  
  lg.tau = tau;

  /* calculate W from last timestep and use for guess */
  vsq = 
    (*gxx) * (*velx) * (*velx) + 
    (*gyy) * (*vely) * (*vely) + 
    (*gzz) * (*velz) * (*velz) + 
    2*( 
       (*gxy) * (*velx) * (*vely) +
       (*gxz) * (*velx) * (*velz) +
       (*gyz) * (*vely) * (*velz) );

  if( (vsq < 0.) && (fabs(vsq) < 1.0e-13) ) { 
    vsq = fabs(vsq);
  }
  if(vsq < 0. || vsq > 1. ) {
    *retval = 2.;
    fprintf(stdout," *retval (inside loop)      = %26.16e \n", *retval      );
    fflush(stdout);
    return;
  }

  gammasq = 1. / (1. - vsq);
  gamma  = sqrt(gammasq);
        
  // Always calculate rho from D and gamma so that using D in EOS remains consistent
  //   i.e. you don't get positive values for dP/d(vsq) . 
  rho0 = lg.D / gamma ;
  u = (*epsilon) * rho0;
  CCTK_REAL uold = u; 
 
  CCTK_REAL dum1,dum2;
//  eosvars.eosanyerr[0]=5;
  p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
  //  p = pressure_rho0_u(rho0,u,gammaeos) ;  // EOS
  // error handling
  if (eosvars.eosanyerr[0] != 0) {
    if(eosvars.eoskeyerr[0] == 668) {
      *retval = 3.0;
    }
  }
 
  w = rho0 + u + p;

  // we need this for the hot EOS failsafe tau reset later 

  lg.bsq = lg.Bsq/(w*w) + lg.VdotBsq;
  
  W_last = w*gammasq;

//  fprintf(stdout," anyerr[0] (before loop) = %d \n", eosvars.eosanyerr[0]);
//  fprintf(stdout,"vsq: rho0=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//  fprintf(stdout,"rho0=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//  fprintf(stdout,"keyerr=%d, anyerr=%d \n", eosvars.eoskeyerr[0], eosvars.eosanyerr[0]);
//  #pragma omp critical 
//  if (eosvars.eosanyerr[0] != 0) {
//     fprintf(stdout,"inside 1: anyerr=%d\n",eosvars.eosanyerr[0]);
//     if (eosvars.eosrl >= GRHydro_c2p_warn_from_reflevel) {
//        fprintf(stdout,"inside 2: anyerr=%d\n",eosvars.eosanyerr[0]);
//        if(eosvars.eoskeyerr[0] == 667 && GRHydro_eos_hot_eps_fix != 0) {
//           fprintf(stdout,"inside 3: anyerr=%d, keyerr=%d\n",eosvars.eosanyerr[0],eosvars.eoskeyerr[0]);
//           // Handling of the case when no new temperature can be
//           // found for a given epsilon. The amount of times
//           // we get to this place should be monitored, as this
//           // 'failsafe' mode creates artificial heat.
//
//           nf = 0;
//           while(eosvars.eosanyerr[0] != 0 && nf<= nfudgemax) {
//              eosvars.eosanyerr[0] = 0;
//              tau = tau + rho0*abs((*epsilon))*0.05*w*w;
//              *epsilon = (*epsilon) + abs((*epsilon))*0.05;
//              u = (*epsilon) * rho0;
//              EOS_Omni_press(eosvars.eoshandle,eosvars.eoskeytemp,eosvars.eosprec,1,
//                 &rho0,epsilon,eosvars.eos_temp,
//                 eosvars.eos_y_e,&p,eosvars.eoskeyerr,eosvars.eosanyerr);
//              nf = nf + 1;
//           } 
//           fprintf(stdout, "Iterations of heat injection: %d \n",nf);
//           fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//           if(nf >= nfudgemax) { 
//              if(GRHydro_c2p_reset_eps_tau_hot_eos != 1) {
//                 CCTK_WARN(failinfomode,"EOS error in c2p 0: injected heat too many times");
//                 fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//                 //CCTK_WARN(failinfomode,warnline);
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                 //call CCTK_WARN(failinfomode,warnline)
//                 fprintf(stdout,"code=%d\n",eosvars.eoskeyerr[0]);
//                 //call CCTK_WARN(failinfomode,warnline)
//                 CCTK_WARN(failwarnmode,"Aborting!!!");
//              } 
//              else {
//                 CCTK_WARN(failinfomode,"EOS error in c2p 0: LAST RESORT -- reset eps and tau based on old temp");
//                 fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                 eosvars.eoskeytemp =1; 
//                 EOS_Omni_press(eosvars.eoshandle,eosvars.eoskeytemp,eosvars.eosprec,1,
//                 &rho0,epsilon,eosvars.eos_temp,eosvars.eos_y_e,&p,eosvars.eoskeyerr,eosvars.eosanyerr);
//                 tau = (rho0 + rho0*(*epsilon) + lg.bsq + p)*w*w - (p + lg.bsq/2.0) - w*w*lg.VdotBsq - rho0*w;
//                 u = (*epsilon) * rho0;
//                 //tau = ( (rho + rho*epsilon) + xpress ) * w_lorentz**2 - xpress - rho*w_lorentz;
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                 eosvars.eoskeytemp =0; 
//              }
//           }
//        }
//        else {
//          CCTK_WARN(failinfomode,"EOS error in c2p 0");
//          fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//          fprintf(stdout,"rho=%f, dens=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,dens,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//          fprintf(stdout,"code=%d\n",eosvars.eoskeyerr[0]);
//          CCTK_WARN(failwarnmode,"Aborting!!!");
//       }
//    } 
//  }

  lg.tau = tau;

  //fprintf(stdout," p                  = %26.16e \n", p                );

  // Make sure that W is large enough so that v^2 < 1 : 
  i_increase = 0;
  while( (( W_last*W_last*W_last * ( W_last + 2.*lg.Bsq ) 
            - lg.QdotBsq*(2.*W_last + lg.Bsq) ) <= W_last*W_last*(lg.Qtsq-lg.Bsq*lg.Bsq))
         && (i_increase < 10) ) {
    W_last *= 10.;
    i_increase++;
  }
  
  // Calculate W and vsq: 
  x_3d[0] =  fabs( W_last );
  x_3d[1] = x1_of_x0( W_last, &lg ) ;

  //Use 2d NR for polytropes!
  if (*handle==1 || *handle==2) {    
    *retval = 1.0*twod_newton_raphson( x_3d, gammaeos, &lg, func_vsq ) ;  

  } else {
    //USE 3d NR for non-polytropes!
    x_3d[2] = u;
    *retval = 1.0*threed_newton_raphson_omni( x_3d, &eosvars, &lg, func_vsq_eosomni ) ;  
  }
  
  W = x_3d[0];
  vsq = x_3d[1];
        
  /* Problem with solver, so return denoting error before doing anything further */
  if( ((*retval) != 0.) || (W == FAIL_VAL) ) {
    *retval = *retval*100.+1.;
#if(DEBUG_CON2PRIMM)
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    fprintf(stdout," *dens        = %26.16e \n", *dens_in         );
    fprintf(stdout," *sx          = %26.16e \n", *sx_in     );
    fprintf(stdout," *sy          = %26.16e \n", *sy_in     );
    fprintf(stdout," *sz          = %26.16e \n", *sz_in     );
    fprintf(stdout," *tau         = %26.16e \n", *tau_in    );
    fprintf(stdout," *Bconsx      = %26.16e \n", *Bconsx_in );
    fprintf(stdout," *Bconsy      = %26.16e \n", *Bconsy_in );
    fprintf(stdout," *Bconsz      = %26.16e \n", *Bconsz_in );
    fprintf(stdout," *rho         = %26.16e \n", *rho       );
    fprintf(stdout," *velx        = %26.16e \n", *velx      );
    fprintf(stdout," *vely        = %26.16e \n", *vely      );
    fprintf(stdout," *velz        = %26.16e \n", *velz      );
    fprintf(stdout," *epsilon     = %26.16e \n", *epsilon     );
    fprintf(stdout," *temp_in     = %26.16e \n", *temp_in     );
    fprintf(stdout," *y_e_in     = %26.16e \n", *y_e_in     );
    fprintf(stdout," *pressure    = %26.16e \n", *pressure    );
    fprintf(stdout," *Bx          = %26.16e \n", *Bx        );
    fprintf(stdout," *By          = %26.16e \n", *By        );
    fprintf(stdout," *Bz          = %26.16e \n", *Bz        );
    fprintf(stdout," *bsq         = %26.16e \n", *bsq       );
    fprintf(stdout," *w_lorentz   = %26.16e \n", *w_lorentz   );
    fprintf(stdout," *gxx         = %26.16e \n", *gxx       );
    fprintf(stdout," *gxy         = %26.16e \n", *gxy       );
    fprintf(stdout," *gxz         = %26.16e \n", *gxz       );
    fprintf(stdout," *gyy         = %26.16e \n", *gyy       );
    fprintf(stdout," *gyz         = %26.16e \n", *gyz       );
    fprintf(stdout," *gzz         = %26.16e \n", *gzz       );
    fprintf(stdout," *uxx         = %26.16e \n", *uxx       );
    fprintf(stdout," *uxy         = %26.16e \n", *uxy       );
    fprintf(stdout," *uxz         = %26.16e \n", *uxz       );
    fprintf(stdout," *uyy         = %26.16e \n", *uyy       );
    fprintf(stdout," *uyz         = %26.16e \n", *uyz       );
    fprintf(stdout," *uzz         = %26.16e \n", *uzz       );
    fprintf(stdout," *sdet        = %26.16e \n", *sdet       );
    fprintf(stdout," *epsnegative = %10d    \n", *epsnegative );
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    fflush(stdout);
#endif
    return;
  }
  else{
    if(W <= 0. || W > W_TOO_BIG) {
      *retval = 3.;
      fprintf(stdout," *retval      = %26.16e \n", *retval      );
      fflush(stdout);
      return;
    }
  }

  // Calculate v^2:
  if( vsq >= 1. ) {
    *retval = 4.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    fflush(stdout);
    return;
  }

  // Recover the primitive variables from the scalars and conserved variables:
  gtmp = sqrt(1. - vsq);
  gamma = 1./gtmp ;
  rho0 = lg.D * gtmp;

  w = W * (1. - vsq) ;
 
  if (*handle==1 || *handle==2) {     
    p = pressure_rho0_w(rho0,w,gammaeos) ;  // EOS
    u = w - (rho0 + p) ;
    *epsilon = u / rho0;
  } else {
    u=x_3d[2];
    *epsilon = u/rho0;

    // Update tau in case we have changed it during the NR iterations

    tau = lg.tau;

//    eosvars.eosanyerr[0]=5;

    p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
    *temp_in = eosvars.eos_temp[0];

//    #pragma omp critical 
//    if (eosvars.eosanyerr[0] != 0) {
//     fprintf(stdout,"inside 4: anyerr=%d\n",eosvars.eosanyerr[0]);
//       if (eosvars.eosrl >= GRHydro_c2p_warn_from_reflevel) {
//          if(eosvars.eoskeyerr[0] == 667 && GRHydro_eos_hot_eps_fix != 0) {
//             // Handling of the case when no new temperature can be
//             // found for a given epsilon. The amount of times
//             // we get to this place should be monitored, as this
//             // 'failsafe' mode creates artificial heat.
//             nf = 0;
//             while(eosvars.eosanyerr[0] != 0 && nf<= nfudgemax) {
//                eosvars.eosanyerr[0] = 0;
//                tau = tau + rho0*abs((*epsilon))*0.05*w*w;
//                *epsilon = (*epsilon) + abs((*epsilon))*0.05;
//                u = (*epsilon) * rho0;
//                EOS_Omni_press(eosvars.eoshandle,eosvars.eoskeytemp,eosvars.eosprec,1,
//                   &rho0,epsilon,eosvars.eos_temp,
//                   eosvars.eos_y_e,&p,eosvars.eoskeyerr,eosvars.eosanyerr);
//                nf = nf + 1;
//             } 
//             fprintf(stdout, "Iterations of heat injection: %d \n",nf);
//             fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//             if(nf >= nfudgemax) { 
//                if(GRHydro_c2p_reset_eps_tau_hot_eos != 1) {
//                   CCTK_WARN(failinfomode,"EOS error in c2p 0: injected heat too many times");
//                   fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//                   //CCTK_WARN(failinfomode,warnline);
//                   fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                   //call CCTK_WARN(failinfomode,warnline)
//                   fprintf(stdout,"code=%d\n",eosvars.eoskeyerr[0]);
//                   //call CCTK_WARN(failinfomode,warnline)
//                   CCTK_WARN(failwarnmode,"Aborting!!!");
//                } 
//                else {
//                   CCTK_WARN(failinfomode,"EOS error in c2p 0: LAST RESORT -- reset eps and tau based on old temp");
//                   fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//                   fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                   eosvars.eoskeytemp =1; 
//                   EOS_Omni_press(eosvars.eoshandle,eosvars.eoskeytemp,eosvars.eosprec,1,
//                   &rho0,epsilon,eosvars.eos_temp,eosvars.eos_y_e,&p,eosvars.eoskeyerr,eosvars.eosanyerr);
//                 //  tau = (rho0 + rho0*(*epsilon) + lg.bsq + p)*w*w - (p + lg.bsq/2.0) - rho0*w;
//                   tau = (rho0 + rho0*(*epsilon) + lg.bsq + p)*w*w - (p + lg.bsq/2.0) - w*w*lg.VdotBsq - rho0*w;
//                   u = (*epsilon) * rho0;
//                   //tau = ( (rho + rho*epsilon) + xpress ) * w_lorentz**2 - xpress - rho*w_lorentz;
//                   //fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//                   eosvars.eoskeytemp =0; 
//                }
//             }
//          }
//          else {
//            CCTK_WARN(failinfomode,"EOS error in c2p 0");
//            fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars.eosit,eosvars.eosrl,eosvars.eosi,eosvars.eosj,eosvars.eosk,eosvars.eosx,eosvars.eosy,eosvars.eosz);
//            fprintf(stdout,"rho=%f, dens=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,dens,*epsilon,eosvars.eos_temp[0],eosvars.eos_y_e[0]);
//            fprintf(stdout,"code=%d\n",eosvars.eoskeyerr[0]);
//            CCTK_WARN(0,"Aborting!!!");
//         }
//       } 
//     }

    // printf("%g %g %g %g\n",rho0,u,*epsilon,p);
   }

   // update tau in case we have modified it in C2P

   *tau_in = tau*sqrt_detg;

  // User may want to handle this case differently, e.g. do NOT return upon 
  // a negative rho/u, calculate v^i so that rho/u can be floored by other routine:
  // HOT: if( (rho0 <= 0.) || (u <= 0.) ) { 
  if(rho0 <= 0.) { 
//    *epsnegative = 1; 
    fprintf(stdout," *epsnegative = %10d    \n", (int)*epsnegative );
    fprintf(stdout," rho0       = %26.16e \n", rho0             ); 
    fprintf(stdout," u                  = %26.16e \n", u                );
    fprintf(stdout," W                  = %26.16e \n", W                );
    fprintf(stdout," vsq                = %26.16e \n", vsq              );
    fprintf(stdout," uold               = %26.16e \n", uold             );
    fflush(stdout);
    return;
  }

  *rho = rho0;
  *w_lorentz = gamma; 
  *pressure = p ; 

  g_o_WBsq = 1./(W+lg.Bsq);
  QdB_o_W  = QdotB / W; 
  *bsq = lg.Bsq * (1.-vsq) + QdB_o_W*QdB_o_W;

  *velx = g_o_WBsq * ( usx + QdB_o_W*(*Bx) ) ;
  *vely = g_o_WBsq * ( usy + QdB_o_W*(*By) ) ;
  *velz = g_o_WBsq * ( usz + QdB_o_W*(*Bz) ) ;

  if (*rho <= rho_abs_min*(1.0+GRHydro_atmo_tolerance) ) {
    *rho = rho_abs_min;
    *velx = 0.0;
    *vely = 0.0;
    *velz = 0.0;
    *w_lorentz = 1.0;
  }
#if(DEBUG_CON2PRIMM)
  fprintf(stdout," *retvalo      = %26.16e \n", *retval      );
  fprintf(stdout," *x2        = %26.16e \n", *x        );
  fprintf(stdout," *y2        = %26.16e \n", *y         );
  fprintf(stdout," *z2        = %26.16e \n", *z         );
  fprintf(stdout," *denso        = %26.16e \n", *dens_in         );
  fprintf(stdout," *sxo                 = %26.16e \n", *sx_in     );    
  fprintf(stdout," *syo         = %26.16e \n", *sy_in     );    
  fprintf(stdout," *szo                 = %26.16e \n", *sz_in     );    
  fprintf(stdout," *tauo        = %26.16e \n", *tau_in    );    
  fprintf(stdout," *Bconsxo     = %26.16e \n", *Bconsx_in );    
  fprintf(stdout," *Bconsyo     = %26.16e \n", *Bconsy_in );    
  fprintf(stdout," *Bconszo      = %26.16e \n", *Bconsz_in );    
  fprintf(stdout," *rhoo         = %26.16e \n", *rho      );    
  fprintf(stdout," *velxo        = %26.16e \n", *velx     );    
  fprintf(stdout," *velyo        = %26.16e \n", *vely     );    
  fprintf(stdout," *velzo        = %26.16e \n", *velz     );    
  fprintf(stdout," *epsilono     = %26.16e \n", *epsilon     );
  fprintf(stdout," *temp_ino     = %26.16e \n", *temp_in     );
  fprintf(stdout," *y_e_ino     = %26.16e \n", *y_e_in     );
  fprintf(stdout," *pressureo    = %26.16e \n", *pressure    );
  fprintf(stdout," *Bxo                 = %26.16e \n", *Bx        );    
  fprintf(stdout," *Byo                 = %26.16e \n", *By        );    
  fprintf(stdout," *Bzo                 = %26.16e \n", *Bz        );    
  fprintf(stdout," *bsqo                = %26.16e \n", *bsq       );    
  fprintf(stdout," *w_lorentzo   = %26.16e \n", *w_lorentz   );
  fprintf(stdout," *gxxo        = %26.16e \n", *gxx       );    
  fprintf(stdout," *gxyo        = %26.16e \n", *gxy       );    
  fprintf(stdout," *gxzo        = %26.16e \n", *gxz       );    
  fprintf(stdout," *gyyo        = %26.16e \n", *gyy       );    
  fprintf(stdout," *gyzo        = %26.16e \n", *gyz       );    
  fprintf(stdout," *gzzo        = %26.16e \n", *gzz       );    
  fprintf(stdout," *uxxo        = %26.16e \n", *uxx       );    
  fprintf(stdout," *uxyo        = %26.16e \n", *uxy       );    
  fprintf(stdout," *uxzo                = %26.16e \n", *uxz       );    
  fprintf(stdout," *uyyo        = %26.16e \n", *uyy       );    
  fprintf(stdout," *uyzo        = %26.16e \n", *uyz       );    
  fprintf(stdout," *uzzo                = %26.16e \n", *uzz       );    
  fprintf(stdout," *sdeto                = %26.16e \n", *sdet       );    
  fprintf(stdout," *epsnegativeo = %10d    \n", *epsnegative );


  fprintf(stdout,"rho          = %26.16e \n",*rho      );
  fprintf(stdout,"epsilon      = %26.16e \n",*epsilon  );
  fprintf(stdout,"pressure     = %26.16e \n",*pressure );
  fprintf(stdout,"w_lorentz    = %26.16e \n",*w_lorentz);
  fprintf(stdout,"bsq          = %26.16e \n",*bsq      );
  fprintf(stdout,"velx         = %26.16e \n",*velx     );
  fprintf(stdout,"vely         = %26.16e \n",*vely     );
  fprintf(stdout,"velz         = %26.16e \n",*velz     );
  fprintf(stdout,"gammaeos     = %26.16e \n",gammaeos  );
  fflush(stdout);
#endif

  /* done! */
  return;

}


/**********************************************************************/ 
/****************************************************************************
   vsq_calc(): 
    
      -- evaluate v^2 (spatial, normalized velocity) from 
            W = \gamma^2 w 

****************************************************************************/
static CCTK_REAL vsq_calc(CCTK_REAL W, struct LocGlob *lgp)
{
        CCTK_REAL Wsq,Xsq,Bsq_W;
        
        Wsq = W*W ;
        Bsq_W = (lgp->Bsq + W);
        Xsq = Bsq_W * Bsq_W;

        return(  ( Wsq * lgp->Qtsq  + lgp->QdotBsq * (Bsq_W + W)) / (Wsq*Xsq) );
}


/********************************************************************

  x1_of_x0(): 
           
    -- calculates v^2 from W  with some physical bounds checking;
    -- asumes x0 is already physical
    -- makes v^2 physical  if not;

*********************************************************************/

static CCTK_REAL x1_of_x0(CCTK_REAL x0, struct LocGlob *lgp ) 
{
  CCTK_REAL x1,vsq;
  CCTK_REAL dv = 1.e-15;

  vsq = fabs(vsq_calc(x0,lgp)) ; // guaranteed to be positive 

  return( ( vsq > 1. ) ? (1.0 - dv) : vsq   ); 

}

/********************************************************************

  validate_x(): 
           
    -- makes sure that x[0,1] have physical values, based upon 
       their definitions:
    
*********************************************************************/

static void validate_x(CCTK_REAL x[2], CCTK_REAL x0[2] ) 
{
  
  const CCTK_REAL dv = 1.e-15;

  /* Always take the absolute value of x[0] and check to see if it's too big:  */ 
  x[0] = fabs(x[0]);
  x[0] = (x[0] > W_TOO_BIG) ?  x0[0] : x[0];
  
  x[1] = (x[1] < 0.) ?   0.       : x[1];  /* if it's too small */
  x[1] = (x[1] > 1.) ?  (1. - dv) : x[1];  /* if it's too big   */

  return;

}

/************************************************************

  twod_newton_raphson(): 

    -- performs Newton-Rapshon method on an 2d system for polytropes.

    -- inspired in part by Num. Rec.'s routine newt();

*****************************************************************/
static CCTK_INT twod_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos, struct LocGlob *lgp, 
                            void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                           CCTK_REAL [][2], CCTK_REAL *, 
                                           CCTK_REAL *, CCTK_REAL, struct LocGlob *) )
{
  CCTK_REAL f, df, dx[2], x_old[2];
  CCTK_REAL resid[2], jac[2][2];
  CCTK_REAL errx, x_orig[2];
  CCTK_INT    n_iter, id, jd, i_extra, doing_extra;
  CCTK_REAL dW,dvsq,vsq_old,vsq,W,W_old;
  const CCTK_REAL dv = (1.-1.e-15);

  CCTK_INT   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ; 
  df = f = 1.;
  i_extra = doing_extra = 0;
  x_old[0] = x_orig[0] = x[0] ;
  x_old[1] = x_orig[1] = x[1] ;

  vsq_old = vsq = W = W_old = 0.;
  n_iter = 0;

  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) { 

    (*funcd) (x, dx, resid, jac, &f, &df, gammaeos, lgp);  /* returns with new dx, f, df */
      

    /* Save old values before calculating the new: */
    errx = 0.;
    x_old[0] = x[0] ; 
    x_old[1] = x[1] ; 

    /* Make the newton step: */
    x[0] += dx[0]  ; 
    x[1] += dx[1]  ; 

    /****************************************/
    /* Calculate the convergence criterion */
    /****************************************/
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]);


    /****************************************/
    /* Make sure that the new x[] is physical : */
    /****************************************/
    if( x[0] < 0. ) {  x[0] = fabs(x[0]);  } 
    else { 
     if(x[0] > W_TOO_BIG)  { x[0] = x_old[0] ; }
    }

    if( x[1] < 0. ) {  x[1] = 0.; } 
    else { 
      if( x[1] > 1. ) { x[1] = dv; }
    }
      
    /*****************************************************************************/
    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*  before stopping                                                          */
    /*****************************************************************************/
    
    if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 1;
    }

    if( doing_extra == 1 ) i_extra++ ;

    if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) 
        || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }   // END of while(keep_iterating)


    /*  Check for bad untrapped divergences : */
  if( (!finite(f)) ||  (!finite(df)) ) {
    return(2);
  }


  if( fabs(errx) <= NEWT_TOL ){
    return(0);
  }
  else if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){
    return(0);
  }
  else {
    return(1);
  } 

  return(0);

}


/************************************************************

  threed_newton_raphson_omni(): 

    -- performs Newton-Rapshon method on an 2d system for polytropes.

    -- inspired in part by Num. Rec.'s routine newt();

*****************************************************************/
static CCTK_INT threed_newton_raphson_omni( CCTK_REAL x[], struct eosomnivars *eosvars, struct LocGlob *lgp, 
                            void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], 
                                           CCTK_REAL [][3], CCTK_REAL *, 
                                           CCTK_REAL *, struct eosomnivars *, struct LocGlob *) )
{
  CCTK_REAL f, df, dx[3], x_old[3];
  CCTK_REAL resid[3], jac[3][3];
  CCTK_REAL errx, x_orig[3];
  CCTK_INT    n_iter, id, jd, i_extra, doing_extra;
  CCTK_REAL dW,dvsq,du,vsq_old,vsq,W,W_old,u,u_old;
  const CCTK_REAL dv = (1.-1.e-15);

  CCTK_INT   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ; 
  df = f = 1.;
  i_extra = doing_extra = 0;
  x_old[0] = x_orig[0] = x[0] ;
  x_old[1] = x_orig[1] = x[1] ;
  x_old[2] = x_orig[2] = x[2] ;

  vsq_old = vsq = W = W_old = u = u_old = 0.;
  n_iter = 0;

  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) { 

    (*funcd) (x, dx, resid, jac, &f, &df, eosvars, lgp);  /* returns with new dx, f, df */

    /* Save old values before calculating the new: */
    errx = 0.;
    x_old[0] = x[0] ; 
    x_old[1] = x[1] ; 
    x_old[2] = x[2] ; 

    /* Make the newton step: */
    x[0] += dx[0]  ; 
    x[1] += dx[1]  ; 
    x[2] += dx[2]  ; 

    //printf("Updating vars: %g %g %g %g %g %g\n",x[0],dx[0],x[1],dx[1],x[2],dx[2]);

    /****************************************/
    /* Calculate the convergence criterion */
    /****************************************/
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]);


    /****************************************/
    /* Make sure that the new x[] is physical : */
    /****************************************/
    if( x[0] < 0. ) {  x[0] = fabs(x[0]);  } 
    else { 
     if(x[0] > W_TOO_BIG)  { x[0] = x_old[0] ; }
    }

    if( x[1] < 0. ) {  x[1] = 0.; } 
    else { 
      if( x[1] > 1. ) { x[1] = dv; }
    }

    // HOT: if( x[2] < 0. ) {  x[2] = 0.; } 
      
    /*****************************************************************************/
    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*  before stopping                                                          */
    /*****************************************************************************/
    
    if( (fabs(errx) <= eosvars->prec) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 1;
    }

    if( doing_extra == 1 ) i_extra++ ;

    if( ((fabs(errx) <= eosvars->prec)&&(doing_extra == 0)) 
        || (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }   // END of while(keep_iterating)


    /*  Check for bad untrapped divergences : */
  if( (!finite(f)) ||  (!finite(df)) ) {
    return(2);
  }


  if( fabs(errx) <= eosvars->prec ){
    return(0);
  }
  else if( (fabs(errx) <= eosvars->prec) && (fabs(errx) > eosvars->prec) ){
    return(0);
  }
  else {
    return(1);
  } 

  return(0);

}

/**********************************************************************/
/*********************************************************************************
   func_vsq(): 

        -- calculates the residuals, and Newton step for general_newton_raphson();
        -- for this method, x=W,vsq here;

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/

static void func_vsq(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                     CCTK_REAL jac[][2], CCTK_REAL *f, CCTK_REAL *df, CCTK_REAL gammaeos, struct LocGlob *lgp)
{

  
  CCTK_REAL  W, vsq, Wsq, p_tmp, dPdvsq, dPdW;
  CCTK_REAL res0, QB2Winv2,res1,j11,detJinv,   Winv,   QB2Winv3,   j10,   B2plusW,   detJ,   t36,   mj01,   j00;


  W = x[0];
  vsq = x[1];
  
  Wsq = W*W;
  
  p_tmp = eos_info(W, vsq, &dPdW, &dPdvsq, gammaeos, lgp);

  // These expressions were calculated using Mathematica, but made into efficient 
  // code using Maple.  Since we know the analytic form of the equations, we can 
  // explicitly calculate the Newton-Raphson step: 

  //j11 = dP/dv^2-B^2/2
  j11 = -lgp->half_Bsq+dPdvsq;

  B2plusW = lgp->Bsq+W;

  //mj01 is B2plusW squared = - (partial Eq. 4 / partial v^2)
  mj01 = B2plusW*B2plusW;

  Winv = 1/W;

  QB2Winv2 = lgp->QdotBsq*Winv*Winv;

  //Eq. 4 - Residual 0: Qtsq - v^2(B^2+W)^2 -QdotBsq(B^2+2W)/W^2
  res0 = lgp->Qtsq-vsq*mj01+QB2Winv2*(lgp->Bsq+W+W);

  //Eq. 5 - Residual 1: -Qdotn - B^2/2(1+v^2)+1/2 QdotBsq/W^2 - W+p
  res1 = -lgp->Qdotn-lgp->half_Bsq*(1.0+vsq)+0.5*QB2Winv2-W+p_tmp;

  QB2Winv3 = QB2Winv2*Winv;

  //j10 is -QB2Winv3 - 1 + dp/dW - (partial Eq. 5 / partial W)
  j10 = -1.0+dPdW-QB2Winv3;

  //This is detJ: j10*mj01/B2W +  -2 j11            *   -j00/2
  detJ = B2plusW*(j10*B2plusW+(lgp->Bsq-2.0*dPdvsq)*(QB2Winv2+vsq*W)*Winv);

  detJinv = 1/detJ;

  // - (Jinv00 * res0 + Jinv01 * res 1)/detJ
  dx[0] = -(j11*res0+mj01*res1)*detJinv;

  //j00 is -2v^2(B^2+W)-2QB2 (B2+W)/W^3 - (partial Eq. 4 / partial W)
  j00 = -2*(vsq+QB2Winv3)*B2plusW;

  // (-Jinv10 * res0 -Jinv11 * res1) / DetJ
  dx[1] = (j10*res0-j00*res1)*detJinv;
  //  detJ = B2plusW*detJ_gcf;
  jac[0][0] = j00;
  jac[0][1] = -mj01;
  jac[1][0] = j10;
  jac[1][1] = j11;
  resid[0] = res0;
  resid[1] = res1;

  *df = -resid[0]*resid[0] - resid[1]*resid[1];

  *f = -0.5 * ( *df );

}

/**********************************************************************/
/*********************************************************************************
   func_vsq_eosomni(): 

        -- calculates the residuals, and Newton step for general_newton_raphson();
        -- for this method, x=W,vsq,u here;

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/

static void func_vsq_eosomni(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[], 
                             CCTK_REAL jac[][3], CCTK_REAL *f, CCTK_REAL *df, 
                             struct eosomnivars *eosvars, struct LocGlob *lgp)
{

  CCTK_REAL p_tmp;
  CCTK_REAL  W, vsq, u, epsilon,Wsq, dPdvsq, dPdW;
  CCTK_REAL res0, Lor, LorInv, rho0, Winv, QB2Winv2, drho0_dv, res1, j11, detJ,detJinv;
  CCTK_REAL QB2Winv3, j10,B2plusW,detJ_gcf,t36,B2plusW_sq, j00,j01,j12,j20,j21,j22;
  CCTK_REAL dpress_dv,dpress_du,dpdrho,dpdeps,c00,c01,c02,c10,c11,c12,c20,c21,c22;

  CCTK_INT nf, nfudgemax, failwarnmode, failinfomode;
  DECLARE_CCTK_PARAMETERS;

  nf =0;
  nfudgemax =30;
  failinfomode =2;
  failwarnmode =1;

  W = x[0];
  vsq = x[1];
  u = x[2];
  
  Wsq = W*W;
  Lor = 1.0/sqrt(1.0-vsq);
  LorInv = sqrt(1.0-vsq);
  rho0 = lgp->D * LorInv;
  epsilon = u/rho0;
  p_tmp = pressure_rho0_eps_eosomni(rho0,epsilon,&dpdrho,&dpdeps,eosvars);
  
//  fprintf(stdout,"vsq: keyerr=%d, eosrl = %d, anyerr = %d \n",eosvars->eoskeyerr[0],eosvars->eosrl, eosvars->eosanyerr[0]);
//  fprintf(stdout,"vsq: rho0=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//  #pragma omp critical 
//  if (eosvars->eosanyerr[0] != 0) {
//     fprintf(stdout,"inside vsq_omni: anyerr=%d rl=%d\n",eosvars->eosanyerr[0], eosvars->eosrl);
//     if (eosvars->eosrl >= GRHydro_c2p_warn_from_reflevel) {
//        if(eosvars->eoskeyerr[0] == 667 && GRHydro_eos_hot_eps_fix != 0) {
//           // Handling of the case when no new temperature can be
//           // found for a given epsilon. The amount of times
//           // we get to this place should be monitored, as this
//           // 'failsafe' mode creates artificial heat.
//           nf = 0;
//           while(eosvars->eosanyerr[0] != 0 && nf<= nfudgemax) {
//              eosvars->eosanyerr[0] = 0;
//              lgp->tau = lgp->tau + rho0*abs(epsilon)*0.05*Lor*Lor;
//              epsilon = epsilon + abs(epsilon)*0.05;
//              u = epsilon*rho0;
//              CCTK_WARN(failwarnmode,"Injecting heat inside vsq_omni without resetting tau");
//              fprintf(stdout,"Injecting heat inside vsq_omni without resetting tau: anyerr=%d\n",eosvars->eosanyerr[0]);
//              EOS_Omni_press(eosvars->eoshandle,eosvars->eoskeytemp,eosvars->eosprec,1,
//                 &rho0,&epsilon,eosvars->eos_temp,
//                 eosvars->eos_y_e,&p_tmp,eosvars->eoskeyerr,eosvars->eosanyerr);
//              nf = nf + 1;
//           } 
//           fprintf(stdout, "Iterations of heat injection: %d \n",nf);
//           fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars->eosit,eosvars->eosrl,eosvars->eosi,eosvars->eosj,eosvars->eosk,eosvars->eosx,eosvars->eosy,eosvars->eosz);
//           if(nf >= nfudgemax) { 
//              if(GRHydro_c2p_reset_eps_tau_hot_eos != 1) {
//                 CCTK_WARN(failinfomode,"EOS error in c2p 0: injected heat too many times");
//                 fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars->eosit,eosvars->eosrl,eosvars->eosi,eosvars->eosj,eosvars->eosk,eosvars->eosx,eosvars->eosy,eosvars->eosz);
//                 //CCTK_WARN(failinfomode,warnline);
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//                 //call CCTK_WARN(failinfomode,warnline)
//                 fprintf(stdout,"code=%d\n",eosvars->eoskeyerr[0]);
//                 //call CCTK_WARN(failinfomode,warnline)
//                 CCTK_WARN(failwarnmode,"Aborting!!!");
//              } 
//              else {
//                 CCTK_WARN(failinfomode,"EOS error in c2p 0: LAST RESORT -- reset eps and tau based on old temp");
//                 fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars->eosit,eosvars->eosrl,eosvars->eosi,eosvars->eosj,eosvars->eosk,eosvars->eosx,eosvars->eosy,eosvars->eosz);
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//                 eosvars->eoskeytemp =1; 
//                 EOS_Omni_press(eosvars->eoshandle,eosvars->eoskeytemp,eosvars->eosprec,1,
//                 &rho0,&epsilon,eosvars->eos_temp,eosvars->eos_y_e,&p_tmp,eosvars->eoskeyerr,eosvars->eosanyerr);
//                 //tau = (rho0 + rho0*(*epsilon) + lg.bsq + p)*w*w - (p + lg.bsq/2.0) - w*w*lg.VdotBsq - rho0*w;
//                 lgp->tau = (rho0 + rho0*epsilon + lgp->bsq + p_tmp)*Lor*Lor - (p_tmp + lgp->bsq/2.0) - Lor*Lor*lgp->VdotBsq - rho0*Lor;
//                 u = epsilon*rho0;
//                 eosvars->eoskeytemp = 0;
//                 fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//              }
//           }
//        }
//        else {
//          CCTK_WARN(failinfomode,"EOS error in c2p 0");
//          fprintf(stdout, "it=%d, rl=%d, i=%d, j=%d, k=%d, x=%f,y=%f,z=%f\n",eosvars->eosit,eosvars->eosrl,eosvars->eosi,eosvars->eosj,eosvars->eosk,eosvars->eosx,eosvars->eosy,eosvars->eosz);
//          fprintf(stdout,"rho=%f, epsilon=%f, temp=%f, ye=%f\n", rho0,epsilon,eosvars->eos_temp[0],eosvars->eos_y_e[0]);
//          fprintf(stdout,"code=%d\n",eosvars->eoskeyerr[0]);
//          CCTK_WARN(failwarnmode,"Aborting!!!");
//       }
//    } 
//  }

  lgp->Qdotn = -(lgp->tau + lgp->D);
  B2plusW = lgp->Bsq+W;
  B2plusW_sq = B2plusW*B2plusW;
  Winv = 1/W;
  QB2Winv2 = lgp->QdotBsq*Winv*Winv;
  QB2Winv3=QB2Winv2*Winv;

  //Eq. 4: Qtsq-v^2(B^2+W)^2-QdotBsq(B^2+2W)/W^2=0 <-No u or p dependence

  resid[0] = lgp->Qtsq - vsq*B2plusW_sq+QB2Winv2*(lgp->Bsq+W+W);

  j00 = -2*(vsq+QB2Winv3)*B2plusW;
  j01 = -1.0*B2plusW_sq;


  //Eq. 5: -Qdotn - B^2(1+vsq)/2 + QdotBsq/2/W^2 - vsq W - rho_0(vsq) - u = 0
  //rho0 = D * sqrt(1-vsq)

  resid[1] = -lgp->Qdotn - lgp->half_Bsq*(1.0+vsq) + 0.5*QB2Winv2 - vsq*W - rho0 - u;

  drho0_dv = -0.5*lgp->D / LorInv;

  j10 = -vsq-QB2Winv3;
  j11 = -lgp->half_Bsq - W - drho0_dv;

  //Eq. 6: u+ p - W(1-vsq) + rho0 = 0  =>  p-W = -W vsq - rho0 - u

  resid[2] = u + p_tmp - W*(1.0-vsq) + rho0;

  //dp/dv = (dp/drho)u *  drho/dv
  //dp/drho_u = dp/drho_eps - eps/rho0 dpdeps 
  dpress_dv = drho0_dv*dpdrho+
    u/2.0/lgp->D*pow(1.0-vsq,-1.5)*dpdeps;

  //dp/du = 1/rho dp deps, since rho0 is function of v only
  dpress_du=dpdeps/rho0;

  jac[0][0] = j00;
  jac[0][1] = j01;
  jac[0][2] = 0.0;
  jac[1][0] = j10;
  jac[1][1] = j11;
  jac[1][2] = -1.0;
  jac[2][0] = vsq-1.0; 
  jac[2][1] = dpress_dv + W + drho0_dv;
  jac[2][2] = dpress_du + 1.0;

  c00 = j11*jac[2][2]+jac[2][1];
  c01 = -1*j01*jac[2][2];
  c02 = j01*jac[1][2];

  c10 = -jac[2][0]-j10*jac[2][2];
  c11 = j00*jac[2][2];
  c12 = j00;

  c20 = j10*jac[2][1]-j11*jac[2][0];
  c21 = j01*jac[2][0]-j00*jac[2][1];
  c22 = j00*j11-j01*j10;

  detJ=j00*c00+j01*c10;
  detJinv = 1/detJ;
  
  dx[0] = -(c00*resid[0]+c01*resid[1]+c02*resid[2])*detJinv;
  dx[1] = -(c10*resid[0]+c11*resid[1]+c12*resid[2])*detJinv;
  dx[2] = -(c20*resid[0]+c21*resid[1]+c22*resid[2])*detJinv;

  *df = -resid[0]*resid[0] - resid[1]*resid[1] - resid[2]*resid[2];

  *f = -0.5 * ( *df );

}


/********************************************************************** 
 ********************************************************************** 
   
 The following routines specify the equation of state.  All routines 
  above here should be indpendent of EOS.  If the user wishes 
  to use another equation of state, the below functions must be replaced 
  by equivalent routines based upon the new EOS. 

 **********************************************************************
**********************************************************************/

/**********************************************************************/
/********************************************************************** 
  eos_info():
 
      -- returns with all the EOS-related values needed;
 **********************************************************************/
static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq, CCTK_REAL gammaeos, struct LocGlob *lgp)
{
  register CCTK_REAL ftmp,gtmp;

  ftmp = 1. - vsq;
  gtmp = sqrt(ftmp);

  CCTK_REAL gam_m1_o_gam = ((gammaeos-1.)/gammaeos);

  *dpdw =  gam_m1_o_gam * ftmp ;
  *dpdvsq =  gam_m1_o_gam * ( 0.5 * lgp->D/gtmp  -  W ) ;

  return( gam_m1_o_gam * ( W * ftmp  -  lgp->D * gtmp )  );  // p 

}

static CCTK_REAL pressure_rho0_eps_eosomni(CCTK_REAL rho,CCTK_REAL epsilon, CCTK_REAL* dpdrho, CCTK_REAL* dpdeps, struct eosomnivars *eosvars)
{

  CCTK_REAL rhopt[1],epspt[1],press[1];
  rhopt[0]=rho;
  epspt[0]=epsilon;

  EOS_Omni_press(eosvars->eoshandle,eosvars->eoskeytemp,eosvars->eosprec,1,
                 &rho,&epsilon,eosvars->eos_temp,
                 eosvars->eos_y_e,press,eosvars->eoskeyerr,eosvars->eosanyerr);

  EOS_Omni_DPressByDRho(eosvars->eoshandle,eosvars->eoskeytemp,eosvars->eosprec,1,
                 &rho,&epsilon,eosvars->eos_temp,
                 eosvars->eos_y_e,dpdrho,eosvars->eoskeyerr,eosvars->eosanyerr);

  EOS_Omni_DPressByDEps(eosvars->eoshandle,eosvars->eoskeytemp,eosvars->eosprec,1,
                 &rho,&epsilon,eosvars->eos_temp,
                 eosvars->eos_y_e,dpdeps,eosvars->eoskeyerr,eosvars->eosanyerr);

  return press[0];

}


/****************************************************************************** 
             END   
 ******************************************************************************/


#undef DEBUG_CON2PRIMM

```

GRHydro_Con2PrimM_ptee.c:
```
/***********************************************************************************
    Copyright 2006 Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, 
                   and Luca Del Zanna.

                        PVS_GRMHD

    This file was derived from PVS_GRMHD.  The authors of PVS_GRMHD include 
    Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, and Luca Del Zanna.
    PVS_GRMHD is available under the GPL from:
    http://rainman.astro.uiuc.edu/codelib/  

    You are morally obligated to cite the following  paper in his/her 
    scientific literature that results from use of this file:

    [1] Noble, S. C., Gammie, C. F., McKinney, J. C., \& Del Zanna, L. \ 2006, 
        Astrophysical Journal, 641, 626.

    PVS_GRMHD 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.

    PVS_GRMHD 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 PVS_GRMHD; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

    If the user has any questions, please direct them to Scott C. Noble at 
    scn@astro.rit.edu  . 

***********************************************************************************/



#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <float.h>
#include <complex.h>

#include "cctk.h"
#include "cctk_Parameters.h"

/* Set this to be 1 if you want debug output */
#define DEBUG_CON2PRIMM (0)


/* Adiabatic index used for the state equation */

#define MAX_NEWT_ITER   (30)       /* Max. # of Newton-Raphson iterations for find_root_2D(); */
#define NEWT_TOL        (1.0e-10)  /* Min. of tolerance allowed for Newton-Raphson iterations */
#define MIN_NEWT_TOL    (1.0e-10)  /* Max. of tolerance allowed for Newton-Raphson iterations */
#define EXTRA_NEWT_ITER (2)

#define NEWT_TOL2       (1.0e-15)  /* TOL of new 1D^*_{v^2} gnr2 method */
#define MIN_NEWT_TOL2   (1.0e-10)  /* TOL of new 1D^*_{v^2} gnr2 method */

#define W_TOO_BIG       (1.e20)    /* \gamma^2 (\rho_0 + u + p) is assumed
                                      to always be smaller than this.  This
                                      is used to detect solver failures */

#define FAIL_VAL        (1.e30)    /* Generic value to which we set variables when a problem arises */

/**************************************************
  The following functions assume a Gamma-law EOS:
***************************************************/

/* Local Globals */
struct LocGlob {
  CCTK_REAL Bsq, QdotBsq, Qtsq, Qdotn, D, half_Bsq, Sc, g_o_gm1,
           W_for_gnr2, rho_for_gnr2, W_for_gnr2_old, rho_for_gnr2_old, drho_dW ;
} ;

// Declarations: 


void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_ptee)  ( 
    CCTK_INT  *handle, CCTK_INT *keytemp, CCTK_REAL *prec,
    CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in,     
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *entropycons_in,
    CCTK_REAL *y_e_in, CCTK_REAL* temp_in,
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval) ;

static CCTK_INT general_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos,
               struct LocGlob *lgp,
               void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [],
                    CCTK_REAL [][1], CCTK_REAL *,
                    CCTK_REAL *, CCTK_REAL, struct LocGlob *) );

static void func_rho(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[],
          CCTK_REAL jac[][1], CCTK_REAL *f, CCTK_REAL *df, 
          CCTK_REAL gammaeos, struct LocGlob *lgp);

/**********************************************************************/
/**********************************************************************************

  Con2PrimM_pt():
  -----------------------------

   -- Attempts an inversion from GRMHD conserved variables to primitive variables assuming a guess.

   -- Uses the 2D method of Noble et al. (2006): 
       -- Solves for two independent variables (W,v^2) via a 2D
          Newton-Raphson method 
       -- Can be used (in principle) with a general equation of state. 

   -- Minimizes two residual functions using a homemade Newton-Raphson routine. 
       -- It is homemade so that it can catch exceptions and handle them correctly, plus it is 
          optimized for this particular  problem. 

  -- Note that the notation used herein is that of Noble et al. (2006) except for the argument 
     list. 


INPUT:  (using GRHydro variable defintions)

   s[x,y,z]   =  scons[0,1,2]  = \alpha \sqrt(\gamma) T^0_i 
   dens, tau  =  as defined in GRHydro and are assumed to be densitized (i.e. with sqrt(\gamma))   
   dens       =  D = \sqrt(\gamma) W \rho    
   tau        =  \alpha^2 \sqrt(\gamma) T^{00} - D 
   g[x,y,z][x,y,x] = spatial metric corresponding to \gamma 
   u[x,y,z][x,y,z] = inverse of the spatial metric, g[x,y,z][x,y,x]
   det        =  sqrt(\gamma)
   B[x,y,z]   =  Bvec[0,1,2] 
   bsq        = b^\mu b_\mu  

   epsnegative = (integer)
               = 0  if rho and epsilon are positive
              != 0  otherwise 


  --  (users should set B[x,y,z] = 0  for hydrodynamic runs) 


OUTPUT:  (using GRHydro variable defintions)
   rho, eps   =  as defined in GRHydro, primitive variables
   vel[x,y,z] =  as defined in GRHydro, primitive variables


RETURN VALUE: of retval = (i*100 + j)  where 
         i = 0 ->  Newton-Raphson solver either was not called (yet or not used) 
                   or returned successfully;
             1 ->  Newton-Raphson solver did not converge to a solution with the 
                   given tolerances;
             2 ->  Newton-Raphson procedure encountered a numerical divergence 
                   (occurrence of "nan" or "+/-inf" ;
             
         j = 0 -> success 
             1 -> failure: some sort of failure in Newton-Raphson; 
             2 -> failure: unphysical vsq = v^2  value at initial guess;
             3 -> failure: W<0 or W>W_TOO_BIG
             4 -> failure: v^2 > 1 
             ( used to be  5 -> failure: rho,uu <= 0   but now sets epsnegative to non-zero )

**********************************************************************************/

void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_ptee)  ( 
    CCTK_INT  *handle, CCTK_INT *keytemp, CCTK_REAL *prec,
    CCTK_REAL *gamma_eos,
    CCTK_REAL *dens_in, 
    CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, 
    CCTK_REAL *tau_in,     
    CCTK_REAL *Bconsx_in, CCTK_REAL *Bconsy_in, CCTK_REAL *Bconsz_in, 
    CCTK_REAL *entropycons_in,
    CCTK_REAL *y_e_in, CCTK_REAL* temp_in,
    CCTK_REAL *rho, 
    CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz,
    CCTK_REAL *epsilon, CCTK_REAL *pressure,
    CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, 
    CCTK_REAL *bsq,
    CCTK_REAL *w_lorentz, 
    CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, 
    CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, 
    CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz,
    CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz,
    CCTK_REAL *sdet,
    CCTK_INT  *epsnegative,
    CCTK_REAL *retval)

{
  CCTK_REAL x_1d[1];
  CCTK_REAL sx, sy, sz;
  CCTK_REAL usx, usy, usz;
  CCTK_REAL tau, dens, gammaeos;
  CCTK_REAL QdotB;
  CCTK_REAL rho0,u,p,w,gammasq,gamma,W,vsq;
  CCTK_REAL g_o_WBsq, QdB_o_W;
  CCTK_REAL sqrt_detg = *sdet;
  CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; 
  CCTK_REAL rho_gm1;
  CCTK_REAL utsq;
 
  DECLARE_CCTK_PARAMETERS;
 
  struct LocGlob lg; 

  gammaeos = *gamma_eos;

  /* Assume ok initially: */
  // BCM: But let the driver function take care of its initialization
  //*retval = 0.; 
  *epsnegative = 0; 

#if(DEBUG_CON2PRIMM)
  fprintf(stdout," *dens        = %26.16e \n", *dens_in         );
  fprintf(stdout," *sx          = %26.16e \n", *sx_in     );    
  fprintf(stdout," *sy          = %26.16e \n", *sy_in     );    
  fprintf(stdout," *sz          = %26.16e \n", *sz_in     );    
  fprintf(stdout," *tau         = %26.16e \n", *tau_in    );    
  fprintf(stdout," *Bconsx      = %26.16e \n", *Bconsx_in );    
  fprintf(stdout," *Bconsy      = %26.16e \n", *Bconsy_in );    
  fprintf(stdout," *Bconsz      = %26.16e \n", *Bconsz_in );    
  fprintf(stdout," *entropycons      = %26.16e \n", *entropycons_in );    
  fprintf(stdout," *rho         = %26.16e \n", *rho       );    
  fprintf(stdout," *velx        = %26.16e \n", *velx      );    
  fprintf(stdout," *vely        = %26.16e \n", *vely      );    
  fprintf(stdout," *velz        = %26.16e \n", *velz      );    
  fprintf(stdout," *epsilon     = %26.16e \n", *epsilon     );
  fprintf(stdout," *pressure    = %26.16e \n", *pressure    );
  fprintf(stdout," *Bx          = %26.16e \n", *Bx        );    
  fprintf(stdout," *By          = %26.16e \n", *By        );    
  fprintf(stdout," *Bz          = %26.16e \n", *Bz        );    
  fprintf(stdout," *bsq         = %26.16e \n", *bsq       );    
  fprintf(stdout," *w_lorentz   = %26.16e \n", *w_lorentz   );
  fprintf(stdout," *gxx         = %26.16e \n", *gxx       );    
  fprintf(stdout," *gxy         = %26.16e \n", *gxy       );    
  fprintf(stdout," *gxz         = %26.16e \n", *gxz       );    
  fprintf(stdout," *gyy         = %26.16e \n", *gyy       );    
  fprintf(stdout," *gyz         = %26.16e \n", *gyz       );    
  fprintf(stdout," *gzz         = %26.16e \n", *gzz       );    
  fprintf(stdout," *uxx         = %26.16e \n", *uxx       );    
  fprintf(stdout," *uxy         = %26.16e \n", *uxy       );    
  fprintf(stdout," *uxz         = %26.16e \n", *uxz       );    
  fprintf(stdout," *uyy         = %26.16e \n", *uyy       );    
  fprintf(stdout," *uyz         = %26.16e \n", *uyz       );    
  fprintf(stdout," *uzz         = %26.16e \n", *uzz       );    
  fprintf(stdout," *sdet        = %26.16e \n", *sdet       );    
  fprintf(stdout," *epsnegative = %10d    \n", *epsnegative );
  fprintf(stdout," *retval      = %26.16e \n", *retval      );
  fflush(stdout);
#endif

  /* First undensitize all conserved variables : */
  sx   = (  *sx_in)   * inv_sqrt_detg;
  sy   = (  *sy_in)   * inv_sqrt_detg;
  sz   = (  *sz_in)   * inv_sqrt_detg;
  tau  = ( *tau_in)   * inv_sqrt_detg;
  dens = (*dens_in)   * inv_sqrt_detg;

  usx  =  (*uxx)*sx + (*uxy)*sy + (*uxz)*sz;
  usy  =  (*uxy)*sx + (*uyy)*sy + (*uyz)*sz;
  usz  =  (*uxz)*sx + (*uyz)*sy + (*uzz)*sz;

  *Bx = (*Bconsx_in) * inv_sqrt_detg;
  *By = (*Bconsy_in) * inv_sqrt_detg;
  *Bz = (*Bconsz_in) * inv_sqrt_detg;

  lg.Sc = (*entropycons_in) * inv_sqrt_detg;
  // Calculate various scalars (Q.B, Q^2, etc)  from the conserved variables:

  lg.g_o_gm1 = gammaeos/(gammaeos-1.0);
  
  lg.Bsq = 
    (*gxx) * (*Bx) * (*Bx) + 
    (*gyy) * (*By) * (*By) + 
    (*gzz) * (*Bz) * (*Bz) + 
    2*( 
       (*gxy) * (*Bx) * (*By) +
       (*gxz) * (*Bx) * (*Bz) +
       (*gyz) * (*By) * (*Bz) );
    
  QdotB = (sx * (*Bx) + sy * (*By) + sz * (*Bz)) ;
  lg.QdotBsq = QdotB*QdotB ;

  lg.Qdotn = -(tau + dens) ;

  lg.Qtsq = (usx * sx  +  usy * sy  +  usz * sz) ;

  lg.D = dens;

  lg.half_Bsq = 0.5*lg.Bsq;

  /* calculate W from last timestep and use for guess */
  vsq = 
    (*gxx) * (*velx) * (*velx) + 
    (*gyy) * (*vely) * (*vely) + 
    (*gzz) * (*velz) * (*velz) + 
    2*( 
       (*gxy) * (*velx) * (*vely) +
       (*gxz) * (*velx) * (*velz) +
       (*gyz) * (*vely) * (*velz) );

  if( (vsq < 0.) && (fabs(vsq) < 1.0e-13) ) { 
    vsq = fabs(vsq);
  }
  if(vsq < 0. || vsq > 1. ) {
    *retval = 2.;
    return;
  }

  gammasq = 1. / (1. - vsq);
  gamma  = sqrt(gammasq);
        
  // Always calculate rho from D and gamma so that using D in EOS remains consistent
  //   i.e. you don't get positive values for dP/d(vsq) . 
  rho0 = lg.D / gamma ;
  rho_gm1 = pow(rho0,(gammaeos-1.));
  p = lg.Sc * rho_gm1 / gamma;
  u = p / (gammaeos-1.);
  w = rho0 + u + p ;

//  W_last = w*gammasq ;

  // Calculate W and vsq: 
  x_1d[0] = rho0;
//  *retval = 1.0*twod_newton_raphson( x_2d, gammaeos, &lg, func_vsq ) ;  
  *retval = general_newton_raphson( x_1d, gammaeos, &lg, func_rho ) ;  
  rho0 = x_1d[0];
        
  /* Problem with solver, so return denoting error before doing anything further */
  if( ((*retval) != 0.) || (rho0 == FAIL_VAL) ) {
    *retval = *retval*100.+1.;
    return;
  }
  else{
    if( rho0 > W_TOO_BIG) {
      *retval = 3.;
      return;
    }
  }

  // Calculate v^2:
  utsq = (lg.D-rho0)*(lg.D+rho0)/(rho0*rho0);
  gammasq = 1.+utsq;
  gamma = sqrt(gammasq);

  if( utsq < 0. ) {
    *retval = 4.;
    return;
  }


  // Recover the primitive variables from the scalars and conserved variables:
  rho0 = lg.D / gamma;
  rho_gm1 = pow(rho0,(gammaeos-1.));
  p = lg.Sc * rho_gm1 / gamma;
  u = p / (gammaeos-1.);
  w = rho0 + u + p ;
  W = w * gammasq;

  // User may want to handle this case differently, e.g. do NOT return upon 
  // a negative rho/u, calculate v^i so that rho/u can be floored by other routine:
  if( (rho0 <= 0.) || (u <= 0.) ) { 
    *epsnegative = 1; 
    return;
  }

  *rho = rho0;
  *epsilon = u / rho0;
  *w_lorentz = gamma; 
  *pressure = p ; 

  g_o_WBsq = 1./(W+lg.Bsq);
  QdB_o_W  = QdotB / W; 
  *bsq = lg.Bsq / gammasq + QdB_o_W*QdB_o_W;

  *velx = g_o_WBsq * ( usx + QdB_o_W*(*Bx) ) ;
  *vely = g_o_WBsq * ( usy + QdB_o_W*(*By) ) ;
  *velz = g_o_WBsq * ( usz + QdB_o_W*(*Bz) ) ;

  if (*rho <= rho_abs_min*(1.0+GRHydro_atmo_tolerance) ) {
    *rho = rho_abs_min;
    *velx = 0.0;
    *vely = 0.0;
    *velz = 0.0;
    *w_lorentz = 1.0;
  }


#if(DEBUG_CON2PRIMM)
  fprintf(stdout,"rho          = %26.16e \n",*rho      );
  fprintf(stdout,"epsilon      = %26.16e \n",*epsilon  );
  fprintf(stdout,"pressure     = %26.16e \n",*pressure );
  fprintf(stdout,"w_lorentz    = %26.16e \n",*w_lorentz);
  fprintf(stdout,"bsq          = %26.16e \n",*bsq      );
  fprintf(stdout,"velx         = %26.16e \n",*velx     );
  fprintf(stdout,"vely         = %26.16e \n",*vely     );
  fprintf(stdout,"velz         = %26.16e \n",*velz     );
  fprintf(stdout,"gammaeos     = %26.16e \n",gammaeos  );
  fflush(stdout);
#endif

  /* done! */
  return;

}

/**********************************************************************/
/************************************************************

  general_newton_raphson(): 

    -- performs Newton-Rapshon method on an arbitrary system.

    -- inspired in part by Num. Rec.'s routine newt();

    Arguements: 

       -- x[]   = set of independent variables to solve for;
       -- n     = number of independent variables and residuals;
       -- funcd = name of function that calculates residuals, etc.;

*****************************************************************/
static CCTK_INT general_newton_raphson( CCTK_REAL x[], CCTK_REAL gammaeos,
               struct LocGlob *lgp,
               void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [],
                    CCTK_REAL [][1], CCTK_REAL *,
                    CCTK_REAL *, CCTK_REAL, struct LocGlob *) )
{
  CCTK_REAL f, df, dx[1], x_old[1], resid[1],
    jac[1][1];
  CCTK_REAL errx, x_orig[1];
  CCTK_INT  n_iter, i_extra, doing_extra;
  CCTK_REAL W,W_old;

  int   keep_iterating;


  // Initialize various parameters and variables:
  errx = 1. ;
  df = f = 1.;
  i_extra = doing_extra = 0;
  x_old[0] = x_orig[0] = x[0] ;

  W = W_old = 0.;

  n_iter = 0;


  /* Start the Newton-Raphson iterations : */
  keep_iterating = 1;
  while( keep_iterating ) {

    (*funcd) (x, dx, resid, jac, &f, &df, gammaeos, lgp);  /* returns with new dx, f, df */

    /* Save old values before calculating the new: */
    errx = 0.;
    x_old[0] = x[0] ;
    /* don't use line search : */
    x[0] += dx[0]  ;

    /****************************************/
    /* Calculate the convergence criterion */
    /****************************************/

    /* For the new criterion, always look at error in "W" : */
    // METHOD specific:
    errx  = (x[0]==0.) ?  fabs(dx[0]) : fabs(dx[0]/x[0]);


    /****************************************/
    /* Make sure that the new x[] is physical : */
    /****************************************/
    x[0] = fabs(x[0]);


    /*****************************************************************************/
    /* If we've reached the tolerance level, then just do a few extra iterations */
    /*  before stopping                                                          */
    /*****************************************************************************/

    if( (fabs(errx) <= NEWT_TOL) && (doing_extra == 0) && (EXTRA_NEWT_ITER > 0) ) {
      doing_extra = 1;
    }

    if( doing_extra == 1 ) i_extra++ ;

    if( ((fabs(errx) <= NEWT_TOL)&&(doing_extra == 0)) ||
   (i_extra > EXTRA_NEWT_ITER) || (n_iter >= (MAX_NEWT_ITER-1)) ) {
      keep_iterating = 0;
    }

    n_iter++;

  }   // END of while(keep_iterating)


  /*  Check for bad untrapped divergences : */
  if( (!finite(f)) || (!finite(df)) || (!finite(x[0]))  ) {
    return(2);
  }


  if( fabs(errx) > MIN_NEWT_TOL){
    return(1);
  }
  if( (fabs(errx) <= MIN_NEWT_TOL) && (fabs(errx) > NEWT_TOL) ){
    return(0);
  }
  if( fabs(errx) <= NEWT_TOL ){
    return(0);
  }

  return(0);

}

/**********************************************************************/
/*********************************************************************************
   func_rho():

        -- residual/jacobian routine to calculate rho Qtsq equation with 
            the definition of W 
        W  =  ( 1 + GAMMA * K_atm * rho^(GAMMA-1)/(GAMMA-1) ) D^2 / rho
              substituted in. 

     Arguments:
          x   = current value of independent var's (on input & output);
         dx   = Newton-Raphson step (on output);
        resid = residuals based on x (on output);
         jac  = Jacobian matrix based on x (on output);
         f    =  resid.resid/2  (on output)
        df    = -2*f;  (on output)
         n    = dimension of x[];
 *********************************************************************************/
static void func_rho(CCTK_REAL x[], CCTK_REAL dx[], CCTK_REAL resid[],
          CCTK_REAL jac[][1], CCTK_REAL *f, CCTK_REAL *df, 
          CCTK_REAL gammaeos, struct LocGlob *lgp)
{

  CCTK_REAL t1,t2;
  CCTK_REAL t12;
  CCTK_REAL t17;
  CCTK_REAL t3, t100,rhosq,t200,rho,W,dWdrho,dvsqdrho,vsq;

  rho = x[0];
  rhosq = rho*rho;
  t200 = 1./(lgp->D*lgp->D);
  t100 = lgp->g_o_gm1*lgp->Sc*pow(rho,(gammaeos-1.));
  W = lgp->D*( lgp->D + t100 ) / rho ;
  dWdrho = lgp->D * ( -lgp->D + t100*(gammaeos-2.) ) / rhosq;
  t1 = W*W;
  t2 = lgp->Bsq+W;
  //    t3 = pow(Bsq+W,2.0);
  t3 = t2*t2;
  vsq = (lgp->D-rho)*(lgp->D+rho)*t200;
  dvsqdrho = -2*rho*t200;
  resid[0] = t1*(lgp->Qtsq-vsq*t3)+lgp->QdotBsq*(t2+W);
  t12 = lgp->Bsq*lgp->Bsq;
  t17 = dWdrho*vsq;
  jac[0][0] = 2*lgp->QdotBsq*dWdrho
    +((lgp->Qtsq-vsq*t12)*2*dWdrho+(-6*t17*lgp->Bsq-dvsqdrho*t12
                +(-2*dvsqdrho*lgp->Bsq-4*t17-dvsqdrho*W)*W)*W)*W;

  dx[0] = -resid[0]/jac[0][0];
  *f = 0.5*resid[0]*resid[0];
  *df = -2. * (*f);

  return;

}


/****************************************************************************** 
             END   
 ******************************************************************************/


#undef DEBUG_CON2PRIMM

```

GRHydro_WENOReconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_WENOReconstruct_drv.F90
   @date      Fri Jan 3 2013
   @author    Christian Reisswig, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   Driver routine to perform the WENO reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

#define sx(i,j,k) scon(i,j,k,1)
#define sy(i,j,k) scon(i,j,k,2)
#define sz(i,j,k) scon(i,j,k,3)
#define Bconsx(i,j,k) Bcons(i,j,k,1)
#define Bconsy(i,j,k) Bcons(i,j,k,2)
#define Bconsz(i,j,k) Bcons(i,j,k,3)


!!$ transform back to vel if Wv was used
subroutine undo_Wv(nx,velxminus,velyminus,velzminus,&
                      velxplus,velyplus,velzplus,&
                      gxx,gxy,gxz,gyy,gyz,gzz)

   implicit none

   DECLARE_CCTK_PARAMETERS
   DECLARE_CCTK_FUNCTIONS
   
   CCTK_INT :: i,nx
   CCTK_REAL :: w, agxx, agxy, agxz, agyy, agyz, agzz
   CCTK_REAL, dimension(nx) :: gxx, gxy, gxz, gyy, gyz, gzz
   CCTK_REAL, dimension(nx) :: velxminus,velyminus,velzminus
   CCTK_REAL, dimension(nx) :: velxplus,velyplus,velzplus
                      
   do i = grhydro_stencil, nx - grhydro_stencil + 1
      ! divide out the Loretnz factor obtained from w_lorentz =
      ! sqrt(1+g_{ij} w^i w^j) for both the
      ! plus and minus quantities this should by construction ensure
      ! that any Lorentz factor calculated from them later on is
      ! physical (ie. > 1.d0)
      agxx = 0.5d0*( gxx(i) + gxx(i-1) )
      agxy = 0.5d0*( gxy(i) + gxy(i-1) )
      agxz = 0.5d0*( gxz(i) + gxz(i-1) )
      agyy = 0.5d0*( gyy(i) + gyy(i-1) )
      agyz = 0.5d0*( gyz(i) + gyz(i-1) )
      agzz = 0.5d0*( gzz(i) + gzz(i-1) )
      w = sqrt( 1.d0 + agxx*velxminus(i)*velxminus(i) + &
                        agyy*velyminus(i)*velyminus(i) &
               + agzz*velzminus(i)*velzminus(i) + &
                  2.d0*agxy*velxminus(i)*velyminus(i) &
               + 2.d0*agxz*velxminus(i)*velzminus(i) + &
                  2.d0*agyz*velyminus(i)*velzminus(i) )
      velxminus(i) = velxminus(i)/w
      velyminus(i) = velyminus(i)/w
      velzminus(i) = velzminus(i)/w
      
      agxx = 0.5d0*( gxx(i) + gxx(i+1) )
      agxy = 0.5d0*( gxy(i) + gxy(i+1) )
      agxz = 0.5d0*( gxz(i) + gxz(i+1) )
      agyy = 0.5d0*( gyy(i) + gyy(i+1) )
      agyz = 0.5d0*( gyz(i) + gyz(i+1) )
      agzz = 0.5d0*( gzz(i) + gzz(i+1) )
      w = sqrt( 1.d0 + agxx*velxplus(i)*velxplus(i) + &
                  agyy*velyplus(i)*velyplus(i) &
               + agzz*velzplus(i)*velzplus(i) + &
               2.d0*agxy*velxplus(i)*velyplus(i) &
               + 2.d0*agxz*velxplus(i)*velzplus(i) + &
               2.d0*agyz*velyplus(i)*velzplus(i) )
      velxplus(i) = velxplus(i)/w
      velyplus(i) = velyplus(i)/w
      velzplus(i) = velzplus(i)/w
   end do
end subroutine undo_Wv

  

 /*@@
   @routine    GRHydro_WENOReconstruct_drv
   @date       Fri Jan 3 2013
   @author     Christian Reisswig, Luca Baiotti, Ian Hawke, Bruno C. Mundim, Joshua Faber, Christian D. Ott
   @desc 
   A driver routine to do WENO reconstruction. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_WENOReconstruct_drv(CCTK_ARGUMENTS)
  
  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  ! save memory when MP is not used
  CCTK_INT :: GRHydro_UseGeneralCoordinates

  integer :: nx, ny, nz, i, j, k, itracer

  logical, dimension(:,:,:), allocatable :: trivial_rp

  CCTK_INT :: type_bitsx, trivialx, not_trivialx, &
       &type_bitsy, trivialy, not_trivialy, &
       &type_bitsz, trivialz, not_trivialz

  CCTK_REAL, dimension(:,:,:),allocatable :: &
       &dum, dump, dumm

  CCTK_INT :: ierr

  ! 1D arrays in x, y and z direction for reconstructing Wv instead of v
!   CCTK_REAL, dimension(nx) :: vxX,vyX,vzX
!   CCTK_REAL, dimension(ny) :: vxY,vyY,vzY
!   CCTK_REAL, dimension(nz) :: vxZ,vyZ,vzZ
  
  allocate(trivial_rp(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)
  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with trivial_rp")
    STOP
  end if
  
!!$ The dum variables are used as dummies if MHD on but divergence cleaning off
  allocate(dum(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dump(cctk_ash(1),cctk_ash(2),cctk_ash(3)),&
       dumm(cctk_ash(1),cctk_ash(2),cctk_ash(3)),STAT=ierr)

  if (ierr .ne. 0) then
    call CCTK_ERROR("Allocation problems with dum dump dumm")
    STOP
  end if
  
  call SpaceMask_GetTypeBits(type_bitsx, "Hydro_RiemannProblemX")
  call SpaceMask_GetStateBits(trivialx, "Hydro_RiemannProblemX", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialx, "Hydro_RiemannProblemX", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsy, "Hydro_RiemannProblemY")
  call SpaceMask_GetStateBits(trivialy, "Hydro_RiemannProblemY", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialy, "Hydro_RiemannProblemY", &
       &"not_trivial")
  call SpaceMask_GetTypeBits(type_bitsz, "Hydro_RiemannProblemZ")
  call SpaceMask_GetStateBits(trivialz, "Hydro_RiemannProblemZ", &
       &"trivial")
  call SpaceMask_GetStateBits(not_trivialz, "Hydro_RiemannProblemZ", &
       &"not_trivial")

  nx = cctk_lsh(1)
  ny = cctk_lsh(2)
  nz = cctk_lsh(3)

  !initialize trivial_rp to false
  !$OMP PARALLEL DO PRIVATE(i,j,k)
  do k=1,nz
     do j=1,ny
        do i=1,nx
           trivial_rp(i,j,k) = .false.
        enddo
     enddo
  enddo
  !$OMP END PARALLEL DO

!!$ WENO starts:
     if (evolve_tracer .ne. 0) then
        do itracer=1,number_of_tracers
           call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
                tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), &
                tracerminus(:,:,:,itracer), trivial_rp, &
                hydro_excision_mask)
        enddo
     end if

    if (flux_direction == 1) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    vel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    vel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    vel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    lvel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    lvel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    lvel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*vel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call undo_Wv(int(nx,ik), velxminus(:,j,k), velyminus(:,j,k), velzminus(:,j,k),&
                                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                                  gxx(:,j,k),gxy(:,j,k),gxz(:,j,k),gyy(:,j,k),gyz(:,j,k),gzz(:,j,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*lvel(:,j,k,1),velxminus(:,j,k),velxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*lvel(:,j,k,2),velyminus(:,j,k),velyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    w_lorentz(:,j,k)*lvel(:,j,k,3),velzminus(:,j,k),velzplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call undo_Wv(int(nx,ik), velxminus(:,j,k), velyminus(:,j,k), velzminus(:,j,k),&
                                  velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),&
                                  gaa(:,j,k),gab(:,j,k),gac(:,j,k),gbb(:,j,k),gbc(:,j,k),gcc(:,j,k))
               end if
            endif
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 eps(:,j,k),epsminus(:,j,k),epsplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_Y_e.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Y_e(:,j,k),Y_e_minus(:,j,k),Y_e_plus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    temperature(:,j,k),tempminus(:,j,k),tempplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bvec(:,j,k,1),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bvec(:,j,k,2),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      Bvec(:,j,k,3),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      lBvec(:,j,k,1),Bvecxminus(:,j,k),Bvecxplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      lBvec(:,j,k,2),Bvecyminus(:,j,k),Bvecyplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                      lBvec(:,j,k,3),Bveczminus(:,j,k),Bveczplus(:,j,k),&
                      trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    entropy(:,j,k),entropyminus(:,j,k),entropyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 dens(:,j,k),densminus(:,j,k),densplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sx(:,j,k),sxminus(:,j,k),sxplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sy(:,j,k),syminus(:,j,k),syplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 sz(:,j,k),szminus(:,j,k),szplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                 tau(:,j,k),tauminus(:,j,k),tauplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bconsx(:,j,k),Bconsxminus(:,j,k),Bconsxplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bconsy(:,j,k),Bconsyminus(:,j,k),Bconsyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    Bconsz(:,j,k),Bconszminus(:,j,k),Bconszplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                    entropycons(:,j,k),entropyconsminus(:,j,k),entropyconsplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(1),&
                  psidc(:,j,k),psidcminus(:,j,k),psidcplus(:,j,k),&
                  trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
          endif

          do i = 1, cctk_lsh(1)
            if (trivial_rp(i,j,k)) then
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx)
            else
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 2) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    vel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    vel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    vel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    lvel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    lvel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    lvel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*vel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call undo_Wv(int(ny,ik), velyminus(j,:,k), velzminus(j,:,k), velxminus(j,:,k),&
                                  velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                                  gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), gxx(j,:,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,1),velxminus(j,:,k),velxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,2),velyminus(j,:,k),velyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    w_lorentz(j,:,k)*lvel(j,:,k,3),velzminus(j,:,k),velzplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call undo_Wv(int(ny,ik), velyminus(j,:,k), velzminus(j,:,k), velxminus(j,:,k),&
                                  velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),&
                                  gbb(j,:,k), gbc(j,:,k), gab(j,:,k), gcc(j,:,k), gac(j,:,k), gaa(j,:,k))
               end if
            endif
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 eps(j,:,k),epsminus(j,:,k),epsplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if(evolve_Y_e.ne.0) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 Y_e(j,:,k),Y_e_minus(j,:,k),Y_e_plus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    temperature(j,:,k),tempminus(j,:,k),tempplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      Bvec(j,:,k,1),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      Bvec(j,:,k,2),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      Bvec(j,:,k,3),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,1),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,2),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,3),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
              end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    entropy(j,:,k),entropyminus(j,:,k),entropyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
         else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 dens(j,:,k),densminus(j,:,k),densplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 sx(j,:,k),sxminus(j,:,k),sxplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 sy(j,:,k),syminus(j,:,k),syplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 sz(j,:,k),szminus(j,:,k),szplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 tau(j,:,k),tauminus(j,:,k),tauplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    Bconsx(j,:,k),Bconsxminus(j,:,k),Bconsxplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    Bconsy(j,:,k),Bconsyminus(j,:,k),Bconsyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    Bconsz(j,:,k),Bconszminus(j,:,k),Bconszplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    entropycons(j,:,k),entropyconsminus(j,:,k),entropyconsplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                 psidc(j,:,k),psidcminus(j,:,k),psidcplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
          endif

          do i = 1, cctk_lsh(2)
            if (trivial_rp(j,i,k)) then
              SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else if (flux_direction == 3) then
      ! constraint transport needs to be able to average fluxes in the directions
      ! other that flux_direction, which in turn need the primitives on interfaces
      !$OMP PARALLEL DO PRIVATE(i, j, k)
      do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + transport_constraints
        do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + transport_constraints
          if (CCTK_EQUALS(recon_vars,"primitive")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if (reconstruct_Wv.eq.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    vel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    vel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    vel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,1),Bvecxminus(j,:,k),Bvecxplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,2),Bvecyminus(j,:,k),Bvecyplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                      lBvec(j,:,k,3),Bveczminus(j,:,k),Bveczplus(j,:,k),&
                      trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
               end if
            else
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*vel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call undo_Wv(int(nz,ik), velzminus(j,k,:), velxminus(j,k,:), velyminus(j,k,:),&
                                  velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                                  gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:),gyy(j,k,:))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call undo_Wv(int(nz,ik), velzminus(j,k,:), velxminus(j,k,:), velyminus(j,k,:),&
                                  velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),&
                                  gcc(j,k,:), gac(j,k,:), gbc(j,k,:), gaa(j,k,:), gab(j,k,:),gbb(j,k,:))
               end if
            endif
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 eps(j,k,:),epsminus(j,k,:),epsplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_Y_e.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Y_e(j,k,:),Y_e_minus(j,k,:),Y_e_plus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if(evolve_temper.ne.0.and.reconstruct_temper.ne.0) then 
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    temperature(j,k,:),tempminus(j,k,:),tempplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                      Bvec(j,k,:,1),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                      Bvec(j,k,:,2),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                      Bvec(j,k,:,3),Bveczminus(j,k,:),Bveczplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               else
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    w_lorentz(j,k,:)*lvel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               end if
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(2),&
                    entropy(j,k,:),entropyminus(j,k,:),entropyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else if (CCTK_EQUALS(recon_vars,"conservative")) then
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 dens(j,k,:),densminus(j,k,:),densplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sx(j,k,:),sxminus(j,k,:),sxplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sy(j,k,:),syminus(j,k,:),syplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 sz(j,k,:),szminus(j,k,:),szplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                 tau(j,k,:),tauminus(j,k,:),tauplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsx(j,k,:),Bconsxminus(j,k,:),Bconsxplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsy(j,k,:),Bconsyminus(j,k,:),Bconsyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    Bconsz(j,k,:),Bconszminus(j,k,:),Bconszplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                    entropycons(j,k,:),entropyconsminus(j,k,:),entropyconsplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
          else
            !$OMP CRITICAL
            call CCTK_ERROR("Variable type to reconstruct not recognized.")
            STOP
            !$OMP END CRITICAL
          end if

          if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
             call GRHydro_WENOReconstruct1d(WENO_order,cctk_lsh(3),&
                  psidc(j,k,:),psidcminus(j,k,:),psidcplus(j,k,:),&
                  trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
          endif

          do i = 1, cctk_lsh(3)
            if (trivial_rp(j,k,i)) then
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz)
            else
              SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz)
            end if
          end do
        end do
      end do
      !$OMP END PARALLEL DO
    else
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
!!$ WENO ends.


  deallocate(trivial_rp)
  deallocate(dum,dump,dumm)


end subroutine GRHydro_WENOReconstruct_drv


```

GRHydro_TVDReconstruct.F90:
```
 /*@@
   @file      GRHydro_TVDReconstruct.F90
   @date      Sat Jan 26 02:11:44 2002
   @author    Luca Baiotti
   @desc 
   The TVD reconstruction routine.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "SpaceMask.h"

 /*@@
   @routine    tvdreconstruct
   @date       Sat Jan 26 02:12:12 2002
   @author     Luca Baiotti
   @desc 
   Performs slope limited TVD reconstruction on the given input GF
   @enddesc 
   @calls     
   @calledby   
   @history 
   Follows (in philosophy) old code by Ian Hawke
   @endhistory 

@@*/

subroutine tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
     orig, bextp, bextm, trivial_rp, hydro_excision_mask)
  
  USE GRHydro_Scalars
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  integer :: i, j, k, xoffset, yoffset, zoffset, nx, ny, nz
  CCTK_REAL, dimension(nx, ny, nz) :: orig, bextp, bextm
  CCTK_REAL :: dupw, dloc, delta, ratio, hdelta
  logical, dimension(nx,ny,nz) :: trivial_rp
  CCTK_INT, dimension(nx,ny,nz) :: hydro_excision_mask


  bextp = 0.d0
  bextm = 0.d0

!!$ Initially all Riemann problems are NON-trivial

  trivial_rp = .false.
    ! constraint transport needs to be able to average fluxes in the directions
    ! other that flux_direction, which in turn need the primitives on interfaces
    !$OMP PARALLEL DO PRIVATE(i,j,k,dupw,dloc,delta,ratio,hdelta)
    do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + transport_constraints*(1-zoffset)
      do j = GRHydro_stencil, ny - GRHydro_stencil + 1 + transport_constraints*(1-yoffset)
        do i = GRHydro_stencil, nx - GRHydro_stencil + 1 + transport_constraints*(1-xoffset)
          if (GRHydro_enable_internal_excision /= 0 .and. &
              (hydro_excision_mask(i,j,k) .ne. 0)) then
            trivial_rp(i-xoffset, j-yoffset, k-zoffset) = .true.
            trivial_rp(i, j, k) = .true.
            bextm(i, j, k) = orig(i, j, k)
            bextp(i, j, k) = orig(i, j, k)
            if (GRHydro_enable_internal_excision /= 0 .and. &
                (hydro_excision_mask(i+xoffset,j+yoffset,k+zoffset) .eq. 0)) then
              bextm(i, j, k) = orig(i+xoffset, j+yoffset, k+zoffset)
              bextp(i, j, k) = orig(i+xoffset, j+yoffset, k+zoffset)
            end if
          else if (GRHydro_enable_internal_excision /= 0 .and. &
                   ((hydro_excision_mask(i-xoffset,j-yoffset,k-zoffset) .ne. 0) .or. &
                    (hydro_excision_mask(i+xoffset,j+yoffset,k+zoffset) .ne. 0))) then
            bextm(i, j, k) = orig(i, j, k)
            bextp(i, j, k) = orig(i, j, k)
          else
            dupw = orig(i, j, k) - orig(i-xoffset, j-yoffset, k-zoffset)
            dloc = orig(i+xoffset, j+yoffset, k+zoffset) - orig(i, j, k)

            if (MINMOD) then
               delta = minmod_func(dupw,dloc)
            else if (MC2) then
!!$            This is the van Leer MC slope limiter
               if (dupw*dloc < 0.d0) then
                  delta=0.d0
               else 
                  delta=sign(min(2.d0*abs(dupw),2.d0*abs(dloc),&
                       0.5d0*(abs(dupw)+abs(dloc))),dupw+dloc)
               end if
            else if (SUPERBEE) then
               if (dupw*dloc < 0.d0) then
                  delta=0.d0
               else 
                  delta=sign(max(min(2.d0*abs(dupw),abs(dloc)),&
                       min(2.d0*abs(dloc),abs(dupw))),dupw+dloc)
               end if
            else
               call CCTK_ERROR("Type of limiter not recognized")
               STOP
               ! NOTREACHED
               delta = 0d0 
            end if
            hdelta = 0.5d0 * delta 
            bextm(i, j, k) = orig(i, j, k) - hdelta
            bextp(i, j, k) = orig(i, j, k) + hdelta
          end if
        end do
      end do
    end do
    !$OMP END PARALLEL DO

contains
  function minmod_func(a_in,b_in) result(minmod_result)
    implicit none
    CCTK_REAL,intent(IN)::a_in,b_in
    CCTK_REAL::minmod_result
    
    minmod_result=0.5D0*(sign(1.0d0,a_in)+sign(1.0d0,b_in))*min(abs(a_in),abs(b_in))
  end function minmod_func

end subroutine tvdreconstruct


```

GRHydro_ENOScalars.F90:
```
 /*@@
   @file      GRHydro_ENOScalars.F90
   @date      Sat Apr  6 17:35:42 2002
   @author    Ian Hawke
   @desc 
   Module containing the coefficient array for ENO reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"

 module GRHydro_ENOScalars

   implicit none

   CCTK_REAL, allocatable, save :: eno_coeffs(:, :)
   
 end module GRHydro_ENOScalars

```

GRHydro_Marquina.F90:
```
  /*@@
   @file      GRHydro_Marquina.f90
   @date      Thu Jan  11 11:03:32 2002
   @author    Pedro Montero, Toni Font    
   @desc 
   Routine to obtain the Marquina Fluxes. Note that this is the 
   MODIFIED Marquina formula as given by Aloy et.al. 
   (ApJ Supp 122 (1999) p.151) and not the full Marquina flux 
   of Donat and Marquina.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

#include "GRHydro_Macros.h"
#include "SpaceMask.h"

 /*@@
   @routine    GRHydro_Marquina.f90 
   @date       Wed Feb 13 11:03:32 2002
   @author     Pedro Montero, Toni Font
   @desc 
   Routine to obtain the Marquina Fluxes
   @enddesc 
   @calls     
   @calledby   
   @history 
   Based on routines by Toni Font
   @endhistory 

@@*/


subroutine GRHydro_Marquina(CCTK_ARGUMENTS)
    
    implicit none


    DECLARE_CCTK_ARGUMENTS
    DECLARE_CCTK_PARAMETERS
    DECLARE_CCTK_FUNCTIONS
    CCTK_REAL, dimension(5) :: marquinaflux, &
         consp,consm_i,fplus,fminus,f_marquina,primp,primm_i
    CCTK_REAL :: avg_alp,avg_beta,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
         avg_det,uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,&
         tmp_w_lorentzp, tmp_w_lorentzm_i, w_lorentzp,w_lorentzm_i, usendh
    integer :: m
    integer :: i,j,k
    integer :: keytemp
    
    CCTK_INT :: type_bits, trivial

    if(evolve_temper.eq.1.and.reconstruct_temper.eq.1) then
       keytemp = 1
    else
       keytemp = 0
    endif

    if (flux_direction == 1) then
      call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX")
      call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", &
           &"trivial")
    else if (flux_direction == 2) then
      call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
      call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
           &"trivial")
    else if (flux_direction == 3) then
      call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
      call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
           &"trivial")
    else
      !Keep this check in here, it is not checked again later
      call CCTK_ERROR("Flux direction not x,y,z")
      STOP
    end if
    
    f_marquina = 0.d0
        
    !$OMP PARALLEL DO PRIVATE(i,j,k,consp,consm_i,primp,primm_i,&
    !$OMP marquinaflux,avg_beta,avg_alp,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,&
    !$OMP f_marquina,uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,usendh,&
    !$OMP tmp_w_lorentzp, tmp_w_lorentzm_i,w_lorentzp,w_lorentzm_i,&
    !$OMP fplus,fminus,m,avg_det)
    do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
      do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
        do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil

!!$        Set the left (p for plus) and right (m_i for minus, i+1) states

          consp(1)   = densplus(i,j,k) 
          consp(2)   = sxplus(i,j,k)
          consp(3)   = syplus(i,j,k)
          consp(4)   = szplus(i,j,k)
          consp(5)   = tauplus(i,j,k)
          
          consm_i(1) = densminus(i+xoffset,j+yoffset,k+zoffset)
          consm_i(2) = sxminus(i+xoffset,j+yoffset,k+zoffset)
          consm_i(3) = syminus(i+xoffset,j+yoffset,k+zoffset)
          consm_i(4) = szminus(i+xoffset,j+yoffset,k+zoffset)
          consm_i(5) = tauminus(i+xoffset,j+yoffset,k+zoffset) 
          
          primp(1)   = rhoplus(i,j,k) 
          primp(2)   = velxplus(i,j,k)
          primp(3)   = velyplus(i,j,k) 
          primp(4)   = velzplus(i,j,k)
          primp(5)   = epsplus(i,j,k)
          
          primm_i(1) = rhominus(i+xoffset,j+yoffset,k+zoffset)
          primm_i(2) = velxminus(i+xoffset,j+yoffset,k+zoffset)
          primm_i(3) = velyminus(i+xoffset,j+yoffset,k+zoffset)
          primm_i(4) = velzminus(i+xoffset,j+yoffset,k+zoffset)
          primm_i(5) = epsminus(i+xoffset,j+yoffset,k+zoffset) 

          marquinaflux = 0.d0
        
!!$        Set metric terms at interface
          
          if (flux_direction == 1) then
             avg_beta = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + &
                  betax(i,j,k))
          else if (flux_direction == 2) then
             avg_beta = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + &
                  betay(i,j,k))
          else
             avg_beta = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + &
                  betaz(i,j,k))
          end if

          avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))

          gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + &
               gxx(i,j,k))
          gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + &
               gxy(i,j,k))
          gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + &
               gxz(i,j,k))
          gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + &
               gyy(i,j,k))
          gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + &
               gyz(i,j,k))
          gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + &
               gzz(i,j,k))

!!$ routine to calculate the determinant of the metric

         avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh)
          
!!$ If the Riemann problem is trivial, just calculate the fluxes from the 
!!$ left state and skip to the next cell

          if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then

            if (flux_direction == 1) then
              call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5),&
                   f_marquina(1),f_marquina(2),f_marquina(3),&
                   f_marquina(4),f_marquina(5),&
                   velxplus(i,j,k),pressplus(i,j,k),&
                   avg_det,avg_alp,avg_beta)
            else if (flux_direction == 2) then
              call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5),&
                   f_marquina(1),f_marquina(3),f_marquina(4),&
                   f_marquina(2),f_marquina(5),&
                   velyplus(i,j,k),pressplus(i,j,k),&
                   avg_det,avg_alp,avg_beta)
            else
              call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5),&
                   f_marquina(1),f_marquina(4),f_marquina(2),&
                   f_marquina(3),f_marquina(5),&
                   velzplus(i,j,k),pressplus(i,j,k),&
                   avg_det,avg_alp,avg_beta)
            end if
            
          else !!! The end of this branch is right at the bottom of the routine
            
            call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, &
                 avg_det,gxxh, gxyh, gxzh, gyyh, gyzh, gzzh)
            
            if (flux_direction == 1) then
              usendh = uxxh
            else if (flux_direction == 2) then
              usendh = uyyh
            else
              usendh = uzzh
            end if

!!$left state

            tmp_w_lorentzp = gxxh*primp(2)*primp(2) + &
                 gyyh*primp(3)*primp(3) + gzzh*primp(4)*primp(4) + &
                 2*gxyh*primp(2)*primp(3) + 2*gxzh*primp(2) *primp(4) + &
                 2*gyzh*primp(3)*primp(4)
            if (tmp_w_lorentzp .ge. 1.d0) then
              w_lorentzp = GRHydro_lorentz_overshoot_cutoff
            else
              w_lorentzp = 1.d0 / sqrt(1.d0 - tmp_w_lorentzp);
            endif


!!$right state

            tmp_w_lorentzm_i = gxxh*primm_i(2)*primm_i(2) + &
                 gyyh*primm_i(3)*primm_i(3) + gzzh*primm_i(4)*primm_i(4) + &
                 2*gxyh*primm_i(2)*primm_i(3) + &
                 2*gxzh*primm_i(2) *primm_i(4)+ &
                 2*gyzh*primm_i(3)*primm_i(4)
            if (tmp_w_lorentzm_i .ge. 1.d0) then
              w_lorentzm_i = GRHydro_lorentz_overshoot_cutoff
            else
              w_lorentzm_i = 1.d0 / sqrt(1.d0 - tmp_w_lorentzm_i);
            endif

            
!!$eigenvalues and right eigenvectors
            
            if (flux_direction == 1) then

               if(evolve_temper.eq.0) then
                  call eigenproblem_marquina(GRHydro_eos_handle,&
                       primm_i(1),primm_i(2), & 
                       primm_i(3),primm_i(4),primm_i(5),primp(1), &
                       primp(2),primp(3),primp(4),primp(5), &
                       gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(2),&
                       consp(3), consp(4), consp(5),consm_i(1),consm_i(2), &
                       consm_i(3),consm_i(4),consm_i(5),marquinaflux(1), &
                       marquinaflux(2),marquinaflux(3),marquinaflux(4), &
                       marquinaflux(5))
               else
                  call eigenproblem_marquina_hot(GRHydro_eos_handle,keytemp,&
                       primm_i(1),primm_i(2), & 
                       primm_i(3),primm_i(4),primm_i(5),primp(1), &
                       primp(2),primp(3),primp(4),primp(5), &
                       tempminus(i+xoffset,j+yoffset,k+zoffset),&
                       tempplus(i,j,k),&
                       y_e_minus(i+xoffset,j+yoffset,k+zoffset),y_e_plus(i,j,k),&
                       gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(2),&
                       consp(3), consp(4), consp(5),consm_i(1),consm_i(2), &
                       consm_i(3),consm_i(4),consm_i(5),marquinaflux(1), &
                       marquinaflux(2),marquinaflux(3),marquinaflux(4), &
                       marquinaflux(5))

               endif
              
            else if (flux_direction == 2) then

               if(evolve_temper.eq.0) then              
                  call eigenproblem_marquina(GRHydro_eos_handle,&
                       primm_i(1),primm_i(3), & 
                       primm_i(4),primm_i(2),primm_i(5),primp(1), &
                       primp(3),primp(4),primp(2),primp(5), &
                       gyyh,gyzh,gxyh,gzzh,gxzh,gxxh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(3),&
                       consp(4), consp(2), consp(5),consm_i(1),consm_i(3), &
                       consm_i(4),consm_i(2),consm_i(5),marquinaflux(1), &
                       marquinaflux(3),marquinaflux(4),marquinaflux(2), &
                       marquinaflux(5))
               else
                  call eigenproblem_marquina_hot(GRHydro_eos_handle,keytemp,&
                       primm_i(1),primm_i(3), & 
                       primm_i(4),primm_i(2),primm_i(5),primp(1), &
                       primp(3),primp(4),primp(2),primp(5), &
                       tempminus(i+xoffset,j+yoffset,k+zoffset),&
                       tempplus(i,j,k),&
                       y_e_minus(i+xoffset,j+yoffset,k+zoffset),y_e_plus(i,j,k),&
                       gyyh,gyzh,gxyh,gzzh,gxzh,gxxh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(3),&
                       consp(4), consp(2), consp(5),consm_i(1),consm_i(3), &
                       consm_i(4),consm_i(2),consm_i(5),marquinaflux(1), &
                       marquinaflux(3),marquinaflux(4),marquinaflux(2), &
                       marquinaflux(5))

               endif
              
            else

               if(evolve_temper.eq.0) then
                  call eigenproblem_marquina(GRHydro_eos_handle,&
                       primm_i(1),primm_i(4), & 
                       primm_i(2),primm_i(3),primm_i(5),primp(1), &
                       primp(4),primp(2),primp(3),primp(5), &
                       gzzh,gxzh,gyzh,gxxh,gxyh,gyyh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(4),&
                       consp(2), consp(3), consp(5),consm_i(1),consm_i(4), &
                       consm_i(2),consm_i(3),consm_i(5),marquinaflux(1), &
                       marquinaflux(4),marquinaflux(2),marquinaflux(3), &
                       marquinaflux(5))
               else
                  call eigenproblem_marquina_hot(GRHydro_eos_handle,keytemp,&
                       primm_i(1),primm_i(4), & 
                       primm_i(2),primm_i(3),primm_i(5),primp(1), &
                       primp(4),primp(2),primp(3),primp(5), &
                       tempminus(i+xoffset,j+yoffset,k+zoffset),&
                       tempplus(i,j,k),&
                       y_e_minus(i+xoffset,j+yoffset,k+zoffset),y_e_plus(i,j,k),&
                       gzzh,gxzh,gyzh,gxxh,gxyh,gyyh, &
                       usendh,avg_det,avg_alp,avg_beta,consp(1),consp(4),&
                       consp(2), consp(3), consp(5),consm_i(1),consm_i(4), &
                       consm_i(2),consm_i(3),consm_i(5),marquinaflux(1), &
                       marquinaflux(4),marquinaflux(2),marquinaflux(3), &
                       marquinaflux(5))
               endif
            end if
            
            fplus = 0.d0
            fminus = 0.d0
            
!!$calculate the fluxes
            
            if (flux_direction == 1) then
              
              call num_x_flux(consp(1),consp(2),consp(3),consp(4),consp(5), &
                   fplus(1),fplus(2),fplus(3),fplus(4), &
                   fplus(5),velxplus(i,j,k),pressplus(i,j,k), &
                   avg_det,avg_alp,avg_beta)
              
              call num_x_flux(consm_i(1),consm_i(2),consm_i(3), &
                   consm_i(4),consm_i(5),fminus(1),fminus(2),fminus(3), &
                   fminus(4), fminus(5), &
                   velxminus(i+xoffset,j+yoffset,k+zoffset), &
                   pressminus(i+xoffset,j+yoffset,k+zoffset), &
                   avg_det,avg_alp,avg_beta)
              
            else if (flux_direction == 2) then
              
              call num_x_flux(consp(1),consp(3),consp(4),consp(2),consp(5), &
                   fplus(1),fplus(3),fplus(4),fplus(2), &
                   fplus(5),velyplus(i,j,k),pressplus(i,j,k), &
                   avg_det,avg_alp,avg_beta)
              
              call num_x_flux(consm_i(1),consm_i(3),consm_i(4), &
                   consm_i(2),consm_i(5),fminus(1),fminus(3),fminus(4), &
                   fminus(2), fminus(5), &
                   velyminus(i+xoffset,j+yoffset,k+zoffset), &
                   pressminus(i+xoffset,j+yoffset,k+zoffset), &
                   avg_det,avg_alp,avg_beta)
              
              else
              
              call num_x_flux(consp(1),consp(4),consp(2),consp(3),consp(5), &
                   fplus(1),fplus(4),fplus(2),fplus(3), &
                   fplus(5),velzplus(i,j,k),pressplus(i,j,k),avg_det, &
                   avg_alp,avg_beta)
              
              call num_x_flux(consm_i(1),consm_i(4),consm_i(2), &
                   consm_i(3),consm_i(5),fminus(1),fminus(4),fminus(2), &
                   fminus(3), fminus(5), &
                   velzminus(i+xoffset,j+yoffset,k+zoffset), &
                   pressminus(i+xoffset,j+yoffset,k+zoffset), &
                   avg_det,avg_alp,avg_beta)
              
            end if
            
!!$ Marquina flux
            
            do m = 1,5
              
              f_marquina(m) = 0.5d0 * (fplus(m) + fminus(m) - marquinaflux(m))
              
            end do

          end if !!! The end of the SpaceMask check for a trivial RP.

          densflux(i,j,k) = f_marquina(1)
          sxflux(i,j,k)   = f_marquina(2)
          syflux(i,j,k)   = f_marquina(3)
          szflux(i,j,k)   = f_marquina(4)
          tauflux(i,j,k)  = f_marquina(5)

        enddo
      enddo
    enddo
      !$OMP END PARALLEL DO

    if (evolve_tracer .ne. 0) then

      !$OMP PARALLEL DO PRIVATE(i,j,k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
          do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil

            if (densflux(i, j, k) > 0.d0) then

              cons_tracerflux(i, j, k,:) = &
                   tracerplus(i, j, k,:) * &
                   densflux(i, j, k)

            else

              cons_tracerflux(i, j, k,:) = &
                   tracerminus(i + xoffset, j + yoffset, k + zoffset,:) * &
                   densflux(i, j, k)

            end if

          end do
        end do
      end do
      !$OMP END PARALLEL DO

    end if

    if (evolve_Y_e .ne. 0) then

      !$OMP PARALLEL DO PRIVATE(i,j,k)
      do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil
        do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil
          do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil

            if (densflux(i, j, k) > 0.d0) then

              Y_e_con_flux(i, j, k) = &
                   Y_e_plus(i, j, k) * &
                   densflux(i, j, k)

            else

              Y_e_con_flux(i, j, k) = &
                   Y_e_minus(i + xoffset, j + yoffset, k + zoffset) * &
                   densflux(i, j, k)

            end if

          end do
        end do
      end do
      !$OMP END PARALLEL DO

    end if
    
    return
end subroutine GRHydro_Marquina

























```

GRHydro_RegisterVars.cc:
```
// GRHydro_RegisterVars.cc
//
// converted from F90 to improve readability and maintainability
//
// Frank Loeffler

#include <cstdio>
#include <string>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

using namespace std;

extern "C" CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

// Utility functions to register variables with MoL
// Note: We could check for the return value here, but MoL issues a
//       level 0 warning in that case anyway. If that changes in the
//       future, a check can simply be inserted here.
static void register_evolved(string v1, string v2)
{
  DECLARE_CCTK_PARAMETERS;
  if (use_MoL_slow_multirate_sector)
     MoLRegisterEvolvedGroupSlow(CCTK_GroupIndex(v1.c_str()), CCTK_GroupIndex(v2.c_str()));
  else
     MoLRegisterEvolvedGroup(CCTK_GroupIndex(v1.c_str()), CCTK_GroupIndex(v2.c_str()));
}
static void register_constrained(string v1)
{
  MoLRegisterConstrainedGroup(CCTK_GroupIndex(v1.c_str()));
}
static void register_saveandrestore(string v1)
{
  MoLRegisterSaveAndRestoreGroup(CCTK_GroupIndex(v1.c_str()));
}

// Main function called by Cactus to register variables with MoL

extern "C" void GRHydro_Register(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  const int general_coordinates = GRHydro_UseGeneralCoordinates(cctkGH);

  // We need some aliased functions, so we first check if they are available
  string needed_funs[7] = {"MoLRegisterEvolvedGroup",
                           "MoLRegisterEvolvedGroupSlow",
                           "MoLRegisterConstrainedGroup",
                           "MoLRegisterSaveAndRestoreGroup",
                           "MoLRegisterEvolved",
                           "MoLRegisterEvolvedSlow",
                           "MoLRegisterConstrained"};
  for (int i = 0; i < 7; i++)
    if (!CCTK_IsFunctionAliased(needed_funs[i].c_str()))
      CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING,
                 "The function \"%s\" has not been aliased!",
                 needed_funs[i].c_str());

  // Now we can set which variables have to be registered as which type with MoL
  register_constrained("HydroBase::rho");
  register_constrained("HydroBase::press");
  register_constrained("HydroBase::eps");
  register_constrained("HydroBase::w_lorentz");
  register_constrained("HydroBase::vel");
  if (*stress_energy_state)
  {
    register_constrained("TmunuBase::stress_energy_scalar");
    register_constrained("TmunuBase::stress_energy_vector");
    register_constrained("TmunuBase::stress_energy_tensor");
  }
  if (general_coordinates) {
    register_constrained("GRHydro::lvel");

    register_constrained("grhydro::local_shift");
    register_constrained("grhydro::local_metric");
    register_constrained("grhydro::local_extrinsic_curvature");
  }

  if (CCTK_EQUALS(evolution_method, "GRHydro"))
  {
    // dens and scon
    register_evolved("GRHydro::dens", "GRHydro::densrhs");
    register_evolved("GRHydro::scon", "GRHydro::srhs");

    if (CCTK_EQUALS(Bvec_evolution_method, "GRHydro")) {
      register_constrained("HydroBase::Bvec");
      if (general_coordinates) {
        register_constrained("GRHydro::lBvec");
      }
      register_evolved("GRHydro::Bcons", "GRHydro::Bconsrhs");
      if(clean_divergence) {
        register_evolved("GRHydro::psidc" , "GRHydro::psidcrhs");
      }
    } else if (CCTK_EQUALS(Bvec_evolution_method, "GRHydro_Avec")) {
      register_constrained("HydroBase::Bvec");
      register_evolved("HydroBase::Avec", "GRHydro::Avecrhs");
      if ( CCTK_EQUALS(Avec_gauge, "lorenz")) {
         register_evolved("HydroBase::Aphi", "GRHydro::Aphirhs");
      }
    }
    // entropycons
    if(CCTK_EQUALS(entropy_evolution_method,"GRHydro")){
      register_evolved("GRHydro::entropycons" , "GRHydro::entropyrhs");
    }

    // tau
    if (CCTK_EQUALS(GRHydro_eos_type, "General"))
      register_evolved("GRHydro::tau" , "GRHydro::taurhs");
    else if (CCTK_EQUALS(GRHydro_eos_type, "Polytype"))
      register_constrained("GRHydro::tau");
    else
      CCTK_WARN(0, "Don't recognize the type of EOS!");

    // lapse, metric, curv
    if(GRHydro_MaxNumSandRVars != 0) { // hack to save some memory since we "know" that someone else will register these as constrained
      register_saveandrestore("admbase::lapse");
      register_saveandrestore("admbase::metric");
      register_saveandrestore("admbase::curv");
    }

    // shift
    if (!CCTK_EQUALS(initial_shift, "none"))
    {
      if (CCTK_EQUALS(shift_evolution_method, "Comoving"))
      {
        register_constrained("admbase::shift");
        register_evolved("GRHydro::GRHydro_coords", 
                         "GRHydro::GRHydro_coords_rhs");
      }
      else if(GRHydro_MaxNumSandRVars != 0) // hack to save some memory since we "know" that someone else will register these as constrained
      { 
        register_saveandrestore("admbase::shift");
      }
    }

    // tracer
    if (evolve_tracer != 0)
      register_evolved("GRHydro::GRHydro_cons_tracers", 
                       "GRHydro::GRHydro_tracer_rhs");
 
    // note that we set in pararamcheck
    // evolve_y_e and evolve_temper, but MoLRegister
    // happens before paramcheck...
    if (CCTK_EQUALS(Y_e_evolution_method,"GRHydro")) {
      register_constrained("HydroBase::Y_e");
      register_evolved("GRHydro::Y_e_con", 
                       "GRHydro::Y_e_con_rhs");
      }

    if (CCTK_EQUALS(temperature_evolution_method,"GRHydro")) {
      register_constrained("HydroBase::temperature");
      register_constrained("HydroBase::entropy");
    }
    // particles
    if (number_of_particles > 0)
      register_evolved("GRHydro::particles", "GRHydro::particle_rhs");
  }
  else if (CCTK_EQUALS(evolution_method, "none"))
  {
    register_constrained("GRHydro::dens");
    register_constrained("GRHydro::scon");
    register_constrained("GRHydro::tau");

    if (CCTK_EQUALS(Bvec_evolution_method, "GRHydro")) {
      register_constrained("HydroBase::Bcons");
      if(clean_divergence) {
        register_constrained("GRHydro::psidc");
      }
    }
  }
}



void GRHydro_Set_Execution_Flags(CCTK_ARGUMENTS)
{
   DECLARE_CCTK_ARGUMENTS;
   
   const int index1 = CCTK_VarIndex("MoL::MoL_SlowStep");
   const int index2 = CCTK_VarIndex("MoL::MoL_SlowPostStep");
   
   if (index1 < 0 || index2 < 0)
   {
      CCTK_WARN(0, "Error: MoL does not provide MoL_SlowStep or MoL_SlowPostStep. Does your MoL thorn support multirate RK?");
   }
   
   *execute_MoL_Step =     *((CCTK_INT *) (CCTK_VarDataPtrI(cctkGH, 0, index1)));
   *execute_MoL_PostStep = *((CCTK_INT *) (CCTK_VarDataPtrI(cctkGH, 0, index2)));
}

void GRHydro_Reset_Execution_Flags(CCTK_ARGUMENTS)
{
   DECLARE_CCTK_ARGUMENTS;
   
   *execute_MoL_Step = 1;
   *execute_MoL_PostStep = 1;
}





```

GRHydro_PPM.h:
```
#include <assert.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>

#if 1
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#endif

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

static inline void steep(double *x, double *dx, double* dmx, const int i) {
  if ( (x[i+1] - x[i]) * (x[i]-x[i-1]) > 0.0 ) {
    dmx[i] = copysign(1.0,dx[i]) * MIN(fabs(dx[i]),
					MIN(2.0*fabs(x[i]-x[i-1]),
					     2.0*fabs(x[i+1]-x[i])));
  } else {
    dmx[i] = 0.0;
  }
}

static inline double approx_at_cell_interface(double* a, const int i) {
  return 7.0/12.0*(a[i]+a[i+1]) - 1.0/12.0*(a[i-1]+a[i+2]);
}

static inline void monotonize(double* restrict xminus,
			      double* restrict x,
			      double* restrict xplus,
			      const int i) {

  if (  !(xplus[i]==x[i] && x[i]==xminus[i]) 
	&& ( (xplus[i]-x[i])*(x[i]-xminus[i]) <= 0.0 ) ) 
    {
      xminus[i] = x[i];
      xplus[i] = x[i];
    }  else if( 6.0 * (xplus[i]-xminus[i]) * 
		(x[i]-0.5*(xplus[i]+xminus[i])) >
		(xplus[i]-xminus[i])*(xplus[i]-xminus[i]) )
    {
      xminus[i] = 3.0*x[i]-2.0*xplus[i]; 
    } else if( 6.0 * (xplus[i]-xminus[i]) * 
	       (x[i]-0.5*(xplus[i]+xminus[i])) <
	       -(xplus[i]-xminus[i])*(xplus[i]-xminus[i]) ) 
    {
      xplus[i] = 3.0*x[i]-2.0*xminus[i]; 
    }
  
  return;
}	     	    




```

GRHydro_LastMoLPostStep.c:
```
// GRHydro_LastMoLPostStep.c
//
// Compute is this is the last MoL PostStep call. Code taken from Christian
// Reisswig's rejected MoL changes.
//
// Roland Haas
// Sun Jun  3 17:35:53 PDT 2012

#include <stdio.h>
#include <string.h>
#include <assert.h>

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

void GRHydro_SetLastMoLPostStep(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;

  const CCTK_INT *MoL_Intermediate_Step = 
    CCTK_VarDataPtr(cctkGH,0,"MoL::MoL_Intermediate_Step");
  if(NULL == MoL_Intermediate_Step)
  {
    CCTK_WARN(CCTK_WARN_ABORT,
              "Could not get data pointer for MoL::MoL_Intermediate_Step");
  }

  // If counter becomes zero, the only thing left to do is to call PostStep!
  // NOTE: MoL's counter is uninitialised during initial data setup!
  *InLastMoLPostStep = cctk_iteration == 0 || *MoL_Intermediate_Step == 0;
}

void GRHydro_ClearLastMoLPostStep(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;

  *InLastMoLPostStep = 0;
}

```


combined_doc_context: ## README (README):
```
Cactus Code Thorn GRHydro
Author(s)    : Luca Baiotti
               Ian Hawke
               Pedro Montero
               Sebastiano Bernuzzi
               Giovanni Corvino
               Toni Font
               Joachim Frieben
               Roberto De Pietri
               Thorsten Kellermann
               Frank Löffler
               Christian D. Ott
               Luciano Rezzolla
               Nikolaos Stergioulas
               Aaryn Tonita
               many others
Maintainer(s): CIGR developers team
Licence      : GPLv2+
--------------------------------------------------------------------------

1. Purpose

GRHydro is the evolution code for a general-purpose 3D relativistic
hydrodynamics code. To work it requires Einstein, MoL (the method of
lines thorn), CactusEOS (the general equation of state interface).
In theory any (suitably written) spacetime evolution thorn should work,
but for the moment the MoL version of BSSN will be the tested version.

For more information see the documentation in the ThornGuide.

```

## Documentation (.tex files):
Files: staggering.tex, documentation.tex

```tex
=== staggering.tex ===
\documentclass{article}
\begin{document}
In what follows, we assume second-order differencing.  Adapt as necessary.

For staggered $A$-field evolution we know the values of the $A$ field at edges:
\begin{equation}
A_x(i,j+\frac{1}{2},k+\frac{1}{2});~A_y(i+\frac{1}{2},j,k+\frac{1}{2});~A_z(i+\frac{1}{2},j+\frac{1}{2},k)
\end{equation}

From these, we calculate directly the values of the $B$-fields at faces:
\begin{equation}
B_{face}^x(i+\frac{1}{2},j,k) =\frac{A_z(i+\frac{1}{2},j+\frac{1}{2},k)-A_z(i+\frac{1}{2},j-\frac{1}{2},k)}{\Delta y}-
\frac{A_y(i+\frac{1}{2},j,k+\frac{1}{2})-A_z(i+\frac{1}{2},j,k-\frac{1}{2})}{\Delta z}
\end{equation}
and the values of the $B$-field at cell centers by averaging
\begin{equation}
B_{cent}^x(i,j,k)=\frac{B_{face}^x(i+\frac{1}{2},j,k)+B_{face}^x(i-\frac{1}{2},j,k)}{2}
\end{equation}
These can be calculated at the end of the timestep.

To update the $A$-field, we calculate
\begin{eqnarray}
\partial_t A_x(i,j+\frac{1}{2},k+\frac{1}{2})& =& -E^x(i,j+\frac{1}{2},k+\frac{1}{2})\\
&=&[v^y B^z-v^z B^y](i,j+\frac{1}{2},k+\frac{1}{2})^{LLF/HLL}
\end{eqnarray}
The values of $B$ need to be reconstructed an ``extra'' time, to the pairs of edges perpendicular to their direction.  The $v$-fields need to be reconstructed twice, once parallel to their direction and once perpendicular (but never doubly perpendicular).  We can minimize work and reuse our previous reconstructed, as suggested by Etienne et al. and originally Del Zanna et al. if we assume reconstruction happens in the perpendicular direction first for the velocities.  Note that to get the wavespeeds at the edges, all primitives need to be reconstructed twice.  To establish the notation in the code, one can try the following: for all primitives except the $B$-field, one reconstructs in the flux-direction, turns either in the right-handed direction (positive cycle through $x-y-z$) or the left-handed direction (cycle in the order $x-z-y$), and then reconstructs either in the plus or minus sense again.  Thus, we have the following,  for the example that {\tt flux\_direction}=1, the $y$-direction.\\

{\tt rhop\_r\_m}: Reconstruct rho in the $+y$ direction, cycle to the right, and then move in the minus ($-z$) direction, resulting in $\rho(i,j+\frac{1}{2},k-\frac{1}{2})$.

Note that since we require reconstruction, the source term for $\partial_t A_x$ is actually calcuated during {\tt FluxTerms}, and we zero out the contribution in {\tt GRHydro\_SourceAM.F90}.
\end{document}

=== documentation.tex ===
\documentclass{article}
%\usepackage{../../../../doc/ThornGuide/cactus}
\usepackage{../../../../doc/latex/cactus}
\begin{document}

% The title of the document (not necessarily the name of the Thorn)
\title{The {\tt GRHydro} code: three-dimensional relativistic hydrodynamics}

% The author of the documentation - on one line, otherwise it does not work
\author{Original authors: Luca Baiotti, Ian Hawke, Pedro Montero \cr Contributors: 
  Sebastiano Bernuzzi, Giovanni Corvino, Toni Font, Joachim Frieben, \cr Roberto De Pietri, Thorsten
  Kellermann, Frank L\"offler, Christian D. Ott, \cr Luciano Rezzolla, Nikolaos Stergioulas, Aaryn
  Tonita, \cr {\it and many others,} \cr {\it especially those who were in the European Network ``Sources of
    Gravitational Waves'' } }

% the date your document was last changed, if your document is in CVS, 
% please use:
\date{$ $Date: 2009-12-07 19:20:47 -0600 (Mon, 07 Dec 2009) $ $}
\maketitle

% *======================================================================*
%  Cactus Thorn template for ThornGuide documentation
%  Author: Ian Kelley
%  Date: Sun Jun 02, 2002
%  $Header$                                                             
%
%  Thorn documentation in the latex file doc/documentation.tex 
%  will be included in ThornGuides built with the Cactus make system.
%  The scripts employed by the make system automatically include 
%  pages about variables, parameters and scheduling parsed from the 
%  relevent thorn CCL files.
%  
%  This template contains guidelines which help to assure that your     
%  documentation will be correctly added to ThornGuides. More 
%  information is available in the Cactus UsersGuide.
%                                                    
%  Guidelines:
%   - Do not change anything before the line
%       % START CACTUS THORNGUIDE",
%     except for filling in the title, author, date etc. fields.
%        - Each of these fields should only be on ONE line.
%        - Author names should be sparated with a \\ or a comma
%   - You can define your own macros are OK, but they must appear after
%     the START CACTUS THORNGUIDE line, and do not redefine standard 
%     latex commands.
%   - To avoid name clashes with other thorns, 'labels', 'citations', 
%     'references', and 'image' names should conform to the following 
%     convention:          
%       ARRANGEMENT_THORN_LABEL
%     For example, an image wave.eps in the arrangement CactusWave and 
%     thorn WaveToyC should be renamed to CactusWave_WaveToyC_wave.eps
%   - Graphics should only be included using the graphix package. 
%     More specifically, with the "includegraphics" command. Do
%     not specify any graphic file extensions in your .tex file. This 
%     will allow us (later) to create a PDF version of the ThornGuide
%     via pdflatex. |
%   - References should be included with the latex "bibitem" command. 
%   - use \begin{abstract}...\end{abstract} instead of \abstract{...}
%   - For the benefit of our Perl scripts, and for future extensions, 
%     please use simple latex.     
%
% *======================================================================* 
% 
% Example of including a graphic image:
%    \begin{figure}[ht]
%       \begin{center}
%          \includegraphics[width=6cm]{MyArrangement_MyThorn_MyFigure}
%       \end{center}
%       \caption{Illustration of this and that}
%       \label{MyArrangement_MyThorn_MyLabel}
%    \end{figure}
%
% Example of using a label:
%   \label{MyArrangement_MyThorn_MyLabel}
%
% Example of a citation:
%    \cite{MyArrangement_MyThorn_Author99}
%
% Example of including a reference
%   \bibitem{MyArrangement_MyThorn_Author99}
%   {J. Author, {\em The Title of the Book, Journal, or periodical}, 1 (1999), 
%   1--16. {\tt http://www.nowhere.com/}}
%
% *======================================================================* 

% If you are using CVS use this line to give version information
% $Header$

% Use the Cactus ThornGuide style file
% (Automatically used from Cactus distribution, if you have a 
%  thorn without the Cactus Flesh download this from the Cactus
%  homepage at www.cactuscode.org)

% Do not delete next line
% START CACTUS THORNGUIDE

% Add all definitions used in this documentation here 
%   \def\mydef etc

%\newcommand{\eqref}[1]{(\ref{#1})}

% Add an abstract for this thorn's documentation
\begin{abstract}
  {\tt GRHydro} is a fully general-relativistic three-dimensional hydrodynamics code. It evolves the
  hydrodynamics using High Resolution Shock Capturing methods and can
  work with realistic equations of state. The evolution of the
  spacetime can be done by any other ``appropriate'' thorn, such as
  the {\tt CCATIE} code, maintained and developed at the Albert-Einstein-Institut (Potsdam).
\end{abstract}

% The following sections are suggestive only.
% Remove them or add your own.

\section{Introduction}
\label{sec:intro}

The {\tt GRHydro}\footnote{GRHydro started as a branch of Whisky. 
  The name Whisky is
  due to Tom Goodale, who pointed out that the in the original Gaelic
  {\it uisge beatha} (from which {\tt Whisky} is derived) meant {\it water of
  life}. This name was chosen at a free and fair democratic ballot
  at the EU Network meeting in Southampton that gave the right answer
  thanks to a little bit of help from the authors of the code after
  some slight irregularities on the part of certain specialists in
  strange stars.} code is based upon the public version of the {\tt Whisky} code which
  is a product of the EU Network on Sources of
  Gravitational Radiation\footnote{http://www.eu-network.org},
  and was initially written by Luca Baiotti, Ian Hawke
  and Pedro Montero, based on the publicly available {\tt GR3D} code and
  with many other important contributors.
  With the help of large parts of the community, the {\tt GRHydro} code got
  improved, extended and included into the Einstein Toolkit.

\section{Using This Thorn}
\label{sec:use}

What follows is a brief introduction to using {\tt GRHydro}. It assumes that
you know the required physics and numerical methods, and also the
basics of Cactus\footnote{http://www.cactuscode.org}. If you don't, then skip this section and come back
to it after reading the rest of this ThornGuide of Cactus. For more details such
as thornlists and parameter files, take a look at the Einstein Toolkit web page
which is currently stored at
\begin{verbatim}
http://www.einsteintoolkit.org
\end{verbatim}

{\tt GRHydro} uses the hydro variables defined in {\tt HydroBase}
and provides own ``conserved'' hydro variables and methods to evolve them. It
does not provide any information about initial data or equations of
state. For these, other thorns are required. A minimal list of thorns
for performing a shock-tube test is given in the shock-tube test
parameter file, found at
\begin{verbatim}
GRHydro/test/GRHydro_test_shock.par
\end{verbatim}
and will include the essential thorns
\begin{verbatim}
GRHydro EOS_Omni ADMBase ADMCoupling MoL
\end{verbatim}
Initial data for shocks can be set using
\begin{verbatim}
GRHydro_Init_Data 
\end{verbatim}
Initial data for spherically symmetric static stars (with
perturbations or multiple ``glued'' stars) can be set by
\begin{verbatim}
TOVSolver
\end{verbatim}

The actual evolution in time is controlled by the Method of Lines
thorn MoL. For full details see the relevant ThornGuide. For the
purposes of {\tt GRHydro} at least two parameters are relevant; {\tt
  ode\_method} and {\tt mol\_timesteps}. If second-order accuracy is
all that is required then {\tt ode\_method} can be set to either {\tt
  "rk2"} (second-order TVD Runge-Kutta evolution) or {\tt "icn"}
(Iterative Crank Nicholson, number of iterations controlled by {\tt
  mol\_timesteps}, defaults to three), and {\tt mol\_timesteps} can be
ignored. A more generic (and hence less efficient) method can be
chosen by setting {\tt ode\_method} to {\tt "genrk"} which is a
Shu-Osher type TVD Runge-Kutta evolution. Then the parameter {\tt
  mol\_timesteps} controls the number of intermediate steps and hence
the order of accuracy. First to seventh order are currently supported.

{\tt GRHydro} currently uses a Reconstruction-Evolution type method. The type
of reconstruction is controlled by the parameter {\tt recon\_method}.
The currently supported values are {\tt "tvd"} for slope limited TVD
reconstruction, {\tt "ppm"} for the Colella-Woodward PPM method, and
{\tt "eno"} for the Essentially Non-Oscillatory method of Harten et
al. Each of these has further controlling parameters. For example
there are a number of slope limiters controlled by the keyword {\tt
  tvd\_limiter}, the PPM method supports shock detection by the
Boolean {\tt ppm\_detect}, and the ENO method can have various orders
of accuracy controlled by {\tt eno\_order}. Note that the higher-order
methods such as PPM and ENO require the stencil size to be increased
using {\tt GRHydro\_stencil} {\bf and} {\tt driver::ghost\_size}.

For the evolution various approximate Riemann solvers are available,
controlled by {\tt riemann\_solver}. Currently implemented are {\tt
  "HLLE"}, {\tt "Roe"} and {\tt "Marquina"}. For the Roe and Marquina
methods there are added options to choose which method is used for
calculating the left eigenvectors. This now defaults to the efficient
methods of the Valencia group, but the explicit matrix inversion is
still there for reference.

For the equations of state, two ``types'' are recognized, controlled
by the parameter {\tt GRHydro\_eos\_type}. These are {\tt "Polytype"}
where the pressure is a function of the rest-mass density, $P=P(\rho)$, and the
more generic {\tt "General"} type where the pressure is a function
of the rest-mass density and the specific internal energy, $P=P(\rho, \epsilon)$. For the
{\tt Polytype} equations of state one fewer equation is evolved and
the specific internal energy is set directly from the rest-mass density. The
actual equation of state used is controlled by the parameter {\tt
  GRHydro\_eos\_table}. Polytype equations of state include {\tt
  "2D\_Polytrope"} and general equations of state include {\tt
  "Ideal\_Fluid"}. 

\subsection{Obtaining This Thorn}

The public version of GRHydro can be found on the
website {\tt http://www.einsteintoolkit.org}. 

\subsection{Basic Usage}

The simplest way to start using {\tt GRHydro} would be to download some
example parameter files from the web page to try it. There are a number
of essential parameters which might reward some experimentation. These
include:
\begin{itemize}
\item Reconstruction methods:
  \begin{itemize}
  \item {\tt recon\_method}: The type of reconstruction method to
    use. {\tt tvd} is the standard. {\tt ppm} is more accurate but it requires 
    more resources. {\tt eno} gives in theory
    arbitrary order of accuracy but it is practically unworthy to go beyond fifth order.
  \item {\tt tvd\_limiter}: When using {\tt tvd} reconstruction the
    choice of limiter can have a large effect. {\tt vanleerMC2} is
    probably the best to use, but the extremes of {\tt minmod} and {\tt
      Superbee} are also interesting.
  \item {\tt ppm\_detect}: When using {\tt ppm} reconstruction with
    shocks, the shock detection algorithm can notably sharpen the
    profile.
  \end{itemize}
\item Riemann solvers: {\tt Marquina} is the standard solver
  used. {\tt HLLE} is significantly faster, but sometimes provides cruder approximation.
\item Equations of state: These are controlled by the {\tt
    GRHydro\_eos\_type} and {\tt GRHydro\_eos\_table} parameters. Changing
  these parameters will depend on which equation of state thorns you
  have compiled in.
\item Initial data parameters: {\tt GRHydro\_rho\_central} is inherited by many
  initial data thorns to set the central density of compact fluid
  objects such as single stars. However, this parameter is depreciated.
\item Atmosphere parameters: Many of these are listed in
  section~\ref{sec:atmosphere}. 
\end{itemize}

\subsection{Special Behaviour}

Although in theory {\tt GRHydro} can deal with conformal metrics as well as
physical metrics, this part of the code is completely untested as we
don't have conformal initial data (although this would not be hard -
we just haven't had the incentive).

\subsection{Interaction With Other Thorns}

{\tt GRHydro} provides the appropriate contribution to the stress energy
through the {\tt TmunuBase} interface. Those spacetime evolvers that
use this interface can use {\tt GRHydro} without change. 
%To pass the required variables across {\tt GRHydro} is a friend of {\tt ADMCoupling}.

{\tt GRHydro} uses the {\tt MoL} thorn to perform the actual time
evolution. This means that if all other evolution thorns are also
using {\tt MoL} then the complete evolution will have the accuracy of
the {\tt MoL} evolution method without change. This (currently) allows
for up to fourth-order accuracy in time without any changes to {\tt GRHydro}.

For the general equations of state {\tt GRHydro} uses the {\tt EOS\_Omni}
interface. This returns the necessary hydrodynamical quantities, such
as the pressure and derivatives with general function calls. The
parameter {\tt GRHydro\_eos\_table} controls which equation of state is
used during evolution.

For the metric quantities {\tt GRHydro} uses the standard {\tt
  CactusEinstein} arrangement, especially {\tt ADMBase}. This allows
the standard thorns to be used for the calculation of constraint
violations, emission of gravitational waves, location of the apparent
horizon, and more.

\subsection{Support and Feedback}

{\tt GRHydro} is part of the Einstein Toolkit, with its web page located at
\begin{verbatim}
http://www.einsteintoolkit.org
\end{verbatim}
It contains information on obtaining the code, together with
thornlists and sample parameter files. For questions, send an email
to the Einstein Toolkit mailing list {\tt users@einsteintoolkit.org}.

\section{Physical System}
\label{sec:phys}

The equations of general relativistic hydrodynamics can be written in
the flux conservative form
\begin{equation}
  \label{eq:consform1}
  \partial_t {\bf q} + \partial_{x^i} {\bf f}^{(i)} ({\bf q}) = {\bf
    s} ({\bf q}),
\end{equation}
where ${\bf q}$ is a set of {\it conserved variables}, ${\bf f}^{(i)}
({\bf q})$ the fluxes and ${\bf s} ({\bf q})$ the source
terms.
The five conserved variables are labeled $D$, $S_i$, and $\tau$, where
$D$ is the generalized particle number density, $S_i$ are the generalized
momenta in each direction, and $\tau$ is an internal energy term.
These conserved variables are composed from a set of {\it primitive variables},
which are $\rho$, the rest-mass density, $p$, the
pressure, $v^i$, the fluid 3-velocities, $\epsilon$, the specific internal
energy, and $W$, the Lorentz factor, via the following relations
% from GRHydro/src/Prim2con.F90
%  w = 1.d0 / sqrt(1.d0 - (gxx*dvelx*dvelx + gyy*dvely*dvely + gzz &
%       &*dvelz*dvelz + 2*gxy*dvelx*dvely + 2*gxz*dvelx *dvelz + 2*gyz&
%       &*dvely*dvelz))
% 
%  dpress = (GRHydro_eos_gamma - 1.d0) * drho * deps
%
%  ddens = sqrt(det) * drho * w
%  dsx = sqrt(det) * (drho*(1+deps)+dpress)*w*w * (gxx*dvelx + gxy&
%       &*dvely + gxz*dvelz)
%  dsy = sqrt(det) * (drho*(1+deps)+dpress)*w*w * (gxy*dvelx + gyy&
%       &*dvely + gyz*dvelz)
%  dsz = sqrt(det) * (drho*(1+deps)+dpress)*w*w * (gxz*dvelx + gyz&
%       &*dvely + gzz*dvelz)
%  dtau = sqrt(det) * ((drho*(1+deps)+dpress)*w*w - dpress) - ddens
\
\begin{eqnarray}
  \label{eq:prim2con}
   D &=& \sqrt{\gamma}W\rho \nonumber \\
   S_i &=& \sqrt{\gamma} \rho h W^2 v_i \nonumber \\
   \tau &=& \sqrt{\gamma}\left( \rho h W^2 - p\right) - D, 
\end{eqnarray}
where $\gamma$ is the determinant of the spatial 3-metric $\gamma_{ij}$ and 
$h \equiv 1 + \epsilon + p/\rho$.
Only five of the primitive variables are
independent. Usually the Lorentz factor is defined in terms of the
velocities and the metric as $W = (1-\gamma_{ij}v^i v^j)^{-1/2}$.  
Also one of the pressure, rest-mass density or specific internal energy terms is given in 
terms of the other two by an {\it equation of state}.

The fluxes are usually defined in terms of both the conserved
variables and the primitive variables:
%
\begin{eqnarray}
{\bf F}^i({\bf U}) &=& [D(\alpha v^i - \beta^i), S_j(\alpha v^i -
  \beta^i) + p\delta^i_j, \tau(\alpha v^i - \beta^i) + p
  v^i]^T\ .
\end{eqnarray}
%
The source terms are
%
\begin{eqnarray} \label{source_terms}
{\bf s}({\bf U}) = \Big [0, T^{\mu\nu}\big (\partial_\mu g_{\nu j} +
  \Gamma^\delta_{\mu\nu} g_{\delta j}\big ), \alpha \big (T^{\mu
    0}\partial_\mu \ln \alpha - T^{\mu\nu}\Gamma^0_{\nu\mu} \big) \Big ]\ .
\end{eqnarray}
%
Note that the source terms do not contain differential operators
acting on the stress-energy tensor and that this is important for the
numerical preservation of the hyperbolicity character of the system.
Also note that in a curved spacetime the equations are not in a
strictly-homogeneous conservative form, which is recovered only in flat
spacetime. This conservative form of the relativistic Euler equations
was first derived by the group at the Universidad de Valencia
\cite{Banyuls97} and therefore was named the {\it Valencia
formulation}. 


%Describe possible equations of state.

%Any other physics points (there'll be lots).

For more detail see the review of Font~\cite{livrevgrrfd}. 

\section{Numerical Implementation}

\section{High Resolution Shock Capturing methods}
\label{sec:hrsc}

The numerical evolution of a hydrodynamical problem is complicated by
the occurrence of {\it shocks}, {\it i.e.} genuine nonlinear discontinuities that
will generically form. It is also complicated by the conservation
constraint. In a High Resolution Shock Capturing (HRSC) method the
requirement of conservation is used to ensure the correct evolution of
a shock. A HRSC method also avoids spurious oscillations at shocks
which are known as Gibbs' phenomena, while retaining a high order of
accuracy over the majority of the domain.

For a full introduction to HRSC methods see~\cite{laney}, \cite{toro},
\cite{leveque}, \cite{livrevsrrfd} and \cite{livrevgrrfd}.

In the {\tt GRHydro} code it was decided to use the {\it method of lines} as a
base for the HRSC scheme. The method of lines is a way of turning a
partial differential equation such as~(\ref{eq:consform1}) into an
ordinary differential equation. For the {\tt GRHydro} code the following steps
are required.
\begin{itemize}
\item Partition the domain of interest into {\it cells}. For
  simplicity we shall assume a regular Cartesian partitioning. This is
  not necessary for the method of lines, but it is for {\tt GRHydro}.
\item Over a given cell with Cartesian coordinates $(x^1_i, x^2_j, x^3_k)$,
  integrate equation~(\ref{eq:consform1}) in space to find the
  ordinary differential equation
  \begin{eqnarray}
    \label{eq:molform1} \nonumber
    \frac{{\rm d} \,}{{\rm d} t} {\bf q} & = & \int \!\!\!\! \int \!\!\!\!
      \int {\bf s} \,{\rm d}^3 x + \int_{x^2_{j-1/2}}^{x^2_{j+1/2}}
    \int_{x^3_{k-1/2}}^{x^3_{k+1/2}} {\bf f}^{(1)} ({\bf q}
    (x^1_{i-1/2}, y, z)) {\rm d} y \, {\rm d} z - \\
    &&    \int_{x^2_{j-1/2}}^{x^2_{j+1/2}} 
    \int_{x^3_{k-1/2}}^{x^3_{k+1/2}} {\bf f}^{(1)} ({\bf q}
    (x^1_{i+1/2}, y, z))
    {\rm d} y \, {\rm d} z + \cdots
  \end{eqnarray}
  where the boundaries of the Cartesian cells are given by $x^1_{i \pm
  1/2}$ and so on.
\item If we define $\bar{\bf q}$ as the integral average of
  ${\bf q}$ over the cell, after dividing (\ref{eq:molform1}) by the volume of the cell, we get an ordinary
  differential equation for $\bar{\bf q}$, in terms of the flux functions and the
  source terms as functions of the spatial differential of $\bar{{\bf
  q}}$. We note that, unlike the spatial differential of ${\bf q}$,
  the spatial differential of $\bar{{\bf q}}$ is well defined in a
  cell containing a discontinuity. 
\end{itemize}

This ordinary differential equation can be solved by the Cactus thorn
MoL. All that {\tt GRHydro} has to do is to return the values of the discrete
spatial differential operator
\begin{eqnarray}
  \label{eq:molrhs1} \nonumber
  {\bf L}({\bf q}) & = & \int \!\!\!\! \int \!\!\!\!
      \int {\bf s} \,{\rm d}^3 x + \int_{x^2_{j-1/2}}^{x^2_{j+1/2}}
    \int_{x^3_{k-1/2}}^{x^3_{k+1/2}} {\bf f}^{(1)} ({\bf q}
    (x^1_{i-1/2}, y, z)) {\rm d} y \, {\rm d} z - \\
    &&    \int_{x^2_{j-1/2}}^{x^2_{j+1/2}} 
    \int_{x^3_{k-1/2}}^{x^3_{k+1/2}} {\bf f}^{(1)} ({\bf q}
    (x^1_{i+1/2}, y, z)) {\rm d} y \, {\rm d} z + \cdots
\end{eqnarray}
given the data ${\bf q}$, and to supply the boundary conditions that will
be required to calculate this right hand side at the next time level.
We note that in the current implementation of MoL the solution to the
ordinary differential equation~(\ref{eq:molform1}) will be $N^{\rm
  th}$-order accurate provided that the time integrator used by MoL is $N^{\rm
  th}$-order accurate in time, and that the discrete operator ${\bf L}$ is
$N^{\rm th}$-order accurate in space and {\it first}-order (or better)
accurate in time.  For more details on the method of lines, and the
options given with the time integration for MoL, see the relevant
chapter in the ThornGuide.

In this implementation of {\tt GRHydro} the right hand side operator ${\bf L}$
will be simplified considerably by approximating the integrals by the
midpoint rule to get
\begin{equation}
  \label{eq:molrhs2}
  {\bf L}({\bf q}) = {\bf s}_{i,j,k} + {\bf f}^{(1)}_{i-1/2,j,k} -
    {\bf f}^{(1)}_{i+1/2,j,k} + \cdots
\end{equation}
where the dependence of the flux on ${\bf q}$ and spatial position is
implicit in the notation. Given this simplification, the calculation
of the right hand side operator splits simply into the following two parts:
\begin{enumerate}
\item Calculate the source terms ${\bf s}({\bf q}(x^1_i, x^2_j,
  x^3_k))$:

  Given that $\bar{{\bf q}}$ is a second-order accurate approximation
  to ${\bf q}$ at the midpoint of the cell, which is precisely $(x^1_i, x^2_j,
  x^3_k)$, for second-order accuracy it is sufficient to use ${\bf
  s}(\bar{{\bf q}}_{i,j,k})$.
\item In each coordinate direction $x^a$, calculate the {\it intercell
    flux} ${\bf f}^{(a)}({\bf q}_{i+1/2,j,k})$:
  
  From the initial data $\bar{{\bf q}}$ given at time $t^n$ we can
  reconstruct the data at the cell boundary, $({\bf q}_{i+1/2,j,k})$
  to any required accuracy in space (except in the vicinity of a
  shock, where only first-order accuracy is guaranteed).
% - FIXME: check,
%  Ian thinks the ENO theorems say that for linear problems get high order
%  even with discty). 
  However this will only be zeroth-order accurate
  in time. To ensure first-order accuracy in time, we have to find
  $({\bf q}_{i+1/2,j,k})(t)$ while retaining the high spatial order
  of accuracy. This requires two steps:
  \begin{enumerate}
  \item {\it Reconstruct} the data ${\bf q}$ over the cells adjacent
    to the required cell boundary. This reconstruction should use the
    high spatial order of accuracy. This gives two values of
    $({\bf q}_{i+1/2,j,k})$, which we call ${\bf q}_L$ and ${\bf q}_R$,
    where ${\bf q}_L$ is obtained from cell $i$ (left cell) and ${\bf q}_R$
    from cell $i+1$ (right cell).
  \item The values ${\bf q}_{L,R}$ are used as initial data for the
    {\it Riemann problem}. This is the initial value problem given by
    the partial differential equation~(\ref{eq:consform1}) with
    semi-infinite piecewise constant initial data ${\bf q}_{L,R}$. As
    the true function ${\bf q}$ is probably not piecewise constant we
    will not get the exact solution of the general problem even if we
    solve the local Riemann problem exactly. However, it will be first-order 
    accurate in time and retain the high order of accuracy in
    space which, as explained in the documentation to the MoL thorn,
    is sufficient to ensure that the method as a whole has a high
    order of accuracy. 
  \end{enumerate}
\end{enumerate}

So, the difficult part of {\tt GRHydro} is expressed in two routines. One that
reconstructs the function ${\bf q}$ at the boundaries of a
computational cell given the cell average data $\bar{{\bf q}}$, and
another that calculates the intercell flux ${\bf f}$ at this cell
boundary. 

\section{Reconstruction}
\label{sec:recon}

In the reduction of all of {\tt GRHydro} to two routines in the last section
one point was glossed over. That is, in order for the numerical method
to be consistent and convergent it must retain conservation and not
introduce spurious oscillations. Up to this point all the steps have
either been exact or have neither changed the conservation properties
or the profile of the function. Also, the calculation of the intercell
flux from the Riemann problem can be made to be ``exactly correct''.
That is, even though as explained above it may not be the true flux
for the real function ${\bf q}$, it will be the exact physical
solution for the values ${\bf q}_{L,R}$ given by the reconstruction
routine, so the intercell flux cannot violate conservation or
introduce oscillations.  Unphysical effects such as these can only be
introduced by an incorrect reconstruction.

For a full explanation of reconstruction methods see
Laney~\cite{laney}, Toro~\cite{toro}, Leveque~\cite{leveque}. For the
moment we will concentrate on the simplest methods that are better
than first-order accurate in space, the TVD slope-limited methods.
More complex methods such as ENO will be introduced later.

In the late 1950's Godunov proved a theorem that, in this context,
says
\begin{quote}
Any {\bf linear} reconstruction method of higher-than-first-order
accuracy may introduce spurious oscillations.
\end{quote}
For this theorem {\it linear} meant that the reconstruction method was
independent of the data it was reconstructing. Simple centred
differencing is a linear second-order method and is oscillatory near a
shock. Instead we must find a reconstruction method that depends on
the data ${\bf q}$ being reconstructed.

Switching our attention to conservation, we note that there is
precisely one conservative first-order reconstruction method,
\begin{equation}
  \label{eq:reconfirst}
  {\bf q}^{{\rm First}}(x) = \bar{{\bf q}}_i, \qquad x \in [
  x_{i-1/2}, x_{i+1/2} ], 
\end{equation}
and that any second-order conservative method can be written in terms
of a {\it slope} or rather \emph{difference} $\Delta_i$ as
\begin{equation}
  \label{eq:reconsecond}
  {\bf q}^{{\rm Second}}(x) = \bar{{\bf q}}_i + \frac{x -
  x_i}{x_{i+1/2} - x_{i-1/2}} \Delta_i, \qquad x \in [ x_{i-1/2}, x_{i+1/2} ].
\end{equation}

\subsection{TVD Reconstruction}
\label{sec:tvd}

As we want a method that is accurate ({\it i.e.}, at least to second order)
while being stable ({\it i.e.}, only first order or nonlinear at shocks)
then the obvious thing to do is to use some second-order method in the
form of equation~(\ref{eq:reconsecond}) in smooth regions but which
changes to the form of equation~(\ref{eq:reconfirst}) smoothly near
shocks. 

In the articles describing the {\tt GRAstro\_Hydro}
code\footnote{http://wugrav.wustl.edu/ASC/internal/asccodes.html},
this was described as an average of the two reconstructions, 
\begin{equation}
  {\bf q}^{{\rm TVD}}(x) = \phi({\bf q}) {\bf q}^{{\rm Second}} + (1 -
  \phi({\bf q})) {\bf q}^{{\rm First}},
  \label{First_qTVD}
\end{equation}
where $\phi \in [0,1]$ varies smoothly in some sense, and is zero near
a shock and 1 in smooth regions. In Toro's notation~\cite{toro} (which we usually adopt here) 
the slope limiter function $\phi$ (having the same attributes as above)
directly multiplies the slope, giving
\begin{equation}
  {\bf q}^{{\rm TVD}}(x) = \bar{{\bf q}}_i + \frac{x -
  x_i}{x_{i+1/2} - x_{i-1/2}} \phi({\bf q}) \Delta_i, \qquad x \in [
  x_{i-1/2}, x_{i+1/2} ]. 
  \label{Toro_qTVD}
\end{equation}
Equations (\ref{First_qTVD}) and (\ref{Toro_qTVD}) are equivalent.

For details on how to construct a limiter, on their stability regions and on 
the explicit expressions for the limiters used here,
see~\cite{toro}. The {\tt GRHydro} code implements the {\tt minmod} limiter
(the most diffusive and the default), the Van Leer Monotonized Centred
(MC) ({\tt VanLeerMC}) limiter in a number of forms (which should give equivalent results), 
and the {\tt Superbee} limiter. The limiter specified by the parameter value {\tt VanLeerMC2} 
is the recommended one.

As an example, we show how TVD with the minmod limiter is implemented
in the code. First, we define the minmod function:
\begin{equation}
  \label{eq:tvdminmod}
  \mathrm{\mathbf{minmod}}(a,b) = \left\{ \begin{array}{c l} 
      \textrm{min}(|a|,|b|) & \textrm{if } (a b > 0)\\
      0 & \textrm{otherwise}. \end{array}\right.
\end{equation}
For reconstructing $\mathbf{q}$ %at the cell interfaces $i+\frac{1}{2}$ and $i-\frac{1}{2}$, 
we choose two differences
\begin{equation}
  \begin{array}{lcl}
    \Delta_{\mathrm{upw}} & = & \mathbf{q}_i - \mathbf{q}_{i-1}\\
    \Delta_{\mathrm{loc}} & = & \mathbf{q}_{i+1} - \mathbf{q}_{i}\,,\\
  \end{array}
\end{equation}
and write
\begin{equation}
  {\bf q}^{{\rm TVD,minmod}}(x) = \bar{{\bf q}}_i + \frac{x -
  x_i}{x_{i+1/2} - x_{i-1/2}} \mathbf{minmod}(\Delta_{\mathrm{upw}},\Delta_{\mathrm{loc}}), 
    \qquad x \in [
  x_{i-1/2}, x_{i+1/2} ]. 
\end{equation}
\subsection{PPM reconstruction}
\label{sec:ppm}

The piecewise parabolic method (PPM) of Colella and
Woodward~\cite{ppm} is a rather more complex method that requires a
number of steps. The implementation in the {\tt GRHydro} code is specialized
to use evenly spaced grids. Also, some of the more complex features are not
implemented; in particular, the dissipation algorithm is only the
simplest given in the original article. Here we just give the implementation
details. For more details on the method we refer to the original
article.

Again we assume we are reconstructing a scalar function $q$ as a
function of $x$ in one dimension on an evenly spaced grid, with spacing $\Delta
x$. The first step is to interpolate a quadratic polynomial to the cell
boundary, 
\begin{equation}
  \label{eq:ppm1}
  q_{i+1/2} = \frac{1}{2} \left( q_{i+1} + q_i \right) + \frac{1}{6}
  \left( \delta_m q_i - \delta_m q_{i+1} \right), 
\end{equation}
where
\begin{equation}
  \label{eq:ppmdm1}
  \delta_m q_i = \left\{ \begin{array}{c l} \textrm{min}(|\delta q_i|,
      2|q_{i+1} - q_i|, 2|q_i - q_{i-1}|) \textrm{ sign}(\delta q_i) &
      \textrm{if } (q_{i+1} - q_i)(q_i - q_{i-1}) > 0, \\
      0 & \textrm{otherwise}. \end{array} \right.,
\end{equation}
and
\begin{equation}
  \label{eq:ppmd1}
  \delta q_i = \frac{1}{2}(q_{i+1} - q_{i-1}).
\end{equation}
At this point we set both left and right states at the interface to be
equal to this,
\begin{equation}
  \label{eq:ppmset1}
  q_i^R = q_{i+1}^L = q_{1+1/2}.
\end{equation}

This reconstruction will be oscillatory near shocks. To preserve
monotonicity, the following replacements are made:
\begin{eqnarray}
  \label{eq:ppmmonot}
  q_i^L = q_i^R = q_i & \textrm{if} & (q_i^R - q_i)(q_i - q_i^L) \leq
  0 \\
  q_i^L = 3 q_i - 2q_i^R & \textrm{if} & (q_i^R - q_i^L)\left( q_i -
  \frac{1}{2} (q_i^L + q_i^R) \right) > \frac{1}{6}(q_i^R - q_i^L)^2
  \\ 
  q_i^R = 3 q_i - 2q_i^L & \textrm{if} & (q_i^R - q_i^L)\left( q_i -
  \frac{1}{2} (q_i^L + q_i^R) \right) < -\frac{1}{6}(q_i^R -
  q_i^L)^2. 
\end{eqnarray}

However, before applying the monotonicity preservation two other steps
may be applied. Firstly we may steepen discontinuities. This is to
ensure sharp profiles and is only applied to contact
discontinuities. This may be switched on or off using the parameter
{\tt ppm\_detect}. This part of the method replaces the cell boundary
reconstructions of the density with
\begin{eqnarray}
  \label{eq:ppmdetect}
  \rho_i^L & = & \rho_i^L (1-\eta) + \left(\rho_{i-1} + \frac{1}{2}
    \delta_m \rho_{i-1} \right) \eta \\
  \rho_i^R & = & \rho_i^R (1-\eta) + \left(\rho_{i+1} - \frac{1}{2}
    \delta_m \rho_{i+1} \right) \eta
\end{eqnarray}
where $\eta$ is only applied if the discontinuity is mostly a contact
(see~\cite{ppm} for the details) and is defined as
\begin{equation}
  \label{eq:ppmeta}
  \eta = \textrm{max}(0, \textrm{min}(1, \eta_1 (\tilde{\eta} - \eta_2))),
\end{equation}
where $\eta_1,\eta_2$ are positive constants and
\begin{equation}
  \label{eq:ppmetatilde}
  \tilde{\eta} = \left\{ \begin{array}{c l} 
  \frac{\rho_{i-2} - \rho_{i+2} + 4 \delta\rho_i}{12\delta\rho_i} &
  \textrm{ if } \left\{
\begin{array}{l}
  \delta^2\rho_{i+1}\delta^2\rho_{i-1} < 0\\
  (\rho_{i+1} - \rho_{i-1}) - \epsilon \textrm{min}(|\rho_{i+1}|,|\rho_{i-1}|) >
  0\nonumber
\end{array} \right. \\
  0 & \textrm{otherwise} \end{array} \right.,
\end{equation}
with $\epsilon$ another positive constant and
\begin{equation}
  \label{eq:ppmd2rho}
  \delta^2\rho_i = \frac{\rho_{i+1} - 2\rho_i + \rho_{i-1}}{6\Delta
    x^2}.  
\end{equation}

Another step that is performed before monotonicity enforcement is to
flatten the zone structure near shocks. This adds simple dissipation
and is always in the code. In short, the reconstructions are again
altered to
\begin{equation}
  \label{eq:ppmflatten}
  q_i^{L,R} = \nu_i q_i^{L,R} + (1 - \nu_i) q_i,
\end{equation}
where
\begin{equation}
  \label{eq:ppmflatten2}
  \nu_i = \left\{ \begin{array}{c l} {\rm max}(0, 1 - \textrm{max}(0, \omega_2
      (\frac{p_{i+1} - p_{i-1}}{p_{i+2} - p_{i-2}} - \omega_1))) & \textrm{
        if } \omega_0 \textrm{min}(p_{i-1}, p_{i+1}) < |p_{i+1} - p_{i - 1}| 
      \textrm{ and } v^x_{i-1} - v^x_{i+1} > 0 \\
      1 & \textrm{otherwise} \end{array} \right.
\end{equation}
and $\omega_0, \omega_1,\omega_2$ are constants.

The above flattening procedure is not the one in the original article of Colella and Woodward, but
it has been adapted from it in order to have a stencil of three points.  The original flattening
procedure is also implemented in {\tt GRHydro}. Instead of \ref{eq:ppmflatten}, it consists in the formula
\begin{equation}
  \label{eq:ppmflatten-stencil4}
  q_i^{L,R} = \tilde \nu_i q_i^{L,R} + (1 - \tilde \nu_i) q_i,
\end{equation}
where
\begin{eqnarray}
\tilde \nu_i &=& {\rm max}\Big(\nu_i,\nu_{i+{\rm sign}(p_{i-1}-p_{i+1})}\Big)
\end{eqnarray}
and $\nu_i$ is given by \ref{eq:ppmflatten2}. This can be activated by setting the parameter {\tt
ppm\_flatten} to {\tt stencil\_4}. Formula \ref{eq:ppmflatten-stencil4}, despite requiring
more computational resources (especially when mesh refinement is used), usually gives very similar
results to \ref{eq:ppmflatten}, so we routinely use \ref{eq:ppmflatten}.


\subsection{ENO Reconstruction}
\label{sec:eno}

An alternative way of getting higher-than-second-order accuracy is the implementation of the
Essentially Non-Oscillatory methods of Harten et.al~\cite{eno}. The
essential idea is to alter the stencil to use those points giving the
smoothest reconstruction. The only restriction is that the stencil
must include the cell to be reconstructed (for stability). Here we
describe the simplest ENO type reconstruction: piecewise polynomial
reconstruction using the (un)divided differences to measure the
smoothness. 

Let $k$ be the order of the reconstruction. Suppose we are
reconstructing the scalar function $q$ in cell $i$. We start with the
cell $I_i$. We then add to the stencil cell $I_j$, where $j = i \pm
1$, where we choose $j$ to minimize the Newton divided differences
\begin{eqnarray}
  \label{enodd}
  q \left[ x_{i-1}, x_i \right] & = & \frac{q_i - q_{i-1}}{x_{i+1/2}
    - x_{i-3/2}} \\
  q \left[ x_i, x_{i+1} \right] & = & \frac{q_{i+1} - q_i}{x_{i+3/2}
    - x_{i-1/2}}.
\end{eqnarray}
\noindent We then recursively add more cells, minimizing the higher-order 
Newton divided differences $q \left[ x_{i-k}, \dots, x_{i+j} \right]$
defined by 
\begin{equation}
  \label{enodd2}
  q \left[ x_{i-k}, \dots, x_{i+j} \right] = \frac{ q \left[ x_{i-k+1},
  \dots, x_{i+j} \right] - q \left[ x_{i-k}, \dots, x_{i+j-1} \right]
  }{x_{i+j} - x_{i-k}}.
\end{equation}
\noindent The reconstruction at the cell boundary is given by a
standard $k^{\textrm{th}}$-order polynomial interpolation on the chosen
stencil. 

\cite{shueno} has outlined an elegant way of calculating the cell
boundary values solely in terms of the stencil and the known data. If
the stencil is given by
\begin{equation}
  \label{enostencil1}
  S(i) = \left\{ I_{i-r}, \dots, I_{i+k-r-1} \right\},
\end{equation}
\noindent for some integer $r$, then there exist constants $c_{rj}$
depending only on the grid $x_i$ such that the boundary
values for cell $I_i$ are given by
\begin{equation}
  \label{enoc1}
  q_{i+1/2} = \sum_{j=0}^{k-1} c_{rj} q_{i-r+j}, \qquad q_{i-1/2} =
  \sum_{j=0}^{k-1} c_{r-1,j} q_{i-r+j}. 
\end{equation}
\noindent The constants $c_{rj}$ are given by the rather complicated
formula 
\begin{equation}
  \label{enoc2}
  c_{rj} = \left\{ \sum_{m=j+1}^k \frac{ \sum_{l=0, l \neq m}^k
  \prod_{q=0, q \neq m, l}^k \left(  x_{i+1/2} - x_{i-r+q-1/2} \right)
  }{ \prod_{l=0, l \neq m}^k \left(  x_{i-r+m-1/2} - x_{i-r+L-1/2}
  \right) }  \right\} \Delta x_{i-r+j}. 
\end{equation}
\noindent This simplifies considerably if the grid is even. The
coefficients for an even grid are given (up to seventh order)
by~\cite{shueno}.

\section{Riemann Problems}
\label{sec:riemann}

Given the reconstructed data, we then solve a local Riemann problem in
order to get the intercell flux. The Riemann problem is specified by
an equation in flux conservative homogeneous form,
\begin{equation}
  \label{eq:homconsform1}
  \partial_t {\bf q} + \partial_{x^i} {\bf f}^{(i)} ({\bf q}) = 0
\end{equation}
with piecewise constant initial data ${\bf q}_{_{L,R}}$ separated by a
discontinuity at $x^{(1)}=0$. Flux terms for the other directions are
given similarly.  There is no intrinsic scale to this problem and so
the solution must be a self similar solution with similarity variable
$\xi = x^{(1)}/t$. The solution is given in terms of {\it waves} which
separate different {\it states}, with each state being constant. The
waves are either {\it shocks}, across which all hydrodynamical
variables change discontinuously, {\it rarefactions}, across which all
the variables change continuously (the wave is not a single value of
$\xi$ for a rarefaction, but spreads across a finite range), or {\it
contact or tangential} discontinuities, across which some but not all
of the hydrodynamical variables change discontinuously and the rest
are constant. The characteristics of the matter evolution converge and
break at a shock, diverge at a rarefaction and are parallel at the
other linear discontinuities.

The best references for solving the Riemann problem either exactly or
approximately are~\cite{leveque}, \cite{toro}, \cite{laney}. Here, we start by 
giving a simple outline. We
start by considering the $N$ dimensional linear problem in one
dimension given by
\begin{equation}
%  \label{eq:linsys1}
  \label{lsrp}
  \partial_t {\bf q} + A \partial_{x} {\bf q} = 0  \ ,
\end{equation}
where $A$ is a $N\times N$ matrix with constant coefficients. We
define the eigenvalues $\lambda^j$ with associated right and left
eigenvectors ${\bf r}^j,{\bf l}_j$, where the eigenvectors are
normalized to each other ({\it i.e.}, their dot product is
$\delta^i_j$). 
%%%%This was sort of written twice
%Defining the characteristic variables ${\bf w}_i$ as
%\begin{equation}
%  \label{eq:charvar1}
%  {\bf w}_i = {\bf l}^j_i \cdot {\bf q}_j \ ,
%\end{equation}
%then equation (\ref{eq:linsys1}) transforms to a set of uncoupled
%linear equations
%\begin{equation}
%  \label{eq:linsys2}
%  \partial_t {\bf w}_i + \Lambda \partial_{x} {\bf w}_i = 0   \ ,
%\end{equation}
%where the matrix $\Lambda$ contains the eigenvalues on the diagonals
%and is zero elsewhere. By convention the eigenvalues are ordered
%$\lambda_1 < \dots < \lambda_N$.
%
%The solution to one of the uncoupled equations along the cell boundary
%is simply that the characteristic variable is given by
%\begin{equation}
%  \label{eq:linflux}
%  {\bf w}_i = \left\{ \begin{array}[c]{r c l} ({\bf w}_i)_L & {\rm if}
%      & \lambda_i > 0 \\ 
%      ({\bf w}_i)_R & {\rm if} & \lambda_i < 0. \end{array}\right\},
%\end{equation}
%where, as before, subscripts $L$ and $R$ are used to denote quantities
%obtained from cells on the left and right, respectively, of the intercell 
%interface.
%To get the intercell flux we transform the solution back to the
%conserved variables by taking the dot product with the right
%eigenvectors and then multiplying by the matrix $A$. This can be written
%in a number of ways; the form we use is
%\begin{equation}
%  \label{eq:linsysflux}
%  {\bf f}_{i+1/2} = \frac{1}{2} \left[ A({\bf q}_{_L}) + A({\bf q}_{_R})
%  - \Sigma_{j=1}^N |\lambda_j| \Delta {\bf w}_j {\bf r} \right], 
%\end{equation}
%where $\Delta {\bf w}^j$ is the jump in the appropriate characteristic
%variable across the $j^{{\rm th}}$ wave. We note that the
%characteristic jumps are easily calculated from
%\begin{equation}
%  \label{eq:charjump}
%  \Delta {\bf w}_i = {\bf l}_i^j \left[ ({\bf q}_R)_j - ({\bf q}_L)_j
%  \right]. 
%\end{equation}
%
%The Roe flux is simply given by locally assuming that the conserved
%variables are constant. Thus the matrix $A$ is simply given by
%evaluating the Jacobian matrix $\partial {\bf f}({\bf q}) / \partial
%{\bf q}$ at some average state. Equation~(\ref{eq:linsysflux}) is then
%used to evaluate the intercell flux. The only questions are
%\begin{itemize}
%\item What is an appropriate intermediate state?
%\item When is this approximate (in)valid?
%\end{itemize}
%
%\subsection{Linear system}
%%
%Let ${\bf l}_i$, ${\bf r}^i$ be the left and right eigenvectors,
%respectively, of the matrix $A$ with eigenvalues $\lambda_i$,
%normalized such that ${\bf l}_i \cdot {\bf r}^j = \delta_i^j$. 
%
\label{sec:linsys}
We shall assume that the eigenvectors span the space. The characteristic
variables ${\bf w}_i$ are defined by
\begin{equation}
  \label{charvar}
  {\bf w}_i = {\bf l}_i \cdot {\bf q}.
\end{equation}
\noindent Then equation (\ref{lsrp}) when written in terms of the
characteristic variables becomes
\begin{equation}
  \label{charvarrp}
  \partial_t {\bf w} + \Lambda \partial_x {\bf w} = 0,
\end{equation}
\noindent where $\Lambda$ is the matrix containing the eigenvalues
$\lambda_i$ on the diagonals and zeros elsewhere. Hence each
characteristic variable ${\bf w}^i$ obeys the linear advection
equation with velocity $a = \lambda_i$. This solves the Riemann
problem in terms of characteristic variables.

In order to write the solution in terms of the original variables
${\bf q}$ we order the variables in such a way  that $\lambda_1 \leq \dots \leq
\lambda_N$. We also define the differences in the characteristic
variables $\Delta {\bf w}_i = ({\bf w}_i)_L - ({\bf w}_i)_R$ across
the $i^{{\rm th}}$ characteristic wave. These differences are single
numbers (`scalars'). We note that these differences can easily be
found from the initial data using
\begin{equation}
  \label{dw}
  \Delta {\bf w}_i = {\bf l}_i \cdot \left( {\bf q}_L - {\bf q}_R
  \right). 
\end{equation}
\noindent As the change in the solution across each wave is precisely
the difference in the associated characteristic variable, the solution
of the Riemann problem in terms of characteristic variables can be
written as either
\begin{equation}
  \label{lsrpsol1}
  {\bf w}_i = ({\bf w}_i)_L + \sum_{j=1}^M \Delta {\bf w}_j {\bf e}^j \quad
  {\rm if}\ \lambda_M < \xi < \lambda_{M+1},
\end{equation}
\noindent or 
\begin{equation}
  \label{lsrpsol2}
  {\bf w} = ({\bf w}_i)_R - \sum_{j=M+1}^N \Delta {\bf w}_j {\bf e}^j
  \quad {\rm if}\ \lambda_M < \xi < \lambda_{M+1},
\end{equation}
\noindent or as the average
\begin{equation}
  \label{lsrpsol3}
  {\bf w}_i = \frac{1}{2} \left( ({\bf w}_i)_L + ({\bf w}_i)_R +
  \sum_{j=1}^M \Delta 
  {\bf w}_j {\bf e}^j - \sum_{j=M+1}^N \Delta {\bf w}_j {\bf e}^j 
  \right) \quad {\rm if}\ \lambda_M < \xi < \lambda_{M+1},
\end{equation}
\noindent where ${\bf e}^i$ is the column vector $({\bf e}^i)_j =
\delta^i_j$. 

Converting back to the original variables ${\bf q}$ we have the
solution
\begin{equation}
  \label{lsrpsol4}
  {\bf q} = \frac{1}{2} \left( {\bf q}_L + {\bf q}_R + \sum_{i=1}^M \Delta
  {\bf w}_i {\bf r}^i - \sum_{i=M+1}^N \Delta {\bf w}_i {\bf r}^i
  \right) \quad {\rm if}\ \lambda_M < \xi < \lambda_{M+1}.
\end{equation} 
\noindent In the case where we are only interested in the flux
along the characteristic $\xi = 0$ we can write the solution in the
simple form
\begin{equation}
  \label{lsrpsol6}
  {\bf f}({\bf q}) = \frac{1}{2} \left( {\bf f}({\bf q}_L) + {\bf f}({\bf
  q}_R) - \sum_{i=1}^N | \lambda_i | \Delta {\bf w}_i {\bf r}^i \right).
\end{equation} 

All exact Riemann solvers have to solve at least an implicit
equation and so are computationally very expensive. As the 
solution of Riemann problems takes a large portion of
the time to run in a HRSC code, approximations that speed the
calculation of the intercell flux are often essential. This is
especially true in higher dimensions (>1), where the solution of the
ordinary differential equation to give the relation across a
rarefaction wave makes the use of an exact Riemann solver impractical.

Approximate Riemann solvers can have problems, as shown in depth by
Quirk~\cite{Quirk}. Hence it is best to compare the
results of as many different solvers as possible. Here we shall describe
the three approximate solvers used in this code, starting with the
simplest.

\subsection{HLLE solver}
\label{sec:hlle}

The Harten-Lax-van Leer-Einfeldt (HLLE) solver of Einfeldt~\cite{Einfeldt88} is a
simple two-wave approximation. We assume that the maximum and minimum wave speeds
$\xi_{\pm}$ are known. The solution of the Riemann problem is then
given by requiring conservation to hold across the waves. The solution
takes the form
\begin{equation}
  \label{hlle1}
  {\bf q} = \left\{ \begin{array}[c]{r c l} {\bf q}_L & {\rm if} & \xi
        < \xi_- \\  {\bf  q}_* & {\rm if} & \xi_- < \xi < \xi_+ \\
        {\bf q}_R & {\rm if} & \xi   > \xi_+, \end{array}\right. 
\end{equation}
\noindent and the intermediate state ${\bf q}_*$ is given by
\begin{equation}
  \label{hlle2}
  {\bf q}_* = \frac{\xi_+ {\bf q}_R - \xi_- {\bf q}_L - {\bf f}({\bf
  q}_R) + {\bf f}({\bf q}_L)}{\xi_+ - \xi_-}.
\end{equation}
\noindent If we just want the numerical flux along the boundary then
this takes the form
\begin{equation}
  \label{hlleflux}
  {\bf f}({\bf q}) = \frac{\widehat{\xi}_+{\bf f}({\bf q}_L) -
  \widehat{\xi}_-{\bf f}({\bf q}_R) + \widehat{\xi}_+ \widehat{\xi}_-
  ({\bf q}_R - {\bf q}_L)}{\widehat{\xi}_+ - \widehat{\xi}_-},
\end{equation}
\noindent where
\begin{equation}
  \label{hlle3}
  \widehat{\xi}_- = {\rm min}(0, \xi_-), \quad \widehat{\xi}_+ =
  {\rm max}(0, \xi_+). 
\end{equation}

Knowledge of the precise minimum and maximum characteristic velocities
$\xi_{\pm}$ requires knowing the solution of the Riemann problem.
Instead, the characteristic velocities are usually found from the
eigenvalues of the Jacobian matrix $\partial {\bf f} / \partial {\bf
  q}$ evaluated at some intermediate state. To ensure that the maximum
and minimum eigenvalues over the entire range between the left and
right states are found, we evaluate the Jacobian in both the left and
right states and take the maximum and minimum over all eigenvalues.
This ensures, for the systems of equations considered here, that the
real maximum and minimum characteristic velocities are contained
within $[\xi_-, \xi_+]$.

If we set $\alpha = {\rm max}(|\xi_-|, |\xi_+|)$ and replace the
characteristic velocities $\xi_{\pm}$ with $\pm \alpha$, we find the
Lax--Friedrichs flux ({\it cf.} also Tadmor's semi-discrete scheme~\cite{Tadmor00})
\begin{equation}
  \label{lfflux}
  {\bf f}({\bf q}) = \frac{1}{2} \left[ {\bf f}({\bf q}_L) + {\bf f}({\bf
  q}_R) + \alpha ({\bf q}_L -{\bf q}_R) \right].
\end{equation}
\noindent This is very diffusive, but also very stable.


\subsection{Roe solver}
\label{sec:roe}

The linearized solver of Roe~\cite{Roe81} is probably the most popular
approximate Riemann solver. The simplest interpretation is that the
Jacobian $\partial {\bf f} / \partial {\bf q}$ is linearized about
some intermediate state. Then the conservation form reduces to the
linear equation
\begin{equation}
  \label{roe1}
  \partial_t {\bf q} + A \partial_x {\bf q} = 0,
\end{equation}
\noindent where $A$ is a constant coefficient matrix. This is
identical to equation (\ref{lsrp}) and so all the results of
section~\ref{sec:linsys} on linear systems hold. We reiterate that the
standard form for the flux along the characteristic ray $\xi=0$ is
\begin{equation}
  \label{roe2}
  {\bf f}({\bf q}) = \frac{1}{2} \left( {\bf f}({\bf q}_L) + {\bf f}({\bf
  q}_R) - \sum_{i=1}^N | \lambda_i | \Delta {\bf w}_i {\bf r}^i \right).
\end{equation} 

There is a choice of which intermediate state the Jacobian should be
evaluated at. Roe gives three criteria that ensure the consistency and
stability of the numerical flux:
\begin{enumerate}
\item $A({\bf q}_{{\rm Roe}}) \left( {\bf q}_R - {\bf q}_L \right) =
  {\bf f}({\bf q}_R) - {\bf f}({\bf q}_L)$,
\item $A({\bf q}_{{\rm Roe}})$ is diagonalizable with real
  eigenvalues, 
\item $A({\bf q}_{{\rm Roe}}) \rightarrow \partial {\bf f} / \partial
  {\bf q}$ smoothly as ${\bf q}_{{\rm Roe}} \rightarrow {\bf q}$.
\end{enumerate}
\noindent A true Roe average for relativistic hydrodynamics, {\it i.e.}, an
intermediate state that satisfies all these conditions, has been
constructed by Eulderink~\cite{Eulderink94}. However, frequently it is sufficient
to use
\begin{equation}
  \label{roe3}
  {\bf q}_{{\rm Roe}} = \frac{1}{2} \left( {\bf q}_R + {\bf q}_L \right),
\end{equation}
\noindent which satisfies only the last two conditions. For simplicity
we have implemented this arithmetic average.


\subsection{Marquina solver}
\label{sec:marq}

Unlike all the other Riemann solvers introduced so far, the Marquina
solver as outlined in \cite{Marquina1} does not solve the Riemann
problem completely. Instead, only the flux along the characteristic
ray $\xi=0$ is given. It can be seen as a generalized Roe solver, as
the results are the same except at sonic points. These points are
where the fluid velocity is equal to the speed of sound of the fluid.
In the context of Riemann problems, sonic points are found when the
ray $\xi=0$ is within a rarefaction wave.

Firstly define the left ${\bf l}({\bf q}_{L,R})$ and right ${\bf
  r}({\bf q}_{L,R})$ eigenvectors and the eigenvalues $\lambda({\bf
  q}_{L,R})$ of the Jacobian matrix $\partial {\bf f} / \partial {\bf
  q}$ evaluated at the left and right states. Next define left and
right characteristic variables ${\bf w}_{L,R}$ and fluxes
${\bf \phi}_{L,R}$ by
\begin{equation}
  \label{marq1}
  ({\bf w}_i)_{L,R} = {\bf l}_i({\bf q}_{L,R}) \cdot {\bf q}_{L,R}, \quad
  ({\bf \phi}_i)_{L,R} = {\bf l}_i({\bf q}_{L,R}) \cdot {\bf f}({\bf
  q}_{L,R}). 
\end{equation}

Then the algorithm chooses the correct-sided characteristic flux if
the eigenvalues $\lambda_i({\bf q}_L)$, $\lambda_i({\bf q}_R)$ have
the same sign, and uses a Lax--Friedrichs type flux if they change
sign. In full, the algorithm is given in figure~\ref{fig:marqcode}.
\begin{figure}[htbp]
  \begin{center}
    \leavevmode
\begin{equation}
  \label{marqalg}
  \begin{array}[l]{l}
    {\bf For}\ \, i = 1, \dots, N\ {\bf do} \\
    \qquad \begin{array}[c]{l}
      {\bf If}\ \, \lambda_i({\bf q}_L) \lambda_i({\bf q}_R) > 0
        \ \, {\bf then} \\
      \qquad \qquad \begin{array}[c]{l}
        {\bf If}\ \,  \lambda_i({\bf q}_L) > 0 \ \, {\bf then} \\
        \qquad \qquad \qquad \begin{array}[c]{r c l}
          {\bf \phi}^i_+ & = & {\bf \phi}^i_L \\
          {\bf \phi}^i_- & = & 0
        \end{array} \\
        {\bf else}  \\
        \qquad \qquad \qquad \begin{array}[c]{r c l}
          {\rm \phi}^i_+ & = & 0 \\
          {\rm \phi}^i_- & = & {\bf \phi}^i_R
        \end{array} \\
        {\bf end if}
      \end{array} \\
      {\bf else} \\
      \qquad \qquad \begin{array}[c]{r c l}
        \alpha^i & = & {\rm max}(|\lambda_i({\bf q}_L), \lambda_i({\bf
          q}_R)|) \\
        {\bf \phi}^i_+ & = & \frac{1}{2} \left( {\bf \phi}^i_L +
          \alpha^i {\bf w}^i_L \right) \\
        {\bf \phi}^i_- & = & \frac{1}{2} \left( {\bf \phi}^i_R -
          \alpha^i {\bf w}^i_R \right)
      \end{array} \\
      {\bf end if} \\
    \end{array} \\
    {\bf end do}
  \end{array}
\end{equation}
    \caption[The algorithm to calculate the Marquina flux]{The
      algorithm to calculate the Marquina flux.}
    \label{fig:marqcode}
  \end{center}
\end{figure}

Then the numerical flux is given by
\begin{equation}
  \label{marqflux}
  {\bf f}({\bf q}) = \sum_{i=1}^N \left[ {\bf \phi}^i_+ 
  {\bf r}^i ({\bf q}_L) + {\bf \phi}^i_- {\bf r}^i ({\bf q}_R)
  \right].
\end{equation}

The above implementation is based on \cite{Aloy99b}.


\section{Other points in {\tt GRHydro}}
\label{sec:misc}

There are a number of other things done by {\tt GRHydro} which, whilst not as
important as reconstruction and evolution, are still essential.


\subsection{Source terms}
\label{sec:sources}

In a curved spacetime the equations are not in homogeneous conservation-law 
form but also contain source terms. These are actually calculated
first, before the flux terms (it simplifies the loop very slightly).
There are a few points to note about the calculation of the sources.
\begin{itemize}
\item The calculation used here, taken from the {\tt GR3D} code, requires both the
  metric and the extrinsic curvature.
\item In order to calculate the Christoffel symbols the gauge and
  metric variables must be differenced. Currently centred differencing
  of second or fourth (we are safe to use this, as {\tt GRHydro} requires 
  always at least 2 ghost zones) order is hardwired in. The two differencings can be selected via
  the parameter {\tt GRHydro::sources\_spatial\_order}.
\item For numerical reasons, namely in order to avoid the presence of time derivatives
  in the source-term computation, the implemented form of the source terms is not
  \eqref{source_terms} directly, but it has been modified as shown in
  the following paragraphs (following a clever idea by Mark Miller (see the {\tt GR3D} code) 
\end{itemize}

%The actual derivation of the source terms is somewhat complex and not
%at all obvious. If anybody comes up with a better way of doing things
%than the below, please alter the documentation. 
In what follows Greek letters range from $0$ to $3$ and roman letters from $1$ to $3$.

For the following computations, we need the expression of some of the 4-Christoffel symbols
$\ {}^{(4)}\Gamma^\rho_{\mu\nu}$ applied to the 3+1 decomposed
variables. In order to remove time derivatives we will frequently make
use of the ADM evolution equation for the 3-metric in the form
%
\begin{equation}
  \label{eq:SourceADMg}
  \partial_t \gamma_{ij} = 2\left(- \alpha K_{ij} + \partial_{(i}
  \beta_{j)} - {}^{(3)}\Gamma^k_{ij} \beta_k \right)\ .
\end{equation}
%
As it is used in what follows, we also recall that $\nabla$ is the
covariant derivative associated with the spatial 3-surface and we note that it is
compatible with the 3-metric:
%
\begin{eqnarray}
\label{compatible_derivative}
\nabla_i\gamma^{jk}=\partial_i\gamma^{jk} + 2{}^{(3)}\Gamma^j_{il}\gamma^{lk} = 0 \ .
\end{eqnarray}
%
We start from the ${}^{(4)}\Gamma^0_{00}$ symbol:
%
\begin{eqnarray}
\label{eq:Gamma000}
{}^{(4)}\Gamma^0_{00} = \frac{1}{2\alpha^2}\Big[
-\partial_t\big(\beta_k\beta^k\big)+2\alpha\partial_t\alpha
+ 2\beta^i\partial_t\beta_i - \beta^i\partial_i\big(\beta_k\beta^k\big) + 2\alpha\beta^i\partial_i\alpha\Big]
\end{eqnarray}
%
and we expand the derivatives as
%
\begin{eqnarray} \label{de_t_beta2}
\partial_t\big(\beta_k\beta^k\big) &=&
\partial_t\big(\gamma_{jk}\beta^j\beta^k\big) = 2\gamma_{jk}\beta^j\partial_t\beta^k +
\beta^j\beta^k\partial_t\gamma_{jk} = \nonumber \\
 &=& 2\beta_k\partial_t\beta^k -2\alpha K_{jk}
\beta^j\beta^k + 2\beta^j\beta^k\partial_j\beta_k - 2{}^{(3)}\Gamma^i_{kj} \beta_i\beta^j\beta^k
\end{eqnarray}
%
and
%
\begin{eqnarray}  \label{de_i_beta2}
\partial_i\big(\beta_k\beta^k\big) =
\partial_i\big(\gamma^{jk}\beta_j\beta_k\big) =
2\gamma^{jk}\beta_j\partial_i\beta_k + \beta_j\beta_k\partial_i\gamma^{jk} =
2\beta_k\partial_i\beta_k -2{}^{(3)}\Gamma^j_{ik}\beta_j\beta^k \ ,
\end{eqnarray}
%
where we have used \eqref{eq:SourceADMg} and
\eqref{compatible_derivative}, respectively.
Inserting \eqref{de_t_beta2} and \eqref{de_i_beta2}, equation
\eqref{eq:Gamma000} becomes
%
\begin{eqnarray}
  \label{eq:Gamma000_final}
{}^{(4)}\Gamma^0_{00} = \frac{1}{\alpha}\Big(\partial_t\alpha +
\beta^i\partial_i\alpha + K_{jk}\beta^j\beta^k \Big)\ .
\end{eqnarray}
%
With the same strategy we then compute
%
\begin{eqnarray}
  \label{eq:SourceChr1a}
  {}^{(4)}\Gamma^0_{i0} & = & - \frac{1}{2\alpha^2} \Big[
      \partial_i (\beta^k \beta_k - \alpha^2) - \beta^j (\partial_i
      \beta_j - \partial_j \beta_i + \partial_t \gamma_{ij}) \Big] = - \frac{1}{\alpha} \Big(\partial_i\alpha - \beta^j K_{ij}\Big)
\end{eqnarray}
%
and
%
\begin{eqnarray}
\label{eq:SourceChr0ij}
  {}^{(4)}\Gamma^0_{ij} & = & - \frac{1}{2\alpha^2} \Big[
      \partial_i\beta_j + \partial_j\beta_i - \partial_t\gamma_{ij} - \beta^k
  (\partial_i\gamma_{kj} + \partial_j\gamma_{ki} - \partial_k\gamma_{ij})\Big] = -
  \frac{1}{\alpha} K_{ij}\ .
\end{eqnarray}
%
Other more straightforward calculations give
%
\begin{alignat}{3}
  \label{eq:SourceS3a}
  {}^{(4)}\Gamma_{00j} &=& {}^{(4)}\Gamma^\nu_{0j}g_{\nu 0} & =  \frac{1}{2} \partial_j \left( \beta_k
    \beta^k - \alpha^2 \right), \\
\nonumber\\
  \label{eq:SourceS3b}
  {}^{(4)}\Gamma_{l0j} &=& {}^{(4)}\Gamma^\nu_{lj}g_{\nu 0} & =  \alpha K_{lj} + \partial_l\beta_j + \partial_j\beta_l - \beta_k{}^{(3)}\Gamma^k_{lj}\ , \\
\nonumber\\
  \label{eq:SourceS3c}
  {}^{(4)}\Gamma_{0lj} &=& {}^{(4)}\Gamma^\nu_{0j}g_{\nu l} & =  -\alpha K_{jl} + \partial_l\beta_j - \beta_k {}^{(3)}\Gamma^k_{lj}\ , \\
\nonumber\\
  \label{eq:SourceS3d}
  {}^{(4)}\Gamma_{lmj} &=& {}^{(4)}\Gamma^\nu_{lj}g_{\nu m} & =  {}^{(3)}\Gamma_{lmj}\ ,
\end{alignat}
%
where~\eqref{eq:SourceADMg} was used to derive \eqref{eq:SourceS3b}
and~\eqref{eq:SourceS3c}.
\subsubsection{Source term for $S_k$}
Now we have all the expressions for calculating the source terms. The
ones for the variables $S_{\,k}$ are
%
\begin{equation}
  \label{eq:SourceS1}
  \big({\mathcal S}_{S_k}\big)_j = T^\mu_\nu \Gamma^\nu_{\mu j} = T^{\mu\nu} \Gamma_{\mu\nu j}\ .
\end{equation}
%
After expanding the derivative in
\eqref{eq:SourceS3a}, the coefficient of the $T^{\ 00}$ term in
\eqref{eq:SourceS1} becomes
%
\begin{eqnarray}
  \label{eq:SourceS4a}
  {}^{(4)}\Gamma_{00j} & = & \frac{1}{2} \beta^l \beta^m \partial_j
  \gamma_{lm} - \alpha \partial_j \alpha + \beta_m \partial_j \beta^m.
\end{eqnarray}
%
The coefficient of the $T^{\,0i}$ term 
% (or the $T^{i0}$ term, as the stress-energy tensor is symmetric) 
is
%
\begin{eqnarray}
  \label{eq:SourceS5a}
  {}^{(4)}\Gamma_{0ij} + {}^{(4)}\Gamma_{i0j} = \partial_j\beta_i = \beta^l \partial_i
  \gamma_{jl} + \gamma_{il} \partial_j \beta^l.
\end{eqnarray}
%
The coefficient of the $T^{\,lm}$ term is simply
%
\begin{eqnarray}
  \label{eq:SourceS6a} 
{}^{(3)}\Gamma_{lmj} =
  \frac{1}{2} \Big (\partial_j\gamma_{ml} + \partial_m\gamma_{jl} - \partial_l\gamma_{mj} \Big).
\end{eqnarray}
%
Finally, summing \eqref{eq:SourceS4a}--\eqref{eq:SourceS6a} we
find
%
\begin{eqnarray}
  \label{eq:SourceS2a} 
\big({\mathcal S}_{S_k}\big)_j & = &
  T^{00}\left( \frac{1}{2} \beta^l \beta^m \partial_j \gamma_{lm} -
  \alpha \partial_j \alpha \right) + T^{0i} \beta^l \partial_j
  \gamma_{il} + T^0_i\partial_j \beta^i + \frac{1}{2} T^{lm}
  \partial_j \gamma_{lm} \ ,
\end{eqnarray}
%
which is the expression implemented in the code. 
%This also has the advantage that all partial derivatives of the shift are collected in
%one term.
% ACTUALLY, NO PARTICULAR EFFORT WAS MADE TO COLLECT THE SHIFT DERIVATIVES...

\subsubsection{Source term for $\tau$}

The source term for $\tau$ is [{\it cf.} \eqref{source_terms}]
%
\begin{equation}
  \label{eq:SourceT1}
  {\mathcal S}_{\tau} = \alpha \left( T^{\mu 0} \partial_{\mu}
  \alpha - \alpha T^{\mu\nu} {}^{(4)}\Gamma^0_{\mu\nu}\right).
\end{equation}
%
For clarity, again we consider separately the terms containing as a
factor the different components of $T^{\mu\nu}$. From
\eqref{eq:Gamma000_final} we find the coefficient of $T^{\,00}$ to be
%
\begin{eqnarray}
  \label{eq:SourceT3a}
\alpha\big(\partial_t \alpha -\alpha {}^{(4)}\Gamma^0_{00}\big) =
-\alpha\big( \beta^i \partial_i \alpha + \beta^k \beta^l K_{kl}\big)\ .
\end{eqnarray}
%
The coefficient of the term $T^{\,0i}$ is given by
% Here we note that we it is T^{0i} + T^{i0}
%
\begin{eqnarray}
  \label{eq:SourceT4a}
  \alpha\big(\partial_i \alpha - 2 \alpha {}^{(4)}\Gamma^0_{i0}\big) =
  2 \alpha\beta^j K_{ij} - \alpha\partial_i \alpha
\end{eqnarray}
%
and, finally, the coefficient for $T^{\,ij}$ is
%
\begin{eqnarray}
  \label{eq:SourceT5a}
  -\alpha^2 {}^{(4)}\Gamma^0_{ij} = \alpha K_{ij}\ .
\end{eqnarray}
The final expression implemented in the code is thus
%
\begin{eqnarray}
  \label{eq:SourceT2a}
  {\mathcal S}_{\tau}  = \alpha\big[ T^{00}\left( \beta^i\beta^j K_{ij} - \beta^i
  \partial_i \alpha \right) +  T^{0i} \left( -\partial_i \alpha + 2
  \beta^j K_{ij} \right) 
+ T^{ij} K_{ij}\big]\ .
\end{eqnarray}

%% original version by Ian. It contains typos, Luca believes
%\subsubsection{Source term for S}
%
%The source terms for $S_j$ are 
%\begin{equation}
%  \label{eq:SourceS1}
%  {\cal S}_{S_j} = \alpha \sqrt{\gamma} T^{\mu\nu}
%  {}^{(4)}\Gamma_{\nu\mu j}.
%\end{equation}
%Ignoring the factor of $\alpha \sqrt{\gamma}$, these source terms are
%coded as
%\begin{eqnarray}
%  \label{eq:SourceS2a}
%  {\cal S}_{S_j} & = & T^{00}\left( \frac{1}{2} \beta^l \beta^m
%    \partial_j \gamma_{lm} - \alpha \partial_j \alpha \right) + \\
%  \label{eq:SourceS2b}
%  &  & T^{0i} \left(  \beta^l \partial_j \gamma_{il} \right) + \\
%  \label{eq:SourceS2c}
%  &  & \frac{1}{2} T^{lm} \partial_j \gamma_{lm} + \\
%  \label{eq:SourceS2d}
%  &  & \frac{\rho h W^2 v_l}{\alpha}\partial_j \beta^l . 
%\end{eqnarray}
%
%In order to get from the first expression to the expression in the
%code we need to calculate the 4-Christoffel symbols ${}^{(4)}\Gamma$
%applied to the 3+1 decomposed variables. In order to remove time
%derivatives we will frequently make use of the ADM evolution equation
%for the 3-metric in the form
%\begin{equation}
%  \label{eq:SourceADMg}
%  \partial_0 \gamma_{ij} = - 2 \left( \alpha K_{ij} + \partial_{(i}
%  \beta_{j)} - {}^{(3)}\Gamma^k_{ij} \beta_k \right),
%\end{equation}
%or equivalent forms.
%
%So, the heart of the calculation is to show that
%\begin{eqnarray}
%  \label{eq:SourceS3a}
%  {}^{(4)}\Gamma_{00j} & = & \frac{1}{2} \partial_j \left( \beta_k
%    \beta^k - \alpha^2 \right), \\
%  \label{eq:SourceS3b}
%  {}^{(4)}\Gamma_{l0j} & = & -\alpha K_{jl} - \beta_{j,l} - \beta_k
%  {}^{(3)}\Gamma^k_{lj}, \\
%  \label{eq:SourceS3c}
%  {}^{(4)}\Gamma_{0mj} & = & \alpha K_{mj} + {}^{(3)}\Gamma^k_{mj}
%  \beta_k, \\
%  \label{eq:SourceS3d}
%  {}^{(4)}\Gamma_{lmj} & = & {}^{(3)}\Gamma_{lmj}.
%\end{eqnarray}
%These are tedious but straightforward, where~(\ref{eq:SourceADMg}) was
%used in equations~(\ref{eq:SourceS3b}) and~(\ref{eq:SourceS3c}).
%
%Substituting these expressions into the original form of
%equation~(\ref{eq:SourceS1}) we find the coefficient of the $T^{00}$
%term to be
%\begin{eqnarray}
%  \label{eq:SourceS4a}
%  {}^{(4)}\Gamma_{00j} & = & \frac{1}{2} \beta^l \beta^m \partial_j
%  \gamma_{lm} - \alpha \partial_j \alpha \\
%  \label{eq:SourceS4b}
%  && + \beta_m \partial_j \beta^m.
%\end{eqnarray}
%Line~(\ref{eq:SourceS4a}) is equivalent to the
%line~(\ref{eq:SourceS2a}) in the code. 
%
%The coefficient of the $T^{0i}+T^{i0}$ term (as the stress-energy
%tensor is symmetric here) is
%\begin{eqnarray}
%  \label{eq:SourceS5a}
%  {}^{(4)}\Gamma_{0ij} + {}^{(4)}\Gamma_{i0j} & = & \beta^l \partial
%  \gamma_{jl} \\
%  \label{eq:SourceS5b}
%  && + \gamma_{il} \partial_j \beta^l.
%\end{eqnarray}
%Similarly to above, line~(\ref{eq:SourceS5a}) is equivalent to the
%line~(\ref{eq:SourceS2b}) in the code. 
%
%The coefficient of the $T^{lm}$ term is given by
%\begin{eqnarray}
%  \label{eq:SourceS6a}
%  {}^{(4)}\Gamma_{lmj} & = & {}^{(3)}\Gamma_{lmj} \\
%  \label{eq:SourceS6b}
%  & = & \frac{1}{2} \gamma_{ml,j} \\ 
%  \label{eq:SourceS6c}
%  && + \frac{1}{2} \left( \gamma_{jl,m} - \gamma_{mj,l} \right).
%\end{eqnarray}
%Again, line~(\ref{eq:SourceS6b}) is equivalent to the
%line~(\ref{eq:SourceS2b}) in the code. 
%
%In each of these sets of coefficients there is an extra line. In the
%case of the coefficient of $T^{lm}$ line~(\ref{eq:SourceS6c}) vanishes
%when contracted with $T^{lm}$ due to the symmetry of the stress-energy
%tensor and the anti-symmetry of line~(\ref{eq:SourceS6c}) with respect
%to $l,m$. However, lines~(\ref{eq:SourceS5b}) and (\ref{eq:SourceS4b})
%do not vanish. Instead, after contraction with the appropriate
%components of the stress-energy tensor, they simplify to form
%line~(\ref{eq:SourceS2d}) in the code. This gathers all partial
%derivatives of the shift in one place.
%
%\subsubsection{Source term for $\tau$}
%
%The derivation of the source term for $\tau$ is a bit more involved.
%
%The source term for $\tau$ is
%\begin{equation}
%  \label{eq:SourceT1}
%  {\cal S}_{\tau} = \alpha \sqrt{\gamma} \left( T^{\mu 0} \partial_{\mu}
%  \alpha - \alpha T^{\mu\nu} {}^{(4)}\Gamma^0_{\mu\nu}\right).
%\end{equation}
%Ignoring the factor of $\alpha \sqrt{\gamma}$, these source terms are
%coded as
%\begin{eqnarray}
%  \label{eq:SourceT2a}
%  {\cal S}_{\tau} & = & T^{00}\left( \beta^i\beta^j K_{ij} - \beta^i
%    \partial_i \alpha \right) + \\
%  \label{eq:SourceT2b}
%  &  & T^{0i} \left( -\partial_i \alpha + 2 \beta^j K_{ij} \right) + \\
%  \label{eq:SourceT2c}
%  &  &  T^{lm} K_{lm}.
%\end{eqnarray}
%
%We consider the coefficient of $T^{00}$ first. In what follows $D$ is
%the covariant derivative associated with the 3-surface. We note that
%it is compatible with the 3-metric, $D_i\gamma_{jk}=0$. Expanding the
%coefficient directly we get
%\begin{eqnarray}
%  \label{eq:SourceT3a}
%  \partial_0 \alpha - \alpha {}^{(4)}\Gamma^0_{00} & = & - \beta^i
%  \partial_i \alpha + \frac{1}{\alpha} \left( \beta^i \partial_0
%    \beta_i - \frac{1}{2} \partial_0 (\beta^k \beta_k) - \frac{1}{2}
%    \beta^i \partial_i (\beta^k \beta_k) \right) \\
%  \label{eq:SourceT3b}
%  & = & -\beta^i \partial_i \alpha + \frac{1}{2\alpha} \left( 2 \beta^i
%    \partial_0 \beta_i - \beta^k \partial_0 \beta_k - \beta_k \partial_0
%    \beta^k - \beta^i D_i (\beta^k \beta_k) \right) \\
%  \label{eq:SourceT3c}
%  & = & -\beta^i \partial_i \alpha + \frac{1}{2\alpha} \left(
%    \gamma_{kl} \beta^l \partial_0 \beta^k - \beta^k \partial_0
%    (\gamma_{kl} \beta^l) - \beta^i \left( \beta_k D_i \beta^k +
%      \beta^k D_i \beta_k \right) \right) \\
%  \label{eq:SourceT3d}
%  & = & -\beta^i \partial_i \alpha + \frac{1}{2\alpha} \left(
%    -\beta^k \beta^l \partial_0 \gamma_{kl} - \beta^i \left( \beta^l
%      D_i \beta_l + \beta^k D_i \beta_k + \beta_k \beta_l D_i
%      \gamma^{kl} \right) \right) \\
%  \label{eq:SourceT3e}
%  & = & -\beta^i \partial_i \alpha + \frac{1}{2\alpha} \left(
%    2 \alpha \beta^k \beta^l K_{kl} - \beta^k \beta^l (D_k \beta_l +
%    D_l \beta_k) + 2 \beta^i \beta^k D_i \beta_k \right) \\
%  \label{eq:SourceT3f}
%  & = & -\beta^i \partial_i \alpha + \beta^k \beta^l K_{kl}.
%\end{eqnarray}
%Again to go from line~(\ref{eq:SourceT3d}) to (\ref{eq:SourceT3e}) we
%used the evolution equation~(\ref{eq:SourceADMg}), expressed in terms
%of the covariant derivative $D$.
%
%To simplify the calculation of the other coefficients we first
%calculate the 4-Christoffel symbol ${}^{(4)}\Gamma^0_{i\nu}$. This is
%given by
%\begin{eqnarray}
%  \label{eq:SourceChr1a}
%  {}^{(4)}\Gamma^0_{i\nu} & = & - \frac{1}{2\alpha^2} \left\{ \left(
%      \partial_i (\beta^k \beta_k - \alpha^2) - \beta^j (\partial_i
%      \beta_j - \partial_j \beta_i + \partial_0 \gamma_{ij}) \right)
%    \delta^0_{\nu} + \right. \\
%    && \left. \left( (\partial_l \beta_i + \partial_i \beta_l -
%      \partial_0 \gamma_{il}) - 2 \beta^j {}^{(3)}\Gamma_{jil} \right)
%    \delta^l_{\nu} \right\} \\
%  \label{eq:SourceChr1b}
%  & = & - \frac{1}{2\alpha^2} \left\{ \left(
%      \partial_i (\beta^k \beta_k - \alpha^2) - \beta^j ( 2 \partial_i
%      \beta_j - 2 \alpha K_{ij} - 2 \beta_k {}^{(3)}\Gamma^k_{ij})
%      \right) \delta^0_{\nu} + \right. \\
%    && \left. \left( (2 \alpha K_{il} + 2 \beta_k
%      {}^{(3)}\Gamma^k_{il}) - 2 \beta^j {}^{(3)}\Gamma_{jil} \right)
%      \delta^l_{\nu} \right\}.
%\end{eqnarray}
%
%The coefficient of $T^{0i} + T^{i0}$ is expanded in a similar
%fashion. Here we note that we only pick up one partial derivative of
%the lapse (as there is a specific ordering on that term) but that
%symmetry gives us two Christoffel symbols,
%\begin{eqnarray}
%  \label{eq:SourceT4a}
%  \partial_i \alpha - 2 \alpha {}^{(4)}\Gamma^0_{i0} & = & \partial_i
%  \alpha + \frac{1}{\alpha} \left( (\beta^k \beta_k - \alpha^2)_{,i} -
%    2 \beta^j (\partial_i \beta_j - \beta_k {}^{(3)}\Gamma^k_{ij} -
%    \alpha K_{ij}) \right) \\
%  \label{eq:SourceT4b}
%  & = & 2 \beta^j K_{ij} - \partial_i \alpha + \frac{1}{\alpha} \left(
%    \partial_i (\beta^k \beta_k) - 2 \beta^j (\partial_i \beta_j -
%    \beta_k {}^{(3)}\Gamma^k_{ij} ) \right). 
%\end{eqnarray}
%We then have to show that the term in brackets vanishes identically.
%Just expanding gives
%\begin{eqnarray}
%  \label{eq:SourceT4c}
%  \left(\dots\right) & = & 2 \beta^k \partial_i \beta_k + \beta^k
%  \beta^l \partial_i \gamma_{kl} - 2 \beta^j \left( \gamma_{jk}
%    \partial_i \beta^k + \beta^k \partial_i \gamma_{jk} - \beta_k
%    \gamma^{kl} (\partial_i \gamma_{lj} + \partial_j \gamma_{il} -
%    \partial_l \gamma_{ij}) \right) \\
%  \label{eq:SourceT4d}
%  & = & \beta^j \beta^l (\partial_j \gamma_{il} - \partial_l
%  \gamma_{ij} )
%\end{eqnarray}
%which is zero by symmetry.
%
%Finally we have the $T^{lm}$ coefficient. Again a simple expansion
%gives
%\begin{eqnarray}
%  \label{eq:SourceT5a}
%  -\alpha {}^{(4)}\Gamma^0_{lm} & = & \frac{1}{2\alpha} \left( 2
%   \alpha K_{lm} + 2 \beta_k {}^{(3)}\Gamma^k_{lm} - 2 \beta^j
%   {}^{(3)} \Gamma_{jlm} \right) \\
%  \label{eq:SourceT5b}
%  & = & K_{lm}.
%\end{eqnarray}
%Once again we had to make use of equation~(\ref{eq:SourceADMg}).


\subsection{Conversion from conservative to primitive variables}
\label{sec:con2prim}

As noted in section~\ref{sec:phys} the variables that are evolved are
the conserved variables $D, S_i, \tau$. But in order to calculate the
fluxes and sources we require the primitive variables $\rho, v_i, P$.
Conversion from primitive to conservative is given analytically by
equation~(\ref{eq:prim2con}). Converting in the other direction is not
possible in a closed form except in certain special circumstances.

There are a number of methods for converting from conservative to
primitive variables; see~\cite{livrevsrrfd}. Here we use a
Newton-Raphson type iteration. If we are using a general equation of
state such as an ideal gas, then we find a root of the pressure
equation. Given an initial guess for the pressure $\bar{P}$ we find
the root of the function
\begin{equation}
  \label{eq:pressure1}
  f = \bar{P} - P(\bar{\rho}, \bar{\epsilon}),
\end{equation}
where the approximate density and specific internal energy are given
by 
\begin{eqnarray}
  \label{eq:press1gives}
  \bar{\rho} & = & \frac{\tilde{D}}{\tilde{\tau} + \bar{P} + \tilde{D}}
  \sqrt{ (\tilde{\tau} + \bar{P} + \tilde{D})^2 - S^2 }, \\
  \bar{W} & = & \frac{\tilde{\tau} + \bar{P} + \tilde{D}}{\sqrt{
      (\tilde{\tau} + \bar{P} + \tilde{D})^2 - S^2 }}, \\
  \bar{\epsilon} & = & \tilde{D}^{-1} \left( \sqrt{ (\tilde{\tau} +
      \bar{P} + \tilde{D})^2 - S^2 } - \bar{P} \bar{W} - \tilde{D}
  \right). 
\end{eqnarray}
Here the conserved variables are all ``undensitized'', {\it e.g.},
\begin{equation}
  \label{eq:undens}
  \tilde{D} = \gamma^{-1/2} D,
\end{equation}
where $\gamma$ is the determinant of the 3-metric, and $S^2$ is given
by 
\begin{equation}
  \label{eq:s2}
  S^2 = \gamma^{ij}\tilde{S}_i\tilde{S}_j.
\end{equation}

In order to perform a Newton-Raphson iteration we need the derivative
of the function with respect to the dependent variable, here the
pressure. This is given by
\begin{equation}
  \label{eq:df}
  f' = 1 - \frac{\partial P}{\partial \rho}\frac{\partial
  \rho}{\partial P} - \frac{\partial P}{\partial
  \epsilon}\frac{\partial \epsilon}{\partial P}, 
\end{equation}
where $\frac{\partial P}{\partial \rho}$ and $\frac{\partial
  P}{\partial \epsilon}$ given by calls to {\tt EOS\_Base}, and
\begin{eqnarray}
  \label{eq:df2}
  \frac{\partial \rho}{\partial P} & = & \frac{\tilde{D}
      S^2}{\sqrt{(\tilde{\tau} + \bar{P} + \tilde{D})^2 -
      S^2}(\tilde{\tau} + \bar{P} + \tilde{D})^2}, \\
  \frac{\partial \epsilon}{\partial P} & = & \frac{\bar{P}
      S^2}{\rho\left((\tilde{\tau} + \bar{P} + \tilde{D})^2 -
      S^2\right)(\tilde{\tau} + \bar{P} + \tilde{D})}. \\
\end{eqnarray}

For a polytropic type equation of state, the function is given by
\begin{equation}
  \label{eq:polyf}
  f = \bar{\rho}\bar{W} - \tilde{D},
\end{equation}
where $\bar{\rho}$ is the variable solved for, the pressure, specific
internal energy and enthalpy $\bar{h}$ are set from the EOS and the
Lorentz factor is found from
\begin{equation}
  \label{eq:polyw}
  \bar{W} = \sqrt{1 + \frac{S^2}{(\tilde{D}\bar{h})^2}}.
\end{equation}
The derivative is given by
\begin{equation}
  \label{eq:dpolyf}
  f' = \bar{W} - \frac{\bar{\rho}S^2 \bar{h}'}{\bar{W} \tilde{D}^2
  \bar{h}^3}, 
\end{equation}
where
\begin{equation}
  \label{eq:dpolyenth}
  \bar{h}' = \bar{\rho}^{-1}\frac{\partial P}{\partial \rho}.
\end{equation}

\subsection{A note on the Roe and Marquina Riemann Solvers}
\label{sec:rsnote}

Finding the Roe or Marquina fluxes as given is
section~\ref{sec:riemann} requires the left eigenvectors to either be
supplied analytically or calculated numerically. 

When this is done by inverting the matrix of right
eigenvectors, in the actual code this is combined with the calculation
of, {\it e.g.}, the characteristic jumps $\Delta {\bf w}$.
Normally the eigenvalues and vectors are ordered lexicographically.
However for the polytropic equation of state one of the equations is
redundant, so the matrix formed by these eigenvectors is linearly
dependent and hence singular. It turns out that this is only a minor
problem; by rearranging the order of the eigenvalues and vectors it is
possible to numerically invert the matrix. 
This means that no specific ordering of the eigenvalues should be
assumed. It also explains the slightly strange ordering in the
routines {\tt GRHydro\_EigenProblem*.F90}.

The current default is that the left eigenvectors are calculated
analytically - for the expressions see Font~\cite{livrevgrrfd}. For
both the Roe and the Marquina solvers an optimized version of the flux
calculation has been implemented. For more details on the analytical
form and the optimized flux calculation see Ib{\'a}{\~n}ez et
al.~\cite{Iban01}, Aloy et al.~\cite{Aloy99} and Frieben et
al.~\cite{Frie02}.

\subsection{The atmosphere}
\label{sec:atmosphere}

In simulations of compact objects, often the matter is located only on a (small) portion of the
numerical grid. In fact, over much of the evolved domain the physical situation is likely to be
sufficiently well approximated by vacuum. However, in the vacuum limit the continuity equations
describing the fluid break down. The speed of sound tends to the speed of light and everything fails
(especially the conversion from conserved to primitive variables).

To avoid this problem it is customary to introduce an atmosphere. In our implementation, this is a
low-density region surrounding the compact objects and initially it has no velocity and is in equilibrium. The
introduction of an atmosphere is managed by the initial data thorns.

However {\tt GRHydro} itself also knows about the atmosphere, of course. If the conserved variables
$D$ or $\tau$ are beneath some minimum value, or an evolution step might push them below such a
value, then the relevant cell is not evolved. Also, if the density should fall below a minimum value
in the routine that converts from conservative to primitive variables, all the variables are reset
to the values adopted for the atmosphere.

Probably the hardest part of using {\tt GRHydro} is to correctly set these
atmosphere values. In the current implementation the atmosphere is
used in three separate places. These are
\begin{enumerate}
\item {\bf Set up of the initial data}. Initial-data routines should set an atmosphere consistent
  with the one that will be evolved.
\item {\bf In the routine that converts from conserved variables to
    primitive variables}. This is where the majority of the atmosphere
  resets will occur. 

  If the equation of state is polytropic then an
  attempt is made to convert to primitive variables. If the iterative
  algorithm returns a negative (and hence unphysical) value of $\rho$,
  then $\rho$ is reset to the atmosphere value, the velocities are set
  to zero, and $P$, $\epsilon$, $S_i$ and $\tau$ are reset to be
  consistent with $\rho$ (and $D$). Note that even though the
  polytropic equation of state gives us sufficient information to
  calculate a consistent value of $D$, this is not done.

  If the equation of state is the more general type (such as that of an ideal fluid) and if $\rho$
  is less than the specified minimum, then, as above, we assume we are in the atmosphere and call
  the routine that changes from the conserved to the primitive variables for the polytrope.

\item {\bf When applying the update}. If the calculated update terms
  for a specific cell would lead to either $D$ or $\tau$ becoming
  negative, then two steps are taken. First, we do not update this
  specific cell. Second, the data in this cell is reset to be the
  atmosphere. 
\end{enumerate}

The reason why the routine that converts to the primitive variables
does not ensure that $D$ is consistent with the other variables is
practical rather than accurate. If the value of the variables is set
such that they all lie precisely on the atmosphere, then small errors
(typically initially of the order of $10^{-25}$ for a $64^3$-point TOV star
in octant symmetry) would move certain cells above the atmosphere
values. Combined with the necessary atmosphere treatment this leads to
high-frequency noise. This will lead to waves of matter falling onto
the star. Despite their extremely low density (typically only an
order of magnitude higher than the floor) they will result in visible
secondary overtones in the oscillations of, {\it e.g.}, the central
density. 

The parameters controlling the atmosphere are the following.
\begin{itemize}
\item {\tt GRHydro::rho\_abs\_min}. An absolute value for $\rho$ in the
  atmosphere. Defaults to -1. Any negative value will be ignored, and
  the value of {\tt rho\_rel\_min} used instead.
\item {\tt GRHydro::rho\_rel\_min}. A relative value for $\rho$ in the
  atmosphere. Defaults to $10^{-7}$. Only used if {\tt rho\_abs\_min}
  is negative, which is the default behaviour. The actual value of the
  atmosphere will be $\rho =${\tt rho\_rel\_min}$\times${\tt
    GRHydro\_rho\_max}, where {\tt GRHydro::GRHydro\_rho\_max}
  is a variable containing the maximum value of $\rho$ on the numerical grid at time zero.
\item {\tt initial\_rho\_abs\_min}. An absolute value for rho in the initial atmosphere. It is used
  only by initial data routines. Unused if negative.
\item {\tt initial\_rho\_rel\_min}. A relative (to the initial maximum rest-mass density) value for rho
  in the atmosphere. It is used only by initial data routines and only if it is positive and {\tt
  initial\_rho\_abs\_min} is negative.
\item {\tt initial\_atmosphere\_factor}. A relative (to the initial atmosphere) value for rho in the
  atmosphere. It is used only by initial data routines. It multiplies the atmosphere value used by
  the initial data solver. Unused if negative.
\item {\tt GRHydro\_atmo\_tolerance}. A parameter useful mostly in mesh-refined simulations. A point
  is set to the atmosphere values in the conservative to primitive routines if its rest-mass density
  is such that $\rho <$ {\tt GRHydro\_rho\_min}$*(1+${\tt GRHydro\_atmo\_tolerance}). This avoids
  occasional spurious oscillations in ({\tt Carpet}) buffer zones lying in the atmosphere (because
  prolongation happens on conserved variables).
\end{itemize}

The motivation for these parameters referring only to the initial data is that it is sometimes best
to set the initial atmosphere to slightly below the atmosphere cutoff used during evolution, as this
avoids truncation error and metric evolution leading to low density waves travelling across the
atmosphere.

The routines essential to the atmosphere are contained in {\tt
GRHydro\_Minima.F90, GRHydro\_Con2Prim.F90, GRHydro\_UpdateMask.F90}. 

\subsection{Advection of passive scalars ('tracers')}
\label{sec:tracer}

For some astrophysical problems it is necessary to advect passive
compositional scalars such as the electron fraction $Y_e$ (number of
electrons per baryon). For a generic tracer $X_k$, the evolution
equation looks like

%%%\begin{eqnarray}
%%%  \label{eq:tracer}
%%%   D &=& \sqrt{\gamma}W\rho \nonumber \\
%%%   S^i &=& \sqrt{\gamma} \rho h W^2 v^i \nonumber \\
%%%   \tau &=& \sqrt{\gamma}\left( \rho h W^2 - p\right) - D, 
%%%\end{eqnarray}

\begin{equation}
  \label{eq:tracer}
  \partial_t { ( D X_k )} + \partial_{x^j} {\bf f}^{(j)} ({D X_k}) = 0\, ,
\end{equation}
where $D$ is the generalized particle number density as defined in
Eq.~(\ref{eq:prim2con}). {\tt GRHydro} currently supports any number of
independent tracer variables. The following parameters have to be
set to use the tracers:

\begin{itemize}
  \item {\tt GRHydro::evolve\_tracer}. Boolean. Set to {\tt yes} if
    you want the tracers to be active.
  \item {\tt GRHydro::number\_of\_tracers}. Integer. Defaults to 0. To
    use tracers, set to at least 1.
\end{itemize}

Note, that your initial data thorn must set initial data for
{\tt GRHydro::tracer[k]} and {\tt GRHydro::cons\_tracer[k]} for all tracers
you want to advect. {\tt GRHydro::cons\_tracer[k]} stores $D X_k$.

\subsubsection{Implementation and Limitations}

\begin{itemize}
  \item Reconstruction: Currently only TVD and PPM reconstruction of the
    tracers $X_k$ are implemented. Since for most astrophysical problems one
    will associate the tracer with some compositional variable it might
    be better to reconstruct $\rho X_k$.

  \item Riemann Solvers: Only HLLE and Marquina are supported. In HLLE,
    the fluxes as given in Eq.~(\ref{eq:tracer}) are computed for each tracer.
    In the Marquina solver, we multiply the $D$-flux by each tracer to get
    the individual tracer fluxes according to the following prescription:

    \begin{equation}
      \label{eq:marquinatracer}
      \begin{array}[l]{l}
	{\bf If}\ \, F_{i+1/2} (D) > 0 \,\, {\bf then} \\
	  \qquad \qquad \begin{array}[c]{l}
	    \qquad \qquad F_{i+1/2} (D X_k) = X_{k_i}^+ F_{i+1/2} (D)
	  \end{array} \\
		 {\bf else} \\
		 \qquad \qquad \begin{array}[c]{r c l}
		   \qquad \qquad F_{i+1/2} (D X_k) = X_{k_{i+1}}^- F_{i+1/2} (D)
		 \end{array} \\
			{\bf end if} \\
      \end{array} \\
    \end{equation}

    The above was suggested by Miguel Aloy and first implemented and
    tested by Harry Dimmelmeier in his code (CoCoNuT), then by Christian~D.~Ott
    in {\tt GRHydro}.

\end{itemize}


\section{History}

The approximate time line is something like this:
\begin{itemize}
\item ~1995: Valencia group hydrodynamics code, fixed spacetime.
\item ~1997: Ported to Cactus, extensively rewritten for the Binary
  Neutron Star Grand Challenge. Primarily written by Mark Miller.
  Released as {\tt GR3D} as public domain code.
\item ~1998-: Developed as Cactus thorn {\tt MAHC} inside the
  GR{\tt Astro\_Hydro} arrangement at Washington University, primarily by
  Mark Miller.
\item 2002-2008: {\tt Whisky} written based on {\tt GR3D}.
\item 2008-: {\tt GRHydro} based on the public version of {\tt Whisky}
\end{itemize}

This is necessarily only a sketch; many people have contributed to
the history of this code, and the present authors were not around for most of it...

\subsection{Thorn Source Code}

This was initially written by Luca Baiotti, Ian Hawke and Pedro
Montero with considerable assistance from Luciano Rezzolla, Toni Font,
Nick Stergioulas and Ed Seidel. This led to the basic {\tt GRHydro} thorns,
{\tt GRHydro} itself, {\tt GRHydro\_Init\_Data} and {\tt GRHydro\_RNSID}.

Since then most of the maintenance has been done by Ian Hawke, Luca Baiotti and Frank L\"offler. Various
people have contributed to the development. In particular
\begin{itemize}
\item The PPM reconstruction methods were written by Ian Hawke heavily
  based on the code of Toni Font. They were later expanded by Christian D. Ott and Luca Baiotti.
\item The Roe and Marquina solvers were made considerably more
  efficient thanks to Joachim Frieben.
\item The current atmosphere algorithm is a mixture of ideas from the
  {\tt GR3D} code, Luciano Rezzolla, Toni Font and Nick
  Stergioulas. The current setup was written by Ian Hawke and Luca Baiotti.
\item The 1-dimensional TOV solver {\tt GRHydro\_TOVSolver} was written
  by Ian Hawke based on a short paper by Thomas Baumgarte.
%\item The use of the equation of state, in particular the routines to
%  ensure the initial hydrodynamic consistency, were due to the work of
%  Harald Dimmelmeier and Christian Ott.
\end{itemize}

\subsection{Thorn Documentation}

This documentation was first written largely by Ian Hawke and Scott Hawley in 2002. Long due,
rather necessary and considerably large updates were made in 2008 by Luca Baiotti.


\subsection{Acknowledgements}

As already mentioned, the history behind this code leads to a long list
of people to be acknowledged.

Firstly, without the work of the Valencia group this sort of code
would be impossible. 

Secondly, the incomparable work of Mark Miller and the Washington
University - AEI Collaboration in producing the {\tt GR3D} and {\tt
GRAstro\_Hydro} codes gave an essential benchmark to aim for, and
encouragement that it was possible!

Thirdly, the support of the Cactus team, especially Tom Goodale,
Gabrielle Allen and Thomas Radke made life a
lot easier.

Finally, for their work in coding, ideas and suggestions, or just
plain encouragement, we would like to thank all at the AEI and in the
EU Network, especially Toni Font, Luciano Rezzolla, Nick Stergioulas,
Ed Seidel, Carsten Gundlach and Jos\'e-Maria Ib{\'a}{\~n}ez.

Originally Ed Seidel and then Luciano Rezzolla and Gabrielle Allen and many others 
have been granting (in addition to valuable
scientific advice) financial support and human resources to the development of the code.

\begin{thebibliography}{20}

\bibitem{Aloy99b}
Aloy M.A., Ib{\'a}nez J.M., Mart\'\i J.M., M{\"u}ller E.
\newblock {\em Astroph. J. Supp.\/}, {\bf 122}: 151 (1999).

\bibitem{Aloy99} 
M.~A. Aloy, J.~A. Pons, and J.~M. Ib{\'a}{\~n}ez.
\newblock An efficient implementation of flux formulae in multidimensional
  relativistic hydrodynamical codes.
\newblock {\em Comput. Phys. Commun.}, {\bf 120}:\penalty0 115--121, 1999.

\bibitem{Banyuls97}
Banyuls F., Font J.A., Ib{\'a}nez J.M., Mart\'{\i} J.M., Miralles J.A.
\newblock {\em Astrophys. J.\/}, {\bf 476}: 221 (1997).

\bibitem{ppm}
P. Colella and P.~R. Woodward.
\newblock The {P}iecewise {P}arabolic {M}ethod ({PPM}) for
{G}as-{D}ynamical {S}imulations.
\newblock {\em J. Comput. Phys.}, {\bf 54}, 174--201, 1984.

\bibitem{Cook00}
G. Cook
\newblock Initial Data for Numerical Relativity
\newblock {\em Living Rev. Relativity}, {\bf 3}, 2000.
\newblock [Article in on-line journal], cited on 31/08/02,
  http://www.livingreviews.org/ Articles/Volume3/2000-5cook/index.html.

\bibitem{Marquina1}
R.~Donat and A.~Marquina.
\newblock Capturing shock reflections: An improved flux formula.
\newblock {\em J. Comput. Phys.}, {\bf 125}:\penalty0 42--58, 1996.

\bibitem{Einfeldt88}
Einfeldt B.
\newblock {\em Journal of Computational Physics\/}, {\bf 25}: 294 (1988).

\bibitem{Eulderink94}
Eulderink F., Mellema G.
\newblock {\em Astron. Astrophys.\/}, {\bf 284}: 652 (1994).

\bibitem{livrevgrrfd}
J.~A. Font.
\newblock Numerical hydrodynamics in {G}eneral {R}elativity.
\newblock {\em Living Rev. Relativity}, {\bf 3}, 2000.
\newblock [Article in on-line journal], cited on 31/07/01,
  http://www.livingreviews.org/ Articles/Volume3/2000-2font/index.html.

\bibitem{Frie02}
J. Frieben, J.~M. Ib{\'a}{\~n}ez, and J. Pons.
\newblock {\em in preparation}

\bibitem{eno}
A.~Harten, B.~Engquist, S.~Osher, and S.~R. Chakravarthy.
\newblock Uniformly high order accurate essentially non-oscillatory schemes,
  {III}.
\newblock {\em J. Comput. Phys.}, {\bf 71}:\penalty0 231--303, 1987.

\bibitem{Iban01}
J.~M. Ib{\'a}{\~n}ez et al.
\newblock in {\em Godunov Methods: Theory and Applications}.
\newblock New York, 485--503, (2001)

\bibitem{Tadmor00}
A. Kurganov and E. Tadmor.
\newblock {\em New high-resolution central schemes for nonlinear conservation laws and
  convection-diffusion equations}.
\newblock {\em J. Comput. Phys.}, {\bf 160}:241, 2000.

\bibitem{laney}
C.~B. Laney.
\newblock {\em Computational {G}asdynamics}.
\newblock Cambridge University Press, 1998.

\bibitem{leveque}
R.~J. LeVeque.
\newblock {N}onlinear conservation laws and finite volume methods for
  astrophysical fluid flow.
\newblock In O.~Steiner and A.~Gautschy, editors, {\em {C}omputational
  {M}ethods for {A}strophysical {F}luid {F}low}. Springer-Verlag, 1998.

\bibitem{livrevsrrfd}
J.~M. Mart{\'{\i}} and E.~M{\"u}ller.
\newblock Numerical hydrodynamics in {S}pecial {R}elativity.
\newblock {\em Living Rev. Relativity}, {\bf 2}, 1999.
\newblock [Article in on-line journal], cited on 31/7/01,
  http://www.livingreviews.org/Articles/Volume2/1999-3marti/index.html.

\bibitem{Quirk}
J.~J. Quirk.
\newblock A contribution to the great {R}iemann solver debate.
\newblock {\em Int. J. Numer. Methods Fluids}, {\bf 18}:\penalty0 555--574,
  1994.

\bibitem{Roe81}
Roe P.L.
\newblock {\em J. Comput. Phy.\/}, {\bf 43}: 357 (1981).

\bibitem{shueno}
C. Shu.
\newblock {H}igh {O}rder {ENO} and {WENO} {S}chemes for
{C}omputational {F}luid {D}ynamics.
\newblock In T.~J. Barth and H. Deconinck, editors {\em High-Order
  Methods for Computational Physics}. Springer, 1999.
\newblock A related on-line version can be found under {\em Essentially
  {N}on-{O}scillatory and {W}eighted {E}ssentially {N}on-{O}scillatory
  {S}chemes for {H}yperbolic {C}onservation {L}aws} at {\tt
  http://www.icase.edu/library/reports/rdp/97/97-65RDP.tex.refer.html}. 

\bibitem{toro}
E.~F. Toro.
\newblock {\em {R}iemann {S}olvers and {N}umerical {M}ethods for {F}luid
  {D}ynamics}.
\newblock {S}pringer-{V}erlag, 2nd edition, 1999.

\end{thebibliography}

% Do not delete next line
% END CACTUS THORNGUIDE

\end{document}

```



Reference answer:
src_code:  /*@@
   @file      GRHydro_PPM.F90
   @date      Sun Feb 10 16:53:29 2002
   @author    Ian Hawke, Toni Font, Luca Baiotti, Frank Loeffler
   @desc 
   Routines to do PPM reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.h"

subroutine PPM_TVD(origm, orig, origp, bextm, bextp)
  CCTK_REAL :: origm, orig, origp, bextm, bextp
  CCTK_REAL :: dloc, dupw, delta

  dupw = orig - origm
  dloc = origp - orig
  if (dupw*dloc < 0.d0) then
    delta=0.d0
  else if (abs(dupw) < abs(dloc)) then
    delta=dupw
  else
    delta=dloc
  end if
  bextm = orig - 0.5d0 * delta
  bextp = orig + 0.5d0 * delta
end subroutine PPM_TVD

 /*@@
   @routine    SimplePPM_1d
   @date       Thu Feb 14 19:08:52 2002
   @author     Ian Hawke, Toni Font, Christian Reisswig
   @desc 
   The simple PPM reconstruction routine that applies along
   each one dimensional slice.

   @enddesc 
   @calls     
   @calledby   
   @history 
   Written in frustration when IH couldn''t get Toni''s original code 
   to work.
   Later extended to enhanced PPM scheme by CR.
   @endhistory 

@@*/

#define SpaceMask_CheckStateBitsF90_1D(mask,i,type_bits,state_bits) \
  (iand(mask((i)),(type_bits)).eq.(state_bits))


subroutine SimplePPM_1d(apply_enhanced_ppm,handle,poly,&
     nx,dx,rho,velx,vely,velz,eps,press,rhominus,&
     velxminus,velyminus,velzminus,epsminus,rhoplus,velxplus,velyplus,&
     velzplus,epsplus,trivial_rp, hydro_excision_mask,&
     gxx, gxy, gxz, gyy, gyz, gzz, beta, alp, w_lorentz, &
     dir, ni, nj, nrx, nry, nrz, ev_l, ev_r, xw)

  USE GRHydro_Scalars
  USE GRHydro_Eigenproblem

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL, parameter :: one = 1

  logical :: apply_enhanced_ppm

  CCTK_INT :: handle,poly,nx
  CCTK_REAL :: dx
  CCTK_REAL, dimension(nx) :: rho,velx,vely,velz,eps
  CCTK_REAL, dimension(nx) :: rhominus,velxminus,velyminus,velzminus,epsminus
  CCTK_REAL, dimension(nx) :: rhoplus,velxplus,velyplus,velzplus,epsplus

  CCTK_INT :: i,s
  CCTK_REAL, dimension(nx) :: drho,dvelx,dvely,dvelz,deps
  CCTK_REAL, dimension(nx) :: dmrho,dmvelx,dmvely,dmvelz,dmeps
  CCTK_REAL, dimension(nx) :: press,dpress,d2rho,tilde_flatten
  CCTK_REAL :: dpress2,dvel,w,flatten,eta,etatilde

  logical, dimension(nx) :: trivial_rp

  CCTK_INT, dimension(nx) :: hydro_excision_mask

  CCTK_REAL, dimension(nx) :: gxx, gxy, gxz, gyy, gyz, gzz, &
                              beta, alp, w_lorentz
  CCTK_INT :: dir, ni, nj, nrx, nry, nrz
  CCTK_REAL, dimension(nrx, nry, nrz) :: ev_l, ev_r, xw

  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, det
  CCTK_REAL, dimension(5) :: lam
  CCTK_REAL :: agxx, agxy, agxz, agyy, agyz, agzz
  CCTK_REAL, dimension(nx) :: xwind, l_ev_l, l_ev_r

  CCTK_REAL :: D2a, D2aL, D2aR, D2aC, D2aLim, rhi, daplus, daminus, D3a, D3aLL, D3aL, D3aR, D2aLL, D2aRR, D3aMin, D3aMax

  logical :: cond

  CCTK_REAL, dimension(nx) :: vx,vy,vz
  
  
  !!$ reconstruct w^i = w_lorentz*v^i to ensure slower than light
  !!$ speeds?
  if (reconstruct_Wv.ne.0) then
    ! all velocity like quantities are now w_lorentz*velocity. We will convert
    ! back to ordinary velocity at the end, using w_lorentz = sqrt(1 + g_{ij}
    ! w^i w^j). 
    vx = w_lorentz*velx
    vy = w_lorentz*vely
    vz = w_lorentz*velz
  else
    vx = velx
    vy = vely
    vz = velz
  end if


!!$  Initially, all the Riemann problems will be trivial
trivial_rp = .true.


#define STEEP(x,dx,dmx)                                              \
         if ( (x(i+1) - x(i)) * (x(i) - x(i-1)) > 0.d0 ) then           &&\
            dmx(i) = sign(one, dx(i)) *                                   \
               min(abs(dx(i)), 2.d0 * abs(x(i) - x(i-1)),                \
                                 2.d0 * abs(x(i+1) - x(i)))              &&\
         else                                                           &&\
            dmx(i) = 0.d0                                                &&\
         end if


  if (.not.apply_enhanced_ppm) then
      !! This is the original PPM algorithm by Colella & Woodward 1984.

      !!$  Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178
      !!$  This is the expression for an even grid.

      do i = 2, nx - 1
         drho(i) = 0.5d0 * (rho(i+1) - rho(i-1))
         dvelx(i) = 0.5d0 * (vx(i+1) - vx(i-1))
         dvely(i) = 0.5d0 * (vy(i+1) - vy(i-1))
         dvelz(i) = 0.5d0 * (vz(i+1) - vz(i-1))
         dpress(i) = press(i+1) - press(i-1)
         d2rho(i) = ((rho(i+1) + rho(i-1)) - 2.d0 * rho(i))! / 6.d0 / dx / dx
         ! since we use d2rho only for the condition d2rho(i+1)*d2rhoi(i-1)<0 
         ! the denominator is not necessary
      end do
      if (poly .eq. 0) then
         do i = 2, nx - 1
            deps(i) = 0.5d0 * (eps(i+1) - eps(i-1))
         end do
      end if

      !!$  Steepened slope. See (1.8) of Colella and Woodward, p.178

      do i = 2, nx - 1
         STEEP(rho, drho, dmrho)
         STEEP(vx, dvelx, dmvelx)
         STEEP(vy, dvely, dmvely)
         STEEP(vz, dvelz, dmvelz)
      end do
      if (poly .eq. 0) then
         do i = 2, nx - 1
            STEEP(eps, deps, dmeps)
         end do
      end if

      !!$  Initial boundary states. See (1.9) of Colella and Woodward, p.178

      do i = 2, nx-2
         rhoplus(i) = 0.5d0 * (rho(i) + rho(i+1)) + &
               (dmrho(i) - dmrho(i+1)) / 6.d0
         rhominus(i+1) = rhoplus(i)
         velxplus(i) = 0.5d0 * (vx(i) + vx(i+1)) + &
               (dmvelx(i) - dmvelx(i+1)) / 6.d0
         velxminus(i+1) = velxplus(i)
         velyplus(i) = 0.5d0 * (vy(i) + vy(i+1)) + &
               (dmvely(i) - dmvely(i+1)) / 6.d0
         velyminus(i+1) = velyplus(i)
         velzplus(i) = 0.5d0 * (vz(i) + vz(i+1)) + &
               (dmvelz(i) - dmvelz(i+1)) / 6.d0
         velzminus(i+1) = velzplus(i)
      end do
      if (poly .eq. 0) then
         do i = 2, nx-2
            epsplus(i) = 0.5d0 * (eps(i) + eps(i+1)) + &
               (dmeps(i) - dmeps(i+1)) / 6.d0
            epsminus(i+1) = epsplus(i)
         end do
      end if
  else
!! This is the modified PPM algorithm by Colella & Sekora 2008 and McCorquodale & Colella 2011.
!! This uses a better limiter based on second derivatives that preserves
!! accuracy at local extrema. It also uses a higher-order interpolation polynomial.

      !!$  Initial boundary states (sixth order accurate). See (17) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACE_STENCIL4(a, ah)  \
      ah = 37.0d0/60.0d0*(a(i)+a(i+1)) - 2.0d0/15.0d0*(a(i-1)+a(i+2)) + 1.0d0/60.0d0*(a(i-2)+a(i+3))
      
      !!$  Initial boundary states (4th order accurate). See (16) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACE(a, ah)  \
      ah = 7.0d0/12.0d0*(a(i)+a(i+1)) - 1.0d0/12.0d0*(a(i-1)+a(i+2))
      
#define LIMIT(a,ah,C, alim) \
      if ((min(a(i),a(i+1)) .le. ah) .and. (ah .le. max(a(i),a(i+1)))) then       &&\
         alim = ah   &&\
      else &&\
         D2a  = 3.0d0 * ((a(i)   + a(i+1)) - 2.0d0*ah    )                                 &&\
         D2aL =         ((a(i-1) + a(i+1)) - 2.0d0*a(i)  )                                 &&\
         D2aR =         ((a(i)   + a(i+2)) - 2.0d0*a(i+1))                                 &&\
         D2aLim = sign(one, D2a)*min(C*abs(D2aL), C*abs(D2aR), abs(D2a))/3.0d0             &&\
         if (D2a*D2aR .ge. 0 .and. D2a*D2aL .ge. 0) then                     &&\
            alim = 0.5d0*(a(i)+a(i+1)) - D2aLim &&\
         else                                                                             &&\
            alim = 0.5d0*(a(i)+a(i+1))                                                    &&\
         end if                                                                           &&\
      endif

#define LIMIT_EPS(a,ah,C, alim) \
      if ((min(a(i),a(i+1)) .le. ah) .and. (ah .le. max(a(i),a(i+1)))) then       &&\
         alim = ah   &&\
      else &&\
         D2a  = 3.0d0 * ((a(i)   + a(i+1)) - 2.0d0*ah    )                                 &&\
         D2aL =         ((a(i-1) + a(i+1)) - 2.0d0*a(i)  )                                 &&\
         D2aR =         ((a(i)   + a(i+2)) - 2.0d0*a(i+1))                                 &&\
         D2aLim = sign(one, D2a)*min(C*abs(D2aL), C*abs(D2aR), abs(D2a))/3.0d0             &&\
         if (D2a*D2aR .ge. 0 .and. D2a*D2aL .ge. 0 .and. abs(D2aLim) .lt. abs(0.5d0*(a(i)+a(i+1)))) then                     &&\
            alim = 0.5d0*(a(i)+a(i+1)) - D2aLim &&\
         else                                                                             &&\
            alim = 0.5d0*(a(i)+a(i+1))                                                    &&\
         end if                                                                           &&\
      endif



   if (PPM3) then
      
      !! We initialize "plus" \equiv a_j+1/2 with (16) via APPROX_AT_CELL_INTERFACE, 
      !! then checking for (13) of Colella & Sekora 2008 and applying
      !! (18) and (19) if (13) is not satisfied. This is done with LIMIT.
      do i = 2, nx-2
         APPROX_AT_CELL_INTERFACE(rho, rhoplus(i))
         LIMIT(rho, rhoplus(i), enhanced_ppm_C2, rhoplus(i))
         rhominus(i+1) = rhoplus(i)
         
         APPROX_AT_CELL_INTERFACE(vx, velxplus(i))
         LIMIT(vx, velxplus(i), enhanced_ppm_C2, velxplus(i))
         velxminus(i+1) = velxplus(i)
         
         APPROX_AT_CELL_INTERFACE(vy, velyplus(i))
         LIMIT(vy, velyplus(i), enhanced_ppm_C2, velyplus(i))
         velyminus(i+1) = velyplus(i)
         
         APPROX_AT_CELL_INTERFACE(vz, velzplus(i))
         LIMIT(vz, velzplus(i), enhanced_ppm_C2, velzplus(i))
         velzminus(i+1) = velzplus(i)
      end do
      if (poly .eq. 0) then
         do i = 2, nx-2
            APPROX_AT_CELL_INTERFACE(eps, epsplus(i))
            LIMIT_EPS(eps, epsplus(i), enhanced_ppm_C2, epsplus(i))
            epsminus(i+1) = epsplus(i)
         end do
      end if
      
    else

      !! Same as above but for 4 stencil points using (17) of Colella & Sekora 2008 as
      !! initial states.
      do i = 3, nx-3
         APPROX_AT_CELL_INTERFACE_STENCIL4(rho, rhoplus(i))
         LIMIT(rho, rhoplus(i), enhanced_ppm_C2, rhoplus(i))
         rhominus(i+1) = rhoplus(i)
         
         APPROX_AT_CELL_INTERFACE_STENCIL4(vx, velxplus(i))
         LIMIT(vx, velxplus(i), enhanced_ppm_C2, velxplus(i))
         velxminus(i+1) = velxplus(i)
         
         APPROX_AT_CELL_INTERFACE_STENCIL4(vy, velyplus(i))
         LIMIT(vy, velyplus(i), enhanced_ppm_C2, velyplus(i))
         velyminus(i+1) = velyplus(i)
         
         APPROX_AT_CELL_INTERFACE_STENCIL4(vz, velzplus(i))
         LIMIT(vz, velzplus(i), enhanced_ppm_C2, velzplus(i))
         velzminus(i+1) = velzplus(i)
      end do
      if (poly .eq. 0) then
         do i = 3, nx-3
            APPROX_AT_CELL_INTERFACE_STENCIL4(eps, epsplus(i))
            LIMIT(eps, epsplus(i), enhanced_ppm_C2, epsplus(i))
            epsminus(i+1) = epsplus(i)
         end do
      end if
    endif
    
    !! Finally compute pressure gradient needed for flattening and shock detection
    do i = 2, nx-1
       dpress(i) = press(i+1) - press(i-1)
    end do
    
  endif


!!$Discontinuity steepening. See (1.14-17) of C&W.
!!$This is the detect routine which mat be activated with the ppm_detect parameter
!!$Note that this part really also depends on the grid being even. 
!!$Note also that we don''t have access to the gas constant gamma.
!!$So this is just dropped from eq. (3.2) of C&W.
!!$We can get around this by just rescaling the constant k0 (ppm_k0 here).

  if (.not.apply_enhanced_ppm) then 
   ! Only for 1984 PPM scheme!
   if (ppm_detect .ne. 0) then

      do i = 3, nx - 2
         if ( (d2rho(i+1)*d2rho(i-1) < 0.d0).and.(abs(rho(i+1)-rho(i-1)) - &
            ppm_epsilon_shock * min(abs(rho(i+1)), abs(rho(i-1))) > 0.d0) ) then
         etatilde = ((rho(i-2) - rho(i+2)) + 4.d0 * drho(i)) / (drho(i) * 12.d0)
         else
         etatilde = 0.d0
         end if
         eta = max(0.d0, min(1.d0, ppm_eta1 * (etatilde - ppm_eta2)))
         if (ppm_k0 * abs(drho(i)) * min(press(i-1),press(i+1)) < &
            abs(dpress(i)) * min(rho(i-1), rho(i+1))) then
         eta = 0.d0
         end if
         if (eta > 0.d0) then
         trivial_rp(i-1) = .false.
         trivial_rp(i) = .false.
         end if
         rhominus(i) = rhominus(i) * (1.d0 - eta) + &
            (rho(i-1) + 0.5d0 * dmrho(i-1)) * eta
         rhoplus(i) = rhoplus(i) * (1.d0 - eta) + &
            (rho(i+1) - 0.5d0 * dmrho(i+1)) * eta
      end do

   end if
  
  !!$ mppm
#define D_UPW(x) (0.5d0 * (x(i) + x(i+1)))
#define LEFT1(x)  (13.d0*x(i+1)-5.d0*x(i+2)+x(i+3)+3.d0*x(i  ))/12.d0
#define RIGHT1(x) (13.d0*x(i  )-5.d0*x(i-1)+x(i-2)+3.d0*x(i+1))/12.d0
   if (ppm_mppm .gt. 0) then
      l_ev_l=0.d0
      l_ev_r=0.d0
      xwind=0.d0
      do i=3, nx - 3
         agxx = 0.5d0*( gxx(i) + gxx(i+1) )
         agxy = 0.5d0*( gxy(i) + gxy(i+1) )
         agxz = 0.5d0*( gxz(i) + gxz(i+1) )
         agyy = 0.5d0*( gyy(i) + gyy(i+1) )
         agyz = 0.5d0*( gyz(i) + gyz(i+1) )
         agzz = 0.5d0*( gzz(i) + gzz(i+1) )
         det = SPATIAL_DETERMINANT(agxx, agxy, agxz, \
                                 agyy, agyz, agzz)
         call UpperMetric (uxx, uxy, uxz, uyy, uyz, uzz, &
                           det, agxx, agxy, agxz, agyy, agyz, agzz)
         call eigenvalues(handle,&
                  D_UPW(rho), D_UPW(velx), D_UPW(vely), D_UPW(velz), &
                  D_UPW(eps), D_UPW(w_lorentz), lam, &
                  agxx, agxy, agxz, agyy, agyz, agzz, &
                  uxx, D_UPW(alp), D_UPW(beta))
         l_ev_l(i)=lam(1)
         l_ev_r(i)=lam(5)
         xwind(i) = (lam(1) + lam(5)) / (abs(lam(1)) + abs(lam(5)))
         xwind(i) = min(1.d0, max(-1.d0, xwind(i)))
#define LEFTPLUS(x,xplus)    xplus(i)   =       abs(xwind(i))  * LEFT1(x) + \
                                          (1.d0-abs(xwind(i))) * xplus(i)
#define LEFTMINUS(x,xminus)  xminus(i+1)=       abs(xwind(i))  * LEFT1(x) + \
                                          (1.d0-abs(xwind(i))) * xminus(i+1)
#define RIGHTPLUS(x,xplus)   xplus(i)   =       abs(xwind(i))  * RIGHT1(x) + \
                                          (1.d0-abs(xwind(i))) * xplus(i)
#define RIGHTMINUS(x,xminus) xminus(i+1)=       abs(xwind(i))  * RIGHT1(x) + \
                                          (1.d0-abs(xwind(i))) * xminus(i+1)
#define CHECK(x,xc) if (x(i+1) .gt. x(i)) then && xc=min(x(i+1),max(x(i),xc)) && else && xc=min(x(i),max(x(i+1),xc)) && endif
   !!$      xwind(i)=0.d0
         if (xwind(i) .lt. 0.0d0) then
         LEFTPLUS(rho, rhoplus)
         LEFTMINUS(rho, rhominus)
         LEFTPLUS(velx, velxplus)
         LEFTMINUS(velx, velxminus)
         LEFTPLUS(vely, velyplus)
         LEFTMINUS(vely, velyminus)
         LEFTPLUS(velz, velzplus)
         LEFTMINUS(velz, velzminus)
         if (poly .eq. 0) then
            LEFTPLUS(eps, epsplus)
            LEFTMINUS(eps, epsminus)
         end if
         else
         RIGHTPLUS(rho, rhoplus)
         RIGHTMINUS(rho, rhominus)
         RIGHTPLUS(velx, velxplus)
         RIGHTMINUS(velx, velxminus)
         RIGHTPLUS(vely, velyplus)
         RIGHTMINUS(vely, velyminus)
         RIGHTPLUS(velz, velzplus)
         RIGHTMINUS(velz, velzminus)
         if (poly .eq. 0) then
            RIGHTPLUS(eps, epsplus)
            RIGHTMINUS(eps, epsminus)
         end if
         end if
         CHECK(rho, rhoplus(i))
         CHECK(rho, rhominus(i+1))
         CHECK(velx, velxplus(i))
         CHECK(velx, velxminus(i+1))
         CHECK(vely, velyplus(i))
         CHECK(vely, velyminus(i+1))
         CHECK(velz, velzplus(i))
         CHECK(velz, velzminus(i+1))
         if (poly .eq. 0) then
         CHECK(eps, epsplus(i))
         CHECK(eps, epsminus(i+1))
         end if
   !!$      if ((dir .eq. 1) .and. (ni .eq. 4) .and. (nj .eq. 4)) then
   !!$        write (*,*) rhoplus(i), rhominus(i+1)
   !!$      end if
      end do
      !!$ mppm debug output
      if (ppm_mppm_debug_eigenvalues .gt. 0) then
         if (dir .eq. 1) then
         ev_l(:,ni,nj) = l_ev_l
         ev_r(:,ni,nj) = l_ev_r
         xw(:,ni,nj) = xwind
         else if (dir .eq. 2) then
         ev_l(ni,:,nj) = l_ev_l
         ev_r(ni,:,nj) = l_ev_r
         xw(ni,:,nj) = xwind
         else if (dir .eq. 3) then
         ev_l(ni,nj,:) = l_ev_l
         ev_r(ni,nj,:) = l_ev_r
         xw(ni,nj,:) = xwind
         else
         write (*,*) "flux direction not 1 to 3 ?"
         end if
      end if
   end if
  end if

!!$  Zone flattening. See appendix of C&W, p. 197-8.
  do i = 3, nx - 2
    dpress2 = press(i+2) - press(i-2)
    dvel = vx(i+1) - vx(i-1)
    if ( (abs(dpress(i)) >  ppm_epsilon * min(press(i-1),press(i+1))) .and. &
         (dvel < 0.d0) ) then
      w = 1.d0
    else
      w = 0.d0
    end if
    if (abs(dpress2) < ppm_small) then
      tilde_flatten(i) = 1.d0
    else
      tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * &
           (dpress(i) / dpress2 - ppm_omega1)))
    end if
  end do


   if (.not.apply_enhanced_ppm) then
      ! In 1984 PPM, flattening is applied before constraining parabolic profiles.
      if (PPM3) then !!$ Implement C&W, page 197, but with a workaround which allows to use stencil=3.
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            if (abs(1.d0 - flatten) > 0.d0) then
               trivial_rp(i-1) = .false.
               trivial_rp(i) = .false.
            end if
            rhoplus(i) = flatten * rhoplus(i) + (1.d0 - flatten) * rho(i)
            rhominus(i) = flatten * rhominus(i) + (1.d0 - flatten) * rho(i)
            velxplus(i) = flatten * velxplus(i) + (1.d0 - flatten) * vx(i)
            velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * vx(i)
            velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vy(i)
            velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vy(i)
            velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * vz(i)
            velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * vz(i)
            if (poly .eq. 0) then
               epsplus(i) = flatten * epsplus(i) + (1.d0 - flatten) * eps(i)
               epsminus(i) = flatten * epsminus(i) + (1.d0 - flatten) * eps(i)
            end if
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            if (abs(1.d0 - flatten) > 0.d0) then
               trivial_rp(i-1) = .false.
               trivial_rp(i) = .false.
            end if
            rhoplus(i) = flatten * rhoplus(i) + (1.d0 - flatten) * rho(i)
            rhominus(i) = flatten * rhominus(i) + (1.d0 - flatten) * rho(i)
            velxplus(i) = flatten * velxplus(i) + (1.d0 - flatten) * vx(i)
            velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * vx(i)
            velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vy(i)
            velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vy(i)
            velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * vz(i)
            velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * vz(i)
            if (poly .eq. 0) then
               epsplus(i) = flatten * epsplus(i) + (1.d0 - flatten) * eps(i)
               epsminus(i) = flatten * epsminus(i) + (1.d0 - flatten) * eps(i)
            end if
         end do
      end if
   endif

!!$ Monotonicity. See (1.10) of C&W.
#define MON(xminus,x,xplus)                                       \
    if (.not.( (xplus(i).eq.x(i)) .and. (x(i).eq.xminus(i)) )     \
        .and. ((xplus(i)-x(i))*(x(i)-xminus(i)) .le. 0.d0)) then&&\
      trivial_rp(i-1) = .false.                                 &&\
      trivial_rp(i) = .false.                                   &&\
      xminus(i) = x(i)                                          &&\
      xplus(i) = x(i)                                           &&\
    else if (6.d0 * (xplus(i) - xminus(i)) * (x(i) - 0.5d0 *      \
                (xplus(i) + xminus(i))) >                         \
                (xplus(i) - xminus(i))**2) then                 &&\
      xminus(i) = 3.d0 * x(i) - 2.d0 * xplus(i)                 &&\
      trivial_rp(i-1) = .false.                                 &&\
      trivial_rp(i) = .false.                                   &&\
    else if (6.d0 * (xplus(i) - xminus(i)) * (x(i) - 0.5d0 *      \
                (xplus(i) + xminus(i))) <                         \
               -(xplus(i) - xminus(i))**2) then                 &&\
      xplus(i) = 3.d0 * x(i) - 2.d0 * xminus(i)                 &&\
      trivial_rp(i-1) = .false.                                 &&\
      trivial_rp(i) = .false.                                   &&\
    end if                                                      &&\
    if (.not.( (xplus(i).eq.x(i)) .and. (x(i).eq.xminus(i)) ) ) then     &&\
      trivial_rp(i-1) = .false.                                 &&\
      trivial_rp(i) = .false.                                   &&\
    end if


!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34
!! This requires 4 stencil points.
#define MON_WITH_LOCAL_EXTREMUM_STENCIL4(aminus, a, aplus, C, C3) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC =  (a(i-1) + a(i+1)) - 2.0d0*a(i)                               &&\
         D2aL =  (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                             &&\
         D2aLL = (a(i-3) + a(i-1)) - 2.0d0*a(i-2)                             &&\
         D2aR =  (a(i)   + a(i+2)) - 2.0d0*a(i+1)                             &&\
         D2aRR = (a(i+1) + a(i+3)) - 2.0d0*a(i+2)                             &&\
         D3a = D2aR - D2aC   &&\
         D3aL = D2aC - D2aL  &&\
         D3aR = D2aRR - D2aR &&\
         D3aLL = D2aL - D2aLL &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            D3aMin = min(D3aLL, D3aL, D3a, D3aR)   &&\
            D3aMax = max(D3aLL, D3aL, D3a, D3aR)   &&\
            if (C3 * max(abs(D3aMin), abs(D3aMax)) .le. D3aMax-D3aMin) then &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) + daplus * rhi     &&\
                     aminus(i) = a(i) - daminus * rhi    &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus) &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
                  endif &&\
            endif &&\
         endif &&\
         trivial_rp(i-1) = .false.                                 &&\
         trivial_rp(i) = .false.                                   &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         trivial_rp(i-1) = .false.  &&\
         trivial_rp(i) = .false.    &&\
      endif

!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This contains an additional limiter in case the correction becomes larger than
!! the corrected value. This is to avoid negative values for epsilon.
!! This requires 4 stencil points.
#define MON_WITH_LOCAL_EXTREMUM_STENCIL4_EPS(aminus, a, aplus, C, C3) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC =  (a(i-1) + a(i+1)) - 2.0d0*a(i)                               &&\
         D2aL =  (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                             &&\
         D2aLL = (a(i-3) + a(i-1)) - 2.0d0*a(i-2)                             &&\
         D2aR =  (a(i)   + a(i+2)) - 2.0d0*a(i+1)                             &&\
         D2aRR = (a(i+1) + a(i+3)) - 2.0d0*a(i+2)                             &&\
         D3a = D2aR - D2aC   &&\
         D3aL = D2aC - D2aL  &&\
         D3aR = D2aRR - D2aR &&\
         D3aLL = D2aL - D2aLL &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            D3aMin = min(D3aLL, D3aL, D3a, D3aR)   &&\
            D3aMax = max(D3aLL, D3aL, D3a, D3aR)   &&\
            if (C3 * max(abs(D3aMin), abs(D3aMax)) .le. D3aMax-D3aMin) then &&\
               if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) + daplus * rhi     &&\
                     aminus(i) = a(i) - daminus * rhi    &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)  &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
                  endif &&\
               else &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) &&\
                     aminus(i) = a(i) &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) &&\
                  endif &&\
               endif &&\
            endif &&\
         endif &&\
         trivial_rp(i-1) = .false.                                 &&\
         trivial_rp(i) = .false.                                   &&\
      else                                                         &&\
         if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         else &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i)               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i)               &&\
            end if                                                    &&\
         endif &&\
         trivial_rp(i-1) = .false.  &&\
         trivial_rp(i) = .false.    &&\
      endif



!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This does not use the check for deviations from a cubic. Thus, it gets away with only 3 stencil points!
#define MON_WITH_LOCAL_EXTREMUM(aminus, a, aplus, C) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC = (a(i-1) + a(i+1)) - 2.0d0*a(i)                                &&\
         D2aL = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                              &&\
         D2aR = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                              &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) + daplus * rhi     &&\
                  aminus(i) = a(i) - daminus * rhi    &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
               endif &&\
         endif &&\
         trivial_rp(i-1) = .false.                                 &&\
         trivial_rp(i) = .false.                                   &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         trivial_rp(i-1) = .false.  &&\
         trivial_rp(i) = .false.    &&\
      endif   
      

!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This does not use the check for deviations from a cubic. Thus, it gets away with only 3 stencil points!
!! This contains an additional limiter in case the correction becomes larger than
!! the corrected value. This is to avoid negative values for epsilon.
#define MON_WITH_LOCAL_EXTREMUM_EPS(aminus, a, aplus, C) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  && \
         D2aC = (a(i-1) + a(i+1)) - 2.0d0*a(i)                                &&\
         D2aL = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                              &&\
         D2aR = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                              &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) + daplus * rhi     &&\
                  aminus(i) = a(i) - daminus * rhi    &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
               endif &&\
            else &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) &&\
                  aminus(i) = a(i) &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) &&\
               endif &&\
            endif &&\
         endif &&\
         trivial_rp(i-1) = .false.                                 &&\
         trivial_rp(i) = .false.                                   &&\
      else                                                         &&\
         if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         else &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i)               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i)               &&\
            end if                                                    &&\
         endif &&\
         trivial_rp(i-1) = .false.  &&\
         trivial_rp(i) = .false.    &&\
      endif   


   if (apply_enhanced_ppm) then
      !! Constrain parabolic profiles, PPM 2011/2008
      if (PPM3) then
            do i = 3, nx - 2
                  MON_WITH_LOCAL_EXTREMUM(rhominus,rho,rhoplus, enhanced_ppm_C2)
                  MON_WITH_LOCAL_EXTREMUM(velxminus,vx,velxplus, enhanced_ppm_C2)
                  MON_WITH_LOCAL_EXTREMUM(velyminus,vy,velyplus, enhanced_ppm_C2)
                  MON_WITH_LOCAL_EXTREMUM(velzminus,vz,velzplus, enhanced_ppm_C2)
            end do
            if (poly .eq. 0) then
                  do i = 3, nx - 2
                     MON_WITH_LOCAL_EXTREMUM_EPS(epsminus,eps,epsplus, enhanced_ppm_C2)
                  end do
            end if
            
      else
            do i = 4, nx - 3
                  MON_WITH_LOCAL_EXTREMUM_STENCIL4(rhominus,rho,rhoplus, enhanced_ppm_C2, enhanced_ppm_C3)
                  MON_WITH_LOCAL_EXTREMUM_STENCIL4(velxminus,vx,velxplus, enhanced_ppm_C2, enhanced_ppm_C3)
                  MON_WITH_LOCAL_EXTREMUM_STENCIL4(velyminus,vy,velyplus, enhanced_ppm_C2, enhanced_ppm_C3)
                  MON_WITH_LOCAL_EXTREMUM_STENCIL4(velzminus,vz,velzplus, enhanced_ppm_C2, enhanced_ppm_C3)
            end do
            if (poly .eq. 0) then
                  do i = 4, nx - 3
                     MON_WITH_LOCAL_EXTREMUM_STENCIL4_EPS(epsminus,eps,epsplus, enhanced_ppm_C2, enhanced_ppm_C3)
                  end do
            endif
      end if 
      
      ! Apply flattening after constraining the parabolic profiles
      if (PPM3) then !!$ Implement C&W, page 197, but with a workaround which allows to use stencil=3.
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            if (abs(1.d0 - flatten) > 0.d0) then
               trivial_rp(i-1) = .false.
               trivial_rp(i) = .false.
            end if
            rhoplus(i) = flatten * rhoplus(i) + (1.d0 - flatten) * rho(i)
            rhominus(i) = flatten * rhominus(i) + (1.d0 - flatten) * rho(i)
            velxplus(i) = flatten * velxplus(i) + (1.d0 - flatten) * vx(i)
            velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * vx(i)
            velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vy(i)
            velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vy(i)
            velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * vz(i)
            velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * vz(i)
            if (poly .eq. 0) then
               epsplus(i) = flatten * epsplus(i) + (1.d0 - flatten) * eps(i)
               epsminus(i) = flatten * epsminus(i) + (1.d0 - flatten) * eps(i)
            end if
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            if (abs(1.d0 - flatten) > 0.d0) then
               trivial_rp(i-1) = .false.
               trivial_rp(i) = .false.
            end if
            rhoplus(i) = flatten * rhoplus(i) + (1.d0 - flatten) * rho(i)
            rhominus(i) = flatten * rhominus(i) + (1.d0 - flatten) * rho(i)
            velxplus(i) = flatten * velxplus(i) + (1.d0 - flatten) * vx(i)
            velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * vx(i)
            velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vy(i)
            velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vy(i)
            velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * vz(i)
            velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * vz(i)
            if (poly .eq. 0) then
               epsplus(i) = flatten * epsplus(i) + (1.d0 - flatten) * eps(i)
               epsminus(i) = flatten * epsminus(i) + (1.d0 - flatten) * eps(i)
            end if
         end do
      end if
    
  endif

  if (.not.apply_enhanced_ppm) then
     !! Constrain parabolic profiles, PPM 1984
     do i = GRHydro_stencil, nx - GRHydro_stencil + 1
         ! original Colella&Woodward monotonicity preservation
         MON(rhominus,rho,rhoplus)
         MON(velxminus,vx,velxplus)
         MON(velyminus,vy,velyplus)
         MON(velzminus,vz,velzplus)
     end do
     if (poly .eq. 0) then
         do i = GRHydro_stencil, nx - GRHydro_stencil + 1
            MON(epsminus,eps,epsplus)
         end do
     end if
  endif

  if (check_for_trivial_rp .eq. 0) then
    trivial_rp = .false.
  end if

  !!$ excision
  do i = 1, nx
    if (GRHydro_enable_internal_excision /= 0 .and. &
        (hydro_excision_mask(i) .ne. 0)) then
      if (i .gt. 1) then
        trivial_rp(i-1)=.true.
      end if
      trivial_rp(i)=.true.
    else
      !!$ Do not optimize cond away by combining the 'if's. Fortran does not
      !!$  have to follow the order of sub-expressions given here and might
      !!$  access outside the array range
      cond = .false.
      if (i .gt. 1 .and. GRHydro_enable_internal_excision /= 0) then
        cond = hydro_excision_mask(i-1) .ne. 0
      end if
      if (cond) then
        rhominus(i)=rho(i)
        rhoplus(i)=rho(i)
        velxminus(i)=vx(i)
        velxplus(i)=vx(i)
        velyminus(i)=vy(i)
        velyplus(i)=vy(i)
        velzminus(i)=vz(i)
        velzplus(i)=vz(i)
        rhominus(i-1)=rho(i)
        rhoplus(i-1)=rho(i)
        velxminus(i-1)=vx(i)
        velxplus(i-1)=vx(i)
        velyminus(i-1)=vy(i)
        velyplus(i-1)=vy(i)
        velzminus(i-1)=vz(i)
        velzplus(i-1)=vz(i)
        if (poly .eq. 0) then
          epsminus(i)=eps(i)
          epsplus(i)=eps(i)
          epsminus(i-1)=eps(i)
          epsplus(i-1)=eps(i)
        end if
      else
        cond = .false.
        if ((i.gt.2) .and. (i.lt.nx) .and. GRHydro_enable_internal_excision /= 0) then
          cond = (ppm_mppm .eq. 0) .and. (hydro_excision_mask(i-2) .ne. 0)
        end if
        if (cond) then
          call PPM_TVD(rho(i-1), rho(i), rho(i+1), rhominus(i), rhoplus(i))
          call PPM_TVD(vx(i-1), vx(i), vx(i+1), velxminus(i), velxplus(i))
          call PPM_TVD(vy(i-1), vy(i), vy(i+1), velyminus(i), velyplus(i))
          call PPM_TVD(vz(i-1), vz(i), vz(i+1), velzminus(i), velzplus(i))
          if (poly .eq. 0) then
            call PPM_TVD(eps(i-1), eps(i), eps(i+1), epsminus(i), epsplus(i))
          end if
        end if
      end if
      cond = .false.
      if (i .lt. nx .and. GRHydro_enable_internal_excision /= 0) then
        cond = hydro_excision_mask(i+1) .ne. 0
      end if
      if (cond) then
        rhominus(i)=rho(i)
        rhoplus(i)=rho(i)
        velxminus(i)=vx(i)
        velxplus(i)=vx(i)
        velyminus(i)=vy(i)
        velyplus(i)=vy(i)
        velzminus(i)=vz(i)
        velzplus(i)=vz(i)
        rhominus(i+1)=rho(i)
        rhoplus(i+1)=rho(i)
        velxminus(i+1)=vx(i)
        velxplus(i+1)=vx(i)
        velyminus(i+1)=vy(i)
        velyplus(i+1)=vy(i)
        velzminus(i+1)=vz(i)
        velzplus(i+1)=vz(i)
        if (poly .eq. 0) then
          epsminus(i)=eps(i)
          epsplus(i)=eps(i)
          epsminus(i+1)=eps(i)
          epsplus(i+1)=eps(i)
        endif
      else
        cond = .false.
        if ((i.lt.nx-1) .and. (i.gt.1) .and. GRHydro_enable_internal_excision /= 0) then
          cond = (ppm_mppm .eq. 0) .and. (hydro_excision_mask(i+2) .ne. 0)
        end if
        if (cond) then
          call PPM_TVD(rho(i-1), rho(i), rho(i+1), rhominus(i), rhoplus(i))
          call PPM_TVD(vx(i-1), vx(i), vx(i+1), velxminus(i), velxplus(i))
          call PPM_TVD(vy(i-1), vy(i), vy(i+1), velyminus(i), velyplus(i))
          call PPM_TVD(vz(i-1), vz(i), vz(i+1), velzminus(i), velzplus(i))
          if (poly .eq. 0) then
            call PPM_TVD(eps(i-1), eps(i), eps(i+1), epsminus(i), epsplus(i))
          end if
        end if
      end if
    end if
  end do
  
  !!$ transform back to vel if Wv was used!
  if (reconstruct_Wv.ne.0) then
    do i = grhydro_stencil, nx - grhydro_stencil + 1
      ! divide out the Loretnz factor obtained from w_lorentz =
      ! sqrt(1+g_{ij} w^i w^j) for both the
      ! plus and minus quantities this should by construction ensure
      ! that any Lorentz factor calculated from them later on is
      ! physical (ie. > 1.d0)
      agxx = 0.5d0*( gxx(i) + gxx(i-1) )
      agxy = 0.5d0*( gxy(i) + gxy(i-1) )
      agxz = 0.5d0*( gxz(i) + gxz(i-1) )
      agyy = 0.5d0*( gyy(i) + gyy(i-1) )
      agyz = 0.5d0*( gyz(i) + gyz(i-1) )
      agzz = 0.5d0*( gzz(i) + gzz(i-1) )
      w = sqrt( 1.d0 + agxx*velxminus(i)*velxminus(i) + &
                       agyy*velyminus(i)*velyminus(i) &
              + agzz*velzminus(i)*velzminus(i) + &
                2.d0*agxy*velxminus(i)*velyminus(i) &
              + 2.d0*agxz*velxminus(i)*velzminus(i) + &
                2.d0*agyz*velyminus(i)*velzminus(i) )
      velxminus(i) = velxminus(i)/w
      velyminus(i) = velyminus(i)/w
      velzminus(i) = velzminus(i)/w
      
      agxx = 0.5d0*( gxx(i) + gxx(i+1) )
      agxy = 0.5d0*( gxy(i) + gxy(i+1) )
      agxz = 0.5d0*( gxz(i) + gxz(i+1) )
      agyy = 0.5d0*( gyy(i) + gyy(i+1) )
      agyz = 0.5d0*( gyz(i) + gyz(i+1) )
      agzz = 0.5d0*( gzz(i) + gzz(i+1) )
      w = sqrt( 1.d0 + agxx*velxplus(i)*velxplus(i) + &
                agyy*velyplus(i)*velyplus(i) &
              + agzz*velzplus(i)*velzplus(i) + &
               2.d0*agxy*velxplus(i)*velyplus(i) &
              + 2.d0*agxz*velxplus(i)*velzplus(i) + &
               2.d0*agyz*velyplus(i)*velzplus(i) )
      velxplus(i) = velxplus(i)/w
      velyplus(i) = velyplus(i)/w
      velzplus(i) = velzplus(i)/w
    end do
  end if
  
  
return

end subroutine SimplePPM_1d

!!!! routine for doing PPM to temperature
subroutine SimplePPM_temperature_1d(apply_enhanced_ppm,&     
     nx,dx,velx,temperature,press,&
     tempminus,&
     tempplus, hydro_excision_mask)

  USE GRHydro_Scalars
  USE GRHydro_Eigenproblem

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  logical :: apply_enhanced_ppm 

  CCTK_REAL, parameter :: one = 1.0d0

  CCTK_INT :: nx
  CCTK_REAL :: dx
  CCTK_REAL, dimension(nx) :: temperature, velx
  CCTK_REAL, dimension(nx) :: tempminus
  CCTK_REAL, dimension(nx) :: tempplus

  CCTK_INT :: i,s
  CCTK_REAL, dimension(nx) :: dtemp
  CCTK_REAL, dimension(nx) :: dmtemp
  CCTK_REAL, dimension(nx) :: press,dpress,tilde_flatten
  CCTK_REAL :: dpress2,dvel,w,flatten

  CCTK_INT, dimension(nx) :: hydro_excision_mask


  CCTK_REAL :: D2a, D2aL, D2aR, D2aC, D2aLim, rhi, daplus, daminus, D3a, D3aLL, D3aL, D3aR, D2aLL, D2aRR, D3aMin, D3aMax

  logical :: cond
  
#define STEEP(x,dx,dmx)                                              \
         if ( (x(i+1) - x(i)) * (x(i) - x(i-1)) > 0.d0 ) then           &&\
            dmx(i) = sign(one, dx(i)) *                                   \
               min(abs(dx(i)), 2.d0 * abs(x(i) - x(i-1)),                \
                                 2.d0 * abs(x(i+1) - x(i)))              &&\
         else                                                           &&\
            dmx(i) = 0.d0                                                &&\
         end if


  if (.not.apply_enhanced_ppm) then
      !! This is the original PPM algorithm by Colella & Woodward 1984.

      !!$  Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178
      !!$  This is the expression for an even grid.

     do i = 2, nx - 1
        dpress(i) = press(i+1) - press(i-1)
        ! the denominator is not necessary
        dtemp(i) = 0.5d0 * (temperature(i+1) - temperature(i-1))
     end do

      !!$  Steepened slope. See (1.8) of Colella and Woodward, p.178

     do i = 2, nx - 1
        STEEP(temperature, dtemp, dmtemp)
     enddo
      

!!$  Initial boundary states. See (1.9) of Colella and Woodward, p.178

     do i = 2, nx-2
        tempplus(i) = 0.5d0 * (temperature(i) + temperature(i+1)) + &
             (dmtemp(i) - dmtemp(i+1)) / 6.d0
        tempminus(i+1) = tempplus(i)
     enddo
  else
     !! This is the modified PPM algorithm by Colella & Sekora 2008 and McCorquodale & Colella 2011.
     !! This uses a better limiter based on second derivatives that preserves
     !! accuracy at local extrema. It also uses a higher-order interpolation polynomial.

      !!$  Initial boundary states (sixth order accurate). See (17) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACE_STENCIL4T(a, ah)  \
      ah = 37.0d0/60.0d0*(a(i)+a(i+1)) - 2.0d0/15.0d0*(a(i-1)+a(i+2)) + 1.0d0/60.0d0*(a(i-2)+a(i+3))
      
      !!$  Initial boundary states (4th order accurate). See (16) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACET(a, ah)  \
      ah = 7.0d0/12.0d0*(a(i)+a(i+1)) - 1.0d0/12.0d0*(a(i-1)+a(i+2))
      
#define LIMITT(a,ah,C, alim) \
      if ((min(a(i),a(i+1)) .le. ah) .and. (ah .le. max(a(i),a(i+1)))) then       &&\
         alim = ah   &&\
      else &&\
         D2a  = 3.0d0 * ((a(i)   + a(i+1)) - 2.0d0*ah    )                                     &&\
         D2aL =         ((a(i-1) + a(i+1)) - 2.0d0*a(i)  )                                     &&\
         D2aR =         ((a(i)   + a(i+2)) - 2.0d0*a(i+1))                                     &&\
         D2aLim = sign(one, D2a)*min(C*abs(D2aL), C*abs(D2aR), abs(D2a))/3.0d0             &&\
         if (D2a*D2aR .ge. 0 .and. D2a*D2aL .ge. 0) then                     &&\
            alim = 0.5d0*(a(i)+a(i+1)) - D2aLim &&\
         else                                                                             &&\
            alim = 0.5d0*(a(i)+a(i+1))                                                    &&\
         end if                                                                           &&\
      endif

#define LIMITT_EPS(a,ah,C, alim) \
      if ((min(a(i),a(i+1)) .le. ah) .and. (ah .le. max(a(i),a(i+1)))) then       &&\
         alim = ah   &&\
      else &&\
         D2a  = 3.0d0 * ((a(i)   + a(i+1)) - 2.0d0*ah    )                                     &&\
         D2aL =         ((a(i-1) + a(i+1)) - 2.0d0*a(i)  )                                     &&\
         D2aR =         ((a(i)   + a(i+2)) - 2.0d0*a(i+1))                                     &&\
         D2aLim = sign(one, D2a)*min(C*abs(D2aL), C*abs(D2aR), abs(D2a))/3.0d0             &&\
         if (D2a*D2aR .ge. 0 .and. D2a*D2aL .ge. 0 .and. abs(D2aLim) .lt. abs(0.5d0*(a(i)+a(i+1)))) then                     &&\
            alim = 0.5d0*(a(i)+a(i+1)) - D2aLim &&\
         else                                                                             &&\
            alim = 0.5d0*(a(i)+a(i+1))                                                    &&\
         end if&&\
      endif



      if (PPM3) then
      
      !! We initialize "plus" \equiv a_j+1/2 with (16) via APPROX_AT_CELL_INTERFACE, 
      !! then checking for (13) of Colella & Sekora 2008 and applying
      !! (18) and (19) if (13) is not satisfied. This is done with LIMIT.
         do i = 2, nx-2

            APPROX_AT_CELL_INTERFACET(temperature, tempplus(i))
            LIMITT_EPS(temperature, tempplus(i), enhanced_ppm_C2, tempplus(i))
            tempminus(i+1) = tempplus(i)

         enddo
      
      else

         !! Same as above but for 4 stencil points using (17) of Colella & Sekora 2008 as
         !! initial states.
         do i = 3, nx-3
         
            APPROX_AT_CELL_INTERFACE_STENCIL4T(temperature, tempplus(i))
            LIMITT_EPS(temperature, tempplus(i), enhanced_ppm_C2, tempplus(i))
            tempminus(i+1) = tempplus(i)
            
         enddo
        
      endif

      !! Finally compute pressure gradient needed for flattening and shock detection
      do i = 2, nx-1
         dpress(i) = press(i+1) - press(i-1)
      end do
      
   endif

!!$  Zone flattening. See appendix of C&W, p. 197-8.
  do i = 3, nx - 2
    dpress2 = press(i+2) - press(i-2)
    dvel = velx(i+1) - velx(i-1)
    if ( (abs(dpress(i)) >  ppm_epsilon * min(press(i-1),press(i+1))) .and. &
         (dvel < 0.d0) ) then
      w = 1.d0
    else
      w = 0.d0
    end if
    if (abs(dpress2) < ppm_small) then
      tilde_flatten(i) = 1.d0
    else
      tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * &
           (dpress(i) / dpress2 - ppm_omega1)))
    end if
  end do


   if (.not.apply_enhanced_ppm) then
      ! In 1984 PPM, flattening is applied before constraining parabolic profiles.
      if (PPM3) then !!$ Implement C&W, page 197, but with a workaround which allows to use stencil=3.
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            tempplus(i) = flatten * tempplus(i) + (1.d0 - flatten) * temperature(i)
            tempminus(i) = flatten * tempminus(i) + (1.d0 - flatten) * temperature(i)
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            tempplus(i) = flatten * tempplus(i) + (1.d0 - flatten) * temperature(i)
            tempminus(i) = flatten * tempminus(i) + (1.d0 - flatten) * temperature(i)
         end do
      end if
   endif

!!$ Monotonicity. See (1.10) of C&W.
#define MONT(xminus,x,xplus)                                       \
    if (.not.( (xplus(i).eq.x(i)) .and. (x(i).eq.xminus(i)) )     \
        .and. ((xplus(i)-x(i))*(x(i)-xminus(i)) .le. 0.d0)) then&&\
      xminus(i) = x(i)                                          &&\
      xplus(i) = x(i)                                           &&\
    else if (6.d0 * (xplus(i) - xminus(i)) * (x(i) - 0.5d0 *      \
                (xplus(i) + xminus(i))) >                         \
                (xplus(i) - xminus(i))**2) then                 &&\
      xminus(i) = 3.d0 * x(i) - 2.d0 * xplus(i)                 &&\
    else if (6.d0 * (xplus(i) - xminus(i)) * (x(i) - 0.5d0 *      \
                (xplus(i) + xminus(i))) <                         \
               -(xplus(i) - xminus(i))**2) then                 &&\
      xplus(i) = 3.d0 * x(i) - 2.d0 * xminus(i)                 &&\
    end if                                                      &&\


!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34
!! This requires 4 stencil points.
#define MONT_WITH_LOCAL_EXTREMUM_STENCIL4(aminus, a, aplus, C, C3) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC  = (a(i-1) + a(i+1)) - 2.0d0*a(i)                               &&\
         D2aL  = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                             &&\
         D2aLL = (a(i-3) + a(i-1)) - 2.0d0*a(i-2)                             &&\
         D2aR  = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                             &&\
         D2aRR = (a(i+1) + a(i+3)) - 2.0d0*a(i+2)                             &&\
         D3a = D2aR - D2aC   &&\
         D3aL = D2aC - D2aL  &&\
         D3aR = D2aRR - D2aR &&\
         D3aLL = D2aL - D2aLL &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            D3aMin = min(D3aLL, D3aL, D3a, D3aR)   &&\
            D3aMax = max(D3aLL, D3aL, D3a, D3aR)   &&\
            if (C3 * max(abs(D3aMin), abs(D3aMax)) .le. D3aMax-D3aMin) then &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) + daplus * rhi     &&\
                     aminus(i) = a(i) - daminus * rhi    &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
                  endif &&\
            endif &&\
         endif &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
      endif

!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This contains an additional limiter in case the correction becomes larger than
!! the corrected value. This is to avoid negative values for epsilon.
!! This requires 4 stencil points.
#define MONT_WITH_LOCAL_EXTREMUM_STENCIL4_EPS(aminus, a, aplus, C, C3) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC  = (a(i-1) + a(i+1)) - 2.0d0*a(i)                               &&\
         D2aL  = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                             &&\
         D2aLL = (a(i-3) + a(i-1)) - 2.0d0*a(i-2)                             &&\
         D2aR  = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                             &&\
         D2aRR = (a(i+1) + a(i+3)) - 2.0d0*a(i+2)                             &&\
         D3a = D2aR - D2aC   &&\
         D3aL = D2aC - D2aL  &&\
         D3aR = D2aRR - D2aR &&\
         D3aLL = D2aL - D2aLL &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            D3aMin = min(D3aLL, D3aL, D3a, D3aR)   &&\
            D3aMax = max(D3aLL, D3aL, D3a, D3aR)   &&\
            if (C3 * max(abs(D3aMin), abs(D3aMax)) .le. D3aMax-D3aMin) then &&\
               if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) + daplus * rhi     &&\
                     aminus(i) = a(i) - daminus * rhi    &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
                  endif &&\
               else &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) &&\
                     aminus(i) = a(i) &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) &&\
                  endif &&\
               endif &&\
            endif &&\
         endif &&\
      else                                                         &&\
         if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         else &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i)               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i)               &&\
            end if                                                    &&\
         endif &&\
      endif


!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This does not use the check for deviations from a cubic. Thus, it gets away with only 3 stencil points!
#define MONT_WITH_LOCAL_EXTREMUM(aminus, a, aplus, C) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC = (a(i-1) + a(i+1)) - 2.0d0*a(i)                                &&\
         D2aL = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                              &&\
         D2aR = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                              &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) + daplus * rhi     &&\
                  aminus(i) = a(i) - daminus * rhi    &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
               endif &&\
         endif &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
      endif   
      

!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This does not use the check for deviations from a cubic. Thus, it gets away with only 3 stencil points!
!! This contains an additional limiter in case the correction becomes larger than
!! the corrected value. This is to avoid negative values for epsilon.
#define MONT_WITH_LOCAL_EXTREMUM_EPS(aminus, a, aplus, C) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC = (a(i-1) + a(i+1)) - 2.0d0*a(i)                                &&\
         D2aL = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                              &&\
         D2aR = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                              &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) + daplus * rhi     &&\
                  aminus(i) = a(i) - daminus * rhi    &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
               endif &&\
            else &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) &&\
                  aminus(i) = a(i) &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) &&\
               endif &&\
            endif &&\
         endif &&\
      else                                                         &&\
         if (abs(daplus) .le. abs(a(i)) .and. abs(daminus) .le. abs(a(i))) then &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
         else &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i)               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i)               &&\
            end if                                                    &&\
         endif &&\
      endif   


   if (apply_enhanced_ppm) then
      !! Constrain parabolic profiles, PPM 2011/2008
      if (PPM3) then
            do i = 3, nx - 2
               MONT_WITH_LOCAL_EXTREMUM_EPS(tempminus,temperature,tempplus, enhanced_ppm_C2)
            enddo
      else
            do i = 4, nx - 3
               MONT_WITH_LOCAL_EXTREMUM_STENCIL4_EPS(tempminus,temperature,tempplus, enhanced_ppm_C2, enhanced_ppm_C3)
            enddo
      end if 
      
      ! Apply flattening after constraining the parabolic profiles
      if (PPM3) then !!$ Implement C&W, page 197, but with a workaround which allows to use stencil=3.
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            tempplus(i) = flatten * tempplus(i) + (1.d0 - flatten) * temperature(i)
            tempminus(i) = flatten * tempminus(i) + (1.d0 - flatten) * temperature(i)
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            tempplus(i) = flatten * tempplus(i) + (1.d0 - flatten) * temperature(i)
            tempminus(i) = flatten * tempminus(i) + (1.d0 - flatten) * temperature(i)
         end do
      end if
    
  endif

  if (.not.apply_enhanced_ppm) then
     !! Constrain parabolic profiles, PPM 1984
     do i = GRHydro_stencil, nx - GRHydro_stencil + 1
         ! original Colella&Woodward monotonicity preservation
        MONT(tempminus,temperature,tempplus)
     enddo
  endif

  !!$ excision
  do i = 1, nx
    if (GRHydro_enable_internal_excision /= 0 .and. &
        (hydro_excision_mask(i) .ne. 0)) then
       ! do nothing
    else
      !!$ Do not optimize cond away by combining the 'if's. Fortran does not
      !!$  have to follow the order of sub-expressions given here and might
      !!$  access outside the array range
      cond = .false.
      if (i .gt. 1 .and. GRHydro_enable_internal_excision /= 0) then
        cond = hydro_excision_mask(i-1) .ne. 0
      end if
      if (cond) then
        tempminus(i) = temperature(i)
        tempplus(i) = temperature(i)
        tempminus(i-1) = temperature(i)
        tempplus(i-1) = temperature(i)
      else
        cond = .false.
        if ((i.gt.2) .and. (i.lt.nx) .and. GRHydro_enable_internal_excision /= 0) then
          cond = (ppm_mppm .eq. 0) .and. (hydro_excision_mask(i-2) .ne. 0)
        end if
        if (cond) then
          call PPM_TVD(temperature(i-1), temperature(i), temperature(i+1), tempminus(i), tempplus(i))
        end if
      end if
      cond = .false.
      if (i .lt. nx .and. GRHydro_enable_internal_excision /= 0) then
        cond = hydro_excision_mask(i+1) .ne. 0
      end if
      if (cond) then
        tempminus(i) = temperature(i)
        tempplus(i) = temperature(i)
        tempminus(i-1) = temperature(i)
        tempplus(i-1) = temperature(i)
      else
        cond = .false.
        if ((i.lt.nx-1) .and. (i.gt.1) .and. GRHydro_enable_internal_excision /= 0) then
          cond = (ppm_mppm .eq. 0) .and. (hydro_excision_mask(i+2) .ne. 0)
        end if
        if (cond) then
          call PPM_TVD(temperature(i-1), temperature(i), temperature(i+1), tempminus(i), tempplus(i))
        end if
      end if
    end if
  end do
  
  
  
return

end subroutine SimplePPM_temperature_1d





subroutine SimplePPM_tracer_1d(apply_enhanced_ppm,&
     nx,dx,rho,velx,vely,velz, &
     tracer,tracerminus,tracerplus,press)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  logical :: apply_enhanced_ppm

  CCTK_REAL, parameter :: one = 1

  CCTK_INT :: nx
  CCTK_REAL :: dx
  CCTK_REAL, dimension(nx) :: rho,velx,vely,velz
  CCTK_REAL, dimension(nx,number_of_tracers) :: tracer,tracerminus,tracerplus
  CCTK_REAL :: tracerflatomega


  CCTK_INT :: i,s,itracer
  CCTK_REAL, dimension(nx) :: press,dpress,tilde_flatten
  CCTK_REAL, dimension(nx,number_of_tracers) :: dmtracer, dtracer, tracerflat!, d2tracer
  CCTK_REAL :: dpress2,w,flatten,dvel

!!$  Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178
!!$  This is the expression for an even grid.


  do i = 2, nx - 1
    dpress(i) = press(i+1) - press(i-1)
  end do

  do itracer=1,number_of_tracers
     do i = 2, nx - 1
        dtracer(i,itracer) = 0.5d0 * (tracer(i+1,itracer) - tracer(i-1,itracer))
!        d2tracer(i,itracer) = (tracer(i+1) - 2.d0 * tracer(i) + tracer(i-1))! / 6.d0 / dx / dx
!    ! since we use d2tracer only for the condition d2tracer(i+1)*d2tracer(i-1)<0 
!    ! the denominator is not necessary
     enddo
  enddo

!!$  Steepened slope. See (1.8) of Colella and Woodward, p.178

  do itracer=1,number_of_tracers
     do i = 2, nx - 1
        if( (tracer(i+1,itracer) - tracer(i,itracer)) * &
             (tracer(i,itracer) - tracer(i-1,itracer)) > 0.0d0 ) then
           dmtracer(i,itracer) = sign(one,dtracer(i,itracer)) * &
                min(abs(dtracer(i,itracer)), 2.0d0 * &
                abs(tracer(i,itracer) - tracer(i-1,itracer)), &
                2.0d0 * abs(tracer(i+1,itracer) - tracer(i,itracer)))
        else
           dmtracer(i,itracer) = 0.0d0
        endif
     end do
  enddo

!!$  Initial boundary states. See (1.9) of Colella and Woodward, p.178

    do itracer=1,number_of_tracers
       do i = 2, nx - 2
          tracerplus(i,itracer) = 0.5d0 * (tracer(i,itracer) + tracer(i+1,itracer)) + &
               (dmtracer(i,itracer) - dmtracer(i+1,itracer)) / 6.d0
          tracerminus(i+1,itracer) = tracerplus(i,itracer)
       enddo
    enddo
    

!!$Discontinuity steepening. See (1.14-17) of C&W.
!!$This is the detect routine which mat be activated with the ppm_detect parameter
!!$Note that this part really also depends on the grid being even. 
!!$Note also that we do not have access to the gas constant gamma.
!!$So this is just dropped from eq. (3.2) of C&W.
!!$We can get around this by just rescaling the constant k0 (ppm_k0 here).

!!! We might play around with this for the tracer. CURRENTLY TURNED OFF

#if 0
  if (ppm_detect .eq. 1000) then
     do itracer=1,number_of_tracers
        
        do i = 3, nx - 2
           if ( (dtracer(i+1,itracer)*dtracer(i-1,itracer) > 0.d0) & !make sure this is not an extremum
           .and.(abs(tracer(i+1,itracer)-tracer(i-1,itracer)) - & !this is to prevent steepening
                !of relatively small composition jumps
                ppm_epsilon_shock * min(tracer(i+1,itracer), tracer(i-1,itracer)) > 0.d0 )  & 
                .and. & ! the actual criterion from Plewa & Mueller
                 ((tracer(i+1,itracer)-tracer(i-1,itracer)) / &
                 (tracer(i+2,itracer)-tracer(i-2,itracer)) > ppm_omega1 ) ) then

           etatilde = (tracer(i-2,itracer) - tracer(i+2,itracer) + & 
                4.d0 * dtracer(i,itracer)) / (dtracer(i,itracer) * 12.d0)

           write(*,*) "Additional Steepening in Zone: ",i

        else
           etatilde = 0.d0
        end if
        eta = max(0.d0, min(1.d0, ppm_eta1 * (etatilde - ppm_eta2)))
        if (ppm_k0 * abs(dtracer(i,itracer)) * min(press(i-1),press(i+1)) < &
             abs(dpress(i)) * min(tracer(i-1,itracer), tracer(i+1,itracer))) then
           eta = 0.d0
        end if
        tracerminus(i,itracer) = tracerminus(i,itracer) * (1.d0 - eta) + &
             (tracer(i-1,itracer) + 0.5d0 * dmtracer(i-1,itracer)) * eta
        tracerplus(i,itracer) = tracerplus(i,itracer) * (1.d0 - eta) + &
             (tracer(i+1,itracer) - 0.5d0 * dmtracer(i+1,itracer)) * eta
     end do

  enddo

  end if
#endif

!!$  Zone flattening. See appendix of C&W, p. 197-8.

  do i = 3, nx - 2
    dpress2 = press(i+2) - press(i-2)
    dvel = velx(i+1) - velx(i-1)
    if ( (abs(dpress(i)) >  ppm_epsilon * min(press(i-1),press(i+1))) .and. &
         (dvel < 0.d0) ) then
      w = 1.d0
    else
      w = 0.d0
    end if
    if (abs(dpress2) < ppm_small) then
      tilde_flatten(i) = 1.d0
    else
      tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * &
           (dpress(i) / dpress2 - ppm_omega1)))
    end if
  end do

  if (PPM3) then
     do itracer=1,number_of_tracers
        do i = 3, nx - 2
           flatten = tilde_flatten(i)
           tracerplus(i,itracer) = flatten * tracerplus(i,itracer) & 
                + (1.d0 - flatten) * tracer(i,itracer)
           tracerminus(i,itracer) = flatten * tracerminus(i,itracer) & 
                + (1.d0 - flatten) * tracer(i,itracer)
        end do
     enddo
  else  !!$ Really implement C&W, page 197; which requires stencil 4.
     do itracer=1,number_of_tracers
        do i = 4, nx - 3
           s=int(sign(one, -dpress(i)))
           flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
           tracerplus(i,itracer) = flatten * tracerplus(i,itracer) + &
                (1.d0 - flatten) * tracer(i,itracer)
           tracerminus(i,itracer) = flatten * tracerminus(i,itracer) & 
                + (1.d0 - flatten) * tracer(i,itracer)
        end do
     enddo
  end if


!! Additional flattening a la Plewa & Mueller                                                                 

#if 1
  do itracer=1,number_of_tracers
     do i = 2, nx - 1
        if ( ( tracer(i+1,itracer) - tracer(i,itracer) ) * &
           ( tracer(i,itracer) - tracer(i-1,itracer) ) < 0.0d0 ) then
           tracerflat(i,itracer) = 1.0d0
        else
           tracerflat(i,itracer) = 0.0d0
        endif
     enddo
  enddo

  do itracer=1,number_of_tracers
     do i = 3, nx -2

        tracerflatomega = 0.5d0 * max(tracerflat(i-1,itracer),2.0d0*tracerflat(i,itracer), &
             tracerflat(i+1,itracer)) * ppm_omega_tracer

        tracerplus(i,itracer) = tracerflatomega*tracer(i,itracer) + &
             (1.0d0 - tracerflatomega)*tracerplus(i,itracer)

        tracerminus(i,itracer) = tracerflatomega*tracer(i,itracer) + &
             (1.0d0 - tracerflatomega)*tracerminus(i,itracer)

     enddo
  enddo


#endif

!!$ Monotonicity. See (1.10) of C&W.                                                                          


  do itracer=1,number_of_tracers
     do i = GRHydro_stencil, nx - GRHydro_stencil + 1
        if (((tracerplus(i,itracer)-tracer(i,itracer))*      &
           (tracer(i,itracer)-tracerminus(i,itracer)) .le. 0.d0)) then
           tracerminus(i,itracer) = tracer(i,itracer)
           tracerplus(i,itracer) = tracer(i,itracer)
        else if ((tracerplus(i,itracer) - tracerminus(i,itracer)) * (tracer(i,itracer) - 0.5d0 * &
             (tracerplus(i,itracer) + tracerminus(i,itracer))) > &
           (tracerplus(i,itracer) - tracerminus(i,itracer))**2 / 6.d0) then
           tracerminus(i,itracer) = 3.d0 * tracer(i,itracer) - 2.d0 * tracerplus(i,itracer)
        else if ((tracerplus(i,itracer) - tracerminus(i,itracer)) * (tracer(i,itracer) - 0.5d0 * &
             (tracerplus(i,itracer) + tracerminus(i,itracer))) <  &
           -(tracerplus(i,itracer) - tracerminus(i,itracer))**2 / 6.d0 ) then
           tracerplus(i,itracer) = 3.d0 * tracer(i,itracer) - 2.d0 * tracerminus(i,itracer)
        end if
     end do
  enddo



end subroutine SimplePPM_tracer_1d


subroutine SimplePPM_ye_1d(apply_enhanced_ppm,&
     nx,dx,rho,velx,vely,velz, &
     Y_e,Y_e_minus,Y_e_plus,press)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  logical :: apply_enhanced_ppm

  CCTK_REAL, parameter :: one = 1

  CCTK_INT :: nx
  CCTK_REAL :: dx
  CCTK_REAL, dimension(nx) :: rho,velx,vely,velz
  CCTK_REAL, dimension(nx) :: Y_e,Y_e_minus,Y_e_plus


  CCTK_INT :: i,s
  CCTK_REAL, dimension(nx) :: press,dpress,tilde_flatten
  CCTK_REAL, dimension(nx) :: dmY_e, dY_e
  CCTK_REAL :: dpress2,w,flatten,dvel

  CCTK_REAL :: D2a, D2aL, D2aR, D2aC, D2aLim, rhi, daplus, daminus, D3a, D3aLL, D3aL, D3aR, D2aLL, D2aRR, D3aMin, D3aMax

  do i = 2, nx - 1
       dpress(i) = press(i+1) - press(i-1)
  end do

  
  if (.not.apply_enhanced_PPM) then
  
   !!$  Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178
   !!$  This is the expression for an even grid.


      do i = 2, nx - 1
            dY_e(i) = 0.5d0 * (Y_e(i+1) - Y_e(i-1))
      !        d2Y_e(i,iY_e) = (Y_e(i+1) - 2.d0 * Y_e(i) + Y_e(i-1))! / 6.d0 / dx / dx
      !    ! since we use d2Y_e only for the condition d2Y_e(i+1)*d2Y_e(i-1)<0 
      !    ! the denominator is not necessary
      enddo


      !!$  Steepened slope. See (1.8) of Colella and Woodward, p.178

      do i = 2, nx - 1
         if( (Y_e(i+1) - Y_e(i)) * &
               (Y_e(i) - Y_e(i-1)) > 0.0d0 ) then
            dmY_e(i) = sign(one,dY_e(i)) * &
                  min(abs(dY_e(i)), 2.0d0 * &
                  abs(Y_e(i) - Y_e(i-1)), &
                  2.0d0 * abs(Y_e(i+1) - Y_e(i)))
         else
            dmY_e(i) = 0.0d0
         endif
      end do

      !!$  Initial boundary states. See (1.9) of Colella and Woodward, p.178

      do i = 2, nx - 2
         Y_e_plus(i) = 0.5d0 * (Y_e(i) + Y_e(i+1)) + &
               (dmY_e(i) - dmY_e(i+1)) / 6.d0
         Y_e_minus(i+1) = Y_e_plus(i)
      enddo
   else
!! This is the modified PPM algorithm by Colella & Sekora 2008.
!! This uses a better limiter based on second derivatives that preserves
!! accuracy at local extrema. It also uses a higher-order interpolation polynomial.


      !!$  Initial boundary states (sixth order accurate). See (17) of Colella and Sekora, p.7071
#undef APPROX_AT_CELL_INTERFACE_STENCIL4
!!$  Initial boundary states (sixth order accurate). See (17) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACE_STENCIL4(a, ah)  \
      ah = 37.0d0/60.0d0*(a(i)+a(i+1)) - 2.0d0/15.0d0*(a(i-1)+a(i+2)) + 1.0d0/60.0d0*(a(i-2)+a(i+3))

#undef APPROX_AT_CELL_INTERFACE
      !!$  Initial boundary states (4th order accurate). See (16) of Colella and Sekora 2008, p.7071
#define APPROX_AT_CELL_INTERFACE(a, ah)  \
      ah = 7.0d0/12.0d0*(a(i)+a(i+1)) - 1.0d0/12.0d0*(a(i-1)+a(i+2))


#undef LIMIT
#define LIMIT(a,ah,C, alim) \
      if ((min(a(i),a(i+1)) .le. ah) .and. (ah .le. max(a(i),a(i+1)))) then       &&\
         alim = ah   &&\
      else &&\
         D2a  = 3.0d0 * ((a(i)   + a(i+1)) - 2.0d0*ah    )                   &&\
         D2aL =         ((a(i-1) + a(i+1)) - 2.0d0*a(i)  )                   &&\
         D2aR =         ((a(i)   + a(i+2)) - 2.0d0*a(i+1))                   &&\
         if (D2a*D2aR .ge. 0 .and. D2a*D2aL .ge. 0) then                     &&\
            alim = 0.5d0*(a(i)+a(i+1)) - sign(one, D2a)*min(C*abs(D2aL), C*abs(D2aR), abs(D2a))/3.0d0 &&\
         else                                                                             &&\
            alim = 0.5d0*(a(i)+a(i+1))                                                    &&\
         end if                                                                           &&\
      endif

      if (PPM3) then
         !! We initialize "plus" \equiv a_j+1/2 with (16) via APPROX_AT_CELL_INTERFACE, 
         !! then checking for (13) of Colella & Sekora 2008 and applying
         !! (18) and (19) if (13) is not satisfied. This is done with LIMIT.
         !! There, we also switch to lower order if we are near atmosphere values.
         do i = 2, nx-2
            APPROX_AT_CELL_INTERFACE(Y_e, Y_e_plus(i))
            LIMIT(Y_e, Y_e_plus(i), enhanced_ppm_C2, Y_e_plus(i))
            Y_e_minus(i+1) = Y_e_plus(i)
         end do
         
      else

         !! Same as above but for 4 stencil points using (17) of Colella & Sekora 2008 as
         !! initial states.
         do i = 3, nx-3
            APPROX_AT_CELL_INTERFACE_STENCIL4(Y_e, Y_e_plus(i))
            LIMIT(Y_e, Y_e_plus(i), enhanced_ppm_C2, Y_e_plus(i))
            Y_e_minus(i+1) = Y_e_plus(i)
         end do
      endif
    
   end if



!!$Discontinuity steepening. See (1.14-17) of C&W.
!!$This is the detect routine which mat be activated with the ppm_detect parameter
!!$Note that this part really also depends on the grid being even. 
!!$Note also that we do not have access to the gas constant gamma.
!!$So this is just dropped from eq. (3.2) of C&W.
!!$We can get around this by just rescaling the constant k0 (ppm_k0 here).


!!$  Zone flattening. See appendix of C&W, p. 197-8.

  do i = 3, nx - 2
    dpress2 = press(i+2) - press(i-2)
    dvel = velx(i+1) - velx(i-1)
    if ( (abs(dpress(i)) >  ppm_epsilon * min(press(i-1),press(i+1))) .and. &
         (dvel < 0.d0) ) then
      w = 1.d0
    else
      w = 0.d0
    end if
    if (abs(dpress2) < ppm_small) then
      tilde_flatten(i) = 1.d0
    else
      tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * &
           (dpress(i) / dpress2 - ppm_omega1)))
    end if
  end do

  if (.not.apply_enhanced_ppm) then
      if (PPM3) then
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            Y_e_plus(i) = flatten * Y_e_plus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
            Y_e_minus(i) = flatten * Y_e_minus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            Y_e_plus(i) = flatten * Y_e_plus(i) + &
                  (1.d0 - flatten) * Y_e(i)
            Y_e_minus(i) = flatten * Y_e_minus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
         end do
      end if
  endif
  

#undef MON_WITH_LOCAL_EXTREMUM_STENCIL4
!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34
!! This requires 4 stencil points.
#define MON_WITH_LOCAL_EXTREMUM_STENCIL4(aminus, a, aplus, C, C3) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC  = (a(i-1) + a(i+1)) - 2.0d0*a(i)                               &&\
         D2aL  = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                             &&\
         D2aLL = (a(i-3) + a(i-1)) - 2.0d0*a(i-2)                             &&\
         D2aR  = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                             &&\
         D2aRR = (a(i+1) + a(i+3)) - 2.0d0*a(i+2)                             &&\
         D3a = D2aR - D2aC   &&\
         D3aL = D2aC - D2aL  &&\
         D3aR = D2aRR - D2aR &&\
         D3aLL = D2aL - D2aLL &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
            D3aMin = min(D3aLL, D3aL, D3a, D3aR)   &&\
            D3aMax = max(D3aLL, D3aL, D3a, D3aR)   &&\
            if (C3 * max(abs(D3aMin), abs(D3aMax)) .le. D3aMax-D3aMin) then &&\
                  if (daplus*daminus .lt. 0) then        &&\
                     aplus(i)  = a(i) + daplus * rhi     &&\
                     aminus(i) = a(i) - daminus * rhi    &&\
                  else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                     aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
                  else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                     aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
                  endif &&\
            endif &&\
         endif &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) + 2.0d0*daminus               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*daplus               &&\
            end if                                                    &&\
      endif
            




#undef MON_WITH_LOCAL_EXTREMUM
!! Monotonicity of PPM 2011 (McCorquodale & Colella 2011), Sec. 2.4.1, Eq. 23-34.
!! This does not use the check for deviations from a cubic. Thus, it gets away with only 3 stencil points!
#define MON_WITH_LOCAL_EXTREMUM(aminus, a, aplus, C) \
      daplus = aplus(i)-a(i)   &&\
      daminus = a(i)-aminus(i) &&\
      if (daplus*daminus .le. 0 .or. (a(i-2)-a(i))*(a(i)-a(i+2)) .le. 0) then &&\
         D2a  = - (12.0d0*a(i) - 6.0d0*(aminus(i)+aplus(i)))                  &&\
         D2aC = (a(i-1) + a(i+1)) - 2.0d0*a(i)                                &&\
         D2aL = (a(i-2) + a(i)  ) - 2.0d0*a(i-1)                              &&\
         D2aR = (a(i)   + a(i+2)) - 2.0d0*a(i+1)                              &&\
         if (sign(one, D2a) .eq. sign(one, D2aC) .and. sign(one, D2a) .eq. sign(one, D2aL) .and. sign(one, D2a) .eq. sign(one, D2aR)) then &&\
            D2aLim = sign(one, D2a) * min(C*abs(D2aL), C*abs(D2aR), C*abs(D2aC), abs(D2a))  &&\
         else                                                      &&\
            D2aLim = 0  &&\
         end if                                                    &&\
         if (abs(D2a) .le. 1.d-12*max(abs(a(i-2)), abs(a(i-1)), abs(a(i)), abs(a(i+1)), abs(a(i+2)))) then  &&\
            rhi = 0  &&\
         else        &&\
            rhi = D2aLim / D2a   &&\
         endif  &&\
         if (.not. (rhi .ge. 1.0d0 - 1.d-12)) then   &&\
               if (daplus*daminus .lt. 0) then        &&\
                  aplus(i)  = a(i) + daplus * rhi     &&\
                  aminus(i) = a(i) - daminus * rhi    &&\
               else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then   &&\
                  aminus(i)  = a(i) - (2.0d0*(1.0d0-rhi)*daplus + rhi*daminus)   &&\
               else if (abs(daplus) .ge. 2.0d0*abs(daminus)) then &&\
                  aplus(i)  = a(i) + (2.0d0*(1.0d0-rhi)*daminus + rhi*daplus)   &&\
               endif &&\
         endif      &&\
      else                                                         &&\
            if (abs(daplus) .ge. 2.0d0*abs(daminus)) then     &&\
               aplus(i) = a(i) - 2.0d0*(aminus(i) - a(i))               &&\
            else if (abs(daminus) .ge. 2.0d0*abs(daplus)) then &&\
               aminus(i) = a(i) - 2.0d0*(aplus(i) - a(i))               &&\
            end if  &&\
      endif





  if (apply_enhanced_ppm) then
      ! Constrain parabolic profiles
      if (PPM3) then
         do i = GRHydro_stencil, nx - GRHydro_stencil + 1
               MON_WITH_LOCAL_EXTREMUM(Y_e_minus,Y_e,Y_e_plus, enhanced_ppm_C2)
         end do
      else
         do i = GRHydro_stencil, nx - GRHydro_stencil + 1
               MON_WITH_LOCAL_EXTREMUM_STENCIL4(Y_e_minus,Y_e,Y_e_plus, enhanced_ppm_C2, enhanced_ppm_C3)
         end do
      endif
      
      ! In PPM 2011/2008, flattening is applied after constraining parabolic profiles.
      if (PPM3) then
         do i = 3, nx - 2
            flatten = tilde_flatten(i)
            Y_e_plus(i) = flatten * Y_e_plus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
            Y_e_minus(i) = flatten * Y_e_minus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
         end do
      else  !!$ Really implement C&W, page 197; which requires stencil 4.
         do i = 4, nx - 3
            s=int(sign(one, -dpress(i)))
            flatten = max(tilde_flatten(i), tilde_flatten(i+s))  
            Y_e_plus(i) = flatten * Y_e_plus(i) + &
                  (1.d0 - flatten) * Y_e(i)
            Y_e_minus(i) = flatten * Y_e_minus(i) & 
                  + (1.d0 - flatten) * Y_e(i)
         end do
      end if
      
  else
      !!$ Monotonicity. See (1.10) of C&W.
      do i = GRHydro_stencil, nx - GRHydro_stencil + 1
         if (((Y_e_plus(i)-Y_e(i))*      &
               (Y_e(i)-Y_e_minus(i)) .le. 0.d0)) then
            Y_e_minus(i) = Y_e(i)
            Y_e_plus(i) = Y_e(i)
         else if ((Y_e_plus(i) - Y_e_minus(i)) * (Y_e(i) - 0.5d0 * &
               (Y_e_plus(i) + Y_e_minus(i))) > &
               (Y_e_plus(i) - Y_e_minus(i))**2 / 6.d0) then
            Y_e_minus(i) = 3.d0 * Y_e(i) - 2.0d0 * Y_e_plus(i)
         else if ((Y_e_plus(i) - Y_e_minus(i)) * (Y_e(i) - 0.5d0 * &
               (Y_e_plus(i) + Y_e_minus(i))) <  &
               -(Y_e_plus(i) - Y_e_minus(i))**2 / 6.0d0 ) then
            Y_e_plus(i) = 3.d0 * Y_e(i) - 2.d0 * Y_e_minus(i)
         end if
      end do
  end if


end subroutine SimplePPM_ye_1d