Task: Implement GRHydro_EigenproblemM.F90 for EinsteinEvolve/GRHydro thorn

thorn_name: EinsteinEvolve/GRHydro
src_filename: GRHydro_EigenproblemM.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_Eigenproblem.F90:
```
 /*@@
   @file      GRHydro_Eigenproblem.F90
   @date      Sat Jan 26 01:25:44 2002
   @author    Ian Hawke, Pedro Montero, Joachim Frieben
   @desc
   Computes the spectral decomposition of a given state.
   Implements the analytical scheme devised by J. M. Ibanez
   et al., "Godunov Methods: Theory and Applications", New
   York, 2001, 485-503. The optimized method for computing
   the Roe flux in the special relativistic case is due to
   M. A. Aloy et al., Comput. Phys. Commun. 120 (1999)
   115-121, and has been extended to the general relativistic
   case as employed in this subroutine by J. Frieben, J. M.
   Ibanez, and J. Pons (in preparation).
   @enddesc
 @@*/

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

module GRHydro_Eigenproblem
  implicit none


 /*@@
   @routine    eigenvalues
   @date       Sat Jan 26 01:26:20 2002
   @author     Ian Hawke
   @desc
   Computes the eigenvalues of the Jacobian matrix evaluated
   at the given state.
   @enddesc
   @calls
   @calledby
   @history
   Culled from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

CONTAINS

subroutine eigenvalues(handle,rho,velx,vely,velz,eps, &
     w_lorentz,lam,gxx,gxy,gxz,gyy,gyz,gzz,u,alp,beta)
  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL lam(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL alp,beta,u

  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_INT handle
  CCTK_REAL dpdrho,dpdeps,press
  character*256 :: warnline

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities

!  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
!       rho,eps,xtemp,xye,cs2,keyerr,anyerr)
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdeps,keyerr,anyerr)

  call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdrho,keyerr,anyerr)

  cs2 = (dpdrho + press * dpdeps / (rho**2))/ &
       (1.0d0 + eps + press/rho)

  if(cs2.lt.0.0d0) then
     if (abs(cs2) .gt. 1.0d-4) then
       !$OMP CRITICAL
        write(warnline,'(a60,6g16.7)') 'abs(cs2), rho, dpdrho, press*dpdeps/rho**2, eps, press/rho: ', abs(cs2), rho, dpdrho, press * dpdeps / (rho**2), eps, press/rho
        call CCTK_WARN(1,warnline)
        call CCTK_WARN(1,"cs2 < 0! Check speed of sound calculation!")
        !$OMP END CRITICAL
        cs2 = 0.0d0
     else
        cs2 = 0.0d0
     endif
  endif


  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = w_lorentz

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp


end subroutine eigenvalues


subroutine eigenvalues_hot(handle,keytemp,ii,jj,kk,rho,velx,vely,velz,eps, &
     temp,ye,w_lorentz,lam,gxx,gxy,gxz,gyy,gyz,gzz,u,alp,beta)
  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL lam(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL alp,beta,u
  CCTK_REAL temp,ye

  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_INT handle,ii,jj,kk

  character(len=512) :: warnline

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

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities
  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,temp,ye,cs2,keyerr,anyerr)
  if(anyerr.ne.0) then
     !$OMP CRITICAL
     call CCTK_WARN(1,"EOS ERROR in eigenvalues_hot")
     write(warnline,"(A10,i5,A10,i5)") "keyerr: ", keyerr, "keytemp: ",keytemp
     call CCTK_WARN(1,warnline)
     write(warnline,"(1P10E15.6)") rho,eps,temp,ye,cs2
     call CCTK_ERROR(warnline)
     STOP
     !$OMP END CRITICAL
  endif

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = w_lorentz

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp


end subroutine eigenvalues_hot

 /*@@
   @routine    eigenproblem
   @date       Sat Jan 26 01:27:59 2002
   @author     Ian Hawke, Pedro Montero, Joachim Frieben
   @desc
   Despite the name this routine currently actually returns the
   Roe flux given the input Roe average state.
   @enddesc
   @calls
   @calledby
   @history
   Culled and altered from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

subroutine eigenproblem(handle,rho,velx,vely,velz,eps,&
     w_lorentz,gxx,gxy,gxz,gyy,gyz,gzz,u,&
     alp,beta,qdiff1,qdiff2,qdiff3,qdiff4,qdiff5,&
     roeflux1,roeflux2,roeflux3,roeflux4,roeflux5)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL lam(5),p(5,5),q(5,5),dw(5),rflux(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz,u
  CCTK_REAL alp,beta,roeflux1,roeflux2,roeflux3,roeflux4,roeflux5

  CCTK_REAL du(5),aa(5,5),qdiff1,qdiff2,qdiff3,qdiff4,qdiff5

  integer i,j
  CCTK_REAL paug(5,6),tmp1,tmp2,sump,summ,f_du(5)
  integer ii,jj,kk
  CCTK_REAL leivec1(5),leivec2(5),leivec3(5),leivecp(5),leivecm(5)
  CCTK_REAL reivec1(5),reivec2(5),reivec3(5),reivecp(5),reivecm(5)
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL press,dpdrho,dpdeps,enthalpy,kappa
  CCTK_REAL axp,axm,vxp,vxm,cxx,cxy,cxz,gam,xsi,dlt,vxa,vxb
  CCTK_INT handle

!!$  Warning, warning. Nasty hack follows

! 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


  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdeps,keyerr,anyerr)

  call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdrho,keyerr,anyerr)

  cs2 = (dpdrho + press * dpdeps / (rho**2))/ &
       (1.0d0 + eps + press/rho)
!  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
!       rho,eps,xtemp,xye,cs2,keyerr,anyerr)

!  if (cs2<0) cs2=0 ! this does not modify the roe crashing problem with shocktube
  enthalpy = one + eps + press / rho

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = w_lorentz

!!$Calculate eigenvalues and put them in conventional order

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp

  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

!!$  lam(1) = lamm
!!$  lam(2) = lam1
!!$  lam(3) = lam2
!!$  lam(4) = lam3
!!$  lam(5) = lamp

  lam(1) = lamm
  lam(5) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(2) = lamp

!!$Compute some auxiliary quantities

  axp = (u - velx*velx)/(u - velx*lamp_nobeta)
  axm = (u - velx*velx)/(u - velx*lamm_nobeta)
  vxp = (velx - lamp_nobeta)/(u - velx * lamp_nobeta)
  vxm = (velx - lamm_nobeta)/(u - velx * lamm_nobeta)

!!$Calculate associated right eigenvectors

  kappa = dpdeps / (dpdeps - rho * cs2)

  reivec1(1) = kappa / (enthalpy * w)
  reivec1(2) = vlowx
  reivec1(3) = vlowy
  reivec1(4) = vlowz
  reivec1(5) = one - reivec1(1)

  reivec2(1) = w * vlowy
  reivec2(2) = enthalpy * (gxy + two * w * w * vlowx * vlowy)
  reivec2(3) = enthalpy * (gyy + two * w * w * vlowy * vlowy)
  reivec2(4) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec2(5) = vlowy * w * (two * w * enthalpy - one)

  reivec3(1) = w * vlowz
  reivec3(2) = enthalpy * (gxz + two * w * w * vlowx * vlowz)
  reivec3(3) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec3(4) = enthalpy * (gzz + two * w * w * vlowz * vlowz)
  reivec3(5) = vlowz * w * (two * w * enthalpy - one)

  reivecp(1) = one
  reivecp(2) = enthalpy * w * (vlowx - vxp)
  reivecp(3) = enthalpy * w * vlowy
  reivecp(4) = enthalpy * w * vlowz
  reivecp(5) = enthalpy * w * axp - one

  reivecm(1) = one
  reivecm(2) = enthalpy * w * (vlowx - vxm)
  reivecm(3) = enthalpy * w * vlowy
  reivecm(4) = enthalpy * w * vlowz
  reivecm(5) = enthalpy * w * axm - one

!!$Calculate associated left eigenvectors if requested

  if (ANALYTICAL) then

    cxx = gyy * gzz - gyz * gyz
    cxy = gxz * gyz - gxy * gzz
    cxz = gxy * gyz - gxz * gyy
    gam = gxx * cxx + gxy * cxy + gxz * cxz
    xsi = cxx - gam * velx * velx
    dlt = enthalpy**3 * w * (kappa - one) * (vxm - vxp) * xsi

    tmp1 = w / (kappa - one)

    leivec1(1) = tmp1 * (enthalpy - w)
    leivec1(2) = tmp1 * w * velx
    leivec1(3) = tmp1 * w * vely
    leivec1(4) = tmp1 * w * velz
    leivec1(5) =-tmp1 * w

    tmp1 = one / (xsi * enthalpy)

    leivec2(1) = (gyz * vlowz - gzz * vlowy) * tmp1
    leivec2(2) = (gzz * vlowy - gyz * vlowz) * tmp1 * velx
    leivec2(3) = (gzz * (one - velx * vlowx) + gxz * vlowz * velx) * tmp1
    leivec2(4) = (gyz * (velx * vlowx - one) - gxz * velx * vlowy) * tmp1
    leivec2(5) = (gyz * vlowz - gzz * vlowy) * tmp1

    leivec3(1) = (gyz * vlowy - gyy * vlowz) * tmp1
    leivec3(2) = (gyy * vlowz - gyz * vlowy) * tmp1 * velx
    leivec3(3) = (gyz * (velx * vlowx - one) - gxy * velx * vlowz) * tmp1
    leivec3(4) = (gyy * (one - velx * vlowx) + gxy * velx * vlowy) * tmp1
    leivec3(5) = (gyz * vlowy - gyy * vlowz) * tmp1

    tmp1 = enthalpy * enthalpy / dlt
    tmp2 = w * w * xsi

    leivecp(1) = - (enthalpy * w * vxm * xsi + (one - kappa) * (vxm * &
      (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxm) * tmp1
    leivecp(2) = - (cxx * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * velx - cxx * velx)) * tmp1
    leivecp(3) = - (cxy * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * vely - cxy * velx)) * tmp1
    leivecp(4) = - (cxz * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * velz - cxz * velx)) * tmp1
    leivecp(5) = - ((one - kappa) * (vxm * (tmp2 - cxx) - gam * velx) - &
      kappa * tmp2 * vxm) * tmp1

    leivecm(1) = (enthalpy * w * vxp * xsi + (one - kappa) * (vxp * &
      (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxp) * tmp1
    leivecm(2) = (cxx * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * velx - cxx * velx)) * tmp1
    leivecm(3) = (cxy * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * vely - cxy * velx)) * tmp1
    leivecm(4) = (cxz * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * velz - cxz * velx)) * tmp1
    leivecm(5) = ((one - kappa) * (vxp * (tmp2 - cxx) - gam * velx) - &
      kappa * tmp2 * vxp) * tmp1

  endif

  du(1) = qdiff1
  du(2) = qdiff2
  du(3) = qdiff3
  du(4) = qdiff4
  du(5) = qdiff5

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (abs(lamp) - abs(lam1)) * leivecp(i) * du(i)
         summ = summ + (abs(lamm) - abs(lam1)) * leivecm(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxp + summ * vxm)

      rflux(1) = abs(lam1) * du(1) + vxa
      rflux(2) = abs(lam1) * du(2) + enthalpy * w * (vlowx * vxa + vxb)
      rflux(3) = abs(lam1) * du(3) + enthalpy * w * (vlowy * vxa)
      rflux(4) = abs(lam1) * du(4) + enthalpy * w * (vlowz * vxa)
      rflux(5) = abs(lam1) * du(5) + enthalpy * w * (velx  * vxb + vxa) - vxa


    else

!!$Form Jacobian matrix in characteristic form from right eigenvectors.
!!$Invert to get the characteristic jumps given the conserved variable
!!$jumps

!!$  p(:,1) = reivecm(:)
!!$  p(:,2) = reivec1(:)
!!$  p(:,3) = reivec2(:)
!!$  p(:,4) = reivec3(:)
!!$  p(:,5) = reivecp(:)
!!$
!!$  write(*,*) p
!!$  stop

      p(:,1) = reivecm(:)
      p(:,2) = reivecp(:)
      p(:,3) = reivec2(:)
      p(:,4) = reivec3(:)
      p(:,5) = reivec1(:)

      q(1,:) = leivecm(:)
      q(2,:) = leivecp(:)
      q(3,:) = leivec2(:)
      q(4,:) = leivec3(:)
      q(5,:) = leivec1(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

!!$Calculate the Roe flux from the standard formula

      do i = 1, 5
        rflux(i) = 0.d0
        do j = 1, 5
          rflux(i) = rflux(i) + p(i,j) * abs(lam(j)) * dw(j)
        end do
      end do
    endif

  else

    p(:,1) = reivecm(:)
    p(:,2) = reivecp(:)
    p(:,3) = reivec2(:)
    p(:,4) = reivec3(:)
    p(:,5) = reivec1(:)

    do i=1,5
      dw(i) = du(i)
      do j=1,5
        aa(i,j) = p(i,j)
      end do
    enddo

    do ii=1,5
      paug(ii,1) = p(ii,1)
      paug(ii,2) = p(ii,2)
      paug(ii,3) = p(ii,3)
      paug(ii,4) = p(ii,4)
      paug(ii,5) = p(ii,5)
    enddo

    paug(1, 6) = du(1)
    paug(2, 6) = du(2)
    paug(3, 6) = du(3)
    paug(4, 6) = du(4)
    paug(5, 6) = du(5)

    do ii=1,5
      tmp1 = paug(ii,ii)
      do jj=ii,6
        paug(ii,jj) = paug(ii,jj)/tmp1
      enddo

      do jj=ii+1,5
        tmp1 = - (paug(jj,ii))
        do kk=ii,6
          paug(jj,kk) = paug(jj,kk) + tmp1*paug(ii,kk)
        enddo
      enddo

    enddo

    f_du(5) = paug(5,6)

    do ii=4,1,-1
      f_du(ii) = paug(ii,6)
      do jj=ii+1,5
        f_du(ii) = f_du(ii) - paug(ii,jj)*f_du(jj)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)

!!$  dw(1) = f_du(1)
!!$  dw(2) = f_du(5)
!!$  dw(3) = f_du(3)
!!$  dw(4) = f_du(4)
!!$  dw(5) = f_du(2)

!!$Calculate the Roe flux from the standard formula

    do i = 1, 5
      rflux(i) = 0.d0
      do j = 1, 5
        rflux(i) = rflux(i) + p(i,j) * abs(lam(j)) * dw(j)
      end do
    end do

  endif

  roeflux1 = rflux(1)
  roeflux2 = rflux(2)
  roeflux3 = rflux(3)
  roeflux4 = rflux(4)
  roeflux5 = rflux(5)

  if(roeflux1.ne.roeflux1) then
     call CCTK_ERROR("Found NaNs in roeflux1, aborting")
     STOP
  endif

end subroutine eigenproblem

 /*@@
   @routine    eigenproblem_leftright
   @date       Sat Jan 26 01:27:59 2002
   @author     Ian Hawke, Pedro Montero, Joachim Frieben
   @desc
   Returns the left and right eigenvectors.
   @enddesc
   @calls
   @calledby
   @history

   @endhistory

@@*/

subroutine eigenproblem_leftright(handle,rho,velx,vely,velz,eps,&
     w_lorentz,gxx,gxy,gxz,gyy,gyz,gzz,u,&
     alp,beta,lambda,levec,revec)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL lambda(5),levec(5,5),revec(5,5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz,u
  CCTK_REAL alp,beta

  CCTK_REAL tmp1,tmp2
  CCTK_REAL leivec1(5),leivec2(5),leivec3(5),leivecp(5),leivecm(5)
  CCTK_REAL reivec1(5),reivec2(5),reivec3(5),reivecp(5),reivecm(5)
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL press,dpdeps,enthalpy,kappa
  CCTK_REAL axp,axm,vxp,vxm,cxx,cxy,cxz,gam,xsi,dlt
  CCTK_INT handle

! 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

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,press,keyerr,anyerr)

  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,cs2,keyerr,anyerr)

  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdeps,keyerr,anyerr)

!  if (cs2<0) cs2=0 ! this does not modify the roe crashing problem with shocktube
  enthalpy = one + eps + press / rho

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = w_lorentz

!!$Calculate eigenvalues and put them in conventional order

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp

  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

!!$  lam(1) = lamm
!!$  lam(2) = lam1
!!$  lam(3) = lam2
!!$  lam(4) = lam3
!!$  lam(5) = lamp

  lambda(1) = lamm
  lambda(2) = lam1
  lambda(3) = lam2
  lambda(4) = lam3
  lambda(5) = lamp

!!$Compute some auxiliary quantities

  axp = (u - velx*velx)/(u - velx*lamp_nobeta)
  axm = (u - velx*velx)/(u - velx*lamm_nobeta)
  vxp = (velx - lamp_nobeta)/(u - velx * lamp_nobeta)
  vxm = (velx - lamm_nobeta)/(u - velx * lamm_nobeta)

!!$Calculate associated right eigenvectors

  kappa = dpdeps / (dpdeps - rho * cs2)

  reivec1(1) = kappa / (enthalpy * w)
  reivec1(2) = vlowx
  reivec1(3) = vlowy
  reivec1(4) = vlowz
  reivec1(5) = one - reivec1(1)

  reivec2(1) = w * vlowy
  reivec2(2) = enthalpy * (gxy + two * w * w * vlowx * vlowy)
  reivec2(3) = enthalpy * (gyy + two * w * w * vlowy * vlowy)
  reivec2(4) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec2(5) = vlowy * w * (two * w * enthalpy - one)

  reivec3(1) = w * vlowz
  reivec3(2) = enthalpy * (gxz + two * w * w * vlowx * vlowz)
  reivec3(3) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec3(4) = enthalpy * (gzz + two * w * w * vlowz * vlowz)
  reivec3(5) = vlowz * w * (two * w * enthalpy - one)

  reivecp(1) = one
  reivecp(2) = enthalpy * w * (vlowx - vxp)
  reivecp(3) = enthalpy * w * vlowy
  reivecp(4) = enthalpy * w * vlowz
  reivecp(5) = enthalpy * w * axp - one

  reivecm(1) = one
  reivecm(2) = enthalpy * w * (vlowx - vxm)
  reivecm(3) = enthalpy * w * vlowy
  reivecm(4) = enthalpy * w * vlowz
  reivecm(5) = enthalpy * w * axm - one

  revec(1,:) = reivecm
  revec(2,:) = reivec1
  revec(3,:) = reivec2
  revec(4,:) = reivec3
  revec(5,:) = reivecp

!!$Calculate associated left eigenvectors if requested

  cxx = gyy * gzz - gyz * gyz
  cxy = gxz * gyz - gxy * gzz
  cxz = gxy * gyz - gxz * gyy
  gam = gxx * cxx + gxy * cxy + gxz * cxz
  xsi = cxx - gam * velx * velx
  dlt = enthalpy**3 * w * (kappa - one) * (vxm - vxp) * xsi
  
  tmp1 = w / (kappa - one)
  
  leivec1(1) = tmp1 * (enthalpy - w)
  leivec1(2) = tmp1 * w * velx
  leivec1(3) = tmp1 * w * vely
  leivec1(4) = tmp1 * w * velz
  leivec1(5) =-tmp1 * w
  
  tmp1 = one / (xsi * enthalpy)
  
  leivec2(1) = (gyz * vlowz - gzz * vlowy) * tmp1
  leivec2(2) = (gzz * vlowy - gyz * vlowz) * tmp1 * velx
  leivec2(3) = (gzz * (one - velx * vlowx) + gxz * vlowz * velx) * tmp1
  leivec2(4) = (gyz * (velx * vlowx - one) - gxz * velx * vlowy) * tmp1
  leivec2(5) = (gyz * vlowz - gzz * vlowy) * tmp1
  
  leivec3(1) = (gyz * vlowy - gyy * vlowz) * tmp1
  leivec3(2) = (gyy * vlowz - gyz * vlowy) * tmp1 * velx
  leivec3(3) = (gyz * (velx * vlowx - one) - gxy * velx * vlowz) * tmp1
  leivec3(4) = (gyy * (one - velx * vlowx) + gxy * velx * vlowy) * tmp1
  leivec3(5) = (gyz * vlowy - gyy * vlowz) * tmp1
  
  tmp1 = enthalpy * enthalpy / dlt
  tmp2 = w * w * xsi
  
  leivecp(1) = - (enthalpy * w * vxm * xsi + (one - kappa) * (vxm * &
       (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxm) * tmp1
  leivecp(2) = - (cxx * (one - kappa * axm) + (two * kappa - one) * vxm * &
       (tmp2 * velx - cxx * velx)) * tmp1
  leivecp(3) = - (cxy * (one - kappa * axm) + (two * kappa - one) * vxm * &
       (tmp2 * vely - cxy * velx)) * tmp1
  leivecp(4) = - (cxz * (one - kappa * axm) + (two * kappa - one) * vxm * &
       (tmp2 * velz - cxz * velx)) * tmp1
  leivecp(5) = - ((one - kappa) * (vxm * (tmp2 - cxx) - gam * velx) - &
       kappa * tmp2 * vxm) * tmp1
  
  leivecm(1) = (enthalpy * w * vxp * xsi + (one - kappa) * (vxp * &
       (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxp) * tmp1
  leivecm(2) = (cxx * (one - kappa * axp) + (two * kappa - one) * vxp * &
       (tmp2 * velx - cxx * velx)) * tmp1
  leivecm(3) = (cxy * (one - kappa * axp) + (two * kappa - one) * vxp * &
       (tmp2 * vely - cxy * velx)) * tmp1
  leivecm(4) = (cxz * (one - kappa * axp) + (two * kappa - one) * vxp * &
       (tmp2 * velz - cxz * velx)) * tmp1
  leivecm(5) = ((one - kappa) * (vxp * (tmp2 - cxx) - gam * velx) - &
       kappa * tmp2 * vxp) * tmp1

  levec(1,:) = leivecm
  levec(2,:) = leivec1
  levec(3,:) = leivec2
  levec(4,:) = leivec3
  levec(5,:) = leivecp

end subroutine eigenproblem_leftright

 /*@@
   @routine    eigenvalues
   @date       Sat Jan 26 01:26:20 2002
   @author     Ian Hawke
   @desc
   Computes the eigenvalues of the Jacobian matrix evaluated
   at the given state.
   @enddesc
   @calls
   @calledby
   @history
   Culled from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

subroutine eigenvalues_general(&
     velx,vely,velz,cs2,&
     lam,&
     gxx,gxy,gxz,gyy,gyz,gzz,&
     u,alp,beta)

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL velx,vely,velz
  CCTK_REAL lam(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL alp,beta,u

  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = one / sqrt(one - v2)

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp

end subroutine eigenvalues_general

 /*@@
   @routine    eigenproblem_general
   @date       Sat Jan 26 01:27:59 2002
   @author     Ian Hawke, Pedro Montero, Joachim Frieben
   @desc
   Despite the name this routine currently actually returns the
   Roe flux given the input Roe average state.
   @enddesc
   @calls
   @calledby
   @history
   Culled and altered from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

subroutine eigenproblem_general(&
     rho,velx,vely,velz,eps,&
     press,cs2,dpdeps,&
     gxx,gxy,gxz,gyy,gyz,gzz,&
     u,alp,beta,&
     qdiff1,qdiff2,qdiff3,qdiff4,qdiff5,&
     roeflux1,roeflux2,roeflux3,roeflux4,roeflux5)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rho,velx,vely,velz,eps
  CCTK_REAL lam(5),p(5,5),q(5,5),dw(5),rflux(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz,u
  CCTK_REAL alp,beta,roeflux1,roeflux2,roeflux3,roeflux4,roeflux5

  CCTK_REAL du(5),aa(5,5),qdiff1,qdiff2,qdiff3,qdiff4,qdiff5

  integer i,j
  CCTK_REAL paug(5,6),tmp1,tmp2,sump,summ,f_du(5)
  integer ii,jj,kk
  CCTK_REAL leivec1(5),leivec2(5),leivec3(5),leivecp(5),leivecm(5)
  CCTK_REAL reivec1(5),reivec2(5),reivec3(5),reivecp(5),reivecm(5)
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_REAL cs2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL press,dpdeps,enthalpy,kappa
  CCTK_REAL axp,axm,vxp,vxm,cxx,cxy,cxz,gam,xsi,dlt,vxa,vxb

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities
  enthalpy = one + eps + press / rho

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = one / sqrt(one - v2)

!!$Calculate eigenvalues and put them in conventional order

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp

  lamp_nobeta = (velx*(one-cs2) + sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)
  lamm_nobeta = (velx*(one-cs2) - sqrt(cs2*(one-v2)*&
       (u*(one-v2*cs2) - velx**2*(one-cs2))))/(one-v2*cs2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

!!$  lam(1) = lamm
!!$  lam(2) = lam1
!!$  lam(3) = lam2
!!$  lam(4) = lam3
!!$  lam(5) = lamp

  lam(1) = lamm
  lam(5) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(2) = lamp

!!$Compute some auxiliary quantities

  axp = (u - velx*velx)/(u - velx*lamp_nobeta)
  axm = (u - velx*velx)/(u - velx*lamm_nobeta)
  vxp = (velx - lamp_nobeta)/(u - velx * lamp_nobeta)
  vxm = (velx - lamm_nobeta)/(u - velx * lamm_nobeta)

!!$Calculate associated right eigenvectors

  kappa = dpdeps / (dpdeps - rho * cs2)

  reivec1(1) = kappa / (enthalpy * w)
  reivec1(2) = vlowx
  reivec1(3) = vlowy
  reivec1(4) = vlowz
  reivec1(5) = one - reivec1(1)

  reivec2(1) = w * vlowy
  reivec2(2) = enthalpy * (gxy + two * w * w * vlowx * vlowy)
  reivec2(3) = enthalpy * (gyy + two * w * w * vlowy * vlowy)
  reivec2(4) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec2(5) = vlowy * w * (two * w * enthalpy - one)

  reivec3(1) = w * vlowz
  reivec3(2) = enthalpy * (gxz + two * w * w * vlowx * vlowz)
  reivec3(3) = enthalpy * (gyz + two * w * w * vlowy * vlowz)
  reivec3(4) = enthalpy * (gzz + two * w * w * vlowz * vlowz)
  reivec3(5) = vlowz * w * (two * w * enthalpy - one)

  reivecp(1) = one
  reivecp(2) = enthalpy * w * (vlowx - vxp)
  reivecp(3) = enthalpy * w * vlowy
  reivecp(4) = enthalpy * w * vlowz
  reivecp(5) = enthalpy * w * axp - one

  reivecm(1) = one
  reivecm(2) = enthalpy * w * (vlowx - vxm)
  reivecm(3) = enthalpy * w * vlowy
  reivecm(4) = enthalpy * w * vlowz
  reivecm(5) = enthalpy * w * axm - one

!!$Calculate associated left eigenvectors if requested

  if (ANALYTICAL) then

    cxx = gyy * gzz - gyz * gyz
    cxy = gxz * gyz - gxy * gzz
    cxz = gxy * gyz - gxz * gyy
    gam = gxx * cxx + gxy * cxy + gxz * cxz
    xsi = cxx - gam * velx * velx
    dlt = enthalpy**3 * w * (kappa - one) * (vxm - vxp) * xsi

    tmp1 = w / (kappa - one)

    leivec1(1) = tmp1 * (enthalpy - w)
    leivec1(2) = tmp1 * w * velx
    leivec1(3) = tmp1 * w * vely
    leivec1(4) = tmp1 * w * velz
    leivec1(5) =-tmp1 * w

    tmp1 = one / (xsi * enthalpy)

    leivec2(1) = (gyz * vlowz - gzz * vlowy) * tmp1
    leivec2(2) = (gzz * vlowy - gyz * vlowz) * tmp1 * velx
    leivec2(3) = (gzz * (one - velx * vlowx) + gxz * vlowz * velx) * tmp1
    leivec2(4) = (gyz * (velx * vlowx - one) - gxz * velx * vlowy) * tmp1
    leivec2(5) = (gyz * vlowz - gzz * vlowy) * tmp1

    leivec3(1) = (gyz * vlowy - gyy * vlowz) * tmp1
    leivec3(2) = (gyy * vlowz - gyz * vlowy) * tmp1 * velx
    leivec3(3) = (gyz * (velx * vlowx - one) - gxy * velx * vlowz) * tmp1
    leivec3(4) = (gyy * (one - velx * vlowx) + gxy * velx * vlowy) * tmp1
    leivec3(5) = (gyz * vlowy - gyy * vlowz) * tmp1

    tmp1 = enthalpy * enthalpy / dlt
    tmp2 = w * w * xsi

    leivecp(1) = - (enthalpy * w * vxm * xsi + (one - kappa) * (vxm * &
      (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxm) * tmp1
    leivecp(2) = - (cxx * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * velx - cxx * velx)) * tmp1
    leivecp(3) = - (cxy * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * vely - cxy * velx)) * tmp1
    leivecp(4) = - (cxz * (one - kappa * axm) + (two * kappa - one) * vxm * &
      (tmp2 * velz - cxz * velx)) * tmp1
    leivecp(5) = - ((one - kappa) * (vxm * (tmp2 - cxx) - gam * velx) - &
      kappa * tmp2 * vxm) * tmp1

    leivecm(1) = (enthalpy * w * vxp * xsi + (one - kappa) * (vxp * &
      (tmp2 - cxx) - gam * velx) - kappa * tmp2 * vxp) * tmp1
    leivecm(2) = (cxx * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * velx - cxx * velx)) * tmp1
    leivecm(3) = (cxy * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * vely - cxy * velx)) * tmp1
    leivecm(4) = (cxz * (one - kappa * axp) + (two * kappa - one) * vxp * &
      (tmp2 * velz - cxz * velx)) * tmp1
    leivecm(5) = ((one - kappa) * (vxp * (tmp2 - cxx) - gam * velx) - &
      kappa * tmp2 * vxp) * tmp1

  endif

  du(1) = qdiff1
  du(2) = qdiff2
  du(3) = qdiff3
  du(4) = qdiff4
  du(5) = qdiff5

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (abs(lamp) - abs(lam1)) * leivecp(i) * du(i)
         summ = summ + (abs(lamm) - abs(lam1)) * leivecm(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxp + summ * vxm)

      rflux(1) = abs(lam1) * du(1) + vxa
      rflux(2) = abs(lam1) * du(2) + enthalpy * w * (vlowx * vxa + vxb)
      rflux(3) = abs(lam1) * du(3) + enthalpy * w * (vlowy * vxa)
      rflux(4) = abs(lam1) * du(4) + enthalpy * w * (vlowz * vxa)
      rflux(5) = abs(lam1) * du(5) + enthalpy * w * (velx  * vxb + vxa) - vxa

    else

!!$Form Jacobian matrix in characteristic form from right eigenvectors.
!!$Invert to get the characteristic jumps given the conserved variable
!!$jumps

!!$  p(:,1) = reivecm(:)
!!$  p(:,2) = reivec1(:)
!!$  p(:,3) = reivec2(:)
!!$  p(:,4) = reivec3(:)
!!$  p(:,5) = reivecp(:)
!!$
!!$  write(*,*) p
!!$  stop

      p(:,1) = reivecm(:)
      p(:,2) = reivecp(:)
      p(:,3) = reivec2(:)
      p(:,4) = reivec3(:)
      p(:,5) = reivec1(:)

      q(1,:) = leivecm(:)
      q(2,:) = leivecp(:)
      q(3,:) = leivec2(:)
      q(4,:) = leivec3(:)
      q(5,:) = leivec1(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

!!$Calculate the Roe flux from the standard formula

      do i = 1, 5
        rflux(i) = 0.d0
        do j = 1, 5
          rflux(i) = rflux(i) + p(i,j) * abs(lam(j)) * dw(j)
        end do
      end do
    endif

  else

    p(:,1) = reivecm(:)
    p(:,2) = reivecp(:)
    p(:,3) = reivec2(:)
    p(:,4) = reivec3(:)
    p(:,5) = reivec1(:)

    do i=1,5
      dw(i) = du(i)
      do j=1,5
        aa(i,j) = p(i,j)
      end do
    enddo

    do ii=1,5
      paug(ii,1) = p(ii,1)
      paug(ii,2) = p(ii,2)
      paug(ii,3) = p(ii,3)
      paug(ii,4) = p(ii,4)
      paug(ii,5) = p(ii,5)
    enddo

    paug(1, 6) = du(1)
    paug(2, 6) = du(2)
    paug(3, 6) = du(3)
    paug(4, 6) = du(4)
    paug(5, 6) = du(5)

    do ii=1,5
      tmp1 = paug(ii,ii)
      do jj=ii,6
        paug(ii,jj) = paug(ii,jj)/tmp1
      enddo

      do jj=ii+1,5
        tmp1 = - (paug(jj,ii))
        do kk=ii,6
          paug(jj,kk) = paug(jj,kk) + tmp1*paug(ii,kk)
        enddo
      enddo

    enddo

    f_du(5) = paug(5,6)

    do ii=4,1,-1
      f_du(ii) = paug(ii,6)
      do jj=ii+1,5
        f_du(ii) = f_du(ii) - paug(ii,jj)*f_du(jj)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)
!!$
!!$  dw(1) = f_du(1)
!!$  dw(2) = f_du(5)
!!$  dw(3) = f_du(3)
!!$  dw(4) = f_du(4)
!!$  dw(5) = f_du(2)

!!$Calculate the Roe flux from the standard formula

    do i = 1, 5
      rflux(i) = 0.d0
      do j = 1, 5
        rflux(i) = rflux(i) + p(i,j) * abs(lam(j)) * dw(j)
      end do
    end do

  endif

  roeflux1 = rflux(1)
  roeflux2 = rflux(2)
  roeflux3 = rflux(3)
  roeflux4 = rflux(4)
  roeflux5 = rflux(5)

end subroutine eigenproblem_general

end module GRHydro_Eigenproblem


```

GRHydro_FluxSplit.F90:
```
 /*@@
   @file      GRHydro_FluxSplit.F90
   @date      Wed Mar  3 22:16:00 2004
   @author    Ian Hawke
   @desc 
   Flux split reconstruction using WENO5.
   @enddesc 
 @@*/

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

 /*@@
   @routine    GRHydro_FSAlpha
   @date       Sun Jan  9 12:25:43 2005
   @author     Ian Hawke
   @desc 
   Compute the maximum characteristic speed over all space
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine GRHydro_FSAlpha(CCTK_ARGUMENTS)

  use GRHydro_Eigenproblem

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  integer :: nx, ny, nz, i, j, k, ierr, max_handle
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, sdet, beta
  CCTK_REAL, dimension(5) :: lambda
  CCTK_REAL :: alpha1_local, alpha2_local, alpha3_local, alpha4_local, &
       alpha5_local

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

  fs_alpha1 = 0.d0
  fs_alpha2 = 0.d0
  fs_alpha3 = 0.d0
  fs_alpha4 = 0.d0
  fs_alpha5 = 0.d0

  alpha1_local = 0.d0
  alpha2_local = 0.d0
  alpha3_local = 0.d0
  alpha4_local = 0.d0
  alpha5_local = 0.d0

  if (flux_direction == 1) then

    do k = 1, nz
      do j = 1, ny
        do i = 1, nx

           sdet = sdetg(i,j,k)
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdet*sdet,&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        

           beta = betax(i,j,k)
          
          call eigenvalues(GRHydro_eos_handle, &
               rho      (i,j,k), &
               vel      (i,j,k,1), &
               vel      (i,j,k,2), &
               vel      (i,j,k,3), &
               eps      (i,j,k), &
               w_lorentz(i,j,k), &
               lambda          , &
               gxx      (i,j,k), &
               gxy      (i,j,k), &
               gxz      (i,j,k), &
               gyy      (i,j,k), &
               gyz      (i,j,k), &
               gzz      (i,j,k), &
               uxx             , &
               alp      (i,j,k), &
               beta               )  

          alpha1_local = max(abs(lambda(1)), alpha1_local)
          alpha2_local = max(abs(lambda(2)), alpha2_local)
          alpha3_local = max(abs(lambda(3)), alpha3_local)
          alpha4_local = max(abs(lambda(4)), alpha4_local)
          alpha5_local = max(abs(lambda(5)), alpha5_local)

        end do
      end do
    end do

  else if (flux_direction == 2) then

    do k = 1, nz
      do j = 1, ny
        do i = 1, nx

           sdet = sdetg(i,j,k)
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdet*sdet,&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        

           beta = betay(i,j,k)
          
          call eigenvalues(GRHydro_eos_handle, &
               rho      (i,j,k), &
               vel      (i,j,k,1), &
               vel      (i,j,k,2), &
               vel      (i,j,k,3), &
               eps      (i,j,k), &
               w_lorentz(i,j,k), &
               lambda          , &
               gyy      (i,j,k), &
               gyz      (i,j,k), &
               gxy      (i,j,k), &
               gzz      (i,j,k), &
               gxz      (i,j,k), &
               gxx      (i,j,k), &
               uyy             , &
               alp      (i,j,k), &
               beta               )  

          alpha1_local = max(abs(lambda(1)), alpha1_local)
          alpha2_local = max(abs(lambda(2)), alpha2_local)
          alpha3_local = max(abs(lambda(3)), alpha3_local)
          alpha4_local = max(abs(lambda(4)), alpha4_local)
          alpha5_local = max(abs(lambda(5)), alpha5_local)

        end do
      end do
    end do

  else if (flux_direction == 3) then

    do k = 1, nz
      do j = 1, ny
        do i = 1, nx

           sdet = sdetg(i,j,k)
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,sdet*sdet,&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        

           beta = betaz(i,j,k)
          
          call eigenvalues(GRHydro_eos_handle, &
               rho      (i,j,k), &
               vel      (i,j,k,1), &
               vel      (i,j,k,2), &
               vel      (i,j,k,3), &
               eps      (i,j,k), &
               w_lorentz(i,j,k), &
               lambda          , &
               gzz      (i,j,k), &
               gxz      (i,j,k), &
               gyz      (i,j,k), &
               gxx      (i,j,k), &
               gxy      (i,j,k), &
               gyy      (i,j,k), &
               uzz             , &
               alp      (i,j,k), &
               beta               )  

          alpha1_local = max(abs(lambda(1)), alpha1_local)
          alpha2_local = max(abs(lambda(2)), alpha2_local)
          alpha3_local = max(abs(lambda(3)), alpha3_local)
          alpha4_local = max(abs(lambda(4)), alpha4_local)
          alpha5_local = max(abs(lambda(5)), alpha5_local)

        end do
      end do
    end do

  else

    call CCTK_ERROR("Flux direction not x,y,z")
    STOP

  end if

!!$  write(*,*) 'fs_alpha: local',alpha1_local,alpha2_local,alpha3_local,alpha4_local,alpha5_local
  
  call CCTK_ReductionHandle(max_handle, "maximum")

  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, max_handle, &
       alpha1_local, fs_alpha1, CCTK_VARIABLE_REAL )
  if ( ierr .ne. 0 ) then
    call CCTK_ERROR("Reduction of alpha1 failed")
    STOP
  end if
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, max_handle, &
       alpha2_local, fs_alpha2, CCTK_VARIABLE_REAL )
  if ( ierr .ne. 0 ) then
    call CCTK_ERROR("Reduction of alpha2 failed")
    STOP
  end if
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, max_handle, &
       alpha3_local, fs_alpha3, CCTK_VARIABLE_REAL )
  if ( ierr .ne. 0 ) then
    call CCTK_ERROR("Reduction of alpha3 failed")
    STOP
  end if
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, max_handle, &
       alpha4_local, fs_alpha4, CCTK_VARIABLE_REAL )
  if ( ierr .ne. 0 ) then
    call CCTK_ERROR("Reduction of alpha4 failed")
    STOP
  end if
  call CCTK_ReduceLocScalar ( ierr, cctkGH, -1, max_handle, &
       alpha5_local, fs_alpha5, CCTK_VARIABLE_REAL )
  if ( ierr .ne. 0 ) then
    call CCTK_ERROR("Reduction of alpha5 failed")
    STOP
  end if

!!$  write(*,*) 'fs_alpha: global',fs_alpha1,fs_alpha2,fs_alpha3,fs_alpha4,fs_alpha5

!!$  fs_alpha1 = max(abs(fs_alpha1), &
!!$                  abs(fs_alpha2), &
!!$                  abs(fs_alpha3), &
!!$                  abs(fs_alpha4), &
!!$                  abs(fs_alpha5) )
!!$
!!$  fs_alpha2 = max(abs(fs_alpha1), &
!!$                  abs(fs_alpha2), &
!!$                  abs(fs_alpha3), &
!!$                  abs(fs_alpha4), &
!!$                  abs(fs_alpha5) )
!!$
!!$  fs_alpha3 = max(abs(fs_alpha1), &
!!$                  abs(fs_alpha2), &
!!$                  abs(fs_alpha3), &
!!$                  abs(fs_alpha4), &
!!$                  abs(fs_alpha5) )
!!$
!!$  fs_alpha4 = max(abs(fs_alpha1), &
!!$                  abs(fs_alpha2), &
!!$                  abs(fs_alpha3), &
!!$                  abs(fs_alpha4), &
!!$                  abs(fs_alpha5) )
!!$
!!$  fs_alpha5 = max(abs(fs_alpha1), &
!!$                  abs(fs_alpha2), &
!!$                  abs(fs_alpha3), &
!!$                  abs(fs_alpha4), &
!!$                  abs(fs_alpha5) )

!!$  write(*,*) 'fs_alpha: final',fs_alpha1,fs_alpha2,fs_alpha3,fs_alpha4,fs_alpha5
  
end subroutine GRHydro_FSAlpha

 /*@@
   @routine    GRHydro_SplitFlux
   @date       Wed Mar  3 22:17:14 2004
   @author     Ian Hawke
   @desc 
   Wrapper routine to split the flux. Synchronization is 
   unfortunately required afterwards.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine GRHydro_SplitFlux(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  integer :: nx, ny, nz, i, j, k

  CCTK_REAL, dimension(:), allocatable :: upper, det, dummy
  CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz

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

  if (flux_direction == 1) then
    allocate(upper(nx), det(nx), dummy(nx))
    do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 2
      do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 2

         dummy = betax(:,j,k)

        do i = 1, cctk_lsh(1)
           det(i) = sdetg(i,j,k)*sdetg(i,j,k)
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det(i),&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        
           upper(i) = uxx
        end do

        call GRHydro_SplitFlux_1D(GRHydro_eos_handle, int(nx,ik),&
             fs_alpha1, fs_alpha2, fs_alpha3, fs_alpha4, fs_alpha5, &
             gxx(:,j,k),gxy(:,j,k),gxz(:,j,k),&
             gyy(:,j,k),gyz(:,j,k),gzz(:,j,k),&
             upper, det,&
             alp(:,j,k),dummy,&
             rho(:,j,k),vel(:,j,k,1),vel(:,j,k,2),vel(:,j,k,3),press(:,j,k),&
             w_lorentz(:,j,k),eps(:,j,k),&
             dens(:,j,k),scon(:,j,k,1),scon(:,j,k,2),scon(:,j,k,3),tau(:,j,k),&
             densfplus(:,j,k), sxfplus(:,j,k), syfplus(:,j,k), &
             szfplus(:,j,k), taufplus(:,j,k), &
             densfminus(:,j,k), sxfminus(:,j,k), syfminus(:,j,k), &
             szfminus(:,j,k), taufminus(:,j,k), &
             densflux(:,j,k), sxflux(:,j,k), syflux(:,j,k), &
             szflux(:,j,k), tauflux(:,j,k))        
      end do
    end do
    deallocate(upper, det, dummy)
  else if (flux_direction == 2) then
    allocate(upper(ny), det(ny), dummy(ny))
    do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 2
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 2

         dummy = betay(i,:,k)

        do j = 1, cctk_lsh(2)
           det(j) = sdetg(i,j,k)**2
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det(j),&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        
           upper(j) = uyy
        end do

        call GRHydro_SplitFlux_1D(GRHydro_eos_handle, int(ny,ik),&
             fs_alpha1, fs_alpha2, fs_alpha3, fs_alpha4, fs_alpha5, &
             gyy(i,:,k),gyz(i,:,k),gxy(i,:,k),&
             gzz(i,:,k),gxz(i,:,k),gxx(i,:,k),&
             upper, det,&
             alp(i,:,k),dummy,&
             rho(i,:,k),vel(i,:,k,2),vel(i,:,k,3),vel(i,:,k,1),press(i,:,k),&
             w_lorentz(i,:,k),eps(i,:,k),&
             dens(i,:,k),scon(i,:,k,2),scon(i,:,k,3),scon(i,:,k,1),tau(i,:,k),&
             densfplus(i,:,k), syfplus(i,:,k), szfplus(i,:,k), &
             sxfplus(i,:,k), taufplus(i,:,k), &
             densfminus(i,:,k), syfminus(i,:,k), szfminus(i,:,k), &
             sxfminus(i,:,k), taufminus(i,:,k), &
             densflux(i,:,k), syflux(i,:,k), szflux(i,:,k), &
             sxflux(i,:,k), tauflux(i,:,k))
      end do
    end do
    deallocate(upper, det, dummy)
  else if (flux_direction == 3) then
    allocate(upper(nz), det(nz), dummy(nz))
    do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 2
      do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 2

         dummy = betaz(i,j,:)
         
        do k = 1, cctk_lsh(3)
           det(k) = sdetg(i,j,k)*sdetg(i,j,k)
           call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det(k),&
                gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),&
                gyz(i,j,k),gzz(i,j,k))        
           upper(k) = uzz
        end do

        call GRHydro_SplitFlux_1D(GRHydro_eos_handle, int(nz,ik),&
             fs_alpha1, fs_alpha2, fs_alpha3, fs_alpha4, fs_alpha5, &
             gzz(i,j,:),gxz(i,j,:),gyz(i,j,:),&
             gxx(i,j,:),gxy(i,j,:),gyy(i,j,:),&
             upper, det,&
             alp(i,j,:),dummy,&
             rho(i,j,:),vel(i,j,:,3),vel(i,j,:,1),vel(i,j,:,2),press(i,j,:),&
             w_lorentz(i,j,:),eps(i,j,:),&
             dens(i,j,:),scon(i,j,:,3),scon(i,j,:,1),scon(i,j,:,2),tau(i,j,:),&
             densfplus(i,j,:), szfplus(i,j,:), sxfplus(i,j,:), &
             syfplus(i,j,:), taufplus(i,j,:), &
             densfminus(i,j,:), szfminus(i,j,:), sxfminus(i,j,:), &
             syfminus(i,j,:), taufminus(i,j,:), &
             densflux(i,j,:), szflux(i,j,:), sxflux(i,j,:), &
             syflux(i,j,:), tauflux(i,j,:))
      end do
    end do
    deallocate(upper, det, dummy)
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if

  return

end subroutine GRHydro_SplitFlux

 /*@@
   @routine    GRHydro_SplitFlux_1D
   @date       Wed Mar  3 22:55:36 2004
   @author     Ian Hawke
   @desc 
   Actually performs the flux splitting. 
   We really should be doing it on a characteristic basis.

   Note the direction rotations on the calling routine.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_SplitFlux_1D(handle, nx, &
     alpha1, alpha2, alpha3, alpha4, alpha5, &
     gxx, gxy, gxz, gyy, gyz, gzz, u, det, alp, beta, &
     rho, velx1, vely1, velz1, press, w_lorentz, eps, &
     dens, sx, sy, sz, tau, &
     densfplus, sxfplus, syfplus, szfplus, taufplus, &
     densfminus, sxfminus, syfminus, szfminus, taufminus, &
     densflux, sxflux, syflux, szflux, tauflux)

  use GRHydro_Eigenproblem

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  CCTK_REAL, parameter :: half = 0.5d0

  CCTK_INT :: i, nx, handle, ll
  CCTK_REAL, dimension(nx) :: gxx, gxy, gxz, gyy, gyz, gzz, &
       u, det, alp, beta, &
       rho, velx1, vely1, velz1, press, w_lorentz, eps, &
       dens, sx, sy, sz, tau, &
       densfplus, sxfplus, syfplus, szfplus, taufplus, &
       densfminus, sxfminus, syfminus, szfminus, taufminus, &
       densflux, sxflux, syflux, szflux, tauflux

  CCTK_REAL :: alpha1, alpha2, alpha3, alpha4, alpha5

  CCTK_REAL, dimension(:), allocatable :: tmp

  CCTK_REAL, dimension(:,:), allocatable :: evals
  CCTK_REAL, dimension(:,:,:), allocatable :: levecs, revecs

  CCTK_REAL, dimension(:), allocatable :: &
     char_v1, char_v2, char_v3, char_v4 ,char_v5, &
     char_f1_plus, char_f2_plus, char_f3_plus, &
     char_f4_plus ,char_f5_plus, &
     char_f1_minus, char_f2_minus, char_f3_minus, &
     char_f4_minus ,char_f5_minus, &
     char_f1, char_f2, char_f3, &
     char_f4 ,char_f5

  CCTK_REAL, dimension(5) :: lambda, alpha
  CCTK_REAL, dimension(5, 5) :: levec, revec

  densfplus = 0.d0
  sxfplus = 0.d0
  syfplus = 0.d0
  szfplus = 0.d0
  taufplus = 0.d0
  densfminus = 0.d0
  sxfminus = 0.d0
  syfminus = 0.d0
  szfminus = 0.d0
  taufminus = 0.d0

  allocate(evals(nx, 5), levecs(nx,5,5), revecs(nx,5,5))
  allocate(tmp(nx))
  allocate(char_v1(nx), char_v2(nx), char_v3(nx), char_v4 (nx),char_v5(nx), &
     char_f1_plus(nx), char_f2_plus(nx), char_f3_plus(nx), &
     char_f4_plus (nx),char_f5_plus(nx), &
     char_f1_minus(nx), char_f2_minus(nx), char_f3_minus(nx), &
     char_f4_minus (nx),char_f5_minus(nx), &
     char_f1(nx), char_f2(nx), char_f3(nx), &
     char_f4 (nx),char_f5(nx))

  do i = 1, nx-1

!!$    Arithmetic mean

!!$    Calculate the maximum eigenvalue and put it here

    call eigenproblem_leftright(handle, &
         half * (rho      (i) + rho      (i+1)), &
         half * (velx1    (i) + velx1    (i+1)), &
         half * (vely1    (i) + vely1    (i+1)), &
         half * (velz1    (i) + velz1    (i+1)), &
         half * (eps      (i) + eps      (i+1)), &
         half * (w_lorentz(i) + w_lorentz(i+1)), &
         half * (gxx      (i) + gxx      (i+1)), &
         half * (gxy      (i) + gxy      (i+1)), &
         half * (gxz      (i) + gxz      (i+1)), &
         half * (gyy      (i) + gyy      (i+1)), &
         half * (gyz      (i) + gyz      (i+1)), &
         half * (gzz      (i) + gzz      (i+1)), &
         half * (u        (i) + u        (i+1)), &
         half * (alp      (i) + alp      (i+1)), &
         half * (beta     (i) + beta     (i+1)), &
         lambda,&
         levec,&
         revec)

    evals(i,:) = lambda
    levecs(i,:,:) = levec
    revecs(i,:,:) = revec
    
  end do
  
  do i = 3, nx - 3

    alpha(1) = alpha1
    alpha(2) = alpha2
    alpha(3) = alpha3
    alpha(4) = alpha4
    alpha(5) = alpha5
    
    do ll = i - 2, i + 3

!!$    Initialize the pointwise fluxes temporarily into the minus

      call num_x_flux(dens(ll), sx(ll), sy(ll), sz(ll), tau(ll), &
           densfminus(ll), sxfminus(ll), syfminus(ll), szfminus(ll), &
           taufminus(ll), &
           velx1(ll), press(ll), det(ll), alp(ll), beta(ll))

      densfminus(ll) = densfminus(ll) * alp(ll)
      sxfminus(ll)   = sxfminus(ll)   * alp(ll)
      syfminus(ll)   = syfminus(ll)   * alp(ll)
      szfminus(ll)   = szfminus(ll)   * alp(ll)
      taufminus(ll)  = taufminus(ll)  * alp(ll)

      char_v1(ll) = levecs(i,1,1) * dens(ll) + &
           levecs(i,1,2) * sx(ll) + &
           levecs(i,1,3) * sy(ll) + &
           levecs(i,1,4) * sz(ll) + &
           levecs(i,1,5) * tau(ll)
      char_v2(ll) = levecs(i,2,1) * dens(ll) + &
           levecs(i,2,2) * sx(ll) + &
           levecs(i,2,3) * sy(ll) + &
           levecs(i,2,4) * sz(ll) + &
           levecs(i,2,5) * tau(ll)
      char_v3(ll) = levecs(i,3,1) * dens(ll) + &
           levecs(i,3,2) * sx(ll) + &
           levecs(i,3,3) * sy(ll) + &
           levecs(i,3,4) * sz(ll) + &
           levecs(i,3,5) * tau(ll)
      char_v4(ll) = levecs(i,4,1) * dens(ll) + &
           levecs(i,4,2) * sx(ll) + &
           levecs(i,4,3) * sy(ll) + &
           levecs(i,4,4) * sz(ll) + &
           levecs(i,4,5) * tau(ll)
      char_v5(ll) = levecs(i,5,1) * dens(ll) + &
           levecs(i,5,2) * sx(ll) + &
           levecs(i,5,3) * sy(ll) + &
           levecs(i,5,4) * sz(ll) + &
           levecs(i,5,5) * tau(ll)
      
      char_f1(ll) = levecs(i,1,1) * densfminus(ll) + &
           levecs(i,1,2) * sxfminus(ll) + &
           levecs(i,1,3) * syfminus(ll) + &
           levecs(i,1,4) * szfminus(ll) + &
           levecs(i,1,5) * taufminus(ll)
      char_f2(ll) = levecs(i,2,1) * densfminus(ll) + &
           levecs(i,2,2) * sxfminus(ll) + &
           levecs(i,2,3) * syfminus(ll) + &
           levecs(i,2,4) * szfminus(ll) + &
           levecs(i,2,5) * taufminus(ll)
      char_f3(ll) = levecs(i,3,1) * densfminus(ll) + &
           levecs(i,3,2) * sxfminus(ll) + &
           levecs(i,3,3) * syfminus(ll) + &
           levecs(i,3,4) * szfminus(ll) + &
           levecs(i,3,5) * taufminus(ll)
      char_f4(ll) = levecs(i,4,1) * densfminus(ll) + &
           levecs(i,4,2) * sxfminus(ll) + &
           levecs(i,4,3) * syfminus(ll) + &
           levecs(i,4,4) * szfminus(ll) + &
           levecs(i,4,5) * taufminus(ll)
      char_f5(ll) = levecs(i,5,1) * densfminus(ll) + &
           levecs(i,5,2) * sxfminus(ll) + &
           levecs(i,5,3) * syfminus(ll) + &
           levecs(i,5,4) * szfminus(ll) + &
           levecs(i,5,5) * taufminus(ll)      

!!$    Calculate the split

      char_f1_plus(ll)  = 0.5d0 * (char_f1(ll) + alpha(1) * char_v1(ll))
      char_f1_minus(ll) = 0.5d0 * (char_f1(ll) - alpha(1) * char_v1(ll))
      char_f2_plus(ll)  = 0.5d0 * (char_f2(ll) + alpha(2) * char_v2(ll))
      char_f2_minus(ll) = 0.5d0 * (char_f2(ll) - alpha(2) * char_v2(ll))
      char_f3_plus(ll)  = 0.5d0 * (char_f3(ll) + alpha(3) * char_v3(ll))
      char_f3_minus(ll) = 0.5d0 * (char_f3(ll) - alpha(3) * char_v3(ll))
      char_f4_plus(ll)  = 0.5d0 * (char_f4(ll) + alpha(4) * char_v4(ll))
      char_f4_minus(ll) = 0.5d0 * (char_f4(ll) - alpha(4) * char_v4(ll))
      char_f5_plus(ll)  = 0.5d0 * (char_f5(ll) + alpha(5) * char_v5(ll))
      char_f5_minus(ll) = 0.5d0 * (char_f5(ll) - alpha(5) * char_v5(ll))

    end do

!!$    Reconstruct the characteristic split fluxes
!!$    After reconstruction, combine to get the characteristic flux

    call GRHydro_WENO5_Left(5_ik, char_f1_plus(i-2:i+2), tmp(i-2:i+2))
    char_f1(i) = tmp(i)
    call GRHydro_WENO5_Right(5_ik, char_f1_minus(i-1:i+3), &
         tmp(i-1:i+3))
    char_f1(i) = char_f1(i) + tmp(i+1)
    
    call GRHydro_WENO5_Left(5_ik, char_f2_plus(i-2:i+2), tmp(i-2:i+2))
    char_f2(i) = tmp(i)
    call GRHydro_WENO5_Right(5_ik, char_f2_minus(i-1:i+3), &
         tmp(i-1:i+3))
    char_f2(i) = char_f2(i) + tmp(i+1)
    
    call GRHydro_WENO5_Left(5_ik, char_f3_plus(i-2:i+2), tmp(i-2:i+2))
    char_f3(i) = tmp(i)
    call GRHydro_WENO5_Right(5_ik, char_f3_minus(i-1:i+3), &
         tmp(i-1:i+3))
    char_f3(i) = char_f3(i) + tmp(i+1)
    
    call GRHydro_WENO5_Left(5_ik, char_f4_plus(i-2:i+2), tmp(i-2:i+2))
    char_f4(i) = tmp(i)
    call GRHydro_WENO5_Right(5_ik, char_f4_minus(i-1:i+3), &
         tmp(i-1:i+3))
    char_f4(i) = char_f4(i) + tmp(i+1)
    
    call GRHydro_WENO5_Left(5_ik, char_f5_plus(i-2:i+2), tmp(i-2:i+2))
    char_f5(i) = tmp(i)
    call GRHydro_WENO5_Right(5_ik, char_f5_minus(i-1:i+3), &
         tmp(i-1:i+3))
    char_f5(i) = char_f5(i) + tmp(i+1)

!!$    Compute physical fluxes
    
    densflux(i) = &
         revecs(i,1,1) * char_f1(i) + revecs(i,2,1) * char_f2(i) + &
         revecs(i,3,1) * char_f3(i) + revecs(i,4,1) * char_f4(i) + &
         revecs(i,5,1) * char_f5(i)
    sxflux(i) = &
         revecs(i,1,2) * char_f1(i) + revecs(i,2,2) * char_f2(i) + &
         revecs(i,3,2) * char_f3(i) + revecs(i,4,2) * char_f4(i) + &
         revecs(i,5,2) * char_f5(i)
    syflux(i) = &
         revecs(i,1,3) * char_f1(i) + revecs(i,2,3) * char_f2(i) + &
         revecs(i,3,3) * char_f3(i) + revecs(i,4,3) * char_f4(i) + &
         revecs(i,5,3) * char_f5(i)
    szflux(i) = &
         revecs(i,1,4) * char_f1(i) + revecs(i,2,4) * char_f2(i) + &
         revecs(i,3,4) * char_f3(i) + revecs(i,4,4) * char_f4(i) + &
         revecs(i,5,4) * char_f5(i)
    tauflux(i) = &
         revecs(i,1,5) * char_f1(i) + revecs(i,2,5) * char_f2(i) + &
         revecs(i,3,5) * char_f3(i) + revecs(i,4,5) * char_f4(i) + &
         revecs(i,5,5) * char_f5(i)

!!$    if (abs(i-200) < 5) then
!!$      write(*,*) i, 'alpha',alpha1,alpha2,alpha3,alpha4,alpha5
!!$      write(*,*) i, 'var',dens(i), sx(i), tau(i)
!!$      write(*,*) i, 'f',densflux(i),sxflux(i),tauflux(i)
!!$    end if
    
  end do

  deallocate(evals, levecs, revecs, tmp)

end subroutine GRHydro_SplitFlux_1D

 /*@@
   @routine    GRHydro_WENO5_Left
   @date       Wed Mar  3 22:57:54 2004
   @author     Ian Hawke
   @desc 
   Upwind biased WENO5.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_WENO5_Left(nx, v, vminus)

  implicit none

  CCTK_INT :: i, nx
  CCTK_REAL, dimension(nx) :: v, vminus
  CCTK_REAL :: one, two, three, four, five, six, seven, &
       ten, eleven, twelve, thirteen, &
       ThirteenByTwelve, Quarter
  parameter (one = 1)
  parameter (two = 2)
  parameter (three = 3)
  parameter (four = 4)
  parameter (five = 5)
  parameter (six = 6)
  parameter (seven = 7)
  parameter (ten = 10)
  parameter (eleven = 11)
  parameter (twelve = 12)
  parameter (thirteen = 13)
  parameter (ThirteenByTwelve = thirteen / twelve)
  parameter (Quarter = one / four)
  CCTK_REAL :: d0, d1, d2
  parameter (d0 = three / ten)
  parameter (d1 = six / ten)
  parameter (d2 = one / ten)
  CCTK_REAL :: c00,c01,c02,c10,c11,c12,c20,c21,c22
  parameter (c00 = two / six)
  parameter (c01 = five / six)
  parameter (c02 = -one / six)
  parameter (c10 = -one / six)
  parameter (c11 = five / six)
  parameter (c12 = two / six)
  parameter (c20 = two / six)
  parameter (c21 = -seven / six)
  parameter (c22 = eleven / six)

  CCTK_REAL :: beta0, beta1, beta2
  CCTK_REAL :: epsilon
  CCTK_REAL :: alpha0, alpha1, alpha2, alphasum
  CCTK_REAL :: w0, w1, w2
  CCTK_REAL :: v0plushalf, v1plushalf, v2plushalf

  epsilon = 1.d-6

  do i = 3, nx-2

    beta0 = ThirteenByTwelve * (v(i  ) - two * v(i+1) + v(i+2))**2 + &
         Quarter * (three * v(i  ) - four * v(i+1) +         v(i+2))**2
    beta1 = ThirteenByTwelve * (v(i-1) - two * v(i  ) + v(i+1))**2 + &
         Quarter * (        v(i-1)                 -         v(i+1))**2
    beta2 = ThirteenByTwelve * (v(i-2) - two * v(i-1) + v(i  ))**2 + &
         Quarter * (        v(i-2) - four * v(i-1) + three * v(i  ))**2
    
    alpha0 = d0 / (epsilon + beta0)**2
    alpha1 = d1 / (epsilon + beta1)**2
    alpha2 = d2 / (epsilon + beta2)**2
    
    alphasum = alpha0 + alpha1 + alpha2
    
    w0 = alpha0 / alphasum
    w1 = alpha1 / alphasum
    w2 = alpha2 / alphasum
    
    v0plushalf = c00 * v(i  ) + c01 * v(i+1) + c02 * v(i+2)
    v1plushalf = c10 * v(i-1) + c11 * v(i  ) + c12 * v(i+1)
    v2plushalf = c20 * v(i-2) + c21 * v(i-1) + c22 * v(i  )
    
    vminus(i) = w0 * v0plushalf + &
                w1 * v1plushalf + &
                w2 * v2plushalf
  
  end do
  
end subroutine GRHydro_WENO5_Left

 /*@@
   @routine    GRHydro_WENO5_Right
   @date       Wed Mar  3 22:58:10 2004
   @author     Ian Hawke
   @desc 
   Downwind biased WENO5.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_WENO5_Right(nx, v, vplus)

  implicit none

  CCTK_INT :: i, nx
  CCTK_REAL, dimension(nx) :: v, vplus
  CCTK_REAL :: one, two, three, four, five, six, seven, &
       ten, eleven, twelve, thirteen, &
       ThirteenByTwelve, Quarter
  parameter (one = 1)
  parameter (two = 2)
  parameter (three = 3)
  parameter (four = 4)
  parameter (five = 5)
  parameter (six = 6)
  parameter (seven = 7)
  parameter (ten = 10)
  parameter (eleven = 11)
  parameter (twelve = 12)
  parameter (thirteen = 13)
  parameter (ThirteenByTwelve = thirteen / twelve)
  parameter (Quarter = one / four)
  CCTK_REAL :: dtilde0, dtilde1, dtilde2
  parameter (dtilde0 = one / ten)
  parameter (dtilde1 = six / ten)
  parameter (dtilde2 = three / ten)
  CCTK_REAL :: ctilde00,ctilde01,ctilde02,ctilde10,ctilde11,&
       ctilde12,ctilde20,ctilde21,ctilde22
  parameter (ctilde00 = eleven / six)
  parameter (ctilde01 = -seven / six)
  parameter (ctilde02 = two / six)
  parameter (ctilde10 = two / six)
  parameter (ctilde11 = five / six)
  parameter (ctilde12 = -one / six)
  parameter (ctilde20 = -one / six)
  parameter (ctilde21 = five / six)
  parameter (ctilde22 = two / six)

  CCTK_REAL :: betatilde0, betatilde1, betatilde2
  CCTK_REAL :: epsilon
  CCTK_REAL :: alphatilde0, alphatilde1, alphatilde2, alphatildesum
  CCTK_REAL :: wtilde0, wtilde1, wtilde2
  CCTK_REAL :: v0minushalf, v1minushalf, v2minushalf

  epsilon = 1.d-6

  do i = 3, nx-2

    betatilde0 = ThirteenByTwelve * (v(i  ) - two * v(i+1) + v(i+2))**2 + &
         Quarter * (three * v(i  ) - four * v(i+1) +         v(i+2))**2
    betatilde1 = ThirteenByTwelve * (v(i-1) - two * v(i  ) + v(i+1))**2 + &
         Quarter * (        v(i-1)                 -         v(i+1))**2
    betatilde2 = ThirteenByTwelve * (v(i-2) - two * v(i-1) + v(i  ))**2 + &
         Quarter * (        v(i-2) - four * v(i-1) + three * v(i  ))**2
    
    alphatilde0 = dtilde0 / (epsilon + betatilde0)**2
    alphatilde1 = dtilde1 / (epsilon + betatilde1)**2
    alphatilde2 = dtilde2 / (epsilon + betatilde2)**2
    
    alphatildesum = alphatilde0 + alphatilde1 + alphatilde2
    
    wtilde0 = alphatilde0 / alphatildesum
    wtilde1 = alphatilde1 / alphatildesum
    wtilde2 = alphatilde2 / alphatildesum
    
    v0minushalf = ctilde00 * v(i  ) + ctilde01 * v(i+1) + ctilde02 * v(i+2)
    v1minushalf = ctilde10 * v(i-1) + ctilde11 * v(i  ) + ctilde12 * v(i+1)
    v2minushalf = ctilde20 * v(i-2) + ctilde21 * v(i-1) + ctilde22 * v(i  )
    
    vplus(i) = wtilde0 * v0minushalf + &
               wtilde1 * v1minushalf + &
               wtilde2 * v2minushalf
  
  end do
  
end subroutine GRHydro_WENO5_Right

```

GRHydro_EvolutionMask.F90:
```
/*@@
   @file      GRHydro_EvolutionMask.F90
   @date      Sat Jul 14 15:38:02 PDT 2012
   @author    Roland Haas
   @desc 
   User level module and Fortran glue code to get access to
   CarpetEvolutionMask::evolution_mask based on runtime parameters.
   @enddesc 
 @@*/
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"

 /*@@
   @routine    GRHydro_EvolutionMask
   @date       Sat Jul 14 15:39:37 PDT 2012
   @author     Roland Haas
   @desc
   User level module to get access to CarpetEvolutionMask::evolution_mask based
   on runtime parameters.
   @history

   @endhistory

@@*/
module GRHydro_EvolutionMask

      implicit none

CONTAINS
       /*@@
         @routine    GRHydro_DeclareEvolutionMask
         @date       Sat Jul 14 15:39:37 PDT 2012
         @author     Roland Haas
         @desc
         Stores a pointer to CarpetEvolutionMask::evoltuion_mask in its
         argument. This function is not thread safe.
         @enddesc
         @calls     
         @calledby
         @history
      
         @endhistory

         @var     cctkGH
         @vdesc   Cactus grid hierarchy
         @vtype   cGH *
         @vio     in
         @vcomment
         @endvar

         @var     evolution_mask
         @vdesc   Cray pointer
         @vtype   CCTK_POINTER
         @vio     out
         @vcomment
         @endvar
      
         @var     evolution_mask_valid
         @vdesc   set to 1 if evolution_mask is valid, 0 otherwise
         @vtype   CCTK_INT
         @vio     out
         @vcomment
         @endvar
      
         @returntype none
         @returndesc
         @endreturndesc
      @@*/
      subroutine GRHydro_DeclareEvolutionMask(cctkGH, evolution_mask, &
                                              evolution_mask_valid)

        implicit none

        DECLARE_CCTK_PARAMETERS
        DECLARE_CCTK_FUNCTIONS

        CCTK_POINTER_TO_CONST :: cctkGH
        CCTK_REAL :: dummy
        pointer (evolution_mask, dummy)
        CCTK_INT :: evolution_mask_valid

        integer, save :: evolution_mask_idx = -1
        logical :: try_use_mask
        integer :: evolution_mask_active

        call CCTK_IsImplementationActive(evolution_mask_active, &
                                         "CarpetEvolutionMask")
        try_use_mask = CCTK_EQUALS(use_evolution_mask, "always") .or.   &
                       (CCTK_EQUALS(use_evolution_mask, "auto") .and. &
                        evolution_mask_active .ne. 0)

        if (try_use_mask) then
          if (evolution_mask_idx .eq. -1) then
            call CCTK_VarIndex(evolution_mask_idx,&
                               "CarpetEvolutionMask::evolution_mask")
          end if
          call CCTK_VarDataPtrI(evolution_mask, cctkGH, 0, evolution_mask_idx)
          if (evolution_mask .eq. CCTK_NullPointer()) then
            call CCTK_Warn(CCTK_WARN_ABORT, "Could not get pointer to evolution_mask. Is CarpetEvolutionMask active?")
          end if
          evolution_mask_valid = 1
        else
          evolution_mask = CCTK_NullPointer()
          evolution_mask_valid = 0
        end if

      end subroutine
end module

```

GRHydro_SourceM.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 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)
#define Bconsrhsx(i,j,k) Bconsrhs(i,j,k,1)
#define Bconsrhsy(i,j,k) Bconsrhs(i,j,k,2)
#define Bconsrhsz(i,j,k) Bconsrhs(i,j,k,3)

 /*@@
   @routine    SourceTermsM
   @date       Aug 30, 2010
   @author     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 SourceTermsM(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 :: bvcx_source, bvcy_source, bvcz_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
  Bconsrhs=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 (evolve_entropy .ne. 0) then
     entropyrhs = 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 bvcx_source,bvcy_source,bvcz_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)

        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

        if(clean_divergence.ne.0) then

           psidcrhs(i,j,k) = -1.d0 * (kap_dc*alp(i,j,k) + &
                dx_betax + dy_betay + dz_betaz ) * psidc(i,j,k) + &
                Bconsx(i,j,k) * (dx_alp - half*alp(i,j,k) * &
                 ( uxx*dx_gxx + uyy*dx_gyy + uzz*dx_gzz + 2.d0*uxy*dx_gxy + &
                   2.d0*uxz*dx_gxz + 2.d0*uyz*dx_gyz ) )/sqrtdet + &
                Bconsy(i,j,k) * (dy_alp - half*alp(i,j,k) * &
                 ( uxx*dy_gxx + uyy*dy_gyy + uzz*dy_gzz + 2.d0*uxy*dy_gxy + &
                   2.d0*uxz*dy_gxz + 2.d0*uyz*dy_gyz ) )/sqrtdet + &
                Bconsz(i,j,k) * (dz_alp - half*alp(i,j,k) * &
                 ( uxx*dz_gxx + uyy*dz_gyy + uzz*dz_gzz + 2.d0*uxy*dz_gxy + &
                   2.d0*uxz*dz_gxz + 2.d0*uyz*dz_gyz ) )/sqrtdet

           !!$ g^{jk} d_i g_{kj} = d_i (g) / det
           dx_det_bydet = uxx*dx_gxx + uyy*dx_gyy + uzz*dx_gzz + &
                2.d0*(uxy*dx_gxy+uxz*dx_gxz+uyz*dx_gyz)
           dy_det_bydet = uxx*dy_gxx + uyy*dy_gyy + uzz*dy_gzz + &
                2.d0*(uxy*dy_gxy+uxz*dy_gxz+uyz*dy_gyz)
           dz_det_bydet = uxx*dz_gxx + uyy*dz_gyy + uzz*dz_gzz + &
                2.d0*(uxy*dz_gxy+uxz*dz_gxz+uyz*dz_gyz)

           !!$ g^{ik} d_k g_{li}
           gdg_x = uxx*dx_gxx + uxy*dy_gxx + uxz*dz_gxx + &
                   uxy*dx_gxy + uyy*dy_gxy + uyz*dz_gxy + &
                   uxz*dx_gxz + uyz*dy_gxz + uzz*dz_gxz

           gdg_y = uxx*dx_gxy + uxy*dy_gxy + uxz*dz_gxy + &
                   uxy*dx_gyy + uyy*dy_gyy + uyz*dz_gyy + &
                   uxz*dx_gyz + uyz*dy_gyz + uzz*dz_gyz

           gdg_z = uxx*dx_gxz + uxy*dy_gxz + uxz*dz_gxz + &
                   uxy*dx_gyz + uyy*dy_gyz + uyz*dz_gyz + &
                   uxz*dx_gzz + uyz*dy_gzz + uzz*dz_gzz

           bvcx_source = -1.d0 * ( Bconsx(i,j,k)*dx_betax + &
                Bconsy(i,j,k)*dy_betax + Bconsz(i,j,k)*dz_betax ) + &
                psidc(i,j,k)*sqrtdet*(( uxx*dx_alp+uxy*dy_alp+uxz*dz_alp ) + &
                alp(i,j,k)*(0.5d0*( uxx*dx_det_bydet + &
                  uxy*dy_det_bydet + uxz*dz_det_bydet) - &
                ( uxx*gdg_x + uxy*gdg_y + uxz*gdg_z )))

           bvcy_source = -1.d0 * ( Bconsx(i,j,k)*dx_betay + &
                Bconsy(i,j,k)*dy_betay + Bconsz(i,j,k)*dz_betay ) + &
                psidc(i,j,k)*sqrtdet*(( uxy*dx_alp+uyy*dy_alp+uyz*dz_alp ) + &
                alp(i,j,k)*(0.5d0*( uxy*dx_det_bydet + &
                  uyy*dy_det_bydet + uyz*dz_det_bydet ) - &
                ( uxy*gdg_x + uyy*gdg_y + uyz*gdg_z )))

           bvcz_source = -1.d0 * ( Bconsx(i,j,k)*dx_betaz + &
                Bconsy(i,j,k)*dy_betaz + Bconsz(i,j,k)*dz_betaz ) + &
                psidc(i,j,k)*sqrtdet*(( uxz*dx_alp+uyz*dy_alp+uzz*dz_alp ) + &
                alp(i,j,k)*(0.5d0*( uxz*dx_det_bydet + &
                  uyz*dy_det_bydet + uzz*dz_det_bydet ) - &
                ( uxz*gdg_x + uyz*gdg_y + uzz*gdg_z )))

           Bconsrhsx(i,j,k) = bvcx_source
           Bconsrhsy(i,j,k) = bvcy_source
           Bconsrhsz(i,j,k) = bvcz_source
        endif

      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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
        Bcons(i,j,k,1) = -1d100
        Bcons(i,j,k,2) = -1d100
        Bcons(i,j,k,3) = -1d100
        psidc(i,j,k) = -1d100
      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 SourceTermsM




```

GRHydro_ENOReconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_ENOReconstruct_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 ENO 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_ENOReconstruct_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 ENO reconstruction. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_ENOReconstruct_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

!!$ ENO 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_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
              call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                 eps(:,j,k),epsminus(:,j,k),epsplus(:,j,k),&
                 trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                    entropy(:,j,k),entropyminus(:,j,k),entropyplus(:,j,k),&
                    trivial_rp(:,j,k), hydro_excision_mask(:,j,k))
            endif
            if (evolve_Y_e.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(1),&
                    temperature(:,j,k),tempminus(:,j,k),tempplus(:,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))
            call GRHydro_ENOReconstruct1d(eno_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_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
            if (evolve_entropy .ne. 0) then
               call GRHydro_ENOReconstruct1d(eno_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_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
      ! 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_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                 rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
              call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                 eps(j,:,k),epsminus(j,:,k),epsplus(j,:,k),&
                 trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                    entropy(j,:,k),entropyminus(j,:,k),entropyplus(j,:,k),&
                    trivial_rp(j,:,k), hydro_excision_mask(j,:,k))
            endif
            if (evolve_Y_e.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(2),&
                    temperature(j,:,k),tempminus(j,:,k),tempplus(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(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))
            call GRHydro_ENOReconstruct1d(eno_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_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))
            endif
            if (evolve_entropy .ne. 0) then
               call GRHydro_ENOReconstruct1d(eno_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_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
      ! 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_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
              call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                   lvel(j,k,:,1),velxminus(j,k,:),velxplus(j,k,:),&
                   trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
              call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                   lvel(j,k,:,2),velyminus(j,k,:),velyplus(j,k,:),&
                   trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
              call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                   lvel(j,k,:,3),velzminus(j,k,:),velzplus(j,k,:),&
                   trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            end if
            call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                 eps(j,k,:),epsminus(j,k,:),epsplus(j,k,:),&
                 trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            if(evolve_mhd.ne.0) then
               if (GRHydro_UseGeneralCoordinates(cctkGH).eq.0) then
                 call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                      lBvec(j,k,:,1),Bvecxminus(j,k,:),Bvecxplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                      lBvec(j,k,:,2),Bvecyminus(j,k,:),Bvecyplus(j,k,:),&
                      trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
                 call GRHydro_ENOReconstruct1d(eno_order,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_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    entropy(j,k,:),entropyminus(j,k,:),entropyplus(j,k,:),&
                    trivial_rp(j,k,:), hydro_excision_mask(j,k,:))
            endif
            if (evolve_Y_e.ne.0) then
               call GRHydro_ENOReconstruct1d(eno_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_ENOReconstruct1d(eno_order,cctk_lsh(3),&
                    temperature(j,k,:),tempminus(j,k,:),tempplus(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,:))
            call GRHydro_ENOReconstruct1d(eno_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_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
            if (evolve_entropy .ne. 0) then
               call GRHydro_ENOReconstruct1d(eno_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_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
!!$ ENO ends.

  deallocate(trivial_rp)
  deallocate(dum,dump,dumm)

end subroutine GRHydro_ENOReconstruct_drv


```

make.code.defn:
```
# Main make.code.defn file for thorn GRHydro

# Source files in this directory

SRCS = 	Utils.F90 \
	GRHydro_Analysis.F90 \
	GRHydro_Boundaries.F90 \
	GRHydro_CalcBcom.F90 \
	GRHydro_CalcUpdate.F90 \
	GRHydro_Con2Prim.F90 \
	GRHydro_Con2PrimHot.F90 \
        GRHydro_DivergenceClean.F90 \
	GRHydro_Eigenproblem.F90 \
	GRHydro_Eigenproblem_Marquina.F90 \
	GRHydro_ENOReconstruct.F90 \
	GRHydro_ENOScalars.F90 \
	GRHydro_EOS.c \
	GRHydro_Flux.F90 \
	GRHydro_FluxSplit.F90 \
	GRHydro_HLLE.F90 \
	GRHydro_HLLC.F90 \
	GRHydro_Loop.F90 \
	GRHydro_Minima.F90 \
	GRHydro_Minima.cc \
	GRHydro_PPM.F90 \
	GRHydro_ParamCheck.F90 \
	GRHydro_Particle.F90 \
	GRHydro_PreLoop.F90 \
	GRHydro_Prim2Con.F90 \
	GRHydro_Reconstruct.F90 \
	GRHydro_Reconstruct.cc \
	GRHydro_ReconstructPoly.F90 \
	GRHydro_RegisterMask.c \
	GRHydro_RegisterVars.cc \
	GRHydro_RiemannSolve.F90 \
	GRHydro_RoeAverage.F90 \
	GRHydro_RoeSolver.F90 \
	GRHydro_Scalars.F90 \
	GRHydro_Shift.F90 \
	GRHydro_Startup.F90 \
	GRHydro_TVDReconstruct.F90 \
	GRHydro_Marquina.F90 \
	GRHydro_UpdateMask.F90 \
	GRHydro_Set_TP_GF.c  \
	GRHydro_Differences.F90 \
	GRHydro_EoSChangeGamma.F90 \
	GRHydro_Tmunu.F90 \
	GRHydro_Con2PrimM.F90 \
	GRHydro_Con2PrimM_pt_EOSOmniold.c \
	GRHydro_Con2PrimM_pt_EOSOmni.c \
	GRHydro_Con2PrimM_pt.c \
	GRHydro_Con2PrimM_ptee.c \
	GRHydro_Con2PrimM_polytype_pt.c \
	GRHydro_EigenproblemM.F90 \
	GRHydro_FluxM.F90 \
	GRHydro_HLLEM.F90 \
        GRHydro_PPMM.F90 \
	GRHydro_Prim2ConM.F90 \
	GRHydro_RiemannSolveM.F90 \
	GRHydro_SourceM.F90 \
	GRHydro_TmunuM.F90 \
	GRHydro_UpdateMaskM.F90 \
	GRHydro_UtilsM.F90 \
        GRHydro_BvecfromAvec.F90 \
	GRHydro_RiemannSolveAM.F90 \
	GRHydro_HLLE_AM.F90 \
	GRHydro_Con2PrimAM.F90 \
	GRHydro_Prim2ConAM.F90 \
	GRHydro_SourceAM.F90 \
	GRHydro_TransformTensorBasis.c \
	GRHydro_Jacobian_state.c \
	GRHydro_PPMMReconstruct_drv.F90\
	GRHydro_ENOReconstruct_drv.F90\
	GRHydro_PPMReconstruct_drv.F90\
	GRHydro_WENOReconstruct_drv.F90\
	GRHydro_MP5Reconstruct_drv.F90\
	GRHydro_LastMoLPostStep.c\
	GRHydro_TVDReconstruct_drv.F90\
	GRHydro_EvolutionMask.F90\
	GRHydro_WENOReconstruct.F90\
	GRHydro_WENOScalars.F90 \
	GRHydro_MP5Reconstruct.F90 \
        Con2Prim_fortran_interfaces.F90 \
        Con2PrimM_fortran_interfaces.F90 \
        GRHydro_Prim2Con.cc \
	GRHydro_PPM.cc \
	GRHydro_ePPM.cc \
        GRHydro_PPMReconstruct_drv_opt.cc \
        GRHydro_WENOReconstruct.cc \
        GRHydro_TVDReconstruct.cc \
        GRHydro_TrivialReconstruct.cc \
        GRHydro_MP5Reconstruct.cc \
        GRHydro_Wrappers.F90 \
	GRHydro_HLLE.cc \
	GRHydro_Source.cc \
	GRHydro_Source.F90


# Subdirectories containing source files
SUBDIRS = 


```

GRHydro_MP5Reconstruct.cc:
```
#include <cmath>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_Reconstruct_drv_impl.hh"
#include "GRHydro_MP5Reconstruct.hh"

using namespace std;

template <typename T> static inline T SQR (T const & x) { return x*x; }

#define MIN(a,b) (((a)<(b))?(a):(b))
#define MAX(a,b) (((a)>(b))?(a):(b))

#define MIN3(a,b,c) (MIN(a, MIN(b,c)))
#define MIN4(a,b,c,d) (MIN(a, MIN(b,MIN(c,d))))
#define MAX3(a,b,c) (MAX(a, MAX(b,c)))

#define MINMOD(x,y)  \
     (0.5*(copysign(1.0,x) + copysign(1.0,y)) * MIN(fabs(x), fabs(y)))

#define MINMOD4(w,x,y,z) \
     (0.125*( copysign(1.0,w)+copysign(1.0,x) )*fabs( (copysign(1.0,w)+copysign(1.0,y)) * (copysign(1.0,w)+copysign(1.0,z)) )*MIN4(fabs(w), fabs(x), fabs(y), fabs(z)))

     
static inline CCTK_REAL MP5(const CCTK_REAL am2, 
                            const CCTK_REAL am1, 
                            const CCTK_REAL a, 
                            const CCTK_REAL ap1, 
                            const CCTK_REAL ap2,
                            const CCTK_REAL anorm,
                            const CCTK_REAL mp5_eps,
                            const CCTK_REAL mp5_alpha
                            )
{
   const CCTK_REAL vl = (2.0*am2 - 13.0*am1 + 47.0*a + 27.0*ap1 - 3.0*ap2) * 1.0/60.0;
   const CCTK_REAL vmp = a + MINMOD( ap1-a, mp5_alpha*(a-am1) );
   if ((vl-a)*(vl-vmp) <= mp5_eps*anorm)
      return vl;
   else {
      const CCTK_REAL djm1 = am2 -2.0*am1 + a;
      const CCTK_REAL dj   = am1 -2.0*a + ap1;
      const CCTK_REAL djp1 = a -2.0*ap1 + ap2;
      const CCTK_REAL dm4jph = MINMOD4(4.0*dj-djp1, 4.0*djp1-dj, dj, djp1);
      const CCTK_REAL dm4jmh = MINMOD4(4.0*dj-djm1, 4.0*djm1-dj, dj, djm1);
      const CCTK_REAL vul = a + mp5_alpha*(a-am1);
      const CCTK_REAL vav = 0.5*(a+ap1);
      const CCTK_REAL vmd = vav - 0.5*dm4jph;
      const CCTK_REAL vlc = a + 0.5*(a-am1) + 4.0/3.0*dm4jmh;
      const CCTK_REAL vmin = MAX(MIN3(a,ap1,vmd), MIN3(a,vul,vlc));
      const CCTK_REAL vmax = MIN(MAX3(a,ap1,vmd), MAX3(a,vul,vlc));
      return vl + MINMOD(vmin-vl, vmax-vl);
   }
   return 0;
}


/**
   MP5 reconstruction operator.
*/
template <bool do_MP5_adaptive_epsilon>
template <int dir>
inline void
GRHydro_MP5Reconstruct1d_cxx<do_MP5_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
                        )
{
#define A(i_) (a[ijk[i_]])
#define Aplus(i_) (aplus[ijk[i_]])
#define Aminus(i_) (aminus[ijk[i_]])

   DECLARE_CCTK_PARAMETERS;
   
   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)
                         };
                       
      if (!do_MP5_adaptive_epsilon) {
                         
         Aplus(2)  = MP5(A(0), A(1), A(2), A(3), A(4), 1.0, mp5_eps, mp5_alpha);
         Aminus(2) = MP5(A(4), A(3), A(2), A(1), A(0), 1.0, mp5_eps, mp5_alpha);
   
      } else {
         
         const CCTK_REAL anorm = sqrt(SQR(A(0)) + SQR(A(1)) + SQR(A(2)) + SQR(A(3)) + SQR(A(4)));
         
         Aplus(2)  = MP5(A(0), A(1), A(2), A(3), A(4), anorm, mp5_eps, mp5_alpha);
         Aminus(2) = MP5(A(4), A(3), A(2), A(1), A(0), anorm, mp5_eps, mp5_alpha);
         
      }

   }
}

// 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_MP5Reconstruct1d_cxx<false>;
template class GRHydro_MP5Reconstruct1d_cxx<true>;

INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_MP5Reconstruct1d_cxx<false>)
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_MP5Reconstruct1d_cxx<true >)

```

GRHydro_TVDReconstruct_drv.F90:
```
 /*@@
   @file      GRHydro_TVDReconstruct_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 TVD reconstruction.
   @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)
#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 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_TVDReconstruct_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 TVD reconstruction. Currently just does
   TVD on the primitive variables.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_TVDReconstruct_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

  if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
    call TVDReconstruct_drv(gaa, gab, gac, gbb, gbc, gcc, lvel, lBvec)
  else
    call TVDReconstruct_drv(gxx, gxy, gxz, gyy, gyz, gzz, vel, Bvec)
  end if

contains
subroutine TVDReconstruct_drv(g11, g12, g13, g22, g23, g33, vup, Bprim)

  implicit none

  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11, g12, g13, g22, g23, g33
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup, Bprim

  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_INT :: ierr

  ! variables used when reconstruct_Wv == true
  CCTK_REAL :: inv_w                                 ! 1/Lorentz factor
  CCTK_REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: wvel ! vel*w_lorentz
  CCTK_REAL :: agxx,agxy,agxz,agyy,agyz,agzz         ! metric components

  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

  !!$ 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).
    allocate(wvel(cctk_ash(1),cctk_ash(2),cctk_ash(3),3),STAT=ierr)
    if (ierr .ne. 0) then
      call CCTK_ERROR("Allocation problems with wvel")
      STOP
    end if
    !$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)
          wvel(i,j,k,1) = vup(i,j,k,1) * w_lorentz(i,j,k)
          wvel(i,j,k,2) = vup(i,j,k,2) * w_lorentz(i,j,k)
          wvel(i,j,k,3) = vup(i,j,k,3) * w_lorentz(i,j,k)
        end do
      end do
    end do
    !$OMP END PARALLEL DO
  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

!!$ TVD 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 (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)

      if (reconstruct_Wv.ne.0) then
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             wvel(:,:,:,1), velxplus, velxminus, trivial_rp, hydro_excision_mask)
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             wvel(:,:,:,2), velyplus, velyminus, trivial_rp, hydro_excision_mask)
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             wvel(:,:,:,3), velzplus, velzminus, trivial_rp, hydro_excision_mask)
        ! 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)
        ! 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,inv_w,agxx,agxy,agxz,agyy,agyz,agzz)
        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)
              agxx = 0.5d0*( g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset) )
              agxy = 0.5d0*( g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset) )
              agxz = 0.5d0*( g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset) )
              agyy = 0.5d0*( g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset) )
              agyz = 0.5d0*( g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset) )
              agzz = 0.5d0*( g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset) )
              inv_w = 1d0/sqrt( 1.d0 + agxx*velxminus(i,j,k)*velxminus(i,j,k) &
                                     + agyy*velyminus(i,j,k)*velyminus(i,j,k) &
                                     + agzz*velzminus(i,j,k)*velzminus(i,j,k) &
                                + 2.d0*agxy*velxminus(i,j,k)*velyminus(i,j,k) &
                                + 2.d0*agxz*velxminus(i,j,k)*velzminus(i,j,k) &
                                + 2.d0*agyz*velyminus(i,j,k)*velzminus(i,j,k) )
              velxminus(i,j,k) = velxminus(i,j,k)*inv_w
              velyminus(i,j,k) = velyminus(i,j,k)*inv_w
              velzminus(i,j,k) = velzminus(i,j,k)*inv_w
              
              agxx = 0.5d0*( g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset) )
              agxy = 0.5d0*( g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset) )
              agxz = 0.5d0*( g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset) )
              agyy = 0.5d0*( g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset) )
              agyz = 0.5d0*( g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset) )
              agzz = 0.5d0*( g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset) )
              inv_w = 1d0/sqrt( 1.d0 + agxx*velxplus(i,j,k)*velxplus(i,j,k) &
                                     + agyy*velyplus(i,j,k)*velyplus(i,j,k) &
                                     + agzz*velzplus(i,j,k)*velzplus(i,j,k) &
                                + 2.d0*agxy*velxplus(i,j,k)*velyplus(i,j,k) &
                                + 2.d0*agxz*velxplus(i,j,k)*velzplus(i,j,k) &
                                + 2.d0*agyz*velyplus(i,j,k)*velzplus(i,j,k) )
              velxplus(i,j,k) = velxplus(i,j,k)*inv_w
              velyplus(i,j,k) = velyplus(i,j,k)*inv_w
              velzplus(i,j,k) = velzplus(i,j,k)*inv_w
            end do
          end do
        end do
        !$OMP END PARALLEL DO
      else
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             vup(:,:,:,1), velxplus, velxminus, trivial_rp, hydro_excision_mask)
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             vup(:,:,:,2), velyplus, velyminus, trivial_rp, hydro_excision_mask)
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             vup(:,:,:,3), velzplus, velzminus, trivial_rp, hydro_excision_mask)
      end if
        call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
             eps, epsplus, epsminus, trivial_rp, hydro_excision_mask)
      if(evolve_mhd.ne.0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bprim(:,:,:,1), Bvecxplus, Bvecxminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bprim(:,:,:,2), Bvecyplus, Bvecyminus, trivial_rp, hydro_excision_mask)
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              Bprim(:,:,:,3), Bveczplus, Bveczminus, trivial_rp, hydro_excision_mask)
      endif
      if (evolve_entropy .ne. 0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              entropy, entropyplus, entropyminus, trivial_rp, hydro_excision_mask)
      endif
      if (evolve_temper .ne. 0 .and. reconstruct_temper .ne. 0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              temperature, tempplus, tempminus, 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)
      call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
           tau, tauplus, tauminus, 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
      if (evolve_entropy .ne. 0) then
         call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, &
              entropycons, entropyconsplus, entropyconsminus, 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
!!$ TVD ends.

  deallocate(trivial_rp)
  ! Fortran 90 will automatically deallocate wvel for us

end subroutine
end subroutine GRHydro_TVDReconstruct_drv



```

GRHydro_Boundaries.F90:
```
 /*@@
   @file      GRHydro_Boundaries.F90
   @date      Sat Jan 26 01:01:14 2002
   @author    
   @desc 
   The two routines for dealing with boundary conditions.
   @enddesc 
 @@*/

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

#include "util_Table.h"

 /*@@
   @routine    GRHydro_InitSymBound
   @date       Sat Jan 26 01:03:04 2002
   @author     Ian Hawke
   @desc 
   Sets up the symmetries at the boundaries of the hydrodynamical variables.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Direct translation of routines from GR3D, GRAstro_Hydro, 
   written by Mark Miller, or WaveToy routines, or...
   @endhistory 

@@*/

subroutine GRHydro_InitSymBound(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  integer, dimension(3) :: sym
  integer :: ierr
  CCTK_INT :: GRHydro_UseGeneralCoordinates, general_coordinates

  ierr = 0
  sym(1) = 1
  sym(2) = 1
  sym(3) = 1

  general_coordinates = GRHydro_UseGeneralCoordinates(cctkGH)
  
  !if (sync_conserved_only .eq. 0) then
   call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::rho")
   call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::press")
   call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::w_lorentz")
   call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::eps")
  !endif
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::dens")
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::tau")
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::GRHydro_C2P_failed")
  if(evolve_mhd.ne.0.and.clean_divergence.ne.0) then
     call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::psidc")
  endif

!!$ handle multiple tracer variables
  if(evolve_tracer.ne.0) then
     call SetCartSymGN(ierr, cctkGH, sym, "GRHydro::GRHydro_tracers")
     call SetCartSymGN(ierr, cctkGH, sym, "GRHydro::GRHydro_cons_tracers")
  endif 

  if(evolve_y_e.ne.0) then
   !if (sync_conserved_only .eq. 0) then
     call SetCartSymGN(ierr, cctkGH, sym, "HydroBase::Y_e")
   !endif
     call SetCartSymGN(ierr, cctkGH, sym, "GRHydro::Y_e_con")
  endif

  if(evolve_temper.ne.0) then
    !if (sync_conserved_only .eq. 0) then
      call SetCartSymGN(ierr, cctkGH, sym, "HydroBase::temperature")
      call SetCartSymGN(ierr, cctkGH, sym, "HydroBase::entropy")
    !endif
  endif
  
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::atmosphere_mask_real")
  
  sym(1) = -1
  sym(2) = 1
  sym(3) = 1
  
  !if (sync_conserved_only .eq. 0) then
      if (general_coordinates .ne. 0) then
         call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::lvel[0]")
      else
         call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[0]")
      endif
  !endif
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[0]")
  if(evolve_mhd.ne.0) then
     !if (sync_conserved_only .eq. 0) then
      call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[0]")
     !endif
     call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::Bcons[0]")
  endif
  
  sym(1) = 1
  sym(2) = -1
  sym(3) = 1
  
  !if (sync_conserved_only .eq. 0) then
      if (general_coordinates .ne. 0) then
         call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::lvel[1]")
      else
         call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[1]")
      endif
  !endif
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[1]")
  if(evolve_mhd.ne.0) then
     !if (sync_conserved_only .eq. 0) then
         call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[1]")
     !endif
     call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::Bcons[1]")
  endif

  sym(1) = 1
  sym(2) = 1
  sym(3) = -1
  
  !if (sync_conserved_only .eq. 0) then
      if (general_coordinates .ne. 0) then
         call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::lvel[2]")
      else
         call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[2]")
      endif
  !endif
  call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[2]")
  if(evolve_mhd.ne.0) then
    !if (sync_conserved_only .eq. 0) then
      call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[2]")
    !endif 
    call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::Bcons[2]")
  endif

! check that storage for shift is active
 if(shift_state.eq.0) then
    call CCTK_ERROR("shift_state = 0 (no shift storage) no longer supported!")
    STOP
  endif

  
end subroutine GRHydro_InitSymBound

 /*@@
   @routine    GRHydro_Boundaries
   @date       Sat Jan 26 01:04:04 2002
   @author     
   @desc 
   Calls the appropriate boundary routines
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_RegisterBoundariesWithMethod(CCTK_ARGUMENTS, bcname)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  character(len=*), INTENT(IN) :: bcname

  integer :: ierr
  CCTK_INT :: GRHydro_UseGeneralCoordinates, general_coordinates

  CCTK_INT, parameter :: faces=CCTK_ALL_FACES
  CCTK_INT, parameter :: ione=1
  logical :: do_Avec, do_Bcons
  
  ierr = 0 

  general_coordinates = GRHydro_UseGeneralCoordinates(cctkGH)
  do_Avec = CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec")
  do_Bcons = CCTK_EQUALS(Bvec_evolution_method,"GRHydro")

  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
       "GRHydro::dens", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
       "GRHydro::tau", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
       "GRHydro::scon", bcname)
  if (sync_conserved_only .eq. 0) then
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "HydroBase::w_lorentz", bcname)
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "HydroBase::rho", bcname)
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "HydroBase::press", bcname)
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "HydroBase::eps", bcname)
    if (general_coordinates .ne. 0) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "GRHydro::lvel", bcname)
    else
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "HydroBase::vel", bcname)
    endif
  endif
  if(evolve_mhd.ne.0) then
     if (sync_conserved_only .eq. 0) then
       if (general_coordinates .ne. 0) then
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "GRHydro::lBvec", bcname)
       else
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "HydroBase::Bvec", bcname)
       endif
     endif
     if(do_Bcons) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
            "GRHydro::Bcons", bcname)
     end if
     if (do_Avec) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
              "HydroBase::Avec", bcname)
     endif
     if(clean_divergence.ne.0) then
        ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "GRHydro::psidc", bcname)
     endif
  endif


  if(evolve_tracer.ne.0) then
    if (sync_conserved_only .eq. 0) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "GRHydro::GRHydro_tracers", bcname)
    endif
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "GRHydro::GRHydro_cons_tracers", bcname)
  endif

  if(evolve_y_e.ne.0) then
    if (sync_conserved_only .eq. 0) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "HydroBase::Y_e", bcname)
    endif
    ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
          "GRHydro::Y_e_con", bcname)
  endif

  if(evolve_temper.ne.0) then
    if (sync_conserved_only .eq. 0) then
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "HydroBase::temperature", bcname)
       ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
             "HydroBase::entropy", bcname)
    endif
  endif

  if (ierr < 0) then
    call CCTK_ERROR("problems with applying the chosen boundary condition")
    STOP
  end if

end subroutine

subroutine GRHydro_Boundaries(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (verbose.eq.1) call CCTK_INFO("Selecting conserved BC (and primitive BC if selected)")

!!$Flat boundaries if required
  if (CCTK_EQUALS(bound,"flat")) then
    call GRHydro_RegisterBoundariesWithMethod(CCTK_PASS_FTOF, "Flat")
  endif

!!$None boundaries if required
  if (CCTK_EQUALS(bound,"none")) then
    call GRHydro_RegisterBoundariesWithMethod(CCTK_PASS_FTOF, "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

end subroutine GRHydro_Boundaries



subroutine GRHydro_SelectPrimitiveInitialGuessesBoundariesForMethod(CCTK_ARGUMENTS, bcname)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  character(len=*), INTENT(IN) :: bcname
  
  integer :: ierr
  CCTK_INT :: GRHydro_UseGeneralCoordinates, general_coordinates

  CCTK_INT, parameter :: faces=CCTK_ALL_FACES
  CCTK_INT, parameter :: ione=1
  
  ierr = 0

  general_coordinates = GRHydro_UseGeneralCoordinates(cctkGH)

! The commented out code are those primitives which do not require and explicit
! initial guess for Con2Prim. The guesses are either not needed or computed from other quantities!

  !ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
  !      "HydroBase::w_lorentz", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::rho", bcname)
  !ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
  !      "HydroBase::press", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::eps", bcname)
  if (general_coordinates .ne. 0) then
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "GRHydro::lvel", bcname)
  else
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "HydroBase::vel", bcname)
  endif
  if(evolve_mhd.ne.0) then
       if (general_coordinates .ne. 0) then
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "GRHydro::lBvec", bcname)
       else
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "HydroBase::Bvec", bcname)
       endif
  endif

  !if(evolve_tracer.ne.0) then
  !  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
  !         "GRHydro::GRHydro_tracers", bcname)
  !endif

  !if(evolve_y_e.ne.0) then
  !  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
  !         "HydroBase::Y_e", bcname)
  !endif

  if(evolve_temper.ne.0) then
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "HydroBase::temperature", bcname)
     !ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
     !      "HydroBase::entropy", bcname)
  endif

  if (ierr < 0) then
    call CCTK_ERROR("problems with applying the chosen boundary condition")
    STOP
  end if

end subroutine GRHydro_SelectPrimitiveInitialGuessesBoundariesForMethod

subroutine GRHydro_SelectPrimitiveInitialGuessesBoundaries(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (verbose.eq.1) call CCTK_INFO("Selecting primitive BC")

!!$Flat boundaries if required
  if (CCTK_EQUALS(bound,"flat")) then
    call GRHydro_SelectPrimitiveInitialGuessesBoundariesForMethod(CCTK_PASS_FTOF, "Flat")
  endif

!!$None boundaries if required
  if (CCTK_EQUALS(bound,"none")) then
    call GRHydro_SelectPrimitiveInitialGuessesBoundariesForMethod(CCTK_PASS_FTOF, "None")
  end if

!!$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

end subroutine GRHydro_SelectPrimitiveInitialGuessesBoundaries








subroutine GRHydro_SelectPrimitiveBoundariesForMethod(CCTK_ARGUMENTS, bcname)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  character(len=*), INTENT(IN) :: bcname

  integer :: ierr
  CCTK_INT :: GRHydro_UseGeneralCoordinates, general_coordinates

  CCTK_INT, parameter :: faces=CCTK_ALL_FACES
  CCTK_INT, parameter :: ione=1
  
  ierr = 0

  general_coordinates = GRHydro_UseGeneralCoordinates(cctkGH)

  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::w_lorentz", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::rho", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::press", bcname)
  ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
        "HydroBase::eps", bcname)
  if (general_coordinates .ne. 0) then
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "GRHydro::lvel", bcname)
  else
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "HydroBase::vel", bcname)
  endif
  if(evolve_mhd.ne.0) then
       if (general_coordinates .ne. 0) then
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "GRHydro::lBvec", bcname)
       else
          ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                "HydroBase::Bvec", bcname)
       endif
  endif

  if(evolve_tracer.ne.0) then
           ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                 "GRHydro::GRHydro_tracers", bcname)
  endif

  if(evolve_y_e.ne.0) then
           ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
                 "HydroBase::Y_e", bcname)
  endif

  if(evolve_temper.ne.0) then
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "HydroBase::temperature", bcname)
     ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
           "HydroBase::entropy", bcname)
  endif

  if (ierr < 0) then
    call CCTK_ERROR("problems with applying the chosen boundary condition")
    STOP
  end if

end subroutine GRHydro_SelectPrimitiveBoundariesForMethod

subroutine GRHydro_SelectPrimitiveBoundaries(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (verbose.eq.1) call CCTK_INFO("Selecting primitive BC")

!!$Flat boundaries if required
  if (CCTK_EQUALS(bound,"flat")) then
    call GRHydro_SelectPrimitiveBoundariesForMethod(CCTK_ARGUMENTS, "Flat")
  endif

!!$None boundaries if required
  if (CCTK_EQUALS(bound,"none")) then
    call GRHydro_SelectPrimitiveBoundariesForMethod(CCTK_ARGUMENTS, "None")
  end if

!!$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

end subroutine GRHydro_SelectPrimitiveBoundaries








subroutine GRHydro_SelectAtmosphereMaskBoundaries(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: ierr

  CCTK_INT, parameter :: faces=CCTK_ALL_FACES
  CCTK_INT, parameter :: ione=1
  
  ierr = 0

!!$Flat boundaries if required  

  if (verbose.eq.1) call CCTK_INFO("Selecting atmosphere mask BC")


  if (CCTK_EQUALS(bound,"flat")) then
      ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
         "GRHydro::GRHydro_atmosphere_mask_real", "Flat")
  endif

  if (CCTK_EQUALS(bound,"none")) then      
      ierr = ierr + Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, &
         "GRHydro::GRHydro_atmosphere_mask_real", "None")
  end if

  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_SelectAtmosphereMaskBoundaries


```

GRHydro_Scalars.F90:
```
 /*@@
   @file      GRHydro_Scalars.F90
   @date      Mon Feb 25 11:11:23 2002
   @author    
   @desc 
   Module containing various scalars to avoid having to use
   CCTK_EQUALS on keywords at every cell (slow).
   @enddesc 
 @@*/

#include "cctk.h"

 module GRHydro_Scalars

   implicit none

   LOGICAL, SAVE :: MINMOD, MC2, SUPERBEE, PPM3, PPM4
   LOGICAL, SAVE :: ANALYTICAL
   LOGICAL, SAVE :: FAST
   LOGICAL, SAVE :: HLLE, LLF

   
 end module GRHydro_Scalars

```

GRHydro_CalcBcom.F90:
```
 /*@@
   @file      GRHydro_CalcBcom.F90
   @date      Jan 01, 2012
   @author    Bruno Mundim
   @histpry
    Based on GRHydro_TmunuM.F90 file.
   @desc 
     The calculation of the magnetic pressure and the comoving magnetic
     field.
   @enddesc 
 @@*/
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.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 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 bcomx(i,j,k) bcom(i,j,k,1)
#define bcomy(i,j,k) bcom(i,j,k,2)
#define bcomz(i,j,k) bcom(i,j,k,3)

 subroutine GRHydro_CalcBcom(CCTK_ARGUMENTS)

   implicit none

   DECLARE_CCTK_ARGUMENTS
   DECLARE_CCTK_FUNCTIONS

   CCTK_REAL :: velxlow, velylow, velzlow
   CCTK_REAL :: Bvecxlow,Bvecylow,Bveczlow
   CCTK_REAL :: bdotv,b2,bxlow,bylow,bzlow,dum1,dum2
   CCTK_INT :: i,j,k
   integer :: timelevels

   call CCTK_ActiveTimeLevels(timelevels, cctkGH, "GRHydro::bcom")
   if(timelevels.eq.0) then
     call CCTK_ERROR("No storage for GRHydro::bcom")
     STOP
   end if

! Only compute if Tmunu is not computed! (Bcom is also computed with Tmunu)
   if (stress_energy_state .ne. 0) then
      return
   endif

   !$OMP PARALLEL DO PRIVATE(i,j,k,velxlow, velylow, velzlow,&
   !$OMP Bvecxlow,Bvecylow,Bveczlow, bdotv,dum1,dum2,b2,bxlow,bylow,bzlow)

   do k = 1, cctk_lsh(3)
     do j = 1, cctk_lsh(2)
       do i = 1, cctk_lsh(1)

          call calc_vlow_blow(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),&
               gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), &
               velx(i,j,k),vely(i,j,k),velz(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(i,j,k), &
               velxlow,velylow,velzlow,Bvecxlow,Bvecylow,Bveczlow, &
               bdotv,b2,dum1,dum2,bxlow,bylow,bzlow)

           bcom_sq(i,j,k) = b2 
           bcom0(i,j,k) = w_lorentz(i,j,k)*bdotv/alp(i,j,k)
           bcomx(i,j,k) = Bvecx(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*velx(i,j,k)-betax(i,j,k))
           bcomy(i,j,k) = Bvecy(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*vely(i,j,k)-betay(i,j,k))
           bcomz(i,j,k) = Bvecz(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*velz(i,j,k)-betaz(i,j,k))

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

   return
 
 end subroutine GRHydro_CalcBcom

```

GRHydro_ENOReconstruct.F90:
```
 /*@@
   @file      GRHydro_ENOReconstruct.F90
   @date      Sat Apr  6 17:37:56 2002
   @author    Ian Hawke
   @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_ENOSetup
   @date       Sat Apr  6 17:42:13 2002
   @author     Ian Hawke
   @desc 
   Sets up the coefficient array for ENO 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_ENOSetup(CCTK_ARGUMENTS)

  USE GRHydro_ENOScalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, l, m, q, allocstat
  CCTK_REAL :: denominator, numerator, numerator_product

  if(.not.allocated(eno_coeffs)) then
     allocate(eno_coeffs(-1:eno_order - 1, 0:eno_order - 1), STAT=allocstat)

     if (allocstat .ne. 0) then
       call CCTK_ERROR("Failed to allocate ENO coefficient arrays!")
       STOP
     end if
  endif

  do i = -1, eno_order - 1
    do j = 0, eno_order - 1

      eno_coeffs(i, j) = 0.d0

      do m = j+1, eno_order

        denominator = 1.d0
        do l = 0, m-1
          denominator = denominator * dble(m - l)
        end do
        do l = m+1, eno_order
          denominator = denominator * dble(m - l)
        end do

        numerator = 0.d0
        do l = 0, m-1
          numerator_product = 1.d0
          do q = 0, l-1
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          do q = l+1, m-1
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          do q = m+1, eno_order
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          numerator = numerator + numerator_product
        end do

        do l = m+1, eno_order
          numerator_product = 1.d0
          do q = 0, m-1
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          do q = m+1, l-1
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          do q = l+1, eno_order
            numerator_product = numerator_product * dble(i - q + 1)
          end do
          numerator = numerator + numerator_product
        end do

        eno_coeffs(i, j) = eno_coeffs(i, j) + numerator / denominator

      end do

    end do
  end do

end subroutine GRHydro_ENOSetup

 /*@@
   @routine    GRHydro_ENOShutdown
   @date       Mon Apr  8 12:40:44 2002
   @author     Ian Hawke
   @desc 
   Deallocates the coefficient arrays
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_ENOShutdown(CCTK_ARGUMENTS)

  USE GRHydro_ENOScalars

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: deallocstat

  if(allocated(eno_coeffs)) then
     deallocate(eno_coeffs, STAT = deallocstat)
     if (deallocstat .ne. 0) then
       call CCTK_ERROR("Failed to deallocate ENO coefficients.")
     end if
  endif

end subroutine GRHydro_ENOShutdown

 /*@@
   @routine    GRHydro_ENOReconstruct1d
   @date       Sat Apr  6 18:15:29 2002
   @author     Ian Hawke
   @desc 
   Perform a one dimensional reconstruction of a given array using ENO.
   Again, see Shu, section 2.1
   @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_ENOReconstruct1d(order, nx, v, vminus, vplus, trivial_rp, &
     hydro_excision_mask)
  USE GRHydro_ENOScalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: order, nx, i, j, k, r
  CCTK_REAL, dimension(nx) :: v, vplus, vminus
  CCTK_REAL, dimension(order, 1-order:nx+order) :: vdiff

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

  CCTK_REAL :: large = 1.d10

  vminus = 0.d0
  vplus = 0.d0
  vdiff = 0.d0

  vdiff(1, 1:nx) = v
  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
      vdiff(1, i) = large * (-1.d0*(1.d0+mod(i,10)))**i
      trivial_rp(i) = .true.
      excise(i) = .true.
      if (i > 1) then
        trivial_rp(i-1) = .true.
      end if
    end if
  end do

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

!!$    Calculate the undivided differences
      do k = 2, order
        do j = max(1, i - order), min(nx, i + order)
          vdiff(k, j) = vdiff(k - 1, j + 1) - vdiff(k - 1, j)
        end do
      end do

!!$    Ensure the stencil stays within the grid
      vdiff(:, 1 - order : 0) = 1.d10
      vdiff(:, nx + 1 : nx + order) = 1.d10

!!$    Find the stencil
      r = 0
      do j = 2, order
        if ( abs(vdiff(j, i-r-1)) < abs(vdiff(j, i-r)) ) r = r + 1
      end do
      
!!$    Calculate the reconstruction
      do j = 0, order - 1
        vminus(i) = vminus(i) + eno_coeffs(r-1, j) * vdiff(1, i-r+j)
        vplus(i) = vplus(i) + eno_coeffs(r, j) * vdiff(1, i-r+j)
      end do
    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_ENOReconstruct1d

```

GRHydro_FluxM.F90:
```
/*@@
@file      GRHydro_FluxM.F90
@date      August 30, 2010
@author    Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
@desc 
The routine to calculate the numerical flux function given a 
  specific state
  @enddesc 
  @@*/
  
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
 
subroutine num_x_fluxM(dens,sx,sy,sz,tau,Bx,By,Bz,&
     densf,sxf,syf,szf,tauf,Bxf,Byf,Bzf,vxt,vyt,vzt,pressstar,&
     bsubx,bsuby,bsubz,ab0,w,det,alp,beta)

  implicit none

  CCTK_REAL :: dens,sx,sy,sz,tau,Bx,By,Bz
  CCTK_REAL :: densf,sxf,syf,szf,tauf,Bxf,Byf,Bzf
  CCTK_REAL :: vxt,vyt,vzt,bsubx,bsuby,bsubz,ab0,w
  CCTK_REAL :: det,alp,beta,pressstar
  CCTK_REAL :: velm
  CCTK_REAL :: sdet,psipstar

  sdet=sqrt(det)
  psipstar=pressstar*sdet

!!$ We actually need all three values of vtilde = v^i - beta^i/alp, as well as
  velm=vxt+beta/alp

!!$ GRHydro splits off alpha for later in the calculation, so we have psi^6 * [Anton eq.42]
!!$ In the notation of Anton et al.:  [psi^6 D] vtilde^i
  densf = dens * vxt

  sxf = sx*vxt+psipstar-bsubx*Bx/w

  syf = sy*vxt-bsuby*Bx/w

  szf = sz*vxt-bsubz*Bx/w

!!$ [psi^6 tau] vtilde^i +p* v^i - alp b^0 B^i/w
  tauf = tau*vxt + psipstar*velm - ab0*Bx/w

!!$ [psi^6 (B^k vtilde^i - B^i vtilde^k)]
  bxf = 0.0
  byf = By * vxt - Bx*vyt
  bzf = Bz * vxt - Bx*vzt

end subroutine num_x_fluxM


```

GRHydro_Con2PrimM_pt_EOSOmniold.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 ;
} ;

struct eosomnivars {
  CCTK_INT eoshandle,eoskeytemp;
  CCTK_REAL prec,eosprec,eos_y_e[1],eos_temp[1];
  CCTK_INT eoskeyerr[1],eosanyerr[1];
} ;

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

void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt2) (
    CCTK_INT  *handle, 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_pt2)  ( 
    CCTK_INT  *handle, 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;
  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 ;

  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;

  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," *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)) ;
  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.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    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;
  p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
  //  p = pressure_rho0_u(rho0,u,gammaeos) ;  // EOS
  w = rho0 + u + p ;

  W_last = w*gammasq ;

  //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.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    return;
  }
  else{
    if(W <= 0. || W > W_TOO_BIG) {
      *retval = 3.;
      fprintf(stdout," *retval      = %26.16e \n", *retval      );
      return;
    }
  }

  // Calculate v^2:
  if( vsq >= 1. ) {
    *retval = 4.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    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;
    p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
   // printf("%g %g %g %g\n",rho0,u,*epsilon,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; 
    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             );
    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,"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; }
    }

    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) <= 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) <= eosvars->prec ){
    return(0);
  }
  else if( (fabs(errx) <= eosvars->prec) && (fabs(errx) > eosvars->prec) ){
    return(0);
  }
  //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);

}

/**********************************************************************/
/*********************************************************************************
   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  W, vsq, u, p_tmp,epsilon,Wsq, dPdvsq, dPdW;
  CCTK_REAL res0, 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;


  W = x[0];
  vsq = x[1];
  u = x[2];
  
  Wsq = W*W;
  
  LorInv = sqrt(1.0-vsq);
  rho0 = lgp->D * LorInv;
  epsilon = u/rho0;
  p_tmp = pressure_rho0_eps_eosomni(rho0,epsilon,&dpdrho,&dpdeps,eosvars);

  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

```

Con2PrimM_fortran_interfaces.F90:
```
#include "cctk.h" 

module Con2PrimM_fortran_interfaces
  implicit none
  
  CCTK_INT, parameter :: izero = 0
  integer, parameter :: ik = kind(izero)

  interface
    subroutine GRHydro_Con2PrimM_ptold(  handle, &
                                       local_gam, dens, &
                        sx,  sy,  sz, &
                        tau, &
                        Bconsx,  Bconsy,  Bconsz, &
                        rho, &
                        velx,  vely,  velz,&
                        epsilon,  pressure,&
                        Bx,  By,  Bz, &
                        bsq,&
                        w_lorentz, &
                        gxx,  gxy,  gxz, &
                        gyy,  gyz,  gzz, &
                        uxx, uxy, uxz,&
                        uyy, uyz, uzz,&
                        det,&
                        epsnegative, &
                        retval)

       implicit none       
       CCTK_INT handle
       CCTK_REAL local_gam
       CCTK_REAL dens 
       CCTK_REAL sx, sy, sz
       CCTK_REAL tau 
       CCTK_REAL Bconsx, Bconsy, Bconsz
       CCTK_REAL rho
       CCTK_REAL velx, vely, velz
       CCTK_REAL epsilon, pressure
       CCTK_REAL Bx, By, Bz
       CCTK_REAL bsq
       CCTK_REAL w_lorentz
       CCTK_REAL gxx, gxy, gxz 
       CCTK_REAL gyy, gyz, gzz
       CCTK_REAL uxx, uxy, uxz
       CCTK_REAL uyy, uyz, uzz
       CCTK_REAL det
       CCTK_INT epsnegative
       CCTK_REAL retval
     end subroutine  GRHydro_Con2PrimM_ptold

     subroutine GRHydro_Con2PrimM_pt2(  handle, keytemp, eos_prec, prec, &
                                       local_gam, dens, &
                        sx,  sy,  sz, &
                        tau, &
                        Bconsx,  Bconsy,  Bconsz, &
                        xye, xtemp, &
                        rho, &
                        velx,  vely,  velz,&
                        epsilon,  pressure,&
                        Bx,  By,  Bz, &
                        bsq,&
                        w_lorentz, &
                        gxx,  gxy,  gxz, &
                        gyy,  gyz,  gzz, &
                        uxx, uxy, uxz,&
                        uyy, uyz, uzz,&
                        det,&
                        epsnegative, &
                        retval)

       implicit none       
       CCTK_INT handle
       CCTK_INT keytemp
       CCTK_REAL eos_prec
       CCTK_REAL prec
       CCTK_REAL local_gam
       CCTK_REAL dens 
       CCTK_REAL sx, sy, sz
       CCTK_REAL tau 
       CCTK_REAL Bconsx, Bconsy, Bconsz
       CCTK_REAL xye
       CCTK_REAL xtemp 
       CCTK_REAL rho
       CCTK_REAL velx, vely, velz
       CCTK_REAL epsilon, pressure
       CCTK_REAL Bx, By, Bz
       CCTK_REAL bsq
       CCTK_REAL w_lorentz
       CCTK_REAL gxx, gxy, gxz 
       CCTK_REAL gyy, gyz, gzz
       CCTK_REAL uxx, uxy, uxz
       CCTK_REAL uyy, uyz, uzz
       CCTK_REAL det
       CCTK_INT epsnegative
       CCTK_REAL retval
     end subroutine  GRHydro_Con2PrimM_pt2


     subroutine GRHydro_Con2PrimM_pt(  handle, GRHydro_reflevel, i, j, k, x, y, z, keytemp, eos_prec, prec, &
                                       local_gam, dens, &
                        sx,  sy,  sz, &
                        tau, &
                        Bconsx,  Bconsy,  Bconsz, &
                        xye, xtemp, &
                        rho, &
                        velx,  vely,  velz,&
                        epsilon,  pressure,&
                        Bx,  By,  Bz, &
                        bsq,&
                        w_lorentz, &
                        gxx,  gxy,  gxz, &
                        gyy,  gyz,  gzz, &
                        uxx, uxy, uxz,&
                        uyy, uyz, uzz,&
                        det,&
                        epsnegative, &
                        retval)

       implicit none       
       CCTK_INT handle
       CCTK_INT GRHydro_reflevel 
       CCTK_INT i, j, k 
       CCTK_REAL x, y, z
       CCTK_INT keytemp
       CCTK_REAL eos_prec
       CCTK_REAL prec
       CCTK_REAL local_gam
       CCTK_REAL dens 
       CCTK_REAL sx, sy, sz
       CCTK_REAL tau 
       CCTK_REAL Bconsx, Bconsy, Bconsz
       CCTK_REAL xye
       CCTK_REAL xtemp 
       CCTK_REAL rho
       CCTK_REAL velx, vely, velz
       CCTK_REAL epsilon, pressure
       CCTK_REAL Bx, By, Bz
       CCTK_REAL bsq
       CCTK_REAL w_lorentz
       CCTK_REAL gxx, gxy, gxz 
       CCTK_REAL gyy, gyz, gzz
       CCTK_REAL uxx, uxy, uxz
       CCTK_REAL uyy, uyz, uzz
       CCTK_REAL det
       CCTK_INT epsnegative
       CCTK_REAL retval
     end subroutine  GRHydro_Con2PrimM_pt

  subroutine GRHydro_Con2PrimM_Polytype_pt(  handle, local_gam,&
                        dens, &
                        sx,  sy,  sz, &
                        sc, &
                        Bconsx,  Bconsy,  Bconsz, &
                        rho, &
                        velx,  vely,  velz,&
                        epsilon,  pressure,&
                        Bx,  By,  Bz, &
                        bsq,&
                        w_lorentz, &
                        gxx,  gxy,  gxz, &
                        gyy,  gyz,  gzz, &
                        uxx, uxy, uxz,&
                        uyy, uyz, uzz,&
                        det,&
                        epsnegative, &
                        retval)

       implicit none       
       CCTK_INT handle
       CCTK_REAL local_gam
       CCTK_REAL dens 
       CCTK_REAL sx, sy, sz
       CCTK_REAL sc 
       CCTK_REAL Bconsx, Bconsy, Bconsz
       CCTK_REAL rho
       CCTK_REAL velx, vely, velz
       CCTK_REAL epsilon, pressure
       CCTK_REAL Bx, By, Bz
       CCTK_REAL bsq
       CCTK_REAL w_lorentz
       CCTK_REAL gxx, gxy, gxz 
       CCTK_REAL gyy, gyz, gzz
       CCTK_REAL uxx, uxy, uxz
       CCTK_REAL uyy, uyz, uzz
       CCTK_REAL det
       CCTK_INT epsnegative
       CCTK_REAL retval
     end subroutine  GRHydro_Con2PrimM_Polytype_pt

  end interface

end module Con2PrimM_fortran_interfaces

```

GRHydro_PPMM.F90:
```
 /*@@
   @file      GRHydro_PPMM.F90
   @date      Sun Feb 10 16:53:29 2002
   @author    Joshua Faber, Scott Noble, Bruno Mundim, 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"

 /*@@
   @routine    SimplePPM_1dM
   @date       Thu Feb 14 19:08:52 2002
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke, Toni Font
   @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.
   @endhistory 

@@*/

subroutine SimplePPM_1dM(handle,poly,nx,dx,&
     rho,velx,vely,velz,Bvcx,Bvcy,Bvcz,psidc,eps,press,&
     rhominus,velxminus,velyminus,velzminus,Bvcxminus,Bvcyminus,Bvczminus,psidcminus,epsminus,&
     rhoplus,velxplus,velyplus,velzplus,Bvcxplus,Bvcyplus,Bvczplus,psidcplus,epsplus,dc_flag,&
     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_EigenproblemM

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: handle,poly,nx
  CCTK_REAL :: dx
  CCTK_REAL, dimension(nx) :: rho,velx,vely,velz,eps
  CCTK_REAL, dimension(nx) :: Bvcx,Bvcy,Bvcz,psidc
  CCTK_REAL, dimension(nx) :: rhominus,velxminus,velyminus,velzminus,epsminus
  CCTK_REAL, dimension(nx) :: Bvcxminus,Bvcyminus,Bvczminus,psidcminus
  CCTK_REAL, dimension(nx) :: rhoplus,velxplus,velyplus,velzplus,epsplus
  CCTK_REAL, dimension(nx) :: Bvcxplus,Bvcyplus,Bvczplus,psidcplus

  CCTK_INT :: i,s,dc_flag
  CCTK_REAL, dimension(nx) :: drho,dvelx,dvely,dvelz,deps
  CCTK_REAL, dimension(nx) :: dBvcx,dBvcy,dBvcz,dpsidc
  CCTK_REAL, dimension(nx) :: dmrho,dmvelx,dmvely,dmvelz,dmeps
  CCTK_REAL, dimension(nx) :: dmBvcx,dmBvcy,dmBvcz,dmpsidc
  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

  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.

!!$  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))
    dBvcx(i) = 0.5d0 * (Bvcx(i+1) - Bvcx(i-1))
    dBvcy(i) = 0.5d0 * (Bvcy(i+1) - Bvcy(i-1))
    dBvcz(i) = 0.5d0 * (Bvcz(i+1) - Bvcz(i-1))
    if(dc_flag.ne.0)dpsidc(i) = 0.5d0 * (psidc(i+1) - psidc(i-1))

    dpress(i) = press(i+1) - press(i-1)
    d2rho(i) = (rho(i+1) - 2.d0 * rho(i) + rho(i-1))! / 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
#define STEEP(x,dx,dmx)                                              \
    if ( (x(i+1) - x(i)) * (x(i) - x(i-1)) > 0.d0 ) then           &&\
      dmx(i) = sign(1.d0, 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
    STEEP(rho, drho, dmrho)
    STEEP(vx, dvelx, dmvelx)
    STEEP(vy, dvely, dmvely)
    STEEP(vz, dvelz, dmvelz)
    STEEP(Bvcx, dBvcx, dmBvcx)
    STEEP(Bvcy, dBvcy, dmBvcy)
    STEEP(Bvcz, dBvcz, dmBvcz)
    if(dc_flag.ne.0) then
       STEEP(psidc,dpsidc,dmpsidc)
    endif

  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)

    Bvcxplus(i) = 0.5d0 * (Bvcx(i) + Bvcx(i+1)) + &
         (dmBvcx(i) - dmBvcx(i+1)) / 6.d0
    Bvcxminus(i+1) = Bvcxplus(i)
    Bvcyplus(i) = 0.5d0 * (Bvcy(i) + Bvcy(i+1)) + &
         (dmBvcy(i) - dmBvcy(i+1)) / 6.d0
    Bvcyminus(i+1) = Bvcyplus(i)
    Bvczplus(i) = 0.5d0 * (Bvcz(i) + Bvcz(i+1)) + &
         (dmBvcz(i) - dmBvcz(i+1)) / 6.d0
    Bvczminus(i+1) = Bvczplus(i)
    if(dc_flag.ne.0) then
       psidcplus(i) = 0.5d0 * (psidc(i) + psidc(i+1)) + &
            (dmpsidc(i) - dmpsidc(i+1)) / 6.d0
       psidcminus(i+1) = psidcplus(i)
    endif
  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

!!$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 (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 eigenvaluesM(handle,&
                 D_UPW(rho), D_UPW(velx), D_UPW(vely), D_UPW(velz), &
                 D_UPW(eps), D_UPW(press), D_UPW(w_lorentz),&
                 D_UPW(Bvcx), D_UPW(Bvcy), D_UPW(Bvcz), 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)
        LEFTPLUS(Bvcx, Bvcxplus)
        LEFTMINUS(Bvcx, Bvcxminus)
        LEFTPLUS(Bvcy, Bvcyplus)
        LEFTMINUS(Bvcy, Bvcyminus)
        LEFTPLUS(Bvcz, Bvczplus)
        LEFTMINUS(Bvcz, Bvczminus)
        if(dc_flag.ne.0) then
           LEFTPLUS(psidc, psidcplus)
           LEFTMINUS(psidc, psidcminus)
        endif
        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)
        RIGHTPLUS(Bvcx, Bvcxplus)
        RIGHTMINUS(Bvcx, Bvcxminus)
        RIGHTPLUS(Bvcy, Bvcyplus)
        RIGHTMINUS(Bvcy, Bvcyminus)
        RIGHTPLUS(Bvcz, Bvczplus)
        RIGHTMINUS(Bvcz, Bvczminus)
        if(dc_flag.ne.0) then
           RIGHTPLUS(psidc, psidcplus)
           RIGHTMINUS(psidc, psidcminus)
        endif
        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))
      CHECK(Bvcx, Bvcxplus(i))
      CHECK(Bvcx, Bvcxminus(i+1))
      CHECK(Bvcy, Bvcyplus(i))
      CHECK(Bvcy, Bvcyminus(i+1))
      CHECK(Bvcz, Bvczplus(i))
      CHECK(Bvcz, Bvczminus(i+1))
      if(dc_flag.ne.0) then
         CHECK(psidc, psidcplus(i))
         CHECK(psidc, psidcminus(i+1))
      endif
      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

!!$  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 (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)
      Bvcxplus(i) = flatten * Bvcxplus(i) + (1.d0 - flatten) * Bvcx(i)
      Bvcxminus(i) = flatten * Bvcxminus(i) + (1.d0 - flatten) * Bvcx(i)
      Bvcyplus(i) = flatten * Bvcyplus(i) + (1.d0 - flatten) * Bvcy(i)
      Bvcyminus(i) = flatten * Bvcyminus(i) + (1.d0 - flatten) * Bvcy(i)
      Bvczplus(i) = flatten * Bvczplus(i) + (1.d0 - flatten) * Bvcz(i)
      Bvczminus(i) = flatten * Bvczminus(i) + (1.d0 - flatten) * Bvcz(i)
      if(dc_flag.ne.0) then
         psidcplus(i) = flatten * psidcplus(i) + (1.d0 - flatten) * psidc(i)
         psidcminus(i) = flatten * psidcminus(i) + (1.d0 - flatten) * psidc(i)
      endif
      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(1.d0, -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)
      Bvcxplus(i) = flatten * Bvcxplus(i) + (1.d0 - flatten) * Bvcx(i)
      Bvcxminus(i) = flatten * Bvcxminus(i) + (1.d0 - flatten) * Bvcx(i)
      Bvcyplus(i) = flatten * Bvcyplus(i) + (1.d0 - flatten) * Bvcy(i)
      Bvcyminus(i) = flatten * Bvcyminus(i) + (1.d0 - flatten) * Bvcy(i)
      Bvczplus(i) = flatten * Bvczplus(i) + (1.d0 - flatten) * Bvcz(i)
      Bvczminus(i) = flatten * Bvczminus(i) + (1.d0 - flatten) * Bvcz(i)
      if(dc_flag.ne.0) then
         psidcplus(i) = flatten * psidcplus(i) + (1.d0 - flatten) * psidc(i)
         psidcminus(i) = flatten * psidcminus(i) + (1.d0 - flatten) * psidc(i)
      endif
      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


!!$ Monotonicity. See (1.10) of C&W.

do i = GRHydro_stencil, nx - GRHydro_stencil + 1
#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

    MON(rhominus,rho,rhoplus)
    MON(velxminus,vx,velxplus)
    MON(velyminus,vy,velyplus)
    MON(velzminus,vz,velzplus)
    MON(Bvcxminus,Bvcx,Bvcxplus)
    MON(Bvcyminus,Bvcy,Bvcyplus)
    MON(Bvczminus,Bvcz,Bvczplus)
    if(dc_flag.ne.0) then
       MON(psidcminus,psidc,psidcplus)
    endif
  end do
  if (poly .eq. 0) then
    do i = GRHydro_stencil, nx - GRHydro_stencil + 1
      MON(epsminus,eps,epsplus)
    end do
  end if

  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)
        Bvcxminus(i)=Bvcx(i)  
        Bvcxplus(i)=Bvcx(i)
        Bvcyminus(i)=Bvcy(i)
        Bvcyplus(i)=Bvcy(i)
        Bvczminus(i)=Bvcz(i)
        Bvczplus(i)=Bvcz(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)
        Bvcxminus(i-1)=Bvcx(i)
        Bvcxplus(i-1)=Bvcx(i)
        Bvcyminus(i-1)=Bvcy(i)
        Bvcyplus(i-1)=Bvcy(i)
        Bvczminus(i-1)=Bvcz(i)
        Bvczplus(i-1)=Bvcz(i)
        if (dc_flag.ne.0) then
          psidcminus(i)=psidc(i)
          psidcplus(i)=psidc(i)
          psidcminus(i-1)=psidc(i)
          psidcplus(i-1)=psidc(i)
        end if
       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))
          call PPM_TVD(Bvcx(i-1), Bvcx(i), Bvcx(i+1), Bvcxminus(i), Bvcxplus(i))
          call PPM_TVD(Bvcy(i-1), Bvcy(i), Bvcy(i+1), Bvcyminus(i), Bvcyplus(i))
          call PPM_TVD(Bvcz(i-1), Bvcz(i), Bvcz(i+1), Bvczminus(i), Bvczplus(i))
          if(dc_flag.ne.0) then
             call PPM_TVD(psidc(i-1), psidc(i), psidc(i+1), psidcminus(i), psidcplus(i))
          endif
          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)
        Bvcxminus(i)=Bvcx(i)
        Bvcxplus(i)=Bvcx(i)
        Bvcyminus(i)=Bvcy(i)
        Bvcyplus(i)=Bvcy(i)
        Bvczminus(i)=Bvcz(i)
        Bvczplus(i)=Bvcz(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)
        Bvcxminus(i+1)=Bvcx(i)
        Bvcxplus(i+1)=Bvcx(i)
        Bvcyminus(i+1)=Bvcy(i)
        Bvcyplus(i+1)=Bvcy(i)
        Bvczminus(i+1)=Bvcz(i)
        Bvczplus(i+1)=Bvcz(i)
        if (dc_flag.ne.0) then
          psidcminus(i)=psidc(i)
          psidcplus(i)=psidc(i)
          psidcminus(i+1)=psidc(i)
          psidcplus(i+1)=psidc(i)
        endif
        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))
          call PPM_TVD(Bvcx(i-1), Bvcx(i), Bvcx(i+1), Bvcxminus(i), Bvcxplus(i))
          call PPM_TVD(Bvcy(i-1), Bvcy(i), Bvcy(i+1), Bvcyminus(i), Bvcyplus(i))
          call PPM_TVD(Bvcz(i-1), Bvcz(i), Bvcz(i+1), Bvczminus(i), Bvczplus(i))
          if(dc_flag.ne.0) then
             call PPM_TVD(Bvcz(i-1), Bvcz(i), Bvcz(i+1), Bvczminus(i), Bvczplus(i))
          endif
          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_1dM



```

GRHydro_TrivialReconstruct.cc:
```
#include <cmath>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"

#include "GRHydro_TrivialReconstruct.hh"
#include "GRHydro_Reconstruct_drv_impl.hh"

using namespace std;


/**
   Trivial first-order reconstruction operator.
*/
template <int dir>
void GRHydro_TrivialReconstruct1d::
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)
{
   for (int i=0; i < nx; ++i)
   {
      const int ijk = dir ==0 ? CCTK_GFINDEX3D(cctkGH, i  , j, k) : dir ==1 ? CCTK_GFINDEX3D(cctkGH, j, i  , k) : CCTK_GFINDEX3D(cctkGH, j, k, i  );

      // Trivial reconstruction!
      aminus[ijk] = a[ijk];
      aplus[ijk]  = a[ijk];
   }
}

// instantiate all copies we need, this way different operators can be compiled
// in parallel. This must match the select routine in GRHydro_Reconstruct.cc
INSTANTIATE_RECONSTRUCTION_OPERATOR(GRHydro_TrivialReconstruct1d)

```

GRHydro_HLLEM.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_HLLEM
   @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_HLLEM(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, dimension(3,3) :: gh, uh
  CCTK_REAL :: usendh
  CCTK_REAL :: rhoenth_p, rhoenth_m
  CCTK_REAL, dimension(3) :: avg_beta
  CCTK_REAL, dimension(3) :: vtp,vtm,blowp,blowm,Bveclowp,Bveclowm
  CCTK_REAL, dimension(3) :: vellowp,vellowm
  CCTK_REAL :: ab0p,ab0m,b2p,b2m,bdotvp,bdotvm
  CCTK_REAL :: wp,wm,v2p,v2m
  CCTK_REAL :: pressstarp,pressstarm

  CCTK_REAL :: entropyconsp,entropyconsm,entropyp,entropym,entropyf,entropydiff,entropyfp,entropyfm

  CCTK_REAL :: psidcp, psidcm, psidcf, psidcdiff, psidcfp, psidcfm
  CCTK_REAL :: charmax_dc, charmin_dc, charpm_dc   
 
  CCTK_INT :: type_bits, trivial
  CCTK_REAL :: xtemp

  integer :: ix,iy,iz

  ! 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")
    ix = 1 ; iy = 2 ; iz = 3
  else if (flux_direction == 2) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", &
         &"trivial")
    ix = 2 ; iy = 3 ; iz = 1
  else if (flux_direction == 3) then
    call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ")
    call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", &
         &"trivial")
    ix = 3 ; iy = 1 ; iz = 2
  else
    call CCTK_ERROR("Flux direction not x,y,z")
    STOP
  end if

  ! constraint transport needs to be able to average fluxes in the directions
  ! other that flux_direction

  !$OMP PARALLEL PRIVATE(k,j,i,f1,lamminus,lamplus,cons_p,cons_m,fplus,fminus,qdiff,psidcf,psidcp,psidcm,prim_p,prim_m,&
  !$OMP avg_beta,avg_alp,&
  !$OMP gh,avg_det,sdet,uh,&
  !$OMP vtp,vtm,vellowp,vellowm,Bveclowp,Bveclowm,&
  !$OMP bdotvp,bdotvm,b2p,b2m,v2p,v2m,wp,wm,&
  !$OMP blowp,blowm,&
  !$OMP rhoenth_p,rhoenth_m,ab0p,ab0m,pressstarp,pressstarm,&
  !$OMP usendh,psidcdiff,psidcfp,psidcfm,charmin,charmax,chartop,charpm,&
  !$OMP charmin_dc,charmax_dc,charpm_dc,m,xtemp,&
  !$OMP entropyconsp,entropyconsm,entropyp,entropym,entropyf,entropydiff,entropyfp,entropyfm)
  ! avoid compiler warnings
  psidcf = 0d0
  psidcp = 0.d0
  psidcm = 0d0
  psidcfp = 0d0
  psidcfm = 0d0

  entropyf = 0d0
  entropyfp = 0d0
  entropyfm = 0d0
  entropyconsm = 0d0
  entropyconsp = 0d0
  !$OMP DO
  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)   = Bconsxplus(i,j,k)
        cons_p(7)   = Bconsyplus(i,j,k)
        cons_p(8)   = Bconszplus(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) = Bconsxminus(i+xoffset,j+yoffset,k+zoffset) 
        cons_m(7) = Bconsyminus(i+xoffset,j+yoffset,k+zoffset) 
        cons_m(8) = Bconszminus(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) 
          
        if(clean_divergence.ne.0) then
           psidcp = psidcplus(i,j,k)
           psidcm = psidcminus(i+xoffset,j+yoffset,k+zoffset)
        endif

        if(evolve_entropy.ne.0) then
           entropyp = entropyplus(i,j,k)
           entropym = entropyminus(i+xoffset,j+yoffset,k+zoffset)
           entropyconsp = entropyconsplus(i,j,k)
           entropyconsm = entropyconsminus(i+xoffset,j+yoffset,k+zoffset)
        endif

!!$        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_beta(1) = 0.5d0 * (beta1(i+xoffset,j+yoffset,k+zoffset) + &
             beta1(i,j,k))
        avg_beta(2) = 0.5d0 * (beta2(i+xoffset,j+yoffset,k+zoffset) + &
             beta2(i,j,k))
        avg_beta(3) = 0.5d0 * (beta3(i+xoffset,j+yoffset,k+zoffset) + &
             beta3(i,j,k))

        avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset))
        
        gh(1,1) = 0.5d0 * (g11(i+xoffset,j+yoffset,k+zoffset) + g11(i,j,k))
        gh(1,2) = 0.5d0 * (g12(i+xoffset,j+yoffset,k+zoffset) + g12(i,j,k))
        gh(1,3) = 0.5d0 * (g13(i+xoffset,j+yoffset,k+zoffset) + g13(i,j,k))
        gh(2,2) = 0.5d0 * (g22(i+xoffset,j+yoffset,k+zoffset) + g22(i,j,k))
        gh(2,3) = 0.5d0 * (g23(i+xoffset,j+yoffset,k+zoffset) + g23(i,j,k))
        gh(3,3) = 0.5d0 * (g33(i+xoffset,j+yoffset,k+zoffset) + g33(i,j,k))
        gh(2,1) = gh(1,2) ; gh(3,1) = gh(1,3) ; gh(3,2) = gh(2,3)

        avg_det =  SPATIAL_DETERMINANT(gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3))
        sdet = sqrt(avg_det)

        call UpperMetric(uh(1,1), uh(1,2), uh(1,3), uh(2,2), uh(2,3), uh(3,3), &
             avg_det,gh(1,1), gh(1,2), gh(1,3), &
             gh(2,2), gh(2,3), gh(3,3))
        uh(2,1) = uh(1,2) ; uh(3,1) = uh(1,3) ; uh(3,2) = uh(2,3)
          

        vtp(1) = prim_p(2)-avg_beta(1)/avg_alp
        vtp(2) = prim_p(3)-avg_beta(2)/avg_alp
        vtp(3) = prim_p(4)-avg_beta(3)/avg_alp
        vtm(1) = prim_m(2)-avg_beta(1)/avg_alp
        vtm(2) = prim_m(3)-avg_beta(2)/avg_alp
        vtm(3) = prim_m(4)-avg_beta(3)/avg_alp

        call calc_vlow_blow(gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3), &
             prim_p(2),prim_p(3),prim_p(4),prim_p(8),prim_p(9),prim_p(10), &
             vellowp(1),vellowp(2),vellowp(3),Bveclowp(1),Bveclowp(2),Bveclowp(3), &
             bdotvp,b2p,v2p,wp,blowp(1),blowp(2),blowp(3))
        call calc_vlow_blow(gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3), &
             prim_m(2),prim_m(3),prim_m(4),prim_m(8),prim_m(9),prim_m(10), &
             vellowm(1),vellowm(2),vellowm(3),Bveclowm(1),Bveclowm(2),Bveclowm(3), &
             bdotvm,b2m,v2m,wm,blowm(1),blowm(2),blowm(3))

        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

!!$ 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

          call num_x_fluxM(cons_p(1),cons_p(1+ix),cons_p(1+iy),cons_p(1+iz),&
               cons_p(5),cons_p(5+ix),cons_p(5+iy),cons_p(5+iz),&
               f1(1),f1(1+ix),f1(1+iy),f1(1+iz),f1(5),f1(5+ix),f1(5+iy),&
               f1(5+iz),&
               vtp(ix),vtp(iy),vtp(iz),pressstarp,blowp(ix),blowp(iy),&
               blowp(iz),ab0p,wp, &
               avg_det,avg_alp,avg_beta(flux_direction))
          if(clean_divergence.ne.0) then
             f1(6)=f1(6) + 1.0d0*sdet*uh(flux_direction,1)*psidcp - cons_p(5+flux_direction)*avg_beta(1)/avg_alp
             f1(7)=f1(7) + 1.0d0*sdet*uh(flux_direction,2)*psidcp - cons_p(5+flux_direction)*avg_beta(2)/avg_alp
             f1(8)=f1(8) + 1.0d0*sdet*uh(flux_direction,3)*psidcp - cons_p(5+flux_direction)*avg_beta(3)/avg_alp
             psidcf = cons_p(5+flux_direction)/sdet-psidcp*avg_beta(flux_direction)/avg_alp
          endif
          if(evolve_entropy.ne.0) then
             entropyf = entropyconsp*vtp(flux_direction)
          endif
          
        else !!! The end of this branch is right at the bottom of the routine
            
          usendh = uh(flux_direction,flux_direction)
          
!!$        Calculate the jumps in the conserved variables
          
          qdiff = cons_m - cons_p

          if (clean_divergence.ne.0) then
             psidcdiff = psidcm - psidcp
          endif
          if(evolve_entropy.ne.0) then
             entropydiff = entropyconsm - entropyconsp
          endif

!!$       Eigenvalues and fluxes either side of the cell interface
          
          if(evolve_temper.ne.1) then
            call eigenvaluesM(GRHydro_eos_handle,&
                 prim_m(1),prim_m(1+ix),prim_m(1+iy),prim_m(1+iz),prim_m(5),prim_m(6),prim_m(7), &
                 prim_m(7+ix),prim_m(7+iy),prim_m(7+iz),&
                 lamminus,gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3),&
                 usendh,avg_alp,avg_beta(flux_direction))
            call eigenvaluesM(GRHydro_eos_handle,&
                 prim_p(1),prim_p(1+ix),prim_p(1+iy),prim_p(1+iz),prim_p(5),prim_p(6),prim_p(7), &
                 prim_p(7+ix),prim_p(7+iy),prim_p(7+iz),&
                 lamplus,gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3),&
                 usendh,avg_alp,avg_beta(flux_direction))
          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(1+ix),prim_m(1+iy),prim_m(1+iz),prim_m(5),prim_m(6),prim_m(7), &
                 prim_m(7+ix),prim_m(7+iy),prim_m(7+iz),&
                 xtemp,y_e_minus(i+xoffset,j+yoffset,k+zoffset),&
                 lamminus,gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3),&
                 usendh,avg_alp,avg_beta(flux_direction))
            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(1+ix),prim_p(1+iy),prim_p(1+iz),prim_p(5),prim_p(6),prim_p(7), &
                 prim_p(7+ix),prim_p(7+iy),prim_p(7+iz),&
                 xtemp,y_e_plus(i,j,k),&
                 lamplus,gh(1,1),gh(1,2),gh(1,3),gh(2,2),gh(2,3),gh(3,3),&
                 usendh,avg_alp,avg_beta(flux_direction))
          endif 

          call num_x_fluxM(cons_p(1),cons_p(1+ix),cons_p(1+iy),cons_p(1+iz),&
               cons_p(5),&
               cons_p(5+ix),cons_p(5+iy),cons_p(5+iz),&
               fplus(1),fplus(1+ix),fplus(1+iy),fplus(1+iz),fplus(5),&
               fplus(5+ix),fplus(5+iy),fplus(5+iz),&
               vtp(ix),vtp(iy),vtp(iz),pressstarp,blowp(ix),blowp(iy),&
               blowp(iz),ab0p,wp, &
               avg_det,avg_alp,avg_beta(flux_direction))
          call num_x_fluxM(cons_m(1),cons_m(1+ix),cons_m(1+iy),cons_m(1+iz),&
               cons_m(5),&
               cons_m(5+ix),cons_m(5+iy),cons_m(5+iz),&
               fminus(1),fminus(1+ix),fminus(1+iy),fminus(1+iz),fminus(5),&
               fminus(5+ix),fminus(5+iy),fminus(5+iz),&
               vtm(ix),vtm(iy),vtm(iz),pressstarm,blowm(ix),blowm(iy),&
               blowm(iz),ab0m,wm, &
               avg_det,avg_alp,avg_beta(flux_direction))

          if(clean_divergence.ne.0) then
             fminus(6)=fminus(6) + 1.0d0*sdet*uh(flux_direction,1)*psidcm - cons_m(5+flux_direction)*avg_beta(1)/avg_alp
             fminus(7)=fminus(7) + 1.0d0*sdet*uh(flux_direction,2)*psidcm - cons_m(5+flux_direction)*avg_beta(2)/avg_alp
             fminus(8)=fminus(8) + 1.0d0*sdet*uh(flux_direction,3)*psidcm - cons_m(5+flux_direction)*avg_beta(3)/avg_alp
             fplus(6)=fplus(6) + 1.0d0*sdet*uh(flux_direction,1)*psidcp - cons_p(5+flux_direction)*avg_beta(1)/avg_alp
             fplus(7)=fplus(7) + 1.0d0*sdet*uh(flux_direction,2)*psidcp - cons_p(5+flux_direction)*avg_beta(2)/avg_alp
             fplus(8)=fplus(8) + 1.0d0*sdet*uh(flux_direction,3)*psidcp - cons_p(5+flux_direction)*avg_beta(3)/avg_alp
             psidcfp = cons_p(5+flux_direction)/sdet-avg_beta(flux_direction)*psidcp/avg_alp
             psidcfm = cons_m(5+flux_direction)/sdet-avg_beta(flux_direction)*psidcm/avg_alp
          endif
          if(evolve_entropy.ne.0) then
             entropyfp = entropyconsp*vtp(flux_direction)
             entropyfm = entropyconsm*vtm(flux_direction)
          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))

          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

          if(clean_divergence.ne.0) then

           psidcdiff = psidcm - psidcp
           select case(whichpsidcspeed)
             case(0)
               if (HLLE) then
                 psidcf = (charmax * psidcfp - charmin * psidcfm + &
                           charmax * charmin * psidcdiff) / charpm
               else if (LLF) then
                 psidcf = 0.5d0 * (psidcfp + psidcfm - chartop * psidcdiff)
               end if
             case(1)
             !!$ Wavespeeds for psidc are +/-c, not Fast Magnetosonic?
             !!$ psidcf = 0.5d0 * (1.d0 * psidcfp - (-1.d0) * psidcfm + &
             !!$      1.d0 * (-1.d0) * psidcdiff) 

             !!$ The fastest speed for psidc comes from the condition
             !!$ that the normal vector to the characteristic hypersurface
             !!$ be spacelike (Eq. 60 of Anton et al.)

             charmax_dc = sqrt(usendh) - avg_beta(flux_direction)/avg_alp
             charmin_dc = -1.d0*sqrt(usendh) - avg_beta(flux_direction)/avg_alp
             charpm_dc = charmax_dc - charmin_dc

             psidcf = (charmax_dc * psidcfp - charmin_dc * psidcfm + &
                       charmax_dc * charmin_dc * psidcdiff) / charpm_dc

             if(decouple_normal_Bfield .ne. 0) then ! same expression for HLLE and LLF
               !!$ B^i field decouples from the others and has same propagation
               !!$ speed as divergence -null direction,  
               !!$ \pm sqrt(g^{xx}} - beta^x/alpha
               f1(5+flux_direction) = (charmax_dc * fplus(5+flux_direction) &
                                     - charmin_dc * fminus(5+flux_direction) + &
                  charmax_dc * charmin_dc * qdiff(5+flux_direction)) / charpm_dc
             end if
             case(2)
             charmax = setcharmax
             charmin = setcharmin
               if (HLLE) then
                 psidcf = (charmax * psidcfp - charmin * psidcfm + &
                           charmax * charmin * psidcdiff) / charpm
               else if (LLF) then
                 chartop = max(-charmin,charmax)
                 psidcf = 0.5d0 * (psidcfp + psidcfm - chartop * psidcdiff)
               end if
           end select
          endif
          
          if(evolve_entropy.ne.0) then
            entropydiff = entropyconsm - entropyconsp
            if (HLLE) then
              entropyf = (charmax * entropyfp - charmin * entropyfm + &
                       charmax * charmin * entropydiff) / charpm
            else if (LLF) then
              entropyf = 0.5d0 * (entropyfp + entropyfm - chartop * entropydiff) 
            end if 
          endif
             
             

        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)

        Bconsxflux(i, j, k) = f1(6)
        Bconsyflux(i, j, k) = f1(7)
        Bconszflux(i, j, k) = f1(8)

        if(clean_divergence.ne.0) then
           psidcflux(i,j,k) = psidcf
        endif

        if(evolve_entropy.ne.0) then
           entropyflux(i,j,k) = entropyf
        endif

        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 DO
  !$OMP END PARALLEL
#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_HLLEM

 /*@@
   @routine    GRHydro_HLLE_TracerM
   @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_TracerM(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
    
  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")
    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
        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")
           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

!!$        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
        
!!$        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")
           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) = 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_TracerM


```

GRHydro_HLLE.cc:
```
#include <cmath>
#include <vector>
#include <iostream>
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
#include "cctk_Functions.h"
#include "SpaceMask.h"

#define MIN(a,b) (((a)<(b))?(a):(b))
#define MAX(a,b) (((a)>(b))?(a):(b))
#define SQR(x) ((x)*(x))

// build up multiple element MIN/MAX from pairwise recursive comparison
// these are ~10 times faster than the MIN(MIN(MIN(... approach presumably
// since they allow for out-of-order evalutation of intermediate results
#define MIN3(a,b,c) MIN(MIN(a,b),c)
#define MIN4(a,b,c,d) MIN(MIN(a,b),MIN(c,d))
#define MIN5(a,b,c,d,e) MIN(MIN4(a,b,c,d),e)
#define MIN6(a,b,c,d,e,f) MIN(MIN4(a,b,c,d),MIN(e,f))
#define MIN7(a,b,c,d,e,f,g) MIN(MIN4(a,b,c,d),MIN3(e,f,g))
#define MIN8(a,b,c,d,e,f,g,h) MIN(MIN4(a,b,c,d),MIN4(e,f,g,h))
#define MIN9(a,b,c,d,e,f,g,h,i) MIN(MIN8(a,b,c,d,e,f,g,h),i)
#define MIN10(a,b,c,d,e,f,g,h,i,j) MIN(MIN8(a,b,c,d,e,f,g,h),MIN(i,j))
#define MIN11(a,b,c,d,e,f,g,h,i,j,k) MIN(MIN8(a,b,c,d,e,f,g,h),MIN3(i,j,k))

#define MAX3(a,b,c) MAX(MAX(a,b),c)
#define MAX4(a,b,c,d) MAX(MAX(a,b),MAX(c,d))
#define MAX5(a,b,c,d,e) MAX(MAX4(a,b,c,d),e)
#define MAX6(a,b,c,d,e,f) MAX(MAX4(a,b,c,d),MAX(e,f))
#define MAX7(a,b,c,d,e,f,g) MAX(MAX4(a,b,c,d),MAX3(e,f,g))
#define MAX8(a,b,c,d,e,f,g,h) MAX(MAX4(a,b,c,d),MAX4(e,f,g,h))
#define MAX9(a,b,c,d,e,f,g,h,i) MAX(MAX8(a,b,c,d,e,f,g,h),i)
#define MAX10(a,b,c,d,e,f,g,h,i,j) MAX(MAX8(a,b,c,d,e,f,g,h),MAX(i,j))
#define MAX11(a,b,c,d,e,f,g,h,i,j,k) MAX(MAX8(a,b,c,d,e,f,g,h),MAX3(i,j,k))

using namespace std;

// some prototypes
extern "C"
CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

static inline CCTK_REAL SpatialDeterminantC(const CCTK_REAL gxx, const CCTK_REAL gxy,
					    const CCTK_REAL gxz, const CCTK_REAL gyy,
					    const CCTK_REAL gyz, const CCTK_REAL gzz);
static inline void UpperMetricC(CCTK_REAL& restrict uxx,
                                CCTK_REAL& restrict uxy,
                                CCTK_REAL& restrict uxz,
                                CCTK_REAL& restrict uyy,
                                CCTK_REAL& restrict uyz,
                                CCTK_REAL& restrict uzz,
				const CCTK_REAL det,
				const CCTK_REAL gxx,
				const CCTK_REAL gxy,
				const CCTK_REAL gxz,
				const CCTK_REAL gyy,
				const CCTK_REAL gyz,
				const CCTK_REAL gzz);

static inline CCTK_REAL max10(const CCTK_REAL * const restrict a)
{
  return MAX11(0., a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]);
}

static inline CCTK_REAL max9(const CCTK_REAL a,
			  const CCTK_REAL b,
			  const CCTK_REAL c,
			  const CCTK_REAL d,
			  const CCTK_REAL e,
			  const CCTK_REAL f,
			  const CCTK_REAL g,
			  const CCTK_REAL h,
			  const CCTK_REAL i) 

{
  return MAX9(a, b, c, d, e, f, g, h, i);
}

static inline CCTK_REAL min10(const CCTK_REAL * const restrict a)
{
  return MIN11(0., a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]);
}

static inline void num_x_flux_cc(const CCTK_REAL dens,
				 const CCTK_REAL sx,
				 const CCTK_REAL sy,
				 const CCTK_REAL sz,
				 const CCTK_REAL tau,
				 CCTK_REAL& densflux,
				 CCTK_REAL& sxflux,
				 CCTK_REAL& syflux,
				 CCTK_REAL& szflux,
				 CCTK_REAL& tauflux,
				 const CCTK_REAL vel, 
				 const CCTK_REAL press,
				 const CCTK_REAL sdet,
				 const CCTK_REAL alp,
				 const CCTK_REAL beta)
{
  
  const CCTK_REAL velmbetainvalp = vel - beta / alp;
  const CCTK_REAL sqrtdetpress = sdet*press;
  
  densflux = dens * velmbetainvalp;
  sxflux   = sx * velmbetainvalp + sqrtdetpress;
  syflux   = sy * velmbetainvalp;
  szflux   = sz * velmbetainvalp;
  tauflux  = tau * velmbetainvalp + sqrtdetpress*vel;

  return;
}

static inline void num_x_fluxM_cc(const CCTK_REAL dens,
				 const CCTK_REAL sx,
				 const CCTK_REAL sy,
				 const CCTK_REAL sz,
				 const CCTK_REAL tau,
				 const CCTK_REAL Bx,
				 const CCTK_REAL By,
				 const CCTK_REAL Bz,
				 CCTK_REAL& densflux,
				 CCTK_REAL& sxflux,
				 CCTK_REAL& syflux,
				 CCTK_REAL& szflux,
				 CCTK_REAL& tauflux,
                                 CCTK_REAL& Bxflux,
                                 CCTK_REAL& Byflux,
                                 CCTK_REAL& Bzflux,
				 const CCTK_REAL velx, 
				 const CCTK_REAL vely, 
				 const CCTK_REAL velz, 
				 const CCTK_REAL press,
				 const CCTK_REAL sdet,
				 const CCTK_REAL alp,
				 const CCTK_REAL betax,
				 const CCTK_REAL betay,
				 const CCTK_REAL betaz,
				 const CCTK_REAL bsubx,
				 const CCTK_REAL bsuby,
				 const CCTK_REAL bsubz,
                                 const CCTK_REAL b2,
				 const CCTK_REAL ab0,
				 const CCTK_REAL w)
{
  
  const CCTK_REAL velmbetainvalpx = velx - betax / alp;
  const CCTK_REAL velmbetainvalpy = vely - betay / alp;
  const CCTK_REAL velmbetainvalpz = velz - betaz / alp;
  const CCTK_REAL pressstar = press + 0.5*b2;
  const CCTK_REAL sqrtdetpressstar = sdet*pressstar;
  
  densflux = dens * velmbetainvalpx;
  sxflux   = sx * velmbetainvalpx + sqrtdetpressstar - bsubx*Bx/w;
  syflux   = sy * velmbetainvalpx - bsuby*Bx/w;
  szflux   = sz * velmbetainvalpx - bsubz*Bx/w;
  tauflux  = tau * velmbetainvalpx + sqrtdetpressstar*velx - ab0*Bx/w;
  Bxflux = 0.0;
  Byflux = By * velmbetainvalpx - Bx*velmbetainvalpy;
  Bzflux = Bz * velmbetainvalpx - Bx*velmbetainvalpz;
  return;
}

static inline void eigenvalues_cc(const CCTK_REAL rho,
				  const CCTK_REAL velx,
				  const CCTK_REAL vely,
				  const CCTK_REAL velz,
				  const CCTK_REAL eps,
				  const CCTK_REAL press,
				  const CCTK_REAL cs2,
				  const CCTK_REAL w,
				  const CCTK_REAL gxx,
				  const CCTK_REAL gxy,
				  const CCTK_REAL gxz,
				  const CCTK_REAL gyy,
				  const CCTK_REAL gyz,
				  const CCTK_REAL gzz,
				  const CCTK_REAL alp,
				  const CCTK_REAL beta,
				  const CCTK_REAL u,
				  CCTK_REAL * const restrict lam) 
{

  const CCTK_REAL vlowx = gxx*velx + gxy*vely + gxz*velz;
  const CCTK_REAL vlowy = gxy*velx + gyy*vely + gyz*velz;
  const CCTK_REAL vlowz = gxz*velx + gyz*vely + gzz*velz;
  const CCTK_REAL v2 = vlowx*velx + vlowy*vely + vlowz*velz;

  const CCTK_REAL boa = beta/alp;
  lam[1] = velx - boa;
  lam[2] = lam[1];
  lam[3] = lam[1];
  const CCTK_REAL lam_tmp1 = 1.0e0/(1.0-v2*cs2);
  const CCTK_REAL lam_tmp2 = sqrt(cs2*(1.0-v2)*
			       (u*(1.0-v2*cs2) - velx*velx*(1.0-cs2)));
  const CCTK_REAL lam_tmp3 = velx*(1.0-cs2);
  lam[0] = (lam_tmp3 - lam_tmp2)*lam_tmp1 - boa;
  lam[4] = (lam_tmp3 + lam_tmp2)*lam_tmp1 - boa;

  return;
}

static inline void eigenvaluesM_cc(const CCTK_REAL rho,
				  const CCTK_REAL velx,
				  const CCTK_REAL vely,
				  const CCTK_REAL velz,
				  const CCTK_REAL eps,
				  const CCTK_REAL press,
				  const CCTK_REAL Bx,
				  const CCTK_REAL By,
				  const CCTK_REAL Bz,
				  const CCTK_REAL cs2,
				  const CCTK_REAL w,
				  const CCTK_REAL gxx,
				  const CCTK_REAL gxy,
				  const CCTK_REAL gxz,
				  const CCTK_REAL gyy,
				  const CCTK_REAL gyz,
				  const CCTK_REAL gzz,
				  const CCTK_REAL alp,
				  const CCTK_REAL beta,
				  const CCTK_REAL u,
				  CCTK_REAL * const restrict lam) 
{

  const CCTK_REAL vlowx = gxx*velx + gxy*vely + gxz*velz;
  const CCTK_REAL vlowy = gxy*velx + gyy*vely + gyz*velz;
  const CCTK_REAL vlowz = gxz*velx + gyz*vely + gzz*velz;
  const CCTK_REAL v2 = vlowx*velx + vlowy*vely + vlowz*velz;

  const CCTK_REAL boa = beta/alp;
  const CCTK_REAL Bxlow = gxx*Bx + gxy*By + gxz*Bz;
  const CCTK_REAL Bylow = gxy*Bx + gyy*By + gyz*Bz;
  const CCTK_REAL Bzlow = gxz*Bx + gyz*By + gzz*Bz;
  const CCTK_REAL B2 =Bxlow*Bx+Bylow*By+Bzlow*Bz;
  const CCTK_REAL Bdotv =Bxlow*velx+Bylow*vely+Bzlow*velz;
  const CCTK_REAL Bdotv2 =Bdotv*Bdotv;
  const CCTK_REAL w2 = w*w;
  const CCTK_REAL b2 =B2/w2+Bdotv2;
  const CCTK_REAL rhos = rho*(1.0+eps)+press+b2;
  const CCTK_REAL va2 = b2/rhos;
  const CCTK_REAL u2 = va2+cs2*(1.0-va2);

  lam[1] = velx - boa;
  lam[2] = lam[1];
  lam[3] = lam[1];

  const CCTK_REAL lam_tmp1 = (velx*(1.0-u2) - sqrt(u2*(1.0-v2)*
			       (u*(1.0-v2*u2) - velx*velx*(1.0-u2))))/(1.0-v2*u2);
  const CCTK_REAL lam_tmp2 = (velx*(1.0-u2) + sqrt(u2*(1.0-v2)*
			       (u*(1.0-v2*u2) - velx*velx*(1.0-u2))))/(1.0-v2*u2);

  lam[0] = lam_tmp1 - boa;
  lam[4] = lam_tmp2 - boa;

  return;
}

// helpers for H viscosity
static inline CCTK_REAL etaX(const cGH *cctkGH,
			  const int i, const int j, const int k,
			  const CCTK_REAL * const restrict vel,
			  const CCTK_REAL * const restrict cs) {

  const int vidxr = CCTK_VECTGFINDEX3D(cctkGH,i+1,j,k,0);
  const int vidx = CCTK_VECTGFINDEX3D(cctkGH,i,j,k,0);
  const int idxr = CCTK_GFINDEX3D(cctkGH,i+1,j,k);
  const int idx = CCTK_GFINDEX3D(cctkGH,i,j,k);

  return 0.5 * (fabs(vel[vidxr]-vel[vidx]) + fabs(cs[idxr]-cs[idx]));
}

static inline CCTK_REAL etaY(const cGH *cctkGH,
			  const int i, const int j, const int k,
			  const CCTK_REAL * const restrict vel,
			  const CCTK_REAL * const restrict cs) {

  const int vidxr = CCTK_VECTGFINDEX3D(cctkGH,i,j+1,k,1);
  const int vidx = CCTK_VECTGFINDEX3D(cctkGH,i,j,k,1);
  const int idxr = CCTK_GFINDEX3D(cctkGH,i,j+1,k);
  const int idx = CCTK_GFINDEX3D(cctkGH,i,j,k);

  return 0.5 * (fabs(vel[vidxr]-vel[vidx]) + fabs(cs[idxr]-cs[idx]));
}

static inline CCTK_REAL etaZ(const cGH *cctkGH,
			  const int i, const int j, const int k,
			  const CCTK_REAL * const restrict vel,
			  const CCTK_REAL * const restrict cs) {

  const int vidxr = CCTK_VECTGFINDEX3D(cctkGH,i,j,k+1,2);
  const int vidx = CCTK_VECTGFINDEX3D(cctkGH,i,j,k,2);
  const int idxr = CCTK_GFINDEX3D(cctkGH,i,j,k+1);
  const int idx = CCTK_GFINDEX3D(cctkGH,i,j,k);

  return 0.5 * (fabs(vel[vidxr]-vel[vidx]) + fabs(cs[idxr]-cs[idx]));
}

static inline void vlow_blow(const CCTK_REAL gxx,const CCTK_REAL gxy,const CCTK_REAL gxz,const CCTK_REAL gyy,const CCTK_REAL gyz,const CCTK_REAL gzz, 
     const CCTK_REAL velx,const CCTK_REAL vely,const CCTK_REAL velz,const CCTK_REAL Bvecx,const CCTK_REAL Bvecy,const CCTK_REAL Bvecz, 
     CCTK_REAL& ab0,CCTK_REAL& b2,CCTK_REAL& w,CCTK_REAL& bxlow,CCTK_REAL& bylow,CCTK_REAL& 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)

  // vel_i  = g_ij v^j
  // B_i = g_ij B^i
  const CCTK_REAL velxlow = gxx*velx + gxy*vely + gxz*velz;
  const CCTK_REAL velylow = gxy*velx + gyy*vely + gyz*velz;
  const CCTK_REAL velzlow = gxz*velx + gyz*vely + gzz*velz;
  const CCTK_REAL Bvecxlow = gxx*Bvecx + gxy*Bvecy + gxz*Bvecz;
  const CCTK_REAL Bvecylow = gxy*Bvecx + gyy*Bvecy + gyz*Bvecz;
  const CCTK_REAL Bveczlow = gxz*Bvecx + gyz*Bvecy + gzz*Bvecz;

  // B^i v_i (= b^0/u^0)
  const CCTK_REAL Bdotv = velxlow*Bvecx+velylow*Bvecy+velzlow*Bvecz;

  // v^2 = v_i v^i; w=(1-v^2)^{-1/2}
  const CCTK_REAL v2 = velxlow*velx + velylow*vely + velzlow*velz;
  w = 1./sqrt(1.-v2);

  // b^2 = B^i B_i / w^2 + (b^0/u^0)^2
  b2=(Bvecx*Bvecxlow+Bvecy*Bvecylow+Bvecz*Bveczlow)/SQR(w)+SQR(Bdotv);

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

  // alpha b_0 = w_lorentz B^i vel_i
  ab0 = w * Bdotv;
}

template<const int fdir, const bool do_ye, const bool do_hvisc, const bool do_tracers, const bool do_mhd, const bool do_clean_divergence>
void GRHydro_HLLE_CC_LL(CCTK_ARGUMENTS) 
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  // save memory when multipatch is not used
  const CCTK_REAL * restrict g11, * restrict g12, * restrict g13;
  const CCTK_REAL * restrict g22, * restrict g23, * restrict g33;
  const CCTK_REAL * restrict beta1, * restrict beta2, * restrict beta3;
  const CCTK_REAL * restrict vup;
  const int offsetx = fdir==1, offsety = fdir==2, offsetz = fdir==3;
  assert(offsetx+offsety+offsetz == 1);

  if(GRHydro_UseGeneralCoordinates(cctkGH)) {
    g11   = gaa;
    g12   = gab;
    g13   = gac;
    g22   = gbb;
    g23   = gbc;
    g33   = gcc;
    beta1 = betaa;
    beta2 = betab;
    beta3 = betac;
    vup   = lvel;
   } else {
    g11   = gxx;
    g12   = gxy;
    g13   = gxz;
    g22   = gyy;
    g23   = gyz;
    g33   = gzz;
    beta1 = betax;
    beta2 = betay;
    beta3 = betaz;
    vup   = vel;
  }

  int type_bits, trivial;
  if(fdir==1) {
    type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemX");
    trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemX",
					    "trivial");
  } else if (fdir==2) {
    type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemY");
    trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemY",
					 "trivial");
  } else if (fdir==3) {
    type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemZ");
    trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemZ",
					 "trivial");
  } else {
    CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
                "Flux direction %d not 1,2,3.", fdir);
  }

#pragma omp parallel for
  for(int k = GRHydro_stencil-1; k < cctk_lsh[2]-GRHydro_stencil+ transport_constraints*(1-offsetz); ++k)
    for(int j = GRHydro_stencil-1; j < cctk_lsh[1]-GRHydro_stencil+ transport_constraints*(1-offsety); ++j)
      for(int i = GRHydro_stencil-1; i < cctk_lsh[0]-GRHydro_stencil+ transport_constraints*(1-offsetx); ++i) {

	const int idx = CCTK_GFINDEX3D(cctkGH,i,j,k);
	const int idxr = 
	  CCTK_GFINDEX3D(cctkGH,i+offsetx,j+offsety,k+offsetz);

        // C++98 does not allow variable sized arrays (C99 does)
        // C++98 does however allow the use of a const-variable as the aray
        // size as long as its value is known at compile time
        // Unfortunately the Intel compiler (v11 at least) produces lots of
        // warnings about out of bounds array accesses unless the arrays are
        // declared with the maximum possible size.
        const int activesize = do_mhd ? 8 : 5;

        CCTK_REAL consp[8];
        CCTK_REAL consm_i[8];
	CCTK_REAL fplus[8];
	CCTK_REAL fminus[8];
	CCTK_REAL f1[8];
	CCTK_REAL qdiff[8];

        CCTK_REAL psidcp, psidcm_i;
        CCTK_REAL psidcfplus, psidcfminus;
        CCTK_REAL psidcf1;
	
	CCTK_REAL lamplusminus[10];
        CCTK_REAL * const lamminus = lamplusminus;
        CCTK_REAL * const lamplus = lamplusminus+5;
	CCTK_REAL avg_beta;

	consp[0] = densplus[idx];
	consp[1] = sxplus[idx];
	consp[2] = syplus[idx];
	consp[3] = szplus[idx];
	consp[4] = tauplus[idx];
	if (do_mhd) {
          consp[5] = Bconsxplus[idx];
          consp[6] = Bconsyplus[idx];
          consp[7] = Bconszplus[idx];
	}
        if (do_clean_divergence)
          psidcp = psidcplus[idx];
	consm_i[0] = densminus[idxr];
	consm_i[1] = sxminus[idxr];
	consm_i[2] = syminus[idxr];
	consm_i[3] = szminus[idxr];
	consm_i[4] = tauminus[idxr];
	if (do_mhd) {
          consm_i[5] = Bconsxminus[idxr];
          consm_i[6] = Bconsyminus[idxr];
          consm_i[7] = Bconszminus[idxr];
	}
        if (do_clean_divergence)
          psidcm_i = psidcminus[idxr];

        if(fdir==1) 
	  avg_beta = 0.5 * (beta1[idxr]+beta1[idx]);
	else if(fdir==2)
	  avg_beta = 0.5 * (beta2[idxr]+beta2[idx]);
	else 
	  avg_beta = 0.5 * (beta3[idxr]+beta3[idx]);

	const CCTK_REAL avg_betax = 0.5 * (beta1[idxr]+beta1[idx]);
	const CCTK_REAL avg_betay = 0.5 * (beta2[idxr]+beta2[idx]);
	const CCTK_REAL avg_betaz = 0.5 * (beta3[idxr]+beta3[idx]);
	const CCTK_REAL avg_alp = 0.5 * (alp[idxr]+alp[idx]);

	const CCTK_REAL gxxh = 0.5 * (g11[idx] + g11[idxr]);
	const CCTK_REAL gxyh = 0.5 * (g12[idx] + g12[idxr]);
	const CCTK_REAL gxzh = 0.5 * (g13[idx] + g13[idxr]);
	const CCTK_REAL gyyh = 0.5 * (g22[idx] + g22[idxr]);
	const CCTK_REAL gyzh = 0.5 * (g23[idx] + g23[idxr]);
	const CCTK_REAL gzzh = 0.5 * (g33[idx] + g33[idxr]);
  
	const CCTK_REAL avg_detr =
	  SpatialDeterminantC(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh);
	const CCTK_REAL savg_detr = sqrt(avg_detr);

	CCTK_REAL uxxh,uxyh,uxzh,uyyh,uyzh,uzzh;
	UpperMetricC(uxxh,uxyh,uxzh,uyyh,uyzh,uzzh,
                        avg_detr,gxxh,gxyh,gxzh,
	                gyyh, gyzh, gzzh);

        // these need to be initialized otherwise the compiler complains even
        // if they are only ever used when do_mhd is true
        CCTK_REAL ab0m = -42.0;
        CCTK_REAL ab0p = -42.0;
        CCTK_REAL b2m = -42.0;
        CCTK_REAL b2p = -42.0;
        CCTK_REAL wm = -42.0;
        CCTK_REAL wp = -42.0;
        CCTK_REAL blowxm = -42.0;
        CCTK_REAL blowym = -42.0;
        CCTK_REAL blowzm = -42.0;
        CCTK_REAL blowxp = -42.0;
        CCTK_REAL blowyp = -42.0;
        CCTK_REAL blowzp = -42.0;

        if (do_mhd) {
          // TODO: we do actually store w_lorentz on the grid and could use it
          vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
               velxplus[idx],velyplus[idx],velzplus[idx],Bvecxplus[idx],Bvecyplus[idx],Bveczplus[idx],
               ab0p,b2p,wp,blowxp,blowyp,blowzp);
   
          vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
               velxminus[idxr],velyminus[idxr],velzminus[idxr],Bvecxminus[idxr],Bvecyminus[idxr],Bveczminus[idxr],
               ab0m,b2m,wm,blowxm,blowym,blowzm);
	}

	// If the Riemann problem is trivial, just calculate the fluxes
	// from the left state and skip to the next cell
	if ( SpaceMask_CheckStateBits(space_mask, idx, type_bits, trivial) ) {

          if (do_mhd) {

            if (fdir==1) {
              num_x_fluxM_cc(consp[0],consp[1],consp[2],consp[3],consp[4],consp[5],consp[6],consp[7],
                          f1[0],f1[1],f1[2],f1[3],f1[4],f1[5],f1[6],f1[7],
                          velxplus[idx],velyplus[idx],velzplus[idx],
                          pressplus[idx],savg_detr,
                          avg_alp,avg_betax,avg_betay,avg_betaz,blowxp,blowyp,blowzp,b2p,ab0p,wp);
              if (do_clean_divergence) {
                f1[5] += savg_detr*uxxh*psidcp - consp[5]*avg_betax/avg_alp;
                f1[6] += savg_detr*uxyh*psidcp - consp[5]*avg_betay/avg_alp;
                f1[7] += savg_detr*uxzh*psidcp - consp[5]*avg_betaz/avg_alp;
                psidcf1 = consp[5]/savg_detr - psidcp*avg_betax/avg_alp;
              }
            } else if(fdir==2) {
              num_x_fluxM_cc(consp[0],consp[2],consp[3],consp[1],consp[4],consp[6],consp[7],consp[5],
                          f1[0],f1[2],f1[3],f1[1],f1[4],f1[6],f1[7],f1[5],
                          velyplus[idx],velzplus[idx],velxplus[idx],
                          pressplus[idx],savg_detr,
                          avg_alp,avg_betay,avg_betaz,avg_betax,blowyp,blowzp,blowxp,b2p,ab0p,wp);
              if (do_clean_divergence) {
                f1[5] += savg_detr*uxyh*psidcp - consp[6]*avg_betax/avg_alp;
                f1[6] += savg_detr*uyyh*psidcp - consp[6]*avg_betay/avg_alp;
                f1[7] += savg_detr*uyzh*psidcp - consp[6]*avg_betaz/avg_alp;
                psidcf1 = consp[6]/savg_detr - psidcp*avg_betay/avg_alp;
              }
            } else {
              num_x_fluxM_cc(consp[0],consp[3],consp[1],consp[2],consp[4],consp[7],consp[5],consp[6],
                          f1[0],f1[3],f1[1],f1[2],f1[4],f1[7],f1[5],f1[6],
                          velzplus[idx],velxplus[idx],velyplus[idx],
                          pressplus[idx],savg_detr,
                          avg_alp,avg_betaz,avg_betax,avg_betay,blowzp,blowxp,blowyp,b2p,ab0p,wp);
              if (do_clean_divergence) {
                f1[5] += savg_detr*uxzh*psidcp - consp[7]*avg_betax/avg_alp;
                f1[6] += savg_detr*uyzh*psidcp - consp[7]*avg_betay/avg_alp;
                f1[7] += savg_detr*uzzh*psidcp - consp[7]*avg_betaz/avg_alp;
                psidcf1 = consp[7]/savg_detr - psidcp*avg_betaz/avg_alp;
              }
            }
          } else {
            if(fdir==1)
              num_x_flux_cc(consp[0],consp[1],consp[2],consp[3],consp[4],
                            f1[0],f1[1],f1[2],f1[3],f1[4],
                            velxplus[idx],pressplus[idx],savg_detr,
                            avg_alp,avg_beta);
            else if (fdir==2)
              num_x_flux_cc(consp[0],consp[2],consp[3],consp[1],consp[4],
                            f1[0],f1[2],f1[3],f1[1],f1[4],
                            velyplus[idx],pressplus[idx],savg_detr,
                            avg_alp,avg_beta);
            else
              num_x_flux_cc(consp[0],consp[3],consp[1],consp[2],consp[4],
                            f1[0],f1[3],f1[1],f1[2],f1[4],
                            velzplus[idx],pressplus[idx],savg_detr,
                            avg_alp,avg_beta);
          }

	} else {

	  // normal case -- full HLLE Riemann solution

	  CCTK_REAL usendh;
	  if(fdir==1) 
	    usendh = uxxh;
	  else if(fdir==2)
	    usendh = uyyh;
	  else
	    usendh = uzzh;

	  // calculate the jumps in the conserved variables
          for(int m=0;m<activesize;++m)
            qdiff[m] = consm_i[m] - consp[m];

	  if (do_mhd) {

      	    if (fdir==1) {
      	      eigenvaluesM_cc(rhominus[idxr],
      	          	   velxminus[idxr],
      	          	   velyminus[idxr],
      	          	   velzminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
			   Bvecxminus[idxr],
			   Bvecyminus[idxr],
			   Bveczminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvaluesM_cc(rhoplus[idx],
      	          	   velxplus[idx],
      	          	   velyplus[idx],
      	          	   velzplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
			   Bvecxplus[idx],
			   Bvecyplus[idx],
			   Bveczplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);

      	      num_x_fluxM_cc(consp[0],consp[1],consp[2],consp[3],consp[4],consp[5],consp[6],consp[7],
      	          	  fplus[0],fplus[1],fplus[2],fplus[3],fplus[4],fplus[5],fplus[6],fplus[7],
      	          	  velxplus[idx],velyplus[idx],velzplus[idx],
			  pressplus[idx],savg_detr,
                          avg_alp,avg_betax,avg_betay,avg_betaz,blowxp,blowyp,blowzp,b2p,ab0p,wp);
      	      num_x_fluxM_cc(consm_i[0],consm_i[1],consm_i[2],consm_i[3],consm_i[4],consm_i[5],consm_i[6],consm_i[7],
      	          	  fminus[0],fminus[1],fminus[2],fminus[3],fminus[4],fminus[5],fminus[6],fminus[7],
      	          	  velxminus[idxr],velyminus[idxr],velzminus[idxr],
      	          	  pressminus[idxr],savg_detr,
                          avg_alp,avg_betax,avg_betay,avg_betaz,blowxm,blowym,blowzm,b2m,ab0m,wm);
              if (do_clean_divergence) {
                fminus[5] += savg_detr*uxxh*psidcm_i - consm_i[5]*avg_betax/avg_alp;
                fminus[6] += savg_detr*uxyh*psidcm_i - consm_i[5]*avg_betay/avg_alp;
                fminus[7] += savg_detr*uxzh*psidcm_i - consm_i[5]*avg_betaz/avg_alp;
                fplus[5] += savg_detr*uxxh*psidcp - consp[5]*avg_betax/avg_alp;
                fplus[6] += savg_detr*uxyh*psidcp - consp[5]*avg_betay/avg_alp;
                fplus[7] += savg_detr*uxzh*psidcp - consp[5]*avg_betaz/avg_alp;
                psidcfminus = consm_i[5]/savg_detr - psidcm_i*avg_betax/avg_alp;
                psidcfplus = consp[5]/savg_detr - psidcp*avg_betax/avg_alp;
              }
            } else if(fdir==2) {
      	      eigenvaluesM_cc(rhominus[idxr],
      	          	   velyminus[idxr],
      	          	   velzminus[idxr],
      	          	   velxminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
			   Bvecyminus[idxr],
			   Bveczminus[idxr],
			   Bvecxminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvaluesM_cc(rhoplus[idx],
      	          	   velyplus[idx],
      	          	   velzplus[idx],
      	          	   velxplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
			   Bvecyplus[idx],
			   Bveczplus[idx],
			   Bvecxplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);
      	      num_x_fluxM_cc(consp[0],consp[2],consp[3],consp[1],consp[4],consp[6],consp[7],consp[5],
      	          	  fplus[0],fplus[2],fplus[3],fplus[1],fplus[4],fplus[6],fplus[7],fplus[5],
      	          	  velyplus[idx],velzplus[idx],velxplus[idx],
      	          	  pressplus[idx],savg_detr,
                          avg_alp,avg_betay,avg_betaz,avg_betax,blowyp,blowzp,blowxp,b2p,ab0p,wp);
      	      num_x_fluxM_cc(consm_i[0],consm_i[2],consm_i[3],consm_i[1],consm_i[4],consm_i[6],consm_i[7],consm_i[5],
      	          	  fminus[0],fminus[2],fminus[3],fminus[1],fminus[4],fminus[6],fminus[7],fminus[5],
      	          	  velyminus[idxr],velzminus[idxr],velxminus[idxr],
      	          	  pressminus[idxr],savg_detr,
                          avg_alp,avg_betay,avg_betaz,avg_betax,blowym,blowzm,blowxm,b2m,ab0m,wm);
              if (do_clean_divergence) {
                fminus[5] += savg_detr*uxyh*psidcm_i - consm_i[6]*avg_betax/avg_alp;
                fminus[6] += savg_detr*uyyh*psidcm_i - consm_i[6]*avg_betay/avg_alp;
                fminus[7] += savg_detr*uyzh*psidcm_i - consm_i[6]*avg_betaz/avg_alp;
                fplus[5] += savg_detr*uxyh*psidcp - consp[6]*avg_betax/avg_alp;
                fplus[6] += savg_detr*uyyh*psidcp - consp[6]*avg_betay/avg_alp;
                fplus[7] += savg_detr*uyzh*psidcp - consp[6]*avg_betaz/avg_alp;
                psidcfminus = consm_i[6]/savg_detr - psidcm_i*avg_betay/avg_alp;
                psidcfplus = consp[6]/savg_detr - psidcp*avg_betay/avg_alp;
              }
      	    } else {
      	      eigenvaluesM_cc(rhominus[idxr],
      	          	   velzminus[idxr],
      	          	   velxminus[idxr],
      	          	   velyminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
			   Bveczminus[idxr],
			   Bvecxminus[idxr],
			   Bvecyminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvaluesM_cc(rhoplus[idx],
      	          	   velzplus[idx],
      	          	   velxplus[idx],
      	          	   velyplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
			   Bveczplus[idx],
			   Bvecxplus[idx],
			   Bvecyplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);
      	      num_x_fluxM_cc(consp[0],consp[3],consp[1],consp[2],consp[4],consp[7],consp[5],consp[6],
      	          	  fplus[0],fplus[3],fplus[1],fplus[2],fplus[4],fplus[7],fplus[5],fplus[6],
      	          	  velzplus[idx],velxplus[idx],velyplus[idx],
      	          	  pressplus[idx],savg_detr,
                          avg_alp,avg_betaz,avg_betax,avg_betay,blowzp,blowxp,blowyp,b2p,ab0p,wp);
      	      num_x_fluxM_cc(consm_i[0],consm_i[3],consm_i[1],consm_i[2],consm_i[4],consm_i[7],consm_i[5],consm_i[6],
      	          	  fminus[0],fminus[3],fminus[1],fminus[2],fminus[4],fminus[7],fminus[5],fminus[6],
      	          	  velzminus[idxr],velxminus[idxr],velyminus[idxr],
      	          	  pressminus[idxr],savg_detr,
                          avg_alp,avg_betaz,avg_betax,avg_betay,blowzm,blowxm,blowym,b2m,ab0m,wm);
              if (do_clean_divergence) {
                fminus[5] += savg_detr*uxzh*psidcm_i - consm_i[7]*avg_betax/avg_alp;
                fminus[6] += savg_detr*uyzh*psidcm_i - consm_i[7]*avg_betay/avg_alp;
                fminus[7] += savg_detr*uzzh*psidcm_i - consm_i[7]*avg_betaz/avg_alp;
                fplus[5] += savg_detr*uxzh*psidcp - consp[7]*avg_betax/avg_alp;
                fplus[6] += savg_detr*uyzh*psidcp - consp[7]*avg_betay/avg_alp;
                fplus[7] += savg_detr*uzzh*psidcp - consp[7]*avg_betaz/avg_alp;
                psidcfminus = consm_i[7]/savg_detr - psidcm_i*avg_betaz/avg_alp;
                psidcfplus = consp[7]/savg_detr - psidcp*avg_betaz/avg_alp;
              }
      	    } 
          } else {
  	    
      	    if (fdir==1) {
      	      eigenvalues_cc(rhominus[idxr],
      	          	   velxminus[idxr],
      	          	   velyminus[idxr],
      	          	   velzminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvalues_cc(rhoplus[idx],
      	          	   velxplus[idx],
      	          	   velyplus[idx],
      	          	   velzplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);
      	      num_x_flux_cc(consp[0],consp[1],consp[2],consp[3],consp[4],
      	          	  fplus[0],fplus[1],fplus[2],fplus[3],fplus[4],
      	          	  velxplus[idx],pressplus[idx],savg_detr,
      	          	  avg_alp,avg_beta);	    
      	      num_x_flux_cc(consm_i[0],consm_i[1],consm_i[2],consm_i[3],consm_i[4],
      	          	  fminus[0],fminus[1],fminus[2],fminus[3],fminus[4],
      	          	  velxminus[idxr],pressminus[idxr],savg_detr,
      	          	  avg_alp,avg_beta);	    
            } else if(fdir==2) {
      	      eigenvalues_cc(rhominus[idxr],
      	          	   velyminus[idxr],
      	          	   velzminus[idxr],
      	          	   velxminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvalues_cc(rhoplus[idx],
      	          	   velyplus[idx],
      	          	   velzplus[idx],
      	          	   velxplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);
      	      num_x_flux_cc(consp[0],consp[2],consp[3],consp[1],consp[4],
      	          	  fplus[0],fplus[2],fplus[3],fplus[1],fplus[4],
      	          	  velyplus[idx],pressplus[idx],savg_detr,
      	          	  avg_alp,avg_beta);	    
      	      num_x_flux_cc(consm_i[0],consm_i[2],consm_i[3],consm_i[1],consm_i[4],
      	          	  fminus[0],fminus[2],fminus[3],fminus[1],fminus[4],
      	          	  velyminus[idxr],pressminus[idxr],savg_detr,
      	          	  avg_alp,avg_beta);	    
      	    } else {
      	      eigenvalues_cc(rhominus[idxr],
      	          	   velzminus[idxr],
      	          	   velxminus[idxr],
      	          	   velyminus[idxr],
      	          	   epsminus[idxr],
      	          	   pressminus[idxr],
      	          	   cs2minus[idxr],
      	          	   w_lorentzminus[idxr],
      	          	   gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamminus);
      	      eigenvalues_cc(rhoplus[idx],
      	          	   velzplus[idx],
      	          	   velxplus[idx],
      	          	   velyplus[idx],
      	          	   epsplus[idx],
      	          	   pressplus[idx],
      	          	   cs2plus[idx],
      	          	   w_lorentzplus[idx],
      	          	   gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,
      	          	   avg_alp,avg_beta,usendh,
      	          	   lamplus);
      	      num_x_flux_cc(consp[0],consp[3],consp[1],consp[2],consp[4],
      	          	  fplus[0],fplus[3],fplus[1],fplus[2],fplus[4],
      	          	  velzplus[idx],pressplus[idx],savg_detr,
      	          	  avg_alp,avg_beta);	    
      	      num_x_flux_cc(consm_i[0],consm_i[3],consm_i[1],consm_i[2],consm_i[4],
      	          	  fminus[0],fminus[3],fminus[1],fminus[2],fminus[4],
      	          	  velzminus[idxr],pressminus[idxr],savg_detr,
      	          	  avg_alp,avg_beta);	    
      	    } 
	  }
	  // H-viscosity
	  if(do_hvisc) {
	    CCTK_REAL etabar = 0.0;
	    
	    if(fdir==1) {
	      etabar = max9(etaX(cctkGH,i,j,k,vup,eos_c),
			    etaY(cctkGH,i,j,k,vup,eos_c),
			    etaY(cctkGH,i+1,j,k,vup,eos_c),
			    etaY(cctkGH,i,j-1,k,vup,eos_c),
			    etaY(cctkGH,i+1,j-1,k,vup,eos_c),
			    etaZ(cctkGH,i,j,k,vup,eos_c),
			    etaZ(cctkGH,i+1,j,k,vup,eos_c),
			    etaZ(cctkGH,i,j,k-1,vup,eos_c),
			    etaZ(cctkGH,i+1,j,k-1,vup,eos_c));
	    } else if(fdir==2) {
	      etabar = max9(etaY(cctkGH,i,j,k,vup,eos_c),
			    etaX(cctkGH,i,j,k,vup,eos_c),
			    etaX(cctkGH,i,j+1,k,vup,eos_c),
			    etaX(cctkGH,i-1,j,k,vup,eos_c),
			    etaX(cctkGH,i-1,j+1,k,vup,eos_c),
			    etaZ(cctkGH,i,j,k,vup,eos_c),
			    etaZ(cctkGH,i,j+1,k,vup,eos_c),
			    etaZ(cctkGH,i,j,k-1,vup,eos_c),
			    etaZ(cctkGH,i,j+1,k-1,vup,eos_c));
	    } else if(fdir==3) {
	      etabar = max9(etaZ(cctkGH,i,j,k,vup,eos_c),
			    etaX(cctkGH,i,j,k,vup,eos_c),
			    etaX(cctkGH,i,j,k+1,vup,eos_c),
			    etaX(cctkGH,i-1,j,k,vup,eos_c),
			    etaX(cctkGH,i-1,j,k+1,vup,eos_c),
			    etaY(cctkGH,i,j,k,vup,eos_c),
			    etaY(cctkGH,i,j,k+1,vup,eos_c),
			    etaY(cctkGH,i,j-1,k,vup,eos_c),
			    etaY(cctkGH,i,j-1,k+1,vup,eos_c));
	    } else {
	      CCTK_ERROR("Flux direction not x,y,z");
	    }
	    // modify eigenvalues of Roe's matrix by computed H viscosity
	    for(int m=0;m<10;m++) {
	      lamplusminus[m]  = copysign(1.0,lamplusminus[m])*MAX(fabs(lamplusminus[m]),etabar);
	      // copysign is C99 and the equivalent of FORTRAN sign(a,b)
	    }

	  }

	  // Find minimum and maximum wavespeeds
	  CCTK_REAL charmax = max10(lamplusminus);
	  CCTK_REAL charmin = min10(lamplusminus);

	  CCTK_REAL icharpm = 1.0 / (charmax-charmin);
          for(int m=0;m<activesize; ++m) {
  	      f1[m] = (charmax * fplus[m] - charmin * fminus[m] +
  	               charmax*charmin * qdiff[m]) * icharpm;
  	  }

          if (do_clean_divergence) {
            const CCTK_REAL psidcqdiff = psidcm_i - psidcp;
            // The fastest speed for psidc comes from the condition
            // that the normal vector to the characteristic hypersurface
            // be spacelike (Eq. 60 of Anton et al.)

            const CCTK_REAL charmax_dc = +sqrt(usendh) - avg_beta/avg_alp;
            const CCTK_REAL charmin_dc = -sqrt(usendh) - avg_beta/avg_alp;
            const CCTK_REAL charpm_dc = charmax_dc - charmin_dc;

            psidcf1 = (charmax_dc * psidcfplus - charmin_dc * psidcfminus +
                       charmax_dc * charmin_dc * psidcqdiff) / charpm_dc;
            f1[4+fdir] = (charmax_dc * fplus[4+fdir]
                        - charmin_dc * fminus[4+fdir] +
                          charmax_dc * charmin_dc * qdiff[4+fdir]) / charpm_dc;
          }
	} // else trivial

   	densflux[idx] = f1[0];
   	sxflux[idx]   = f1[1];
   	syflux[idx]   = f1[2];
   	szflux[idx]   = f1[3];
   	tauflux[idx]  = f1[4];
        if (do_mhd) {	
   	  Bconsxflux[idx]   = f1[5];
   	  Bconsyflux[idx]   = f1[6];
   	  Bconszflux[idx]   = f1[7];
        }
        if (do_clean_divergence)
          psidcflux[idx] = psidcf1;

	if(do_ye) {
	  if(densflux[idx] > 0.0) 
	    Y_e_con_flux[idx] = Y_e_plus[idx] * densflux[idx];
	  else
	    Y_e_con_flux[idx] = Y_e_minus[idxr] * densflux[idx];
	}
	
	if(do_tracers) {
	  if(densflux[idx] > 0.0) 
	    for(int m=0;m<number_of_tracers; ++m) {
	      const int idx4 = CCTK_VECTGFINDEX3D(cctkGH,i,j,k,m);
	      cons_tracerflux[idx4] = cons_tracerplus[idx4] 
		* densflux[idx];
	    }
	  else 
	    for(int m=0;m<number_of_tracers; ++m) {
	      const int idx4 = CCTK_VECTGFINDEX3D(cctkGH,i,j,k,m);
	      const int idx4r = 
		CCTK_VECTGFINDEX3D(cctkGH,i+offsetx,j+offsety,k+offsetz,m);
	      cons_tracerflux[idx4] = cons_tracerminus[idx4r] 
		* densflux[idx];
	    }
	} // do tracers


      } // end big loop
}				  


/**
   Select a particular flavor of HLLE Riemann solver.
*/
template <int dir>
struct riemann {

  static inline void select(const bool apply_Hvisc,
                            const bool evolve_Y_e,
                            const bool evolve_tracer,
                            const bool evolve_MHD,
                            const bool clean_divergence,
                             CCTK_ARGUMENTS)
  {
    if(apply_Hvisc) 
      if(evolve_Y_e)
	if(evolve_tracer) 
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,true,true,true,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,true,true,true,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,true,true,true,false,false>(CCTK_PASS_CTOC);
	else
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,true,true,false,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,true,true,false,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,true,true,false,false,false>(CCTK_PASS_CTOC);
      else
	if(evolve_tracer)
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,false,true,true,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,false,true,true,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,false,true,true,false,false>(CCTK_PASS_CTOC);
	else
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,false,true,false,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,false,true,false,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,false,true,false,false,false>(CCTK_PASS_CTOC);
    else
      if(evolve_Y_e)
	if(evolve_tracer)
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,true,false,true,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,true,false,true,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,true,false,true,false,false>(CCTK_PASS_CTOC);
	else
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,true,false,false,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,true,false,false,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,true,false,false,false,false>(CCTK_PASS_CTOC);
      else
	if(evolve_tracer) 
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,false,false,true,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,false,false,true,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,false,false,true,false,false>(CCTK_PASS_CTOC);
	else
	  if(evolve_MHD) 
            if(clean_divergence)
              GRHydro_HLLE_CC_LL<dir,false,false,false,true,true>(CCTK_PASS_CTOC);
            else
              GRHydro_HLLE_CC_LL<dir,false,false,false,true,false>(CCTK_PASS_CTOC);
	  else
	    GRHydro_HLLE_CC_LL<dir,false,false,false,false,false>(CCTK_PASS_CTOC);
  }

};


void GRHydro_HLLE_CC(CCTK_ARGUMENTS) 
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  // flux direction 1
  if(*flux_direction==1)

    riemann<1>::select(apply_H_viscosity, *evolve_Y_e, evolve_tracer, *evolve_MHD, clean_divergence, CCTK_PASS_CTOC);

  // flux direction 2
  else if(*flux_direction==2)

    riemann<2>::select(apply_H_viscosity, *evolve_Y_e, evolve_tracer, *evolve_MHD, clean_divergence, CCTK_PASS_CTOC);

    // flux direction 3
  else if(*flux_direction==3)

    riemann<3>::select(apply_H_viscosity, *evolve_Y_e, evolve_tracer, *evolve_MHD, clean_divergence, CCTK_PASS_CTOC);

  else
    CCTK_ERROR("Illegal flux direction!");

  return;
}

extern "C"
CCTK_FCALL void CCTK_FNAME(GRHydro_HLLE_CC_F2C)(cGH ** p_cctkGH) {
  GRHydro_HLLE_CC(*p_cctkGH);
}


extern "C"
void H_viscosity_calc_cs_cc(CCTK_ARGUMENTS) {

  // This is a preperatory routine for H viscosity.
  // All it does is fill a speed of sound helper array

  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  const size_t n = size_t(cctk_ash[0]*cctk_ash[1]*cctk_ash[2]);
  std::vector<CCTK_INT> keyerr(n);
  CCTK_INT anyerr = 0;
  int keytemp = 0;

  if(!*evolve_temper) {
#pragma omp parallel for
    for(int k=0;k<cctk_lsh[2];k++)
      for(int j=0;j<cctk_lsh[1];j++) {
	const int i = CCTK_GFINDEX3D(cctkGH,0,j,k);
	CCTK_REAL cs2[cctk_ash[0]];
	EOS_Omni_cs2(*GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,cctk_lsh[0],
		     &(rho[i]),&(eps[i]),NULL,NULL,&cs2[i],
		     &(keyerr[i]),&anyerr);

	for(int ii=0;ii<cctk_lsh[0];++ii) {
	  eos_c[ii+i] = sqrt(cs2[ii]);
	}
      }
  } else {
#pragma omp parallel for
    for(int k=0;k<cctk_lsh[2];k++)
      for(int j=0;j<cctk_lsh[1];j++) {
	const int i = CCTK_GFINDEX3D(cctkGH,0,j,k);
	CCTK_REAL cs2[cctk_ash[0]];
	EOS_Omni_cs2(*GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,cctk_lsh[0],
		     &rho[i],&eps[i],&temperature[i],&Y_e[i],
		     &cs2[i],&keyerr[i],&anyerr);
	for(int ii=0;ii<cctk_lsh[0];++ii) {
	  eos_c[ii+i] = sqrt(cs2[ii]);
	}
      } // for
    if(anyerr) {
      for(size_t i=0;i<n;i++) {
	if(keyerr[i] != 0) {
#pragma omp critical
	  {
	    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
		       "rl: %d i,x,y,z: %d %15.6E %15.6E %15.6E, keyerr: %d",
		       int(*GRHydro_reflevel), int(i), x[i], y[i], z[i], int(keyerr[i]));
	    CCTK_VWarn(1, __LINE__, __FILE__, CCTK_THORNSTRING,
		       "rl: %d r,t,ye: %15.6E %15.6E %15.6E, keyerr: %d",
		       int(*GRHydro_reflevel), rho[i], temperature[i], Y_e[i], int(keyerr[i]));
	  }
	}
      } // for i, i<n
      CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING,
		 "Aborting!");
    } // anyerr
  } // if evolve_temper

}

static inline void UpperMetricC(CCTK_REAL& restrict uxx,
                                CCTK_REAL& restrict uxy,
                                CCTK_REAL& restrict uxz,
                                CCTK_REAL& restrict uyy,
                                CCTK_REAL& restrict uyz,
                                CCTK_REAL& restrict uzz,
				const CCTK_REAL det,
				const CCTK_REAL gxx,
				const CCTK_REAL gxy,
				const CCTK_REAL gxz,
				const CCTK_REAL gyy,
				const CCTK_REAL gyz,
				const CCTK_REAL gzz)
{
  const CCTK_REAL invdet = 1.0 / det;
  uxx = (-gyz*gyz + gyy*gzz)*invdet;
  uxy = (gxz*gyz - gxy*gzz)*invdet;
  uxz = (-gxz*gyy + gxy*gyz)*invdet;
  uyy = (-gxz*gxz + gxx*gzz)*invdet;
  uyz = (gxy*gxz - gxx*gyz)*invdet;
  uzz = (-gxy*gxy + gxx*gyy)*invdet;

  return;
}

static inline CCTK_REAL SpatialDeterminantC(const CCTK_REAL gxx, const CCTK_REAL gxy,
					    const CCTK_REAL gxz, const CCTK_REAL gyy,
					    const CCTK_REAL gyz, const CCTK_REAL gzz) 
{
  return -gxz*gxz*gyy + 2.0*gxy*gxz*gyz - gxx*gyz*gyz 
    - gxy*gxy*gzz + gxx*gyy*gzz;
}


```

GRHydro_EOS.c:
```
 /*@@
   @file      GRHydro_EOS.c
   @date      Wed Feb  6 18:25:33 2002
   @author    
   @desc 
   Sets the EOS handle number for use by
   all the GRHydro routines
   @enddesc 
 @@*/

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

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

 /*@@
   @routine    GRHydro_EOSHandle
   @date       Wed Feb  6 18:28:01 2002
   @author     Ian Hawke
   @desc 
   Sets the EOS handle number
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

void GRHydro_EOSHandle(CCTK_ARGUMENTS)
{

  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  CCTK_INFO("Trying to get EOS handles");
  EOS_Omni_GetHandle("2D_Polytrope");
  CCTK_INFO("Trying to get EOS handles");
  if (!(*GRHydro_eos_handle       = EOS_Omni_GetHandle(GRHydro_eos_table)))
    CCTK_WARN(0, "Cannot get EOS handle, aborting.");
  if (!(*GRHydro_polytrope_handle = EOS_Omni_GetHandle("2D_Polytrope")))
    CCTK_WARN(0, "Cannot get polytrope EOS handle, aborting.");
  CCTK_VInfo(CCTK_THORNSTRING, "GRHydro will use the %s equation of state.",
                               GRHydro_eos_table);

}

```

GRHydro_Prim2ConAM.F90:
```
  /*@@
   @file      primitive2conservative
   @date      Aug 31, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Primitive to conservative routine
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"
#include "cctk_Functions.h"
#include "GRHydro_Macros.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 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 DOT(x1,y1,z1,x2,y2,z2)   ( DOTP(gxx,gxy,gxz,gyy,gyz,gzz,x1,y1,z1,x2,y2,z2) )
#define DOT2(x1,y1,z1)           ( DOTP2(gxx,gxy,gxz,gyy,gyz,gzz,x1,y1,z1) )
#define DOTPT(x1,y1,z1,x2,y2,z2) ( DOTP(gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt,x1,y1,z1,x2,y2,z2) )
#define DOTPT2(x1,y1,z1)         ( DOTP2(gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt,x1,y1,z1) )

 /*@@
   @routine   primitive2conservativeAM
   @date      Aug 31
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts primitive to conserved variables for the boundary extended data.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine primitive2conservativeAM(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
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  CCTK_REAL :: xtemp(1)
  character(len=256) NaN_WarnLine

  ! constraint transport needs to be able to average fluxes in the directions
  ! other that flux_direction, which in turn need the primitives on interfaces

  if(evolve_temper.ne.1) then

  !$OMP PARALLEL DO PRIVATE(k,j,i,avg_sdetl,avg_sdetr,&
  !$OMP                      gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,&
  !$OMP                      gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)
  do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
    do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
      do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
        
        gxxl = 0.5d0 * (gxx(i,j,k) + gxx(i-xoffset,j-yoffset,k-zoffset))
        gxyl = 0.5d0 * (gxy(i,j,k) + gxy(i-xoffset,j-yoffset,k-zoffset))
        gxzl = 0.5d0 * (gxz(i,j,k) + gxz(i-xoffset,j-yoffset,k-zoffset))
        gyyl = 0.5d0 * (gyy(i,j,k) + gyy(i-xoffset,j-yoffset,k-zoffset))
        gyzl = 0.5d0 * (gyz(i,j,k) + gyz(i-xoffset,j-yoffset,k-zoffset))
        gzzl = 0.5d0 * (gzz(i,j,k) + gzz(i-xoffset,j-yoffset,k-zoffset))
        gxxr = 0.5d0 * (gxx(i,j,k) + gxx(i+xoffset,j+yoffset,k+zoffset))
        gxyr = 0.5d0 * (gxy(i,j,k) + gxy(i+xoffset,j+yoffset,k+zoffset))
        gxzr = 0.5d0 * (gxz(i,j,k) + gxz(i+xoffset,j+yoffset,k+zoffset))
        gyyr = 0.5d0 * (gyy(i,j,k) + gyy(i+xoffset,j+yoffset,k+zoffset))
        gyzr = 0.5d0 * (gyz(i,j,k) + gyz(i+xoffset,j+yoffset,k+zoffset))
        gzzr = 0.5d0 * (gzz(i,j,k) + gzz(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))

        call prim2conAM(GRHydro_eos_handle, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
             avg_sdetl,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),Bvecxminus(i,j,k), &
             Bvecyminus(i,j,k), Bveczminus(i,j,k), w_lorentzminus(i, j, k))
 
        call prim2conAM(GRHydro_eos_handle, gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
             avg_sdetr, 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),&
             Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k), &
             w_lorentzplus(i,j,k)) 

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

  else

     !$OMP PARALLEL DO PRIVATE(i, j, k, avg_sdetl, avg_sdetr, xtemp,&
     !$OMP                      gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
     !$OMP                      gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)
     do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
       do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
         do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
              
              gxxl = 0.5d0 * (gxx(i,j,k) + gxx(i-xoffset,j-yoffset,k-zoffset))
              gxyl = 0.5d0 * (gxy(i,j,k) + gxy(i-xoffset,j-yoffset,k-zoffset))
              gxzl = 0.5d0 * (gxz(i,j,k) + gxz(i-xoffset,j-yoffset,k-zoffset))
              gyyl = 0.5d0 * (gyy(i,j,k) + gyy(i-xoffset,j-yoffset,k-zoffset))
              gyzl = 0.5d0 * (gyz(i,j,k) + gyz(i-xoffset,j-yoffset,k-zoffset))
              gzzl = 0.5d0 * (gzz(i,j,k) + gzz(i-xoffset,j-yoffset,k-zoffset))
              gxxr = 0.5d0 * (gxx(i,j,k) + gxx(i+xoffset,j+yoffset,k+zoffset))
              gxyr = 0.5d0 * (gxy(i,j,k) + gxy(i+xoffset,j+yoffset,k+zoffset))
              gxzr = 0.5d0 * (gxz(i,j,k) + gxz(i+xoffset,j+yoffset,k+zoffset))
              gyyr = 0.5d0 * (gyy(i,j,k) + gyy(i+xoffset,j+yoffset,k+zoffset))
              gyzr = 0.5d0 * (gyz(i,j,k) + gyz(i+xoffset,j+yoffset,k+zoffset))
              gzzr = 0.5d0 * (gzz(i,j,k) + gzz(i+xoffset,j+yoffset,k+zoffset))
              
              avg_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl,gyzl,gzzl))
              avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr,gyzr,gzzr))

              ! we do not have plus/minus vars for temperature since
              ! eps is reconstructed. Hence, we do not update the
              ! variable 'temperature' in prim2con at the interfaces 
              ! We will instead use an average temperature as an initial
              ! guess.
              xtemp(1) = 0.5d0*(temperature(i,j,k) + &
                   temperature(i-xoffset,j-yoffset,k-zoffset))

    !$OMP CRITICAL
              if (y_e_minus(i,j,k) .le. 0.0d0 .or. y_e_plus(i,j,k) .le. 0.0d0) then
                  write(NaN_WarnLine,'(a100,7g15.6)') '(y_e_minus,y_e_plus,x,y,z,rho)', y_e(i,j,k), y_e_minus(i,j,k), y_e_plus(i,j,k), x(i,j,k),y(i,j,k),z(i,j,k),rho(i,j,k)
                  call CCTK_WARN(1, NaN_WarnLine)
              endif 
    !$OMP END CRITICAL
              call prim2conAM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                   int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k), gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                   avg_sdetl,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),Bvecxminus(i,j,k), &
                   Bvecyminus(i,j,k), Bveczminus(i,j,k), w_lorentzminus(i, j, k), xtemp, y_e_minus(i,j,k))
              ! we do not have plus/minus vars for temperature since
              ! eps is reconstructed. Hence, we do not update the
              ! variable 'temperature' in prim2con at the interfaces
              ! We will instead use an average temperature as an initial
              ! guess.
              xtemp(1) = 0.5d0*(temperature(i,j,k) + &
                   temperature(i+xoffset,j+yoffset,k+zoffset))
  
              call prim2conAM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                   int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k), gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                   avg_sdetr, 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),&
                   Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k), &
                   w_lorentzplus(i,j,k), xtemp, y_e_plus(i,j,k)) 
             
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  endif


end subroutine primitive2conservativeAM

 /*@@
   @routine    prim2conAM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2conAM_hot(handle, GRHydro_reflevel, ii, jj, kk, x, y, z, &
     gxx, gxy, gxz, gyy, gyz, gzz, sdet, ddens, &
     dsx, dsy, dsz, dtau, drho, dvelx, dvely, dvelz, &
     deps, dpress, dBvcx, dBvcy, dBvcz, w, temp, ye) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL, dimension(1) :: ddens, dsx, dsy, dsz, dtau, &
       drho, dvelx, dvely, dvelz,&
       deps, dpress, dBvcx, dBvcy, dBvcz, vlowx, vlowy, vlowz   
  CCTK_REAL :: temp(1),ye(1), yein(1), x, y, z
  CCTK_INT :: handle, GRHydro_reflevel, ii, jj, kk
  CCTK_REAL :: w
  CCTK_REAL, dimension(1) :: Bdotv,ab0,b2,blowx,blowy,blowz
  character(len=256) NaN_WarnLine
  character(len=512) warnline

! begin EOS Omni vars
  CCTK_INT  :: n, keytemp, anyerr, keyerr(1)
 ! CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1)
  CCTK_REAL :: temp0(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
  
  temp0 = temp
  w = 1.d0 / sqrt(1.d0 - DOT2(dvelx(1),dvely(1),dvelz(1)))

!!$ BEGIN: Check for NaN value
  if (w .ne. w) then
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a100,6g15.6)') 'NaN produced in sqrt(): (gxx,gxy,gxz,gyy,gyz,gzz)', gxx, gxy, gxz, gyy, gyz, gzz
    call CCTK_WARN(1, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (dvelx,dvely,dvelz)', dvelx, dvely, dvelz
    call CCTK_WARN(1, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (x,y,z)', x, y, z
    call CCTK_WARN(1, NaN_WarnLine)
    !write(NaN_WarnLine,'(a100,g15.6)') 'NaN produced in sqrt(): w', w
    !call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
  endif
!!$ END: Check for NaN value

  ye = max(min(ye,GRHydro_Y_e_max),GRHydro_Y_e_min)
 
  yein = ye 
 
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,temp,ye,dpress,keyerr,anyerr)  
  ! error handling
  if(anyerr.ne.0) then
     if(GRHydro_reflevel.lt.GRHydro_c2p_warn_from_reflevel) then
        ! in this case (coarse grid error that is hopefully restricted
        ! away), we use the average temperature between cells and call
        ! the EOS with keytemp=1
        keytemp=1
        call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
             drho,deps,temp,ye,dpress,keyerr,anyerr)  
        keytemp=0
        if(anyerr.ne.0) then
           !$OMP CRITICAL
           call CCTK_WARN(1,"EOS error in prim2con_hot: lev 2")
           write(warnline,"(3i5,1P10E15.6)") ii,jj,kk,x,y,z
           call CCTK_WARN(1,warnline)
           write(warnline,"(1P10E15.6)") drho,deps,temp,ye,yein
           call CCTK_WARN(1,warnline)
           write(warnline,"(A7,i8)") "code: ",keyerr(1)
           call CCTK_WARN(1,warnline)
           write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
           call CCTK_WARN(1,warnline)
           !$OMP END CRITICAL
        endif
     else
        ! This is a way of recovering even on finer refinement levels:
        ! Use the average temperature at the interface instead of the
        ! reconstructed specific internal energy.
        !$OMP CRITICAL
        call CCTK_WARN(1,"EOS error in prim2con_hot: NOW using averaged temp!")
        write(warnline,"(3i5,1P10E15.6)") ii,jj,kk,x,y,z
        call CCTK_WARN(1,warnline)
        write(warnline,"(1P10E15.6)") drho,deps,temp0,ye
        call CCTK_WARN(1,warnline)
        write(warnline,"(A7,i8)") "code: ",keyerr(1)
        call CCTK_WARN(1,warnline)
        write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
        call CCTK_WARN(1,warnline)
        !$OMP END CRITICAL
        keytemp=1
        temp = temp0
        call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
             drho,deps,temp,ye,dpress,keyerr,anyerr)  
        keytemp=0
        if(anyerr.ne.0) then
           !$OMP CRITICAL
           call CCTK_WARN(1,"EOS error in prim2con_hot")
           write(warnline,"(3i5,1P10E15.6)") ii,jj,kk,x,y,z
           call CCTK_WARN(1,warnline)
           write(warnline,"(1P10E15.6)") drho,deps,temp,ye
           call CCTK_WARN(1,warnline)
           write(warnline,"(A7,i8)") "code: ",keyerr(1)
           call CCTK_WARN(1,warnline)
           write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
           call CCTK_WARN(1,warnline)
           call CCTK_ERROR("Aborting!!!")
           STOP
           !$OMP END CRITICAL
        endif
     endif
  endif

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 

  !!$OMP CRITICAL
  !write(NaN_WarnLine,'(a100,3g15.6)') '(dens out, sdet, w:)', ddens,sdet,w
  !call CCTK_WARN(1, NaN_WarnLine)
  !!$OMP END CRITICAL
end subroutine prim2conAM_hot


subroutine prim2conAM(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdet, ddens, &
     dsx, dsy, dsz, dtau, drho, dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, w) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL, dimension(1) :: ddens, dsx, dsy, dsz, dtau, &
       drho, dvelx, dvely, dvelz,&
       deps, dpress, dBvcx, dBvcy, dBvcz, vlowx, vlowy, vlowz   
  CCTK_REAL :: w
  CCTK_REAL, dimension(1) :: Bdotv,ab0,b2,blowx,blowy,blowz
  CCTK_INT :: handle
  character(len=256) NaN_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
  
  w = 1.d0 / sqrt(1.d0 - DOT2(dvelx(1),dvely(1),dvelz(1)))

!!$ BEGIN: Check for NaN value
  if (w .ne. w) then
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a100,6g15.6)') 'NaN produced in sqrt(): (gxx,gxy,gxz,gyy,gyz,gzz)', gxx, gxy, gxz, gyy, gyz, gzz
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (dvelx,dvely,dvelz)', dvelx, dvely, dvelz
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
  endif
!!$ END: Check for NaN value

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,xtemp,xye,dpress,keyerr,anyerr)  

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 

end subroutine prim2conAM


 /*@@
   @routine    Primitive2ConservativeCellsAM
   @date       Aug 31, 2010
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Primitive2ConservativeCellsAM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  CCTK_REAL :: maxtau0

  maxtau0 = -1.0d60
  
  if(evolve_temper.ne.1) then

  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet), REDUCTION(MAX:maxtau0)
  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
        
         sdet = sdetg(i,j,k)

        call prim2conAM(GRHydro_eos_handle,gxx(i,j,k),&
             gxy(i,j,k),gxz(i,j,k),&
             gyy(i,j,k),gyz(i,j,k),gzz(i,j,k),&
             sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),&
             rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),Bvecx(i,j,k), &
             Bvecy(i,j,k), Bvecz(i,j,k), w_lorentz(i,j,k))

        maxtau0 = max(maxtau0,tau(i,j,k))

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

  ! TODO: to actually reduce GRHydro_tau_min over all Carpet components
  ! we need to modify Carpet looping to allow this function to be called
  ! on all AMR levels before calling any other function. The best would be
  ! to set a special bin where functions would be called on all levels first
  ! instead of calling all functions per level. The workaround for this problem
  ! is to set GRHydro_tau_min to a user specified value as it was set in 
  ! GRHydro_Minima.F90. Once this issue is solved, then uncomment the line
  ! below and create two other routines to be run in global mode so that 
  ! GRHydro_tau_min can be properly initialized and reduced.

  !GRHydro_tau_min = GRHydro_tau_min * maxtau0 

  else 
  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet)
  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
        
         sdet = sdetg(i,j,k)

         call prim2conAM_hot(GRHydro_eos_handle,GRHydro_reflevel,&
              i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),&
              gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),&
              gyy(i,j,k),gyz(i,j,k),gzz(i,j,k),&
              sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
              tau(i,j,k),&
              rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
              eps(i,j,k),press(i,j,k),Bvecx(i,j,k), &
              Bvecy(i,j,k), Bvecz(i,j,k), w_lorentz(i,j,k), temperature(i,j,k), Y_e(i,j,k))

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

  if(evolve_Y_e.ne.0) 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
           do i = GRHydro_stencil,cctk_lsh(1)-GRHydro_stencil+1
              Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif



end subroutine Primitive2ConservativeCellsAM


 /*@@
   @routine    Prim2ConservativePolytypeAM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   Same as first routine, only for polytropes.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Prim2ConservativePolytypeAM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  
  ! 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, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_sdetl,&
  !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr)
  do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
    do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
      do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
        
        gxxl = 0.5d0 * (gxx(i,j,k) + gxx(i-xoffset,j-yoffset,k-zoffset))
        gxyl = 0.5d0 * (gxy(i,j,k) + gxy(i-xoffset,j-yoffset,k-zoffset))
        gxzl = 0.5d0 * (gxz(i,j,k) + gxz(i-xoffset,j-yoffset,k-zoffset))
        gyyl = 0.5d0 * (gyy(i,j,k) + gyy(i-xoffset,j-yoffset,k-zoffset))
        gyzl = 0.5d0 * (gyz(i,j,k) + gyz(i-xoffset,j-yoffset,k-zoffset))
        gzzl = 0.5d0 * (gzz(i,j,k) + gzz(i-xoffset,j-yoffset,k-zoffset))
        gxxr = 0.5d0 * (gxx(i,j,k) + gxx(i+xoffset,j+yoffset,k+zoffset))
        gxyr = 0.5d0 * (gxy(i,j,k) + gxy(i+xoffset,j+yoffset,k+zoffset))
        gxzr = 0.5d0 * (gxz(i,j,k) + gxz(i+xoffset,j+yoffset,k+zoffset))
        gyyr = 0.5d0 * (gyy(i,j,k) + gyy(i+xoffset,j+yoffset,k+zoffset))
        gyzr = 0.5d0 * (gyz(i,j,k) + gyz(i+xoffset,j+yoffset,k+zoffset))
        gzzr = 0.5d0 * (gzz(i,j,k) + gzz(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))

        call prim2conpolytypeAM(GRHydro_eos_handle, gxxl,gxyl,gxzl,&
             gyyl,gyzl,gzzl, &
             avg_sdetl,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),Bvecxminus(i,j,k), &
             Bvecyminus(i,j,k),Bveczminus(i,j,k),w_lorentzminus(i, j, k))
 
        call prim2conpolytypeAM(GRHydro_eos_handle, gxxr,gxyr,gxzr,&
             gyyr,gyzr,gzzr, &
             avg_sdetr,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),Bvecxplus(i,j,k), &
             Bvecyplus(i,j,k),Bveczplus(i,j,k),w_lorentzplus(i, j, k))

        if (densminus(i,j,k) .ne. densminus(i,j,k)) then
        !$OMP CRITICAL
        call CCTK_WARN(1, "NaN in densminus(i,j,k) (Prim2Con)")
        !$OMP END CRITICAL
        endif
      end do
    end do
  end do
  !$OMP END PARALLEL DO
end subroutine Prim2ConservativePolytypeAM

 /*@@
   @routine    prim2conpolytypeAM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2conpolytypeAM(handle, gxx, gxy, gxz, gyy, gyz, &
     gzz, sdet, ddens, dsx, dsy, dsz, dtau, &
     drho, dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, w) 
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, &
       drho, dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, &
       w_tmp, w, vlowx, vlowy, vlowz
  CCTK_INT :: handle
  CCTK_REAL :: Bdotv,ab0,b2,blowx,blowy,blowz
  character(len=256) NaN_WarnLine

! begin EOS Omni vars
  CCTK_INT  :: n, keytemp, anyerr, keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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
  
  w_tmp = DOT2(dvelx,dvely,dvelz)

  if (w_tmp .ge. 1.d0) then
    ! In theory this should not happen, and even when accepting the fact
    ! that numerically it can, one might be tempted to set w to some large
    ! value in that case. However, this would lead to completely bogus
    ! and hard to trace wrong values below. There is no good value to
    ! choose in this case, but something small is probably the best of
    ! all bad choices.
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a80,2g15.6)') 'Infinite Lorentz factor reset. rho, w_tmp: ', drho, w_tmp
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
    w = 1.d-20
  else
    w = 1.d0 / sqrt(1.d0 - w_tmp)
  endif

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,deps,keyerr,anyerr)

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 
  
end subroutine prim2conpolytypeAM


 /*@@
   @routine    Primitive2ConservativePolyCellsAM
   @date       Aug 31, 2010
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Primitive2ConservativePolyCellsAM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  
  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet)
  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
        
        sdet = sdetg(i,j,k)


        call prim2conpolytypeAM(GRHydro_eos_handle,gxx(i,j,k),gxy(i,j,k),&
             gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k),&
             sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),&
             rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),Bvecx(i,j,k), Bvecy(i,j,k), &
             Bvecz(i,j,k), w_lorentz(i,j,k))

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

  if(evolve_Y_e.ne.0) 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
           do i = GRHydro_stencil,cctk_lsh(1)-GRHydro_stencil+1
              Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif


end subroutine Primitive2ConservativePolyCellsAM

!!$
!!$ Prim2Con doesn't change for tracers with the addition of a B-field!
!!$


```

GRHydro_Tmunu.F90:
```
 /*@@
   @file      GRHydro_Tmunu.F90
   @date      Thu Apr 16 19:38:40 2009
   @author    Ian Hawke
   @histpry
    Apr. 2009: Luca Baiotti copied and adapted for the Tmunu-thorn mechanism the original include file
   @desc 
     The calculation of the stress energy tensor.
     The version used here was worked out by Miguel Alcubierre. I
     think it was an extension of the routine from GR3D, written
     by Mark Miller.
     C version added by Ian Hawke.

     Lower components of the stress-energy tensor obtained from
     the hydro variables.  The components are given by:

     T      =  rho h  u   u    +  P  g
      mu nu            mu  nu         mu nu

     where rho is the energy density of the fluid, h the enthalpy
     and P the pressure.  The enthalpy is given in terms of the
     basic variables as:

     h  =  1  +  e  +  P/rho

     with e the internal energy (eps here).

     In the expresion for T_{mu,nu} we also have the four-velocity
     of the fluid given by (v_i is the 3-velocity field):

                                 i
     u  =  W ( - alpha +  v  beta  )
      0                    i

     u  =  W v
      i       i
                                                i  -1/2
     with W the Lorentz factor:   W = ( 1 -  v v  )
                                              i

     and where alpha and beta are the lapse and shift vector.

     Finally, the 4 metric is given by

                   2             i
     g   =  - alpha  + beta  beta
      00                   i

     g   =  beta
      0i        i


     g   =  gamma      (the spatial metric)
      ij        ij


   @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)

 subroutine GRHydro_Tmunu(CCTK_ARGUMENTS)

   implicit none

   DECLARE_CCTK_ARGUMENTS
   DECLARE_CCTK_PARAMETERS
   DECLARE_CCTK_FUNCTIONS

   CCTK_REAL velxlow, velylow, velzlow
   CCTK_REAL betaxlow, betaylow, betazlow, beta2
   CCTK_REAL utlow, uxlow, uylow, uzlow
   CCTK_REAL rhoenthalpy
   CCTK_REAL ut,ux,uy,uz,bst,bsx,bsy,bsz,bs2
   CCTK_REAL dampfac
   CCTK_INT i,j,k

!!$ Damping factor
   dampfac = 1.0

   !$OMP PARALLEL DO PRIVATE(i,j,k,velxlow, velylow, velzlow,&
   !$OMP betaxlow, betaylow, betazlow, beta2, utlow, uxlow, uylow, uzlow,&
   !$OMP rhoenthalpy, ut,ux,uy,uz,bst,bsx,bsy,bsz,bs2,dampfac)
   do k = 1, cctk_lsh(3)
     do j = 1, cctk_lsh(2)
       do i = 1, cctk_lsh(1)

          velxlow = gxx(i,j,k)*velx(i,j,k) + gxy(i,j,k)*vely(i,j,k) + gxz(i,j,k)*velz(i,j,k)
          velylow = gxy(i,j,k)*velx(i,j,k) + gyy(i,j,k)*vely(i,j,k) + gyz(i,j,k)*velz(i,j,k)
          velzlow = gxz(i,j,k)*velx(i,j,k) + gyz(i,j,k)*vely(i,j,k) + gzz(i,j,k)*velz(i,j,k)

!!$       Calculate lower components and square of shift vector.

          betaxlow = gxx(i,j,k)*betax(i,j,k) + gxy(i,j,k)*betay(i,j,k) + gxz(i,j,k)*betaz(i,j,k)
          betaylow = gxy(i,j,k)*betax(i,j,k) + gyy(i,j,k)*betay(i,j,k) + gyz(i,j,k)*betaz(i,j,k)
          betazlow = gxz(i,j,k)*betax(i,j,k) + gyz(i,j,k)*betay(i,j,k) + gzz(i,j,k)*betaz(i,j,k)
          
          beta2 = betax(i,j,k)*betaxlow + betay(i,j,k)*betaylow + betaz(i,j,k)*betazlow 
           
!!$       Calculate the specific relativistic enthalpy times rho times the
!!$       square of the lorentz factor.

         rhoenthalpy = w_lorentz(i,j,k)**2*(rho(i,j,k)*(1.0d0 + eps(i,j,k)) + press(i,j,k))

!!$       Calculate lower components of 4-velocity (without the Lorent factor).

         utlow = (-alp(i,j,k) + velx(i,j,k)*betaxlow + vely(i,j,k)*betaylow + velz(i,j,k)*betazlow)

         uxlow = velxlow
         uylow = velylow
         uzlow = velzlow


!!$      Initialize damping factor
         dampfac = 1.0
!!$      Apply tanh blending for Tmunu.
         if ((Tmunu_damping_radius_min .gt. 0) .and. (r(i,j,k) .gt. Tmunu_damping_radius_min)) then
            !  0.5 * (1.0 - tanh(4.0*(x-x0)/sigma0))
            if (r(i,j,k) .lt. Tmunu_damping_radius_max) then
               dampfac = 0.5d0 * (1.0d0 - tanh((8.0d0*r(i,j,k)-4.0d0*(Tmunu_damping_radius_max+Tmunu_damping_radius_min))/(Tmunu_damping_radius_max-Tmunu_damping_radius_min)))
            else
               dampfac = 0.0
               continue   ! no need to add anything to Tmunu at the current point (it's zero anyway!)
            endif
         else
            dampfac = 1.0
         endif
         
!!$       Calculate Tmunu (the lower components!).

         eTtt(i,j,k) = eTtt(i,j,k) + dampfac * (rhoenthalpy*utlow**2 + press(i,j,k)*(beta2 - alp(i,j,k)**2))

         eTtx(i,j,k) = eTtx(i,j,k) + dampfac * (rhoenthalpy*utlow*uxlow + press(i,j,k)*betaxlow)
         eTty(i,j,k) = eTty(i,j,k) + dampfac * (rhoenthalpy*utlow*uylow + press(i,j,k)*betaylow)
         eTtz(i,j,k) = eTtz(i,j,k) + dampfac * (rhoenthalpy*utlow*uzlow + press(i,j,k)*betazlow)

         eTxx(i,j,k) = eTxx(i,j,k) + dampfac * (rhoenthalpy*uxlow**2 + press(i,j,k)*gxx(i,j,k))
         eTyy(i,j,k) = eTyy(i,j,k) + dampfac * (rhoenthalpy*uylow**2 + press(i,j,k)*gyy(i,j,k))
         eTzz(i,j,k) = eTzz(i,j,k) + dampfac * (rhoenthalpy*uzlow**2 + press(i,j,k)*gzz(i,j,k))
         
         eTxy(i,j,k) = eTxy(i,j,k) + dampfac * (rhoenthalpy*uxlow*uylow + press(i,j,k)*gxy(i,j,k))
         eTxz(i,j,k) = eTxz(i,j,k) + dampfac * (rhoenthalpy*uxlow*uzlow + press(i,j,k)*gxz(i,j,k))
         eTyz(i,j,k) = eTyz(i,j,k) + dampfac * (rhoenthalpy*uylow*uzlow + press(i,j,k)*gyz(i,j,k))

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

   return
 
 end subroutine GRHydro_Tmunu

```

GRHydro_Reconstruct.cc:
```
 /*@@
   @file      GRHydro_Reconstruct.cc
   @date      Thu Dec 2013
   @author    Christian Reisswig
   @desc 
   Wrapper routine to perform the reconstruction.using tmeplate metaprogramming
   @enddesc 
 @@*/

#include <iostream>
#include <cassert>
#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.h"

#include "SpaceMask.h"

#include "GRHydro_Functions.h"

#include "GRHydro_Reconstruct_drv_cxx.hh"
#include "GRHydro_WENOReconstruct.hh"
#include "GRHydro_TrivialReconstruct.hh"
#include "GRHydro_TVDReconstruct.hh"
#include "GRHydro_MP5Reconstruct.hh"

#define velx (&vup[0])
#define vely (&vup[N])
#define velz (&vup[2*N])

#define Bvecx (&Bprim[0])
#define Bvecy (&Bprim[N])
#define Bvecz (&Bprim[2*N])

/*
  External routines
*/
extern "C"
CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

/*
  This is needed right now because we want to also call this from Fotran
*/
extern "C"
void CCTK_FCALL CCTK_FNAME(GRHydro_PPMReconstruct_drv_opt)(cGH /*const*/ * const restrict & /*restrict*/ cctkGH);

extern "C"
void CCTK_FCALL CCTK_FNAME(primitive2conservativeM)(cGH /*const*/ * const restrict & /*restrict*/ cctkGH);


/**
   This class selects a reconstruction variant.
*/
template <class RECONSTRUCT>
struct reconstruct
{
   static inline void select(const bool do_mhd,
                             const bool do_Ye,
                             const bool do_temp,
                             const bool reconstruct_Wv,
                             const bool clean_divergence,
                             cGH const * const restrict cctkGH)
   {
       if (!do_mhd && !do_Ye && !do_temp && reconstruct_Wv)
          GRHydro_Reconstruct_drv_cxx <false, false, false, true, false, RECONSTRUCT > (cctkGH);
       else if (do_mhd && !do_Ye && !do_temp && reconstruct_Wv && !clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, false, false, true, false, RECONSTRUCT > (cctkGH);
       else if (do_mhd && do_Ye && do_temp && reconstruct_Wv && !clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, true, true, true, false, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && !do_Ye && !do_temp && reconstruct_Wv && clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, false, false, true, true, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && do_Ye && do_temp && reconstruct_Wv && clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, true, true, true, true, RECONSTRUCT  > (cctkGH);
       else if (!do_mhd && do_Ye && do_temp && reconstruct_Wv)
          GRHydro_Reconstruct_drv_cxx <false, true, true, true, false, RECONSTRUCT  > (cctkGH);
       else if (!do_mhd && !do_Ye && !do_temp && !reconstruct_Wv)
          GRHydro_Reconstruct_drv_cxx <false, false, false, false, false, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && !do_Ye && !do_temp && !reconstruct_Wv && !clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, false, false, false, false, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && do_Ye && do_temp && !reconstruct_Wv && !clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, true, true, false, false, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && !do_Ye && !do_temp && !reconstruct_Wv && clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, false, false, false, true, RECONSTRUCT  > (cctkGH);
       else if (do_mhd && do_Ye && do_temp && !reconstruct_Wv && clean_divergence)
          GRHydro_Reconstruct_drv_cxx <true, true, true, false, true, RECONSTRUCT  > (cctkGH);
       else if (!do_mhd && do_Ye && do_temp && !reconstruct_Wv)
          GRHydro_Reconstruct_drv_cxx <false, true, true, false, false, RECONSTRUCT  > (cctkGH);
       else
          assert(0&&"Unsupported template arguments");
   }
};


/**
   This is a new template metaprogramming way of calling various reconstruction methods.
   It tries to avoid duplicated code as much as possible
*/

extern "C" void Reconstruction_cxx(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  const bool do_mhd = CCTK_EQUALS(Bvec_evolution_method, "GRHydro");
  const bool do_Ye = CCTK_EQUALS(Y_e_evolution_method, "GRHydro");
  const bool do_temp = CCTK_EQUALS(temperature_evolution_method, "GRHydro");
  const bool do_clean_divergence = clean_divergence;

  /*
     Set up multipatch stuff
  */

  const CCTK_REAL * restrict vup;
  const CCTK_REAL * restrict Bprim;

  //Multipatch related pointers
  if(GRHydro_UseGeneralCoordinates(cctkGH)) {
    vup=lvel;
    Bprim=lBvec;
  } else {
    vup=vel;
    Bprim=Bvec;
  }
  
  const int nx=cctk_lsh[0];
  const int ny=cctk_lsh[1];
  const int nz=cctk_lsh[2];

  const int N = nx*ny*nz;

  int type_bits;
  int not_trivial;
  int trivial;

  if (*flux_direction == 1) {
     type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemX");
     not_trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemX","not_trivial");
     trivial     = SpaceMask_GetStateBits("Hydro_RiemannProblemX","trivial");
  } else if (*flux_direction == 2) {
     type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemY");
     not_trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemY","not_trivial");
     trivial     = SpaceMask_GetStateBits("Hydro_RiemannProblemY","trivial");
  } else if (*flux_direction == 3) {
     type_bits = SpaceMask_GetTypeBits("Hydro_RiemannProblemZ");
     not_trivial = SpaceMask_GetStateBits("Hydro_RiemannProblemZ","not_trivial");
     trivial     = SpaceMask_GetStateBits("Hydro_RiemannProblemZ","trivial");
  }

  CCTK_REAL local_min_tracer = 1e42;
  if (evolve_tracer) {
    if (use_min_tracer)
      local_min_tracer = min_tracer;
    else
      local_min_tracer = 0.0;
  }

  /*
     First initialize all variables by first order trivial reconstruction!
  */


  if (!do_mhd && !do_Ye && !do_temp)
      GRHydro_Reconstruct_drv_cxx <false, false, false, false, false, GRHydro_TrivialReconstruct1d > (cctkGH);
  else if (do_mhd && !do_Ye && !do_temp && !clean_divergence)
      GRHydro_Reconstruct_drv_cxx <true, false, false, false, false, GRHydro_TrivialReconstruct1d > (cctkGH);
  else if (do_mhd && !do_Ye && !do_temp && clean_divergence)
      GRHydro_Reconstruct_drv_cxx <true, false, false, false, true, GRHydro_TrivialReconstruct1d > (cctkGH);
  else if (do_mhd && do_Ye && do_temp && !clean_divergence)
      GRHydro_Reconstruct_drv_cxx <true, true, true, false, false, GRHydro_TrivialReconstruct1d > (cctkGH);
  else if (do_mhd && do_Ye && do_temp && clean_divergence)
      GRHydro_Reconstruct_drv_cxx <true, true, true, false, true, GRHydro_TrivialReconstruct1d > (cctkGH);
  else if (!do_mhd && do_Ye && do_temp)
      GRHydro_Reconstruct_drv_cxx <false, true, true, false, false, GRHydro_TrivialReconstruct1d > (cctkGH);
  else
      CCTK_ERROR("Don't know how to initialize reconstructed variables");


  /*
     Now do the real reconstruction!
  */

  if (CCTK_EQUALS(recon_method,"tvd")) {
    // this handles MHD and non-MHD

    if (CCTK_EQUALS(tvd_limiter, "minmod")) {
       
       reconstruct<GRHydro_TVDReconstruct1d<tvd::minmod> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
       
    } else if (CCTK_EQUALS(tvd_limiter, "vanleerMC2")) {
       
       reconstruct<GRHydro_TVDReconstruct1d<tvd::mc2> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
       
    } else if (CCTK_EQUALS(tvd_limiter, "superbee")) {
       
       reconstruct<GRHydro_TVDReconstruct1d<tvd::superbee> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
    
    } else {
       CCTK_ERROR("TVD limiter not recognized!");
    }

  } else if (CCTK_EQUALS(recon_method,"ppm")) {
    // PPM is special. It cannot reconstruct individual functions.
    // Rather, all function are reconstructed at once!
    // Hence we have a specialized calling function.
    
    CCTK_FNAME(GRHydro_PPMReconstruct_drv_opt)(cctkGH);

  } else if (CCTK_EQUALS(recon_method,"eno")) {
    // this handles MHD and non-MHD

    // TODO!!
    CCTK_ERROR("Sorry. Eno reconstruction not yet implemented!");

  } else if (CCTK_EQUALS(recon_method,"weno")) {
    // this handles MHD and non-MHD

    if (weno_adaptive_epsilon) {
       
       reconstruct<GRHydro_WENOReconstruct1d_cxx<false, true> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
          
    } else {
       
       reconstruct<GRHydro_WENOReconstruct1d_cxx<false, false> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
    
    }

  } else if (CCTK_EQUALS(recon_method, "weno-z")) {

       reconstruct<GRHydro_WENOReconstruct1d_cxx<true, false> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);

  } else if (CCTK_EQUALS(recon_method,"mp5")) {
    // this handles MHD and non-MHD

    if (mp5_adaptive_eps)
       reconstruct<GRHydro_MP5Reconstruct1d_cxx<true> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);
    else
       reconstruct<GRHydro_MP5Reconstruct1d_cxx<false> >::select(do_mhd, do_Ye, do_temp, reconstruct_Wv, clean_divergence, cctkGH);

  } else
    CCTK_ERROR("Reconstruction method not recognized!");


  /*
     Here goes the excision treatment.
     If any of the points in the reconstruction stencil is excised,
     we switch to trivial reconstruction.
     If the current point itself is excised, we mark the Riemann problem as "trivial".
     If the current point is just one point away from an excision boundary, we use the current cell values
     to provide an "extrapolated" guess for the reconstructed state at the excision boundary
  */
  if (GRHydro_enable_internal_excision) {
     
      #pragma omp parallel for
      for (int k=GRHydro_stencil-1; k < cctk_lsh[2] - GRHydro_stencil+1+transport_constraints*(1-*zoffset); ++k)
         for (int j=GRHydro_stencil-1; j < cctk_lsh[1] - GRHydro_stencil+1+transport_constraints*(1-*yoffset); ++j)
            for (int i=GRHydro_stencil-1; i < cctk_lsh[0] - GRHydro_stencil+1+transport_constraints*(1-*xoffset); ++i) {
               
               const int ijk = CCTK_GFINDEX3D(cctkGH, i, j, k);
               const int ijk_m = CCTK_GFINDEX3D(cctkGH, i-*xoffset, j-*yoffset, k-*zoffset);
               const int ijk_p = CCTK_GFINDEX3D(cctkGH, i+*xoffset, j+*yoffset, k+*zoffset);
               
               bool excise = false;
               bool first_order = false;
               bool extrapolate = false;
               int extrap_ijk = 0;
               
               // Whenever we modify the previously reconstructed value,
               // we need to change the trivial flag!
               bool change_riemann_trivial_flag = false;
               
               // for an excised point in the reconstruction stencil radius of the current point, we need to switch down to first order
               for (int l=-(GRHydro_stencil-1); l < GRHydro_stencil-1; ++l) {
                  const int ijk_l = CCTK_GFINDEX3D(cctkGH, i+*xoffset*l, j+*yoffset*l, k+*zoffset*l);
                  if (hydro_excision_mask[ijk_l]) {
                     first_order = true;
                     break;
                  }
               }
               
               // if the current point is excised, then we will mark the Riemann problem as trivial.
               if (hydro_excision_mask[ijk])
                  excise = true;
               
               if (!excise && hydro_excision_mask[ijk_m]) {
                  extrapolate = true;
                  extrap_ijk = ijk_m;
               }
               
               if (!excise && hydro_excision_mask[ijk_p]) {
                  extrapolate = true;
                  extrap_ijk = ijk_p;
               }
               
               if (first_order)
               {
                  rhominus[ijk] = rho[ijk];
                  rhoplus[ijk]  = rho[ijk];
                  
                  epsminus[ijk] = eps[ijk];
                  epsplus[ijk]  = eps[ijk];
                  
                  velxminus[ijk] = velx[ijk];
                  velxplus[ijk]  = velx[ijk];
                  velyminus[ijk] = vely[ijk];
                  velyplus[ijk]  = vely[ijk];
                  velzminus[ijk] = velz[ijk];
                  velzplus[ijk]  = velz[ijk];
                  
                  if (do_Ye) {
                     Y_e_plus[ijk]  = Y_e[ijk];
                     Y_e_minus[ijk] = Y_e[ijk];
                  }
                  if (do_temp) {
                    tempminus[ijk] = temperature[ijk];
                    tempplus[ijk] = temperature[ijk];
                  }
                  if (do_mhd) {
                    Bvecxminus[ijk] = Bvecx[ijk];
                    Bvecxplus[ijk]  = Bvecx[ijk];
                    Bvecyminus[ijk] = Bvecy[ijk];
                    Bvecyplus[ijk]  = Bvecy[ijk];
                    Bveczminus[ijk] = Bvecz[ijk];
                    Bveczplus[ijk]  = Bvecz[ijk];
                    if (do_clean_divergence) {
                       psidcminus[ijk] = psidc[ijk];
                       psidcplus[ijk] = psidc[ijk];
                    }
                  }
                  if (evolve_tracer) {
                     for (int l=0; l < number_of_tracers; ++l) {
                        tracerminus[ijk + l*N] = tracer[ijk + l*N];
                        tracerplus[ijk + l*N]  = tracer[ijk + l*N];
                     }
                  }

                  // Riemann problem might not be trivial anymore!
                  change_riemann_trivial_flag = true;
               }
               
               if (extrapolate)
               {
                  rhominus[extrap_ijk] = rho[ijk];
                  rhoplus[extrap_ijk]  = rho[ijk];
                  
                  epsminus[extrap_ijk] = eps[ijk];
                  epsplus[extrap_ijk]  = eps[ijk];
                  
                  velxminus[extrap_ijk] = velx[ijk];
                  velxplus[extrap_ijk]  = velx[ijk];
                  velyminus[extrap_ijk] = vely[ijk];
                  velyplus[extrap_ijk]  = vely[ijk];
                  velzminus[extrap_ijk] = velz[ijk];
                  velzplus[extrap_ijk]  = velz[ijk];
                  
                  if (do_Ye) {
                     Y_e_plus[extrap_ijk]  = Y_e[ijk];
                     Y_e_minus[extrap_ijk] = Y_e[ijk];
                  }
                  if (do_temp) {
                    tempminus[extrap_ijk] = temperature[ijk];
                    tempplus[extrap_ijk] = temperature[ijk];
                  }
                  if (do_mhd) {
                    Bvecxminus[extrap_ijk] = Bvecx[ijk];
                    Bvecxplus[extrap_ijk]  = Bvecx[ijk];
                    Bvecyminus[extrap_ijk] = Bvecy[ijk];
                    Bvecyplus[extrap_ijk]  = Bvecy[ijk];
                    Bveczminus[extrap_ijk] = Bvecz[ijk];
                    Bveczplus[extrap_ijk]  = Bvecz[ijk];
                    if (do_clean_divergence) {
                       psidcminus[extrap_ijk] = psidc[ijk];
                       psidcplus[extrap_ijk] = psidc[ijk];
                    }
                  }
                  if (evolve_tracer) {
                     for (int l=0; l < number_of_tracers; ++l) {
                        tracerminus[extrap_ijk + l*N] = tracer[ijk + l*N];
                        tracerplus[extrap_ijk + l*N]  = tracer[ijk + l*N];
                     }
                  }

                  // Riemann problem might not be trivial anymore!
                  change_riemann_trivial_flag = true;
               }
               
               if (change_riemann_trivial_flag && !excise) {
                  SpaceMask_SetStateBits(space_mask, ijk_m, type_bits, not_trivial);
                  SpaceMask_SetStateBits(space_mask, ijk,   type_bits, not_trivial);
               } else if (excise) {
                  SpaceMask_SetStateBits(space_mask, ijk_m, type_bits, trivial);
                  SpaceMask_SetStateBits(space_mask, ijk,   type_bits, trivial);
               }
            }

      
   }


  /*
     Here goes the atmosphere treatment!
  */
  #pragma omp parallel for
  for (int k=GRHydro_stencil-1; k < cctk_lsh[2] - GRHydro_stencil+1+transport_constraints*(1-*zoffset); ++k)
     for (int j=GRHydro_stencil-1; j < cctk_lsh[1] - GRHydro_stencil+1+transport_constraints*(1-*yoffset); ++j)
        for (int i=GRHydro_stencil-1; i < cctk_lsh[0] - GRHydro_stencil+1+transport_constraints*(1-*xoffset); ++i) {
           const int ijk = CCTK_GFINDEX3D(cctkGH, i, j, k);
           const int ijk_m = CCTK_GFINDEX3D(cctkGH, i-*xoffset, j-*yoffset, k-*zoffset);
           
           // Whenever we modify a previously reconstructed value,
           // we need to change the trivial flag!
           bool change_riemann_trivial_flag = false;
           
           if (rhominus[ijk] < *GRHydro_rho_min || rhoplus[ijk] < *GRHydro_rho_min)
           {
              rhominus[ijk] = rho[ijk];
              rhoplus[ijk]  = rho[ijk];
              
              epsminus[ijk] = eps[ijk];
              epsplus[ijk]  = eps[ijk];
              
              velxminus[ijk] = velx[ijk];
              velxplus[ijk]  = velx[ijk];
              velyminus[ijk] = vely[ijk];
              velyplus[ijk]  = vely[ijk];
              velzminus[ijk] = velz[ijk];
              velzplus[ijk]  = velz[ijk];
              // TODO: add reconstruct_Wv treatment
              
              if (do_Ye) {
                 Y_e_plus[ijk]  = Y_e[ijk];
                 Y_e_minus[ijk] = Y_e[ijk];
              }
              if (do_temp) {
                 tempminus[ijk] = temperature[ijk];
                 tempplus[ijk] = temperature[ijk];
              }
              if (do_mhd) {
                 Bvecxminus[ijk] = Bvecx[ijk];
                 Bvecxplus[ijk]  = Bvecx[ijk];
                 Bvecyminus[ijk] = Bvecy[ijk];
                 Bvecyplus[ijk]  = Bvecy[ijk];
                 Bveczminus[ijk] = Bvecz[ijk];
                 Bveczplus[ijk]  = Bvecz[ijk];
                 if (do_clean_divergence) {
                    psidcminus[ijk] = psidc[ijk];
                    psidcplus[ijk] = psidc[ijk];
                 }
              }
              if (evolve_tracer) {
                 for (int l=0; l < number_of_tracers; ++l) {
                    if (tracerminus[ijk + l*N] < local_min_tracer || tracerplus[ijk + l*N] < local_min_tracer) {
                       tracerminus[ijk + l*N] = tracer[ijk + l*N];
                       tracerplus[ijk + l*N]  = tracer[ijk + l*N];
                    }
                 }
              }
              
              change_riemann_trivial_flag = true;
           }
           
           if (!do_temp) {
              if (epsplus[ijk] < 0.0) {
                 epsplus[ijk] = eps[ijk];
                 change_riemann_trivial_flag = true;
              }
              if (epsminus[ijk] < 0.0) {
                 epsminus[ijk] = eps[ijk];
                 change_riemann_trivial_flag = true;
              }
           }
           
           if (change_riemann_trivial_flag) {
              // Riemann problem might not be trivial anymore!
              SpaceMask_SetStateBits(space_mask, ijk_m, type_bits, not_trivial);
              SpaceMask_SetStateBits(space_mask, ijk,   type_bits, not_trivial);
           }
        }


  /*
     Here goes the prim2con call for reconstructed variables!
  */

  if (CCTK_EQUALS(recon_vars, "primitive") || CCTK_EQUALS(recon_method, "ppm")) {
    GRHydro_Primitive2Conservative_CC(CCTK_PASS_CTOC);
  } else if (CCTK_EQUALS(recon_vars,"conservative")) {
    CCTK_ERROR("Conservative reconstruction currently not supported!");
  } else
    CCTK_ERROR("Variable type to reconstruct not recognized.");


}


```

GRHydro_Prim2Con.F90:
```
  /*@@
   @file      primitive2conservative
   @date      Thu Jan  11 11:03:32 2002
   @author    Pedro Montero, Ian Hawke
   @desc 
   Primitive to conservative routine
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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 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   primitive2conservative.f90 
   @date       Thu Jan 11 11:03:32 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   Converts primitive to conserved variables for the boundary extended data.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine primitive2conservative(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
  CCTK_INT :: keytemp
  CCTK_REAL :: g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
       g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr
  CCTK_REAL :: xtemp(1)

  ! 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)

  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

  if(evolve_temper.ne.1) then
     !$OMP PARALLEL DO PRIVATE(i, j, k, avg_sdetl, avg_sdetr,&
     !$OMP                      g11l,g12l,g13l,g22l,g23l,g33l, &
     !$OMP                      g11r,g12r,g13r,g22r,g23r,g33r)
     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
              
              g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
              g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
              g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
              g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
              g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
              g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
              g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
              g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
              g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
              g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
              g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
              g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))
              
              avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
              avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))
              
              call prim2con(GRHydro_eos_handle, g11l,g12l,g13l,g22l,& 
                   g23l,g33l, &
                   avg_sdetl,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))
              
              call prim2con(GRHydro_eos_handle, g11r,g12r,g13r,&
                   g22r,g23r,g33r, &
                   avg_sdetr, 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)) 
              
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  else
     if(reconstruct_temper.ne.0) then
        keytemp = 1
        !$OMP PARALLEL DO PRIVATE(i, j, k, avg_sdetl, avg_sdetr, xtemp,&
        !$OMP                      g11l,g12l,g13l,g22l,g23l,g33l, &
        !$OMP                      g11r,g12r,g13r,g22r,g23r,g33r)
        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
                 
                 g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
                 g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
                 g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
                 g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
                 g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
                 g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
                 g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
                 g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
                 g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
                 g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
                 g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
                 g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))
              
                 avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
                 avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))

                 call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                      int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k),&
                      r(i,j,k),&
                      g11l,g12l,g13l,g22l,& 
                      g23l,g33l, &
                      avg_sdetl,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),&
                      tempminus(i,j,k),y_e_minus(i,j,k))

                 call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel, &
                      int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k),&
                      r(i,j,k),&
                      g11r,g12r,g13r,&
                      g22r,g23r,g33r,&
                      avg_sdetr, 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),tempplus(i,j,k), &
                      y_e_plus(i,j,k)) 
                 
              end do
           end do
        end do
        !$OMP END PARALLEL DO
     else
        keytemp = 0
        !$OMP PARALLEL DO PRIVATE(i, j, k, avg_sdetl, avg_sdetr, xtemp,&
        !$OMP                      g11l,g12l,g13l,g22l,g23l,g33l, &
        !$OMP                      g11r,g12r,g13r,g22r,g23r,g33r)
        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
                 
                 g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
                 g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
                 g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
                 g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
                 g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
                 g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
                 g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
                 g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
                 g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
                 g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
                 g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
                 g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))
              
                 avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
                 avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))

                 xtemp(1) = 0.5d0*(temperature(i,j,k) + &
                      temperature(i-xoffset,j-yoffset,k-zoffset))
                 call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                      int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k),&
                      r(i,j,k),&
                      g11l,g12l,g13l,g22l,& 
                      g23l,g33l, &
                      avg_sdetl,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),&
                      xtemp,y_e_minus(i,j,k))

                 xtemp(1) = 0.5d0*(temperature(i,j,k) + &
                      temperature(i-xoffset,j-yoffset,k-zoffset))
                 call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel, &
                      int(cctk_iteration,ik),int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k),&
                      r(i,j,k),&
                      g11r,g12r,g13r,&
                      g22r,g23r,g33r,&
                      avg_sdetr, 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),xtemp, &
                      y_e_plus(i,j,k)) 
                 tempminus(i,j,k) = xtemp(1)
              
              end do
           end do
        end do
        !$OMP END PARALLEL DO
     endif
  endif

end subroutine primitive2conservative

 /*@@
   @routine    prim2con
   @date       Sat Jan 26 01:52:18 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2con(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdetg, ddens, &
     dsx, dsy, dsz, dtau , drho, dvelx, dvely, dvelz, deps, dpress, w) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdetg
  CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, drho, dvelx, dvely, dvelz,&
       deps, dpress, w, vlowx, vlowy, vlowz   
  CCTK_INT :: handle

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

  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))  

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,xtemp,xye,dpress,keyerr,anyerr)  

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  ddens = sdetg * drho * w 
  dsx = sdetg * (drho*(1+deps)+dpress)*w*w * vlowx
  dsy = sdetg * (drho*(1+deps)+dpress)*w*w * vlowy
  dsz = sdetg * (drho*(1+deps)+dpress)*w*w * vlowz
  dtau = sdetg * ((drho*(1+deps)+dpress)*w*w - dpress) - ddens 

end subroutine prim2con


subroutine prim2con_hot(handle, keytemp, GRHydro_reflevel, cctk_iteration, ii, jj, kk, &
     x, y, z, r, gxx, gxy, gxz, gyy, gyz, gzz, sdetg, ddens, &
     dsx, dsy, dsz, dtau , drho, dvelx, dvely, dvelz, deps, dpress, w, &
     temp,ye) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdetg
  CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, drho(1), dvelx, dvely, dvelz,&
       deps(1), dpress(1), w, vlowx, vlowy, vlowz   
  CCTK_REAL :: temp(1),ye(1), x, y, z, r
  CCTK_INT :: handle, GRHydro_reflevel, cctk_iteration, ii, jj, kk
  CCTK_REAL :: h
  character(len=512) warnline

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,lkeytemp,anyerr,keyerr(1)
  CCTK_REAL :: temp0(1)
  n = 1;lkeytemp=keytemp;anyerr = 0;keyerr(1) = 0
! end EOS Omni vars

  temp0 = temp
  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))  

  ! make sure Y_e and temperature within allowed range
  ye = max(min(ye,GRHydro_Y_e_max),GRHydro_Y_e_min)
  temp = max(GRHydro_hot_atmo_temp,min(temp,GRHydro_max_temp))

  call EOS_Omni_press(handle,lkeytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,temp,ye,dpress,keyerr,anyerr)  
  ! error handling
  if(anyerr.ne.0) then
     if(reconstruct_temper.ne.0) then
        if(keytemp.eq.1) then
           !$OMP CRITICAL
           call CCTK_WARN(1,"EOS error in prim2con_hot:")
           write(warnline,"(i8,4i5,1P10E15.6)") cctk_iteration,GRHydro_Reflevel,ii,jj,kk,x,y,z,r
           call CCTK_WARN(1,warnline)
           write(warnline,"(1P10E15.6)") drho,deps,temp,ye
           call CCTK_WARN(1,warnline)
           write(warnline,"(A7,i8,A10,i8)") "keyerr: ",keyerr(1)," keytemp:",lkeytemp
           call CCTK_ERROR(warnline)
           STOP
           !$OMP END CRITICAL
        else
           if(keyerr(1).eq.668 .and. temp(1).lt.10.0d0) then
              !$OMP CRITICAL
              write(warnline,"(A18,i7,4i4,1P10E15.6)") "p2c resetting T: ",cctk_iteration, &
                   GRHydro_reflevel,ii,jj,kk,drho,deps,temp,ye
              call CCTK_WARN(1,warnline)
              !$OMP END CRITICAL
              temp = GRHydro_hot_atmo_temp
              lkeytemp = 1
              call EOS_Omni_press(handle,lkeytemp,GRHydro_eos_rf_prec,n,&
                   drho,deps,temp,ye,dpress,keyerr,anyerr)  
              lkeytemp = 0
              if(anyerr.ne.0) then
                 !$OMP CRITICAL
                 write(warnline,"(A7,i8,A10,i8)") "keyerr: ",keyerr(1)," keytemp:",lkeytemp
                 call CCTK_WARN(1,warnline)
                 call CCTK_ERROR("Fatal EOS error in p2c!")
                 STOP
                 !$OMP END CRITICAL
              endif
           else
              !$OMP CRITICAL
              call CCTK_WARN(1,"EOS error in prim2con_hot:")
              write(warnline,"(i8,4i5,1P10E15.6)") cctk_iteration,GRHydro_Reflevel,ii,jj,kk,x,y,z,r
              call CCTK_WARN(1,warnline)
              write(warnline,"(1P10E15.6)") drho,deps,temp,ye
              call CCTK_WARN(1,warnline)
              write(warnline,"(A7,i8,A10,i8)") "keyerr: ",keyerr(1)," keytemp:",lkeytemp
              call CCTK_ERROR(warnline)
              STOP
              !$OMP END CRITICAL
           endif
        endif
     else
        if(GRHydro_reflevel.lt.GRHydro_c2p_warn_from_reflevel) then
           ! in this case (coarse grid error that is hopefully restricted
           ! away), we use the average temperature between cells and call
           ! the EOS with keytemp=1
           lkeytemp=1
           temp = temp0
           call EOS_Omni_press(handle,lkeytemp,GRHydro_eos_rf_prec,n,&
                drho,deps,temp,ye,dpress,keyerr,anyerr)  
           lkeytemp=0
           if(anyerr.ne.0) then
              !$OMP CRITICAL
              call CCTK_WARN(1,"EOS error in prim2con_hot:")
              write(warnline,"(i8,3i5,1P10E15.6)") cctk_iteration,ii,jj,kk,x,y,z,r
              call CCTK_WARN(1,warnline)
              write(warnline,"(1P10E15.6)") drho,deps,temp,ye
              call CCTK_WARN(1,warnline)
              write(warnline,"(A7,i8)") "code: ",keyerr(1)
              call CCTK_WARN(1,warnline)
              write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
              call CCTK_WARN(1,warnline)
              !$OMP END CRITICAL
           endif
        else
           ! This is a way of recovering even on finer refinement levels:
           ! Use the average temperature at the interface instead of the
           ! reconstructed specific internal energy.
           if(GRHydro_eos_hot_prim2con_warn.ne.0) then
              !$OMP CRITICAL
              call CCTK_WARN(1,"EOS error in prim2con_hot: NOW using averaged temp!")
              write(warnline,"(i8,3i5,1P10E15.6)") cctk_iteration,ii,jj,kk,x,y,z,r
              call CCTK_WARN(1,warnline)
              write(warnline,"(1P10E15.6)") drho,deps,temp0,ye
              call CCTK_WARN(1,warnline)
              write(warnline,"(A7,i8)") "code: ",keyerr(1)
              call CCTK_WARN(1,warnline)
              write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
              call CCTK_WARN(1,warnline)
              !$OMP END CRITICAL
           endif
           lkeytemp=1
           temp = temp0
           call EOS_Omni_press(handle,lkeytemp,GRHydro_eos_rf_prec,n,&
                drho,deps,temp,ye,dpress,keyerr,anyerr)  
           lkeytemp=0
           if(anyerr.ne.0) then
              !$OMP CRITICAL
              call CCTK_WARN(1,"EOS error in prim2con_hot")
              write(warnline,"(i8,3i5,1P10E15.6)") cctk_iteration,ii,jj,kk,x,y,z,r
              call CCTK_WARN(1,warnline)
              write(warnline,"(1P10E15.6)") drho,deps,temp,ye
              call CCTK_WARN(1,warnline)
              write(warnline,"(A7,i8)") "code: ",keyerr(1)
              call CCTK_WARN(1,warnline)
              write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
              call CCTK_WARN(1,warnline)
              call CCTK_ERROR("Aborting!!!")
              STOP
              !$OMP END CRITICAL
           endif
        endif
     endif
  endif
  
  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  h = drho(1)*(1.0d0+deps(1))+dpress(1)
  ddens = sdetg * drho(1) * w 
  dsx = sdetg * h*w*w * vlowx
  dsy = sdetg * h*w*w * vlowy
  dsz = sdetg * h*w*w * vlowz
  dtau = sdetg * (h*w*w - dpress(1)) - ddens 


end subroutine prim2con_hot


 /*@@
   @routine    Primitive2ConservativeCells
   @date       Sun Mar 10 21:16:20 2002
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Primitive2ConservativeCells(CCTK_ARGUMENTS)

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

  CCTK_INT :: i, j, k
  CCTK_INT :: keytemp

  character(len=512) :: 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)

  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

  if(evolve_temper.ne.1) then
     !$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)
          
              call prim2con(GRHydro_eos_handle,g11(i,j,k),&
                   g12(i,j,k),g13(i,j,k),&
                   g22(i,j,k),g23(i,j,k),g33(i,j,k),&
                   sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
                   tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
                   eps(i,j,k),press(i,j,k),w_lorentz(i,j,k))

           end do
        end do
     end do
     !$OMP END PARALLEL DO
  else
     keytemp = 0
     !$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)
          
              call prim2con_hot(GRHydro_eos_handle,keytemp,&
                   GRHydro_reflevel,int(cctk_iteration,ik),&
                   int(i,ik),int(j,ik),int(k,ik),&
                   x(i,j,k),y(i,j,k),z(i,j,k),r(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),&
                   sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
                   tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
                   eps(i,j,k),press(i,j,k),w_lorentz(i,j,k), &
                   temperature(i,j,k),y_e(i,j,k))
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  endif

  if(evolve_Y_e.ne.0) then
     !$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)
              Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif


end subroutine Primitive2ConservativeCells


 /*@@
   @routine    Prim2ConservativePolytype
   @date       Tue Mar 19 22:52:21 2002
   @author     Ian Hawke
   @desc 
   Same as first routine, only for polytropes.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Prim2ConservativePolytype(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k
  CCTK_REAL :: g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
       g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr

  ! 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)

  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
  
  !$OMP PARALLEL DO PRIVATE(i, j, k, g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
  !$OMP g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr)
  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
        
        g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))

        call prim2conpolytype(GRHydro_eos_handle, g11l,g12l,g13l,&
             g22l,g23l,g33l, &
             avg_sdetl,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))
 
        call prim2conpolytype(GRHydro_eos_handle, g11r,g12r,g13r,&
             g22r,g23r,g33r, &
             avg_sdetr, 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)) 
      end do
    end do
  end do
  !$OMP END PARALLEL DO


  ! Note on Y_e: We use Y_e_plus and Y_e_minus directly
  ! in the Riemann solver. That's why it is not necessary
  ! to do a prim2con for Y_e

end subroutine Prim2ConservativePolytype

 /*@@
   @routine    prim2conpolytype
   @date       Sat Jan 26 01:52:18 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2conpolytype(handle, gxx, gxy, gxz, gyy, gyz, &
     gzz, sdetg, ddens, &
     dsx, dsy, dsz, dtau , drho, dvelx, dvely, dvelz, deps, dpress, w) 
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdetg
  CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, drho, dvelx, dvely, dvelz,&
       deps, dpress, w_tmp, w, vlowx, vlowy, vlowz, sqrtdet   
  CCTK_INT :: handle
  character(len=256) NaN_WarnLine

! begin EOS Omni vars
  CCTK_INT  :: n, keytemp, anyerr, keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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
  
  w_tmp = gxx*dvelx*dvelx + gyy*dvely*dvely + gzz *dvelz*dvelz + &
          2*gxy*dvelx*dvely + 2*gxz*dvelx*dvelz + 2*gyz*dvely*dvelz
  if (w_tmp .ge. 1.d0) then
    ! In theory this should not happen, and even when accepting the fact
    ! that numerically it can, one might be tempted to set w to some large
    ! value in that case. However, this would lead to completely bogus
    ! and hard to trace wrong values below. There is no good value to
    ! choose in this case, but something small is probably the best of
    ! all bad choices.
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a80,2g15.6)') 'Infinite Lorentz factor reset. rho, w_tmp: ', drho, w_tmp
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
    w = 1.d-20
  else
    w = 1.d0 / sqrt(1.d0 - w_tmp)
  endif

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,deps,keyerr,anyerr)

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  ddens = sdetg * drho * w 
  dsx = sdetg * (drho*(1+deps)+dpress)*w*w * vlowx
  dsy = sdetg * (drho*(1+deps)+dpress)*w*w * vlowy
  dsz = sdetg * (drho*(1+deps)+dpress)*w*w * vlowz
  dtau = sdetg * ((drho*(1+deps)+dpress)*w*w - dpress) - ddens 

end subroutine prim2conpolytype


 /*@@
   @routine    Primitive2ConservativePolyCells
   @date       Sun Mar 10 21:16:20 2002
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Primitive2ConservativePolyCells(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k

  ! 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)

  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
  
  !$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)
        
        call prim2conpolytype(GRHydro_eos_handle,g11(i,j,k),g12(i,j,k),&
             g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),w_lorentz(i,j,k))

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

  if(evolve_Y_e.ne.0) then
     !$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)
              Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif

end subroutine Primitive2ConservativePolyCells

 /*@@
   @routine    Prim2ConservativeTracer
   @date       Mon Mar  8 13:32:32 2004
   @author     Ian Hawke
   @desc 
   Gets the conserved tracer variable from the primitive.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Prim2ConservativeTracer(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k
  CCTK_REAL :: g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
       g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr

  ! 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
  
  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
        
        g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))
        cons_tracerplus(i,j,k,:) = tracerplus(i,j,k,:) * &
             avg_sdetr * rhoplus(i,j,k) / &
             sqrt(1.d0 - &
                   (g11r * velxplus(i,j,k)**2 + &
                    g22r * velyplus(i,j,k)**2 + &
                    g33r * velzplus(i,j,k)**2 + &
                    2.d0 * (g12r * velxplus(i,j,k) * velyplus(i,j,k) + &
                            g13r * velxplus(i,j,k) * velzplus(i,j,k) + &
                            g23r * velyplus(i,j,k) * velzplus(i,j,k) ) ) )
        cons_tracerminus(i,j,k,:) = tracerminus(i,j,k,:) * &
             avg_sdetl * rhominus(i,j,k) / &
             sqrt(1.d0 - &
                   (g11l * velxminus(i,j,k)**2 + &
                    g22l * velyminus(i,j,k)**2 + &
                    g33l * velzminus(i,j,k)**2 + &
                    2.d0 * (g12l * velxminus(i,j,k) * velyminus(i,j,k) + &
                            g13l * velxminus(i,j,k) * velzminus(i,j,k) + &
                            g23l * velyminus(i,j,k) * velzminus(i,j,k) ) ) )

      end do
    end do
  end do

end subroutine Prim2ConservativeTracer


```

GRHydro_Eigenproblem_Marquina.F90:
```
/*@@
  @file    GRHydro_Eigenproblem_Marquina.F90
  @date    Wed Feb 13 12:30 2002
  @author  Pedro Montero, Toni Font, Joachim Frieben
  @desc
  Computes the eigenvectors (p) and eigenvalues (lam) for Marquina flux
  formula for the input primitive state. Note that this is the MODIFIED
  Marquina formula as given by M. A. Aloy et al., Astrophys. J. Suppl.
  122 (1999) 151, and not the full Marquina flux of Donat and Marquina.
  The optimized method for computing the Marquina flux in the special
  relativistic case is due to M. A. Aloy et al., Comput. Phys. Commun.
  120 (1999) 115-121, and has been extended to the general relativistic
  case as employed in this subroutine by J. Frieben, J. M. Ibanez, and
  J. Pons (in preparation).
  @enddesc
@@*/

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

#define MARQUINA_SMALL 1.0d-10

 /*@@
   @routine    eigenproblem_marquina
   @date       Wed Feb 13 12:27:59 2002
   @author     Pedro Montero, Toni Font, Joachim Frieben
   @desc
   Computes the eigenvectors (p) and eigenvalues (lam) for
   Marquina flux formula
   for the input primitive state.
   @enddesc
   @calls
   @calledby
   @history
   Follows the routines by Toni Font and GR3D of Mark Miller.
   @endhistory

@@*/

subroutine eigenproblem_marquina(handle,rhor,velxr,velyr,&
     velzr,epsr,rhol,velxl,velyl,velzl,epsl,gxx,gxy,gxz,&
     gyy,gyz,gzz,u,det,alp,beta,densl,sxl,syl,szl,taul,&
     densr,sxr,syr,szr,taur,flux1,flux2,flux3,flux4,flux5)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rhor,velxr,velyr,velzr,epsr
  CCTK_REAL rhol,velxl,velyl,velzl,epsl
  CCTK_REAL densl,sxl,syl,szl,taul
  CCTK_REAL densr,sxr,syr,szr,taur

  CCTK_REAL lam(5),p(5,5),q(5,5),dw(5)
  CCTK_REAL rfluxr(5),rfluxl(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz,u,det
  CCTK_REAL alp,beta,flux1r,flux2r,flux3r,flux4r,flux5r
  CCTK_REAL flux1l,flux2l,flux3l,flux4l,flux5l
  CCTK_REAL flux1,flux2,flux3,flux4,flux5

!!$  LOCAL VARS

  CCTK_REAL du(5),aa(5,5)
  integer i,j,k
  CCTK_REAL paug(5,6),tmp1,tmp2,sump,summ,f_du(5)
  CCTK_REAL leivec1l(5),leivec2l(5),leivec3l(5),leivecpl(5),leivecml(5)
  CCTK_REAL leivec1r(5),leivec2r(5),leivec3r(5),leivecpr(5),leivecmr(5)
  CCTK_REAL reivec1l(5),reivec2l(5),reivec3l(5),reivecpl(5),reivecml(5)
  CCTK_REAL reivec1r(5),reivec2r(5),reivec3r(5),reivecpr(5),reivecmr(5)
  CCTK_REAL lam1l,lam2l,lam3l,lamml,lampl,lamm_nobetal,lamp_nobetal
  CCTK_REAL lam1r,lam2r,lam3r,lammr,lampr,lamm_nobetar,lamp_nobetar
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamp_tmp

  CCTK_REAL cs2l,cs2r,one,two
  CCTK_REAL vlowxr,vlowyr,vlowzr,v2r,wr
  CCTK_REAL vlowxl,vlowyl,vlowzl,v2l,wl

  CCTK_REAL pressl,dpdrhol,dpdepsl,enthalpyl,kappal
  CCTK_REAL pressr,dpdrhor,dpdepsr,enthalpyr,kappar
  CCTK_REAL axpl,axml,vxpl,vxml,xsil,dltl
  CCTK_REAL axpr,axmr,vxpr,vxmr,xsir,dltr
  CCTK_REAL cxx,cxy,cxz,gam,vxa,vxb
  CCTK_INT handle
  CCTK_REAL invrhol, betainvalp, invfacl
  CCTK_REAL invrhor, invfacr
  CCTK_REAL invulpfac, invulmfac, invurpfac, invurmfac

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

  one = 1.0d0
  two = 2.0d0

!!$  LEFT

!!$  Set required fluid quantities
  invrhol = one / rhol

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,xtemp,xye,pressl,keyerr,anyerr)
!  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
!       rhol,epsl,xtemp,xye,cs2l,keyerr,anyerr)
  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,xtemp,xye,dpdepsl,keyerr,anyerr)
  call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,xtemp,xye,dpdrhol,keyerr,anyerr)
  cs2l = (dpdrhol + pressl * dpdepsl * invrhol**2)/ &
       (1.0d0 + epsl + pressl*invrhol)

  enthalpyl = one + epsl + pressl * invrhol

  vlowxl = gxx*velxl + gxy*velyl + gxz*velzl
  vlowyl = gxy*velxl + gyy*velyl + gyz*velzl
  vlowzl = gxz*velxl + gyz*velyl + gzz*velzl
  v2l = vlowxl*velxl + vlowyl*velyl + vlowzl*velzl

  if (v2l .ge. 1.d0-MARQUINA_SMALL) then
    v2l = 1.d0-MARQUINA_SMALL
  endif
!!$  Assume consistent primitive data

  wl = one / sqrt(one - v2l)

!!$  EIGENVALUES

  betainvalp = beta / alp
  lam1l = velxl - betainvalp
  lam2l = lam1l
  lam3l = lam1l
  lamp_tmp = cs2l*(one-v2l)*(u*(one-v2l*cs2l) - velxl**2*(one-cs2l))
  if (lamp_tmp .le. MARQUINA_SMALL) then
    lamp_tmp = MARQUINA_SMALL;
  endif
  invfacl = one/(one-v2l*cs2l)
  lamp_nobetal = (velxl*(one-cs2l) + sqrt(lamp_tmp))*invfacl
  lamm_nobetal = (velxl*(one-cs2l) - sqrt(lamp_tmp))*invfacl

  lampl = lamp_nobetal - betainvalp
  lamml = lamm_nobetal - betainvalp

!!$  RIGHT

!!$  Set required fluid quantities
  invrhor = one / rhor

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,xtemp,xye,pressr,keyerr,anyerr)
!  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
!       rhor,epsr,xtemp,xye,cs2r,keyerr,anyerr)
  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,xtemp,xye,dpdepsr,keyerr,anyerr)
  call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,xtemp,xye,dpdrhor,keyerr,anyerr)
  cs2r = (dpdrhor + pressr * dpdepsr * invrhor**2)/ &
       (1.0d0 + epsr + pressr*invrhor)

  enthalpyr = one + epsr + pressr * invrhor

  vlowxr = gxx*velxr + gxy*velyr + gxz*velzr
  vlowyr = gxy*velxr + gyy*velyr + gyz*velzr
  vlowzr = gxz*velxr + gyz*velyr + gzz*velzr
  v2r = vlowxr*velxr + vlowyr*velyr + vlowzr*velzr

  if (v2r .ge. 1.d0-MARQUINA_SMALL) then
    v2r = 1.d0-MARQUINA_SMALL
  endif
!!$  Assume consistent primitive data
  wr = one / sqrt(one - v2r)

!!$  EIGENVALUES

  lam1r = velxr - betainvalp
  lam2r = lam1r
  lam3r = lam1r
  lamp_tmp = cs2r*(one-v2r)*(u*(one-v2r*cs2r) - velxr**2*(one-cs2r))
  if (lamp_tmp .le. MARQUINA_SMALL) then
    lamp_tmp = MARQUINA_SMALL;
  endif
  invfacr = one/(one-v2r*cs2r)
  lamp_nobetar = (velxr*(one-cs2r) + sqrt(lamp_tmp))*invfacr
  lamm_nobetar = (velxr*(one-cs2r) - sqrt(lamp_tmp))*invfacr

  lampr = lamp_nobetar - betainvalp
  lammr = lamm_nobetar - betainvalp

!!$  FINAL

  lam1 = max(abs(lam1l),abs(lam1r))
  lam2 = lam1
  lam3 = lam1
  lamp = max(abs(lampl),abs(lampr))
  lamm = max(abs(lamml),abs(lammr))

!!$  lam(1) = lamm
!!$  lam(2) = lam1
!!$  lam(3) = lam2
!!$  lam(4) = lam3
!!$  lam(5) = lamp

  lam(1) = lamm
  lam(5) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(2) = lamp
  
!!$  LEFT

!!$  Compute some auxiliary quantities

  invulpfac = one / (u - velxl*lamp_nobetal)
  invulmfac = one / (u - velxl*lamm_nobetal)
  axpl = (u - velxl*velxl)*invulpfac
  axml = (u - velxl*velxl)*invulmfac
  vxpl = (velxl - lamp_nobetal)*invulpfac
  vxml = (velxl - lamm_nobetal)*invulmfac

!!$  Calculate associated right eigenvectors

  kappal = dpdepsl / (dpdepsl - rhol * cs2l)


!!$  Right eigenvector # 1

  reivec1l(1) = kappal / (enthalpyl * wl)
  reivec1l(2) = vlowxl
  reivec1l(3) = vlowyl
  reivec1l(4) = vlowzl
  reivec1l(5) = one - reivec1l(1)

!!$  Right eigenvector # 2

  reivec2l(1) = wl * vlowyl
  reivec2l(2) = enthalpyl * (gxy + two * wl * wl * vlowxl * vlowyl)
  reivec2l(3) = enthalpyl * (gyy + two * wl * wl * vlowyl * vlowyl)
  reivec2l(4) = enthalpyl * (gyz + two * wl * wl * vlowyl * vlowzl)
  reivec2l(5) = vlowyl * wl * (two * wl * enthalpyl - one)

!!$  Right eigenvector # 3

  reivec3l(1) = wl * vlowzl
  reivec3l(2) = enthalpyl * (gxz + two * wl * wl * vlowxl * vlowzl)
  reivec3l(3) = enthalpyl * (gyz + two * wl * wl * vlowyl * vlowzl)
  reivec3l(4) = enthalpyl * (gzz + two * wl * wl * vlowzl * vlowzl)
  reivec3l(5) = vlowzl * wl * (two * wl * enthalpyl - one)

!!$  Right + eigenvector

  reivecpl(1) = one
  reivecpl(2) = enthalpyl * wl * (vlowxl - vxpl)
  reivecpl(3) = enthalpyl * wl * vlowyl
  reivecpl(4) = enthalpyl * wl * vlowzl
  reivecpl(5) = enthalpyl * wl * axpl - one

!!$  Right - eigenvector

  reivecml(1) = one
  reivecml(2) = enthalpyl * wl * (vlowxl - vxml)
  reivecml(3) = enthalpyl * wl * vlowyl
  reivecml(4) = enthalpyl * wl * vlowzl
  reivecml(5) = enthalpyl * wl * axml - one

!!$  RIGHT

!!$  Compute some auxiliary quantities

  invurpfac = one / (u - velxr*lamp_nobetar)
  invurmfac = one / (u - velxr*lamm_nobetar)
  axpr = (u - velxr*velxr)*invurpfac
  axmr = (u - velxr*velxr)*invurmfac
  vxpr = (velxr - lamp_nobetar)*invurpfac
  vxmr = (velxr - lamm_nobetar)*invurmfac

!!$  Calculate associated right eigenvectors

  kappar = dpdepsr / (dpdepsr - rhor * cs2r)

!!$  Right eigenvector # 1

  reivec1r(1) = kappar / (enthalpyr * wr)
  reivec1r(2) = vlowxr
  reivec1r(3) = vlowyr
  reivec1r(4) = vlowzr
  reivec1r(5) = one - reivec1r(1)

!!$  Right eigenvector # 2

  reivec2r(1) = wr * vlowyr
  reivec2r(2) = enthalpyr * (gxy + two * wr * wr * vlowxr * vlowyr)
  reivec2r(3) = enthalpyr * (gyy + two * wr * wr * vlowyr * vlowyr)
  reivec2r(4) = enthalpyr * (gyz + two * wr * wr * vlowyr * vlowzr)
  reivec2r(5) = vlowyr * wr * (two * wr * enthalpyr - one)

!!$  Right eigenvector # 3

  reivec3r(1) = wr * vlowzr
  reivec3r(2) = enthalpyr * (gxz + two * wr * wr * vlowxr * vlowzr)
  reivec3r(3) = enthalpyr * (gyz + two * wr * wr * vlowyr * vlowzr)
  reivec3r(4) = enthalpyr * (gzz + two * wr * wr * vlowzr * vlowzr)
  reivec3r(5) = vlowzr * wr * (two * wr * enthalpyr - one)

!!$  Right + eigenvector

  reivecpr(1) = one
  reivecpr(2) = enthalpyr * wr * (vlowxr - vxpr)
  reivecpr(3) = enthalpyr * wr * vlowyr
  reivecpr(4) = enthalpyr * wr * vlowzr
  reivecpr(5) = enthalpyr * wr * axpr - one

!!$  Right - eigenvector

  reivecmr(1) = one
  reivecmr(2) = enthalpyr * wr * (vlowxr - vxmr)
  reivecmr(3) = enthalpyr * wr * vlowyr
  reivecmr(4) = enthalpyr * wr * vlowzr
  reivecmr(5) = enthalpyr * wr * axmr - one

!!$  Calculate associated left eigenvectors if requested

  if (ANALYTICAL) then

    cxx = gyy * gzz - gyz * gyz
    cxy = gxz * gyz - gxy * gzz
    cxz = gxy * gyz - gxz * gyy
    gam = gxx * cxx + gxy * cxy + gxz * cxz

!!$  LEFT

    xsil = cxx - gam * velxl * velxl
    dltl = enthalpyl**3 * wl * (kappal - one) * (vxml - vxpl) * xsil

!!$  Left eigenvector # 1

    tmp1 = wl / (kappal - one)

    leivec1l(1) = tmp1 * (enthalpyl - wl)
    leivec1l(2) = tmp1 * wl * velxl
    leivec1l(3) = tmp1 * wl * velyl
    leivec1l(4) = tmp1 * wl * velzl
    leivec1l(5) =-tmp1 * wl

!!$  Left eigenvector # 2

    tmp1 = one / (xsil * enthalpyl)

    leivec2l(1) = (gyz * vlowzl - gzz * vlowyl) * tmp1
    leivec2l(2) = (gzz * vlowyl - gyz * vlowzl) * tmp1 * velxl
    leivec2l(3) = (gzz * (one - velxl * vlowxl) + gxz * vlowzl * velxl ) * tmp1
    leivec2l(4) = (gyz * (velxl * vlowxl - one) - gxz * velxl * vlowyl) * tmp1
    leivec2l(5) = (gyz * vlowzl - gzz * vlowyl) * tmp1

!!$  Left eigenvector # 3

    leivec3l(1) = (gyz * vlowyl - gyy * vlowzl) * tmp1
    leivec3l(2) = (gyy * vlowzl - gyz * vlowyl) * tmp1 * velxl
    leivec3l(3) = (gyz * (velxl * vlowxl - one) - gxy * velxl * vlowzl) * tmp1
    leivec3l(4) = (gyy * (one - velxl * vlowxl) + gxy * velxl * vlowyl) * tmp1
    leivec3l(5) = (gyz * vlowyl - gyy * vlowzl) * tmp1

!!$  Left + eigenvector

    tmp1 = enthalpyl * enthalpyl / dltl
    tmp2 = wl * wl * xsil

    leivecpl(1) = - (enthalpyl * wl * vxml * xsil + (one - kappal) * &
      (vxml * (tmp2 - cxx) - gam * velxl) - kappal * tmp2 * vxml) * tmp1
    leivecpl(2) = - (cxx * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velxl - cxx * velxl)) * tmp1
    leivecpl(3) = - (cxy * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velyl - cxy * velxl)) * tmp1
    leivecpl(4) = - (cxz * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velzl - cxz * velxl)) * tmp1
    leivecpl(5) = - ((one - kappal) * (vxml * (tmp2 - cxx) - gam * velxl) - &
      kappal * tmp2 * vxml) * tmp1

!!$  Left - eigenvector

    leivecml(1) = (enthalpyl * wl * vxpl * xsil + (one - kappal) * &
      (vxpl * (tmp2 - cxx) - gam * velxl) - kappal * tmp2 * vxpl) * tmp1
    leivecml(2) = (cxx * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velxl - cxx * velxl)) * tmp1
    leivecml(3) = (cxy * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velyl - cxy * velxl)) * tmp1
    leivecml(4) = (cxz * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velzl - cxz * velxl)) * tmp1
    leivecml(5) = ((one - kappal) * (vxpl * (tmp2 - cxx) - gam * &
      velxl) - kappal * tmp2 * vxpl) * tmp1

!!$  RIGHT

    xsir = cxx - gam * velxr * velxr
    dltr = enthalpyr**3 * wr * (kappar - one) * (vxmr - vxpr) * xsir

!!$  Left eigenvector # 1

    tmp1 = wr / (kappar - one)

    leivec1r(1) = tmp1 * (enthalpyr - wr)
    leivec1r(2) = tmp1 * wr * velxr
    leivec1r(3) = tmp1 * wr * velyr
    leivec1r(4) = tmp1 * wr * velzr
    leivec1r(5) =-tmp1 * wr

!!$  Left eigenvector # 2

    tmp1 = one / (xsir * enthalpyr)

    leivec2r(1) = (gyz * vlowzr - gzz * vlowyr) * tmp1
    leivec2r(2) = (gzz * vlowyr - gyz * vlowzr) * tmp1 * velxr
    leivec2r(3) = (gzz * (one - velxr * vlowxr) + gxz * vlowzr * velxr) * tmp1
    leivec2r(4) = (gyz * (velxr * vlowxr - one) - gxz * velxr * vlowyr) * tmp1
    leivec2r(5) = (gyz * vlowzr - gzz * vlowyr) * tmp1

!!$  Left eigenvector # 3

    leivec3r(1) = (gyz * vlowyr - gyy * vlowzr) * tmp1
    leivec3r(2) = (gyy * vlowzr - gyz * vlowyr) * tmp1 * velxr
    leivec3r(3) = (gyz * (velxr * vlowxr - one) - gxy * velxr * vlowzr) * tmp1
    leivec3r(4) = (gyy * (one - velxr * vlowxr) + gxy * velxr * vlowyr) * tmp1
    leivec3r(5) = (gyz * vlowyr - gyy * vlowzr) * tmp1

!!$  Left + eigenvector

    tmp1 = enthalpyr * enthalpyr / dltr
    tmp2 = wr * wr * xsir

    leivecpr(1) = - (enthalpyr * wr * vxmr * xsir + (one - kappar) * &
      (vxmr * (tmp2 - cxx) - gam * velxr) - kappar * tmp2 * vxmr) * tmp1
    leivecpr(2) = - (cxx * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velxr - cxx * velxr)) * tmp1
    leivecpr(3) = - (cxy * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velyr - cxy * velxr)) * tmp1
    leivecpr(4) = - (cxz * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velzr - cxz * velxr)) * tmp1
    leivecpr(5) = - ((one - kappar) * (vxmr * (tmp2 - cxx) - gam * velxr) - &
      kappar * tmp2 * vxmr) * tmp1

!!$  Left - eigenvector

    leivecmr(1) = (enthalpyr * wr * vxpr * xsir + (one - kappar) * &
      (vxpr * (tmp2 - cxx) - gam * velxr) - kappar * tmp2 * vxpr) * tmp1
    leivecmr(2) = (cxx * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velxr - cxx * velxr)) * tmp1
    leivecmr(3) = (cxy * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velyr - cxy * velxr)) * tmp1
    leivecmr(4) = (cxz * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velzr - cxz * velxr)) * tmp1
    leivecmr(5) = ((one - kappar) * (vxpr * (tmp2 - cxx) - gam * &
      velxr) - kappar * tmp2 * vxpr) * tmp1

  endif

!!$  LEFT
!!$  PUT RIGHT EIGENVECTORS IN THE P MATRIX

!!$  p(:,1) = reivecml(:)
!!$  p(:,2) = reivec1l(:)
!!$  p(:,3) = reivec2l(:)
!!$  p(:,4) = reivec3l(:)
!!$  p(:,5) = reivecpl(:)

  p(:,1) = reivecml(:)
  p(:,2) = reivecpl(:)
  p(:,3) = reivec2l(:)
  p(:,4) = reivec3l(:)
  p(:,5) = reivec1l(:)

!!$  Calculate change in u:

  du(1) = densl
  du(2) = sxl
  du(3) = syl
  du(4) = szl
  du(5) = taul

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (lamp - lam1) * leivecpl(i) * du(i)
         summ = summ + (lamm - lam1) * leivecml(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxpl + summ * vxml)

      rfluxl(1) = lam1 * du(1) + vxa
      rfluxl(2) = lam1 * du(2) + enthalpyl * wl * (vlowxl * vxa + vxb)
      rfluxl(3) = lam1 * du(3) + enthalpyl * wl * (vlowyl * vxa)
      rfluxl(4) = lam1 * du(4) + enthalpyl * wl * (vlowzl * vxa)
      rfluxl(5) = lam1 * du(5) + enthalpyl * wl * (velxl  * vxb + vxa) - vxa

    else

!!$  PUT LEFT EIGENVECTORS IN THE Q MATRIX

      q(1,:) = leivecml(:)
      q(2,:) = leivecpl(:)
      q(3,:) = leivec2l(:)
      q(4,:) = leivec3l(:)
      q(5,:) = leivec1l(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

      do i = 1, 5
        rfluxl(i) = 0.d0
        do j = 1, 5
          rfluxl(i) = rfluxl(i) + p(i,j) * lam(j) * dw(j)
        end do
      end do

    endif

  else

!!$  Solve for characteristic variable change, dw

    dw=du
    aa = p

    do i=1,5
      paug(:,i) = p(:,i)
    enddo

!same, but in old F77 style!
!!$    do i=1,5
!!$      dw(i) = du(i)
!!$      do j=1,5
!!$        aa(i,j) = p(i,j)
!!$      end do
!!$    enddo
!!$
!!$    do i=1,5
!!$      paug(i,1) = p(i,1)
!!$      paug(i,2) = p(i,2)
!!$      paug(i,3) = p(i,3)
!!$      paug(i,4) = p(i,4)
!!$      paug(i,5) = p(i,5)
!!$    enddo

    paug(1,6) = du(1)
    paug(2,6) = du(2)
    paug(3,6) = du(3)
    paug(4,6) = du(4)
    paug(5,6) = du(5)

!!$  Get lower left triangle to be all zeros
    do i=1,5
!!$  First, make diagonal element 1
      tmp1 = one / paug(i,i)
      do j=i,6
        paug(i,j) = paug(i,j)*tmp1
      enddo
!!$  Now, get rid of everything below that diagonal
      do j=i+1,5
        tmp1 = - (paug(j,i))
        do k=i,6
          paug(j,k) = paug(j,k) + tmp1*paug(i,k)
        enddo
      enddo
    enddo
!!$  Back substitute
    f_du(5) = paug(5,6)
    do i=4,1,-1
      f_du(i) = paug(i,6)
      do j=i+1,5
        f_du(i) = f_du(i) - paug(i,j)*f_du(j)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)

    do i = 1, 5
      rfluxl(i) = 0.d0
      do j = 1, 5
        rfluxl(i) = rfluxl(i) + p(i,j) * lam(j) * dw(j)
      end do
    end do

  endif

    flux1l = rfluxl(1)
    flux2l = rfluxl(2)
    flux3l = rfluxl(3)
    flux4l = rfluxl(4)
    flux5l = rfluxl(5)

!!$  RIGHT

!!$  PUT RIGHT EIGENVECTORS IN THE P MATRIX

!!$  p(:,1) = reivecmr(:)
!!$  p(:,2) = reivec1r(:)
!!$  p(:,3) = reivec2r(:)
!!$  p(:,4) = reivec3r(:)
!!$  p(:,5) = reivecpr(:)

  p(:,1) = reivecmr(:)
  p(:,2) = reivecpr(:)
  p(:,3) = reivec2r(:)
  p(:,4) = reivec3r(:)
  p(:,5) = reivec1r(:)

  du(1) = densr
  du(2) = sxr
  du(3) = syr
  du(4) = szr
  du(5) = taur

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (lamp - lam1) * leivecpr(i) * du(i)
         summ = summ + (lamm - lam1) * leivecmr(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxpr + summ * vxmr)

      rfluxr(1) = lam1 * du(1) + vxa
      rfluxr(2) = lam1 * du(2) + enthalpyr * wr * (vlowxr * vxa + vxb)
      rfluxr(3) = lam1 * du(3) + enthalpyr * wr * (vlowyr * vxa)
      rfluxr(4) = lam1 * du(4) + enthalpyr * wr * (vlowzr * vxa)
      rfluxr(5) = lam1 * du(5) + enthalpyr * wr * (velxr  * vxb + vxa) - vxa

    else

!!$  PUT LEFT EIGENVECTORS IN THE Q MATRIX

      q(1,:) = leivecmr(:)
      q(2,:) = leivecpr(:)
      q(3,:) = leivec2r(:)
      q(4,:) = leivec3r(:)
      q(5,:) = leivec1r(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

      do i = 1, 5
        rfluxr(i) = 0.d0
        do j = 1, 5
          rfluxr(i) = rfluxr(i) + p(i,j) * lam(j) * dw(j)
        end do
      end do

    endif

  else

!!$  Solve for characteristic variable change, dw

    do i=1,5
      dw(i) = du(i)
      do j=1,5
        aa(i,j) = p(i,j)
      end do
    enddo

    do i=1,5
      paug(i,1) = p(i,1)
      paug(i,2) = p(i,2)
      paug(i,3) = p(i,3)
      paug(i,4) = p(i,4)
      paug(i,5) = p(i,5)
    enddo

    paug(1,6) = du(1)
    paug(2,6) = du(2)
    paug(3,6) = du(3)
    paug(4,6) = du(4)
    paug(5,6) = du(5)

!!$  Get lower left triangle to be all zeros

    do i=1,5
!!$  First, make diagonal element 1
      tmp1 = one / paug(i,i)
      do j=i,6
        paug(i,j) = paug(i,j)*tmp1
      enddo
!!$  Now, get rid of everything below that diagonal
      do j=i+1,5
        tmp1 = - (paug(j,i))
        do k=i,6
          paug(j,k) = paug(j,k) + tmp1*paug(i,k)
        enddo
      enddo
    enddo
!!$  Back substitute

    f_du(5) = paug(5,6)
    do i=4,1,-1
      f_du(i) = paug(i,6)
      do j=i+1,5
        f_du(i) = f_du(i) - paug(i,j)*f_du(j)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)

    do i = 1, 5
      rfluxr(i) = 0.d0
      do j = 1, 5
        rfluxr(i) = rfluxr(i) + p(i,j) * lam(j) * dw(j)
      end do
    end do

  endif

  flux1r = rfluxr(1)
  flux2r = rfluxr(2)
  flux3r = rfluxr(3)
  flux4r = rfluxr(4)
  flux5r = rfluxr(5)

  flux1 = flux1r - flux1l 
  flux2 = flux2r - flux2l 
  flux3 = flux3r - flux3l 
  flux4 = flux4r - flux4l 
  flux5 = flux5r - flux5l 

  return

end subroutine eigenproblem_marquina

subroutine eigenproblem_marquina_hot(handle,keytemp,rhor,velxr,velyr,&
     velzr,epsr,rhol,velxl,velyl,velzl,epsl,templ,tempr,ye_l,ye_r,gxx,gxy,gxz,&
     gyy,gyz,gzz,u,det,alp,beta,densl,sxl,syl,szl,taul,&
     densr,sxr,syr,szr,taur,flux1,flux2,flux3,flux4,flux5)

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL rhor,velxr,velyr,velzr,epsr
  CCTK_REAL rhol,velxl,velyl,velzl,epsl
  CCTK_REAL densl,sxl,syl,szl,taul
  CCTK_REAL densr,sxr,syr,szr,taur
  CCTK_REAL templ,tempr,ye_l,ye_r

  CCTK_REAL lam(5),p(5,5),q(5,5),dw(5)
  CCTK_REAL rfluxr(5),rfluxl(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz,u,det
  CCTK_REAL alp,beta,flux1r,flux2r,flux3r,flux4r,flux5r
  CCTK_REAL flux1l,flux2l,flux3l,flux4l,flux5l
  CCTK_REAL flux1,flux2,flux3,flux4,flux5

!!$  LOCAL VARS

  CCTK_REAL du(5),aa(5,5)
  integer i,j,k
  CCTK_REAL paug(5,6),tmp1,tmp2,sump,summ,f_du(5)
  CCTK_REAL leivec1l(5),leivec2l(5),leivec3l(5),leivecpl(5),leivecml(5)
  CCTK_REAL leivec1r(5),leivec2r(5),leivec3r(5),leivecpr(5),leivecmr(5)
  CCTK_REAL reivec1l(5),reivec2l(5),reivec3l(5),reivecpl(5),reivecml(5)
  CCTK_REAL reivec1r(5),reivec2r(5),reivec3r(5),reivecpr(5),reivecmr(5)
  CCTK_REAL lam1l,lam2l,lam3l,lamml,lampl,lamm_nobetal,lamp_nobetal
  CCTK_REAL lam1r,lam2r,lam3r,lammr,lampr,lamm_nobetar,lamp_nobetar
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamp_tmp

  CCTK_REAL cs2l,cs2r,one,two
  CCTK_REAL vlowxr,vlowyr,vlowzr,v2r,wr
  CCTK_REAL vlowxl,vlowyl,vlowzl,v2l,wl

  CCTK_REAL pressl,dpdepsl,enthalpyl,kappal
  CCTK_REAL pressr,dpdepsr,enthalpyr,kappar
  CCTK_REAL axpl,axml,vxpl,vxml,xsil,dltl
  CCTK_REAL axpr,axmr,vxpr,vxmr,xsir,dltr
  CCTK_REAL cxx,cxy,cxz,gam,vxa,vxb
  CCTK_INT handle
  CCTK_REAL invrhol, betainvalp, invfacl
  CCTK_REAL invrhor, invfacr
  CCTK_REAL invulpfac, invulmfac, invurpfac, invurmfac


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

  one = 1.0d0
  two = 2.0d0

!!$  LEFT

!!$  Set required fluid quantities
  invrhol = one / rhol
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,templ,ye_l,pressl,keyerr,anyerr)
  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,templ,ye_l,cs2l,keyerr,anyerr)
  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhol,epsl,templ,ye_l,dpdepsl,keyerr,anyerr)

  enthalpyl = one + epsl + pressl * invrhol

  vlowxl = gxx*velxl + gxy*velyl + gxz*velzl
  vlowyl = gxy*velxl + gyy*velyl + gyz*velzl
  vlowzl = gxz*velxl + gyz*velyl + gzz*velzl
  v2l = vlowxl*velxl + vlowyl*velyl + vlowzl*velzl

  if (v2l .ge. 1.d0-MARQUINA_SMALL) then
    v2l = 1.d0-MARQUINA_SMALL
  endif
!!$  Assume consistent primitive data

  wl = one / sqrt(one - v2l)

!!$  EIGENVALUES

  betainvalp = beta / alp
  lam1l = velxl - betainvalp
  lam2l = lam1l
  lam3l = lam1l
  lamp_tmp = cs2l*(one-v2l)*(u*(one-v2l*cs2l) - velxl**2*(one-cs2l))
  if (lamp_tmp .le. MARQUINA_SMALL) then
    lamp_tmp = MARQUINA_SMALL;
  endif
  invfacl = one/(one-v2l*cs2l)
  lamp_nobetal = (velxl*(one-cs2l) + sqrt(lamp_tmp))*invfacl
  lamm_nobetal = (velxl*(one-cs2l) - sqrt(lamp_tmp))*invfacl

  lampl = lamp_nobetal - betainvalp
  lamml = lamm_nobetal - betainvalp

!!$  RIGHT

!!$  Set required fluid quantities
  invrhor = one / rhor

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,tempr,ye_r,pressr,keyerr,anyerr)
  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,tempr,ye_r,cs2r,keyerr,anyerr)
  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rhor,epsr,tempr,ye_r,dpdepsr,keyerr,anyerr)

  enthalpyr = one + epsr + pressr * invrhor

  vlowxr = gxx*velxr + gxy*velyr + gxz*velzr
  vlowyr = gxy*velxr + gyy*velyr + gyz*velzr
  vlowzr = gxz*velxr + gyz*velyr + gzz*velzr
  v2r = vlowxr*velxr + vlowyr*velyr + vlowzr*velzr

  if (v2r .ge. 1.d0-MARQUINA_SMALL) then
    v2r = 1.d0-MARQUINA_SMALL
  endif
!!$  Assume consistent primitive data
  wr = one / sqrt(one - v2r)

!!$  EIGENVALUES

  lam1r = velxr - betainvalp
  lam2r = lam1r
  lam3r = lam1r
  lamp_tmp = cs2r*(one-v2r)*(u*(one-v2r*cs2r) - velxr**2*(one-cs2r))
  if (lamp_tmp .le. MARQUINA_SMALL) then
    lamp_tmp = MARQUINA_SMALL;
  endif
  invfacr = one/(one-v2r*cs2r)
  lamp_nobetar = (velxr*(one-cs2r) + sqrt(lamp_tmp))*invfacr
  lamm_nobetar = (velxr*(one-cs2r) - sqrt(lamp_tmp))*invfacr

  lampr = lamp_nobetar - betainvalp
  lammr = lamm_nobetar - betainvalp

!!$  FINAL

  lam1 = max(abs(lam1l),abs(lam1r))
  lam2 = lam1
  lam3 = lam1
  lamp = max(abs(lampl),abs(lampr))
  lamm = max(abs(lamml),abs(lammr))

!!$  lam(1) = lamm
!!$  lam(2) = lam1
!!$  lam(3) = lam2
!!$  lam(4) = lam3
!!$  lam(5) = lamp

  lam(1) = lamm
  lam(5) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(2) = lamp
  
!!$  LEFT

!!$  Compute some auxiliary quantities

  invulpfac = one / (u - velxl*lamp_nobetal)
  invulmfac = one / (u - velxl*lamm_nobetal)
  axpl = (u - velxl*velxl)*invulpfac
  axml = (u - velxl*velxl)*invulmfac
  vxpl = (velxl - lamp_nobetal)*invulpfac
  vxml = (velxl - lamm_nobetal)*invulmfac

!!$  Calculate associated right eigenvectors

  kappal = dpdepsl / (dpdepsl - rhol * cs2l)


!!$  Right eigenvector # 1

  reivec1l(1) = kappal / (enthalpyl * wl)
  reivec1l(2) = vlowxl
  reivec1l(3) = vlowyl
  reivec1l(4) = vlowzl
  reivec1l(5) = one - reivec1l(1)

!!$  Right eigenvector # 2

  reivec2l(1) = wl * vlowyl
  reivec2l(2) = enthalpyl * (gxy + two * wl * wl * vlowxl * vlowyl)
  reivec2l(3) = enthalpyl * (gyy + two * wl * wl * vlowyl * vlowyl)
  reivec2l(4) = enthalpyl * (gyz + two * wl * wl * vlowyl * vlowzl)
  reivec2l(5) = vlowyl * wl * (two * wl * enthalpyl - one)

!!$  Right eigenvector # 3

  reivec3l(1) = wl * vlowzl
  reivec3l(2) = enthalpyl * (gxz + two * wl * wl * vlowxl * vlowzl)
  reivec3l(3) = enthalpyl * (gyz + two * wl * wl * vlowyl * vlowzl)
  reivec3l(4) = enthalpyl * (gzz + two * wl * wl * vlowzl * vlowzl)
  reivec3l(5) = vlowzl * wl * (two * wl * enthalpyl - one)

!!$  Right + eigenvector

  reivecpl(1) = one
  reivecpl(2) = enthalpyl * wl * (vlowxl - vxpl)
  reivecpl(3) = enthalpyl * wl * vlowyl
  reivecpl(4) = enthalpyl * wl * vlowzl
  reivecpl(5) = enthalpyl * wl * axpl - one

!!$  Right - eigenvector

  reivecml(1) = one
  reivecml(2) = enthalpyl * wl * (vlowxl - vxml)
  reivecml(3) = enthalpyl * wl * vlowyl
  reivecml(4) = enthalpyl * wl * vlowzl
  reivecml(5) = enthalpyl * wl * axml - one

!!$  RIGHT

!!$  Compute some auxiliary quantities

  invurpfac = one / (u - velxr*lamp_nobetar)
  invurmfac = one / (u - velxr*lamm_nobetar)
  axpr = (u - velxr*velxr)*invurpfac
  axmr = (u - velxr*velxr)*invurmfac
  vxpr = (velxr - lamp_nobetar)*invurpfac
  vxmr = (velxr - lamm_nobetar)*invurmfac

!!$  Calculate associated right eigenvectors

  kappar = dpdepsr / (dpdepsr - rhor * cs2r)

!!$  Right eigenvector # 1

  reivec1r(1) = kappar / (enthalpyr * wr)
  reivec1r(2) = vlowxr
  reivec1r(3) = vlowyr
  reivec1r(4) = vlowzr
  reivec1r(5) = one - reivec1r(1)

!!$  Right eigenvector # 2

  reivec2r(1) = wr * vlowyr
  reivec2r(2) = enthalpyr * (gxy + two * wr * wr * vlowxr * vlowyr)
  reivec2r(3) = enthalpyr * (gyy + two * wr * wr * vlowyr * vlowyr)
  reivec2r(4) = enthalpyr * (gyz + two * wr * wr * vlowyr * vlowzr)
  reivec2r(5) = vlowyr * wr * (two * wr * enthalpyr - one)

!!$  Right eigenvector # 3

  reivec3r(1) = wr * vlowzr
  reivec3r(2) = enthalpyr * (gxz + two * wr * wr * vlowxr * vlowzr)
  reivec3r(3) = enthalpyr * (gyz + two * wr * wr * vlowyr * vlowzr)
  reivec3r(4) = enthalpyr * (gzz + two * wr * wr * vlowzr * vlowzr)
  reivec3r(5) = vlowzr * wr * (two * wr * enthalpyr - one)

!!$  Right + eigenvector

  reivecpr(1) = one
  reivecpr(2) = enthalpyr * wr * (vlowxr - vxpr)
  reivecpr(3) = enthalpyr * wr * vlowyr
  reivecpr(4) = enthalpyr * wr * vlowzr
  reivecpr(5) = enthalpyr * wr * axpr - one

!!$  Right - eigenvector

  reivecmr(1) = one
  reivecmr(2) = enthalpyr * wr * (vlowxr - vxmr)
  reivecmr(3) = enthalpyr * wr * vlowyr
  reivecmr(4) = enthalpyr * wr * vlowzr
  reivecmr(5) = enthalpyr * wr * axmr - one

!!$  Calculate associated left eigenvectors if requested

  if (ANALYTICAL) then

    cxx = gyy * gzz - gyz * gyz
    cxy = gxz * gyz - gxy * gzz
    cxz = gxy * gyz - gxz * gyy
    gam = gxx * cxx + gxy * cxy + gxz * cxz

!!$  LEFT

    xsil = cxx - gam * velxl * velxl
    dltl = enthalpyl**3 * wl * (kappal - one) * (vxml - vxpl) * xsil

!!$  Left eigenvector # 1

    tmp1 = wl / (kappal - one)

    leivec1l(1) = tmp1 * (enthalpyl - wl)
    leivec1l(2) = tmp1 * wl * velxl
    leivec1l(3) = tmp1 * wl * velyl
    leivec1l(4) = tmp1 * wl * velzl
    leivec1l(5) =-tmp1 * wl

!!$  Left eigenvector # 2

    tmp1 = one / (xsil * enthalpyl)

    leivec2l(1) = (gyz * vlowzl - gzz * vlowyl) * tmp1
    leivec2l(2) = (gzz * vlowyl - gyz * vlowzl) * tmp1 * velxl
    leivec2l(3) = (gzz * (one - velxl * vlowxl) + gxz * vlowzl * velxl ) * tmp1
    leivec2l(4) = (gyz * (velxl * vlowxl - one) - gxz * velxl * vlowyl) * tmp1
    leivec2l(5) = (gyz * vlowzl - gzz * vlowyl) * tmp1

!!$  Left eigenvector # 3

    leivec3l(1) = (gyz * vlowyl - gyy * vlowzl) * tmp1
    leivec3l(2) = (gyy * vlowzl - gyz * vlowyl) * tmp1 * velxl
    leivec3l(3) = (gyz * (velxl * vlowxl - one) - gxy * velxl * vlowzl) * tmp1
    leivec3l(4) = (gyy * (one - velxl * vlowxl) + gxy * velxl * vlowyl) * tmp1
    leivec3l(5) = (gyz * vlowyl - gyy * vlowzl) * tmp1

!!$  Left + eigenvector

    tmp1 = enthalpyl * enthalpyl / dltl
    tmp2 = wl * wl * xsil

    leivecpl(1) = - (enthalpyl * wl * vxml * xsil + (one - kappal) * &
      (vxml * (tmp2 - cxx) - gam * velxl) - kappal * tmp2 * vxml) * tmp1
    leivecpl(2) = - (cxx * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velxl - cxx * velxl)) * tmp1
    leivecpl(3) = - (cxy * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velyl - cxy * velxl)) * tmp1
    leivecpl(4) = - (cxz * (one - kappal * axml) + (two * kappal - one) * &
      vxml * (tmp2 * velzl - cxz * velxl)) * tmp1
    leivecpl(5) = - ((one - kappal) * (vxml * (tmp2 - cxx) - gam * velxl) - &
      kappal * tmp2 * vxml) * tmp1

!!$  Left - eigenvector

    leivecml(1) = (enthalpyl * wl * vxpl * xsil + (one - kappal) * &
      (vxpl * (tmp2 - cxx) - gam * velxl) - kappal * tmp2 * vxpl) * tmp1
    leivecml(2) = (cxx * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velxl - cxx * velxl)) * tmp1
    leivecml(3) = (cxy * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velyl - cxy * velxl)) * tmp1
    leivecml(4) = (cxz * (one - kappal * axpl) + (two * kappal - one) * &
      vxpl * (tmp2 * velzl - cxz * velxl)) * tmp1
    leivecml(5) = ((one - kappal) * (vxpl * (tmp2 - cxx) - gam * &
      velxl) - kappal * tmp2 * vxpl) * tmp1

!!$  RIGHT

    xsir = cxx - gam * velxr * velxr
    dltr = enthalpyr**3 * wr * (kappar - one) * (vxmr - vxpr) * xsir

!!$  Left eigenvector # 1

    tmp1 = wr / (kappar - one)

    leivec1r(1) = tmp1 * (enthalpyr - wr)
    leivec1r(2) = tmp1 * wr * velxr
    leivec1r(3) = tmp1 * wr * velyr
    leivec1r(4) = tmp1 * wr * velzr
    leivec1r(5) =-tmp1 * wr

!!$  Left eigenvector # 2

    tmp1 = one / (xsir * enthalpyr)

    leivec2r(1) = (gyz * vlowzr - gzz * vlowyr) * tmp1
    leivec2r(2) = (gzz * vlowyr - gyz * vlowzr) * tmp1 * velxr
    leivec2r(3) = (gzz * (one - velxr * vlowxr) + gxz * vlowzr * velxr) * tmp1
    leivec2r(4) = (gyz * (velxr * vlowxr - one) - gxz * velxr * vlowyr) * tmp1
    leivec2r(5) = (gyz * vlowzr - gzz * vlowyr) * tmp1

!!$  Left eigenvector # 3

    leivec3r(1) = (gyz * vlowyr - gyy * vlowzr) * tmp1
    leivec3r(2) = (gyy * vlowzr - gyz * vlowyr) * tmp1 * velxr
    leivec3r(3) = (gyz * (velxr * vlowxr - one) - gxy * velxr * vlowzr) * tmp1
    leivec3r(4) = (gyy * (one - velxr * vlowxr) + gxy * velxr * vlowyr) * tmp1
    leivec3r(5) = (gyz * vlowyr - gyy * vlowzr) * tmp1

!!$  Left + eigenvector

    tmp1 = enthalpyr * enthalpyr / dltr
    tmp2 = wr * wr * xsir

    leivecpr(1) = - (enthalpyr * wr * vxmr * xsir + (one - kappar) * &
      (vxmr * (tmp2 - cxx) - gam * velxr) - kappar * tmp2 * vxmr) * tmp1
    leivecpr(2) = - (cxx * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velxr - cxx * velxr)) * tmp1
    leivecpr(3) = - (cxy * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velyr - cxy * velxr)) * tmp1
    leivecpr(4) = - (cxz * (one - kappar * axmr) + (two * kappar - one) * &
      vxmr * (tmp2 * velzr - cxz * velxr)) * tmp1
    leivecpr(5) = - ((one - kappar) * (vxmr * (tmp2 - cxx) - gam * velxr) - &
      kappar * tmp2 * vxmr) * tmp1

!!$  Left - eigenvector

    leivecmr(1) = (enthalpyr * wr * vxpr * xsir + (one - kappar) * &
      (vxpr * (tmp2 - cxx) - gam * velxr) - kappar * tmp2 * vxpr) * tmp1
    leivecmr(2) = (cxx * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velxr - cxx * velxr)) * tmp1
    leivecmr(3) = (cxy * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velyr - cxy * velxr)) * tmp1
    leivecmr(4) = (cxz * (one - kappar * axpr) + (two * kappar - one) * &
      vxpr * (tmp2 * velzr - cxz * velxr)) * tmp1
    leivecmr(5) = ((one - kappar) * (vxpr * (tmp2 - cxx) - gam * &
      velxr) - kappar * tmp2 * vxpr) * tmp1

  endif

!!$  LEFT
!!$  PUT RIGHT EIGENVECTORS IN THE P MATRIX

!!$  p(:,1) = reivecml(:)
!!$  p(:,2) = reivec1l(:)
!!$  p(:,3) = reivec2l(:)
!!$  p(:,4) = reivec3l(:)
!!$  p(:,5) = reivecpl(:)

  p(:,1) = reivecml(:)
  p(:,2) = reivecpl(:)
  p(:,3) = reivec2l(:)
  p(:,4) = reivec3l(:)
  p(:,5) = reivec1l(:)

!!$  Calculate change in u:

  du(1) = densl
  du(2) = sxl
  du(3) = syl
  du(4) = szl
  du(5) = taul

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (lamp - lam1) * leivecpl(i) * du(i)
         summ = summ + (lamm - lam1) * leivecml(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxpl + summ * vxml)

      rfluxl(1) = lam1 * du(1) + vxa
      rfluxl(2) = lam1 * du(2) + enthalpyl * wl * (vlowxl * vxa + vxb)
      rfluxl(3) = lam1 * du(3) + enthalpyl * wl * (vlowyl * vxa)
      rfluxl(4) = lam1 * du(4) + enthalpyl * wl * (vlowzl * vxa)
      rfluxl(5) = lam1 * du(5) + enthalpyl * wl * (velxl  * vxb + vxa) - vxa

    else

!!$  PUT LEFT EIGENVECTORS IN THE Q MATRIX

      q(1,:) = leivecml(:)
      q(2,:) = leivecpl(:)
      q(3,:) = leivec2l(:)
      q(4,:) = leivec3l(:)
      q(5,:) = leivec1l(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

      do i = 1, 5
        rfluxl(i) = 0.d0
        do j = 1, 5
          rfluxl(i) = rfluxl(i) + p(i,j) * lam(j) * dw(j)
        end do
      end do

    endif

  else

!!$  Solve for characteristic variable change, dw

    dw=du
    aa = p

    do i=1,5
      paug(:,i) = p(:,i)
    enddo

!same, but in old F77 style!
!!$    do i=1,5
!!$      dw(i) = du(i)
!!$      do j=1,5
!!$        aa(i,j) = p(i,j)
!!$      end do
!!$    enddo
!!$
!!$    do i=1,5
!!$      paug(i,1) = p(i,1)
!!$      paug(i,2) = p(i,2)
!!$      paug(i,3) = p(i,3)
!!$      paug(i,4) = p(i,4)
!!$      paug(i,5) = p(i,5)
!!$    enddo

    paug(1,6) = du(1)
    paug(2,6) = du(2)
    paug(3,6) = du(3)
    paug(4,6) = du(4)
    paug(5,6) = du(5)

!!$  Get lower left triangle to be all zeros
    do i=1,5
!!$  First, make diagonal element 1
      tmp1 = one / paug(i,i)
      do j=i,6
        paug(i,j) = paug(i,j)*tmp1
      enddo
!!$  Now, get rid of everything below that diagonal
      do j=i+1,5
        tmp1 = - (paug(j,i))
        do k=i,6
          paug(j,k) = paug(j,k) + tmp1*paug(i,k)
        enddo
      enddo
    enddo
!!$  Back substitute
    f_du(5) = paug(5,6)
    do i=4,1,-1
      f_du(i) = paug(i,6)
      do j=i+1,5
        f_du(i) = f_du(i) - paug(i,j)*f_du(j)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)

    do i = 1, 5
      rfluxl(i) = 0.d0
      do j = 1, 5
        rfluxl(i) = rfluxl(i) + p(i,j) * lam(j) * dw(j)
      end do
    end do

  endif

    flux1l = rfluxl(1)
    flux2l = rfluxl(2)
    flux3l = rfluxl(3)
    flux4l = rfluxl(4)
    flux5l = rfluxl(5)

!!$  RIGHT

!!$  PUT RIGHT EIGENVECTORS IN THE P MATRIX

!!$  p(:,1) = reivecmr(:)
!!$  p(:,2) = reivec1r(:)
!!$  p(:,3) = reivec2r(:)
!!$  p(:,4) = reivec3r(:)
!!$  p(:,5) = reivecpr(:)

  p(:,1) = reivecmr(:)
  p(:,2) = reivecpr(:)
  p(:,3) = reivec2r(:)
  p(:,4) = reivec3r(:)
  p(:,5) = reivec1r(:)

  du(1) = densr
  du(2) = sxr
  du(3) = syr
  du(4) = szr
  du(5) = taur

  if (ANALYTICAL) then

    if (FAST) then

      sump = 0.0d0
      summ = 0.0d0

      do i=1,5
         sump = sump + (lamp - lam1) * leivecpr(i) * du(i)
         summ = summ + (lamm - lam1) * leivecmr(i) * du(i)
      enddo

      vxa = sump + summ
      vxb =-(sump * vxpr + summ * vxmr)

      rfluxr(1) = lam1 * du(1) + vxa
      rfluxr(2) = lam1 * du(2) + enthalpyr * wr * (vlowxr * vxa + vxb)
      rfluxr(3) = lam1 * du(3) + enthalpyr * wr * (vlowyr * vxa)
      rfluxr(4) = lam1 * du(4) + enthalpyr * wr * (vlowzr * vxa)
      rfluxr(5) = lam1 * du(5) + enthalpyr * wr * (velxr  * vxb + vxa) - vxa

    else

!!$  PUT LEFT EIGENVECTORS IN THE Q MATRIX

      q(1,:) = leivecmr(:)
      q(2,:) = leivecpr(:)
      q(3,:) = leivec2r(:)
      q(4,:) = leivec3r(:)
      q(5,:) = leivec1r(:)

      do i=1,5
        dw(i) = 0.0d0
        do j=1,5
          dw(i) = dw(i) + q(i,j) * du(j)
        enddo
      enddo

      do i = 1, 5
        rfluxr(i) = 0.d0
        do j = 1, 5
          rfluxr(i) = rfluxr(i) + p(i,j) * lam(j) * dw(j)
        end do
      end do

    endif

  else

!!$  Solve for characteristic variable change, dw

    do i=1,5
      dw(i) = du(i)
      do j=1,5
        aa(i,j) = p(i,j)
      end do
    enddo

    do i=1,5
      paug(i,1) = p(i,1)
      paug(i,2) = p(i,2)
      paug(i,3) = p(i,3)
      paug(i,4) = p(i,4)
      paug(i,5) = p(i,5)
    enddo

    paug(1,6) = du(1)
    paug(2,6) = du(2)
    paug(3,6) = du(3)
    paug(4,6) = du(4)
    paug(5,6) = du(5)

!!$  Get lower left triangle to be all zeros

    do i=1,5
!!$  First, make diagonal element 1
      tmp1 = one / paug(i,i)
      do j=i,6
        paug(i,j) = paug(i,j)*tmp1
      enddo
!!$  Now, get rid of everything below that diagonal
      do j=i+1,5
        tmp1 = - (paug(j,i))
        do k=i,6
          paug(j,k) = paug(j,k) + tmp1*paug(i,k)
        enddo
      enddo
    enddo
!!$  Back substitute

    f_du(5) = paug(5,6)
    do i=4,1,-1
      f_du(i) = paug(i,6)
      do j=i+1,5
        f_du(i) = f_du(i) - paug(i,j)*f_du(j)
      enddo
    enddo

    dw(1) = f_du(1)
    dw(2) = f_du(2)
    dw(3) = f_du(3)
    dw(4) = f_du(4)
    dw(5) = f_du(5)

    do i = 1, 5
      rfluxr(i) = 0.d0
      do j = 1, 5
        rfluxr(i) = rfluxr(i) + p(i,j) * lam(j) * dw(j)
      end do
    end do

  endif

  flux1r = rfluxr(1)
  flux2r = rfluxr(2)
  flux3r = rfluxr(3)
  flux4r = rfluxr(4)
  flux5r = rfluxr(5)

  flux1 = flux1r - flux1l 
  flux2 = flux2r - flux2l 
  flux3 = flux3r - flux3l 
  flux4 = flux4r - flux4l 
  flux5 = flux5r - flux5l 

  return

end subroutine eigenproblem_marquina_hot


```

GRHydro_TmunuM.F90:
```
 /*@@
   @file      GRHydro_Tmunu.F90
   @date      Aug 30, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @histpry
    Apr. 2009: Luca Baiotti copied and adapted for the Tmunu-thorn mechanism the original include file
   @desc 
     The calculation of the stress energy tensor.
     The version used here was worked out by Miguel Alcubierre. I
     think it was an extension of the routine from GR3D, written
     by Mark Miller.
     C version added by Ian Hawke.

     Lower components of the stress-energy tensor obtained from
     the hydro variables.  The components are given by:

     T      =  (rho h +b^2) u   u    +  (P+b^2/2)  g      - b   b
      mu nu                   mu  nu                mu nu     mu nu 

     where rho is the energy density of the fluid, h the enthalpy
     and P the pressure.  The enthalpy is given in terms of the
     basic variables as:

     h  =  1  +  e  +  P/rho

     with e the internal energy (eps here).

     In the expresion for T_{mu,nu} we also have the four-velocity
     of the fluid given by (v_i is the 3-velocity field):

                                 i
     u  =  W ( - alpha +  v  beta  )
      0                    i

     u  =  W v
      i       i
                                                i  -1/2
     with W the Lorentz factor:   W = ( 1 -  v v  )
                                              i

     and where alpha and beta are the lapse and shift vector.

     Finally, the 4 metric is given by

                   2             i
     g   =  - alpha  + beta  beta
      00                   i

     g   =  beta
      0i        i


     g   =  gamma      (the spatial metric)
      ij        ij


   @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 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 bcomx(i,j,k) bcom(i,j,k,1)
#define bcomy(i,j,k) bcom(i,j,k,2)
#define bcomz(i,j,k) bcom(i,j,k,3)

 subroutine GRHydro_TmunuM(CCTK_ARGUMENTS)

   implicit none

   DECLARE_CCTK_ARGUMENTS
   DECLARE_CCTK_PARAMETERS
   DECLARE_CCTK_FUNCTIONS

   CCTK_REAL :: velxlow, velylow, velzlow
   CCTK_REAL :: betaxlow, betaylow, betazlow, beta2
   CCTK_REAL :: Bvecxlow,Bvecylow,Bveczlow
   CCTK_REAL :: bdotv,b2,bxlow,bylow,bzlow,btlow,dum1,dum2
   CCTK_REAL :: utlow,rhohstarw2,pstar
   CCTK_REAL :: bdotbeta,vdotbeta
   CCTK_INT :: i,j,k


   !$OMP PARALLEL DO PRIVATE(i,j,k,velxlow, velylow, velzlow,&
   !$OMP Bvecxlow,Bvecylow,Bveczlow, bdotv,dum1,dum2,b2,bxlow,bylow,bzlow,&
   !$OMP betaxlow, betaylow, betazlow, beta2, bdotbeta,vdotbeta,utlow, btlow,&
   !$OMP rhohstarw2,pstar)

   do k = 1, cctk_lsh(3)
     do j = 1, cctk_lsh(2)
       do i = 1, cctk_lsh(1)

          ! need separate dum1, dum2 b/c of Fortrans aliasing rules
          call calc_vlow_blow(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),&
               gyy(i,j,k),gyz(i,j,k),gzz(i,j,k), &
               velx(i,j,k),vely(i,j,k),velz(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(i,j,k), &
               velxlow,velylow,velzlow,Bvecxlow,Bvecylow,Bveczlow, &
               bdotv,b2,dum1,dum2,bxlow,bylow,bzlow)
          
!!$       Calculate lower components and square of shift vector.
          
          
          betaxlow = gxx(i,j,k)*betax(i,j,k) + gxy(i,j,k)*betay(i,j,k) + gxz(i,j,k)*betaz(i,j,k)
          betaylow = gxy(i,j,k)*betax(i,j,k) + gyy(i,j,k)*betay(i,j,k) + gyz(i,j,k)*betaz(i,j,k)
          betazlow = gxz(i,j,k)*betax(i,j,k) + gyz(i,j,k)*betay(i,j,k) + gzz(i,j,k)*betaz(i,j,k)
          beta2 = betax(i,j,k)*betaxlow + betay(i,j,k)*betaylow + betaz(i,j,k)*betazlow 
          
          bdotbeta = betaxlow*Bvecx(i,j,k)+betaylow*Bvecy(i,j,k)+betazlow*Bvecz(i,j,k)
          vdotbeta = betaxlow*velx(i,j,k)+betaylow*vely(i,j,k)+betazlow*velz(i,j,k)

!!$   u0 low is missing the w_lorentz factor (see below)!!
          utlow = -1.d0*alp(i,j,k) + vdotbeta
          
          btlow = -1.0d0*w_lorentz(i,j,k)*alp(i,j,k)*bdotv + &
               bdotbeta/w_lorentz(i,j,k) + w_lorentz(i,j,k)*bdotv*vdotbeta

!!$       Calculate the specific relativistic enthalpy times rho + the mag. field contribution times the
!!$       square of the lorentz factor.

         rhohstarw2 = w_lorentz(i,j,k)**2*(rho(i,j,k)*(1.0d0 + eps(i,j,k)) + press(i,j,k) + b2)
         pstar =  press(i,j,k)+0.5d0*b2

!!$       Calculate lower components of 4-velocity (without the Lorent factor).
!!$         uxlow = velxlow
!!$         uylow = velylow
!!$         uzlow = velzlow

!!$       Calculate Tmunu (the lower components!).

         eTtt(i,j,k) = eTtt(i,j,k) + rhohstarw2*utlow**2 + pstar*(beta2 - alp(i,j,k)**2) - btlow**2

         eTtx(i,j,k) = eTtx(i,j,k) + rhohstarw2*utlow*velxlow + pstar*betaxlow - btlow*bxlow
         eTty(i,j,k) = eTty(i,j,k) + rhohstarw2*utlow*velylow + pstar*betaylow - btlow*bylow
         eTtz(i,j,k) = eTtz(i,j,k) + rhohstarw2*utlow*velzlow + pstar*betazlow - btlow*bzlow

         eTxx(i,j,k) = eTxx(i,j,k) + rhohstarw2*velxlow**2 + pstar*gxx(i,j,k) - bxlow**2
         eTyy(i,j,k) = eTyy(i,j,k) + rhohstarw2*velylow**2 + pstar*gyy(i,j,k) - bylow**2
         eTzz(i,j,k) = eTzz(i,j,k) + rhohstarw2*velzlow**2 + pstar*gzz(i,j,k) - bzlow**2
         
         eTxy(i,j,k) = eTxy(i,j,k) + rhohstarw2*velxlow*velylow + pstar*gxy(i,j,k) - bxlow*bylow
         eTxz(i,j,k) = eTxz(i,j,k) + rhohstarw2*velxlow*velzlow + pstar*gxz(i,j,k) - bxlow*bzlow
         eTyz(i,j,k) = eTyz(i,j,k) + rhohstarw2*velylow*velzlow + pstar*gyz(i,j,k) - bylow*bzlow

         if(calculate_bcom .ne. 0) then
           bcom_sq(i,j,k) = b2 
           bcom0(i,j,k) = w_lorentz(i,j,k)*bdotv/alp(i,j,k)
           bcomx(i,j,k) = Bvecx(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*velx(i,j,k)-betax(i,j,k))
           bcomy(i,j,k) = Bvecy(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*vely(i,j,k)-betay(i,j,k))
           bcomz(i,j,k) = Bvecz(i,j,k)/w_lorentz(i,j,k) + bcom0(i,j,k)*(alp(i,j,k)*velz(i,j,k)-betaz(i,j,k))
         endif 

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

   return
 
 end subroutine GRHydro_TmunuM

```

GRHydro_Con2PrimAM.F90:
```
/*@@
   @file      GRHydro_Con2PrimAM.F90
   @date      Sep 3, 2010
   @author    Scott Noble, Joshua Faber, Bruno Mundim, Tanja Bode
   @desc 
   The routines for converting conservative to primitive variables.
   Vector-potential MHD.
   @enddesc 
 @@*/

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

#define ITER_TOL (1.0e-8)
#define MAXITER (50)

 /*@@
   @routine    Conservative2PrimitiveAM
   @date       Sep 3, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Conservative2PrimitiveAM(CCTK_ARGUMENTS)

  use Con2PrimM_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, det, sdet, pmin(1), epsmin(1)
  CCTK_REAL :: oob, b2, d2, s2, bscon, bxhat, byhat, bzhat, bhatscon
  CCTK_REAL :: Wm, Wm0, Wm_resid, Wmold
  CCTK_REAL :: s2m, s2m0, s2m_resid, s2mold, s2max, taum
  CCTK_INT :: niter
  CCTK_INT :: epsnegative
  character(len=100) warnline
  
  CCTK_REAL :: local_min_tracer, local_gam(1), local_pgam,local_K, sc
  CCTK_REAL :: local_perc_ptol

! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xtemp(1),xye(1),xeps(1),xrho(1),one(1)=1.0d0
! end EOS Omni vars                 

  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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)

  logical :: posdef

  CCTK_REAL :: g11c, g12c, g13c, g22c, g23c, g33c
  CCTK_REAL :: tmp1

  ! Save the primitive variables to temporary functions before calling the
  ! con2prim pointwise routines:
  CCTK_REAL :: rho_tmp, press_tmp, eps_tmp
  CCTK_REAL :: velx_tmp, vely_tmp, velz_tmp, w_lorentz_tmp
  CCTK_REAL :: Bvecx_tmp, Bvecy_tmp, Bvecz_tmp
  CCTK_REAL :: Bconsx_tmp, Bconsy_tmp, Bconsz_tmp

  CCTK_REAL :: bdotv, magpress

  ! Assume 3-metric is positive definite. Check deep inside the horizon 
  ! if this is actually satisfied and if it is not then cast the metric 
  !as conformally flat only for con2prim inversion purposes.
  posdef = .true. 
 
  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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    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 betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

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

  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

!  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)
  ! 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,pmin,keyerr,anyerr)
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,xeps,xtemp,xye,pmin,epsmin,keyerr,anyerr)

  call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
         one,one,xtemp,xye,local_gam,keyerr,anyerr)
  local_gam = local_gam+1.d0

  !call CCTK_WARN(1,"In Con2PrimAM")

  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz, det, epsnegative, &
  !$OMP b2,xrho,xeps,xpress,xtemp,local_K,local_pgam,sc,keyerr,anyerr,keytemp, &
  !$OMP local_perc_ptol,posdef,g11c,g12c,g13c,g22c,g23c,g33c,tmp1, &
  !$OMP sdet,d2,s2,oob,bscon,bxhat,byhat,bzhat, &
  !$OMP bhatscon,Wm,Wm0,Wm_resid,Wmold,s2m,s2m0,s2m_resid,s2mold,s2max, &
  !$OMP taum,niter,rho_tmp,press_tmp,eps_tmp,velx_tmp,vely_tmp,velz_tmp, &
  !$OMP Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, &
  !$OMP w_lorentz_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,bdotv,magpress)
  do k = 1, nz 
     do j = 1, ny 
        do i = 1, nx
           
           !do not compute if in atmosphere or in excised region
           if ((atmosphere_mask(i,j,k) .ne. 0) .or. &
                (hydro_excision_mask(i,j,k) .ne. 0)) cycle
           
           epsnegative = 0
           
           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))        
           
!!$ Tracers don't need an MHD treatment!
           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

           
           b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
           2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
           g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))

       
           if ( dens(i,j,k) .le. sdet*GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then
              
              !call CCTK_WARN(1,"Con2Prim: Resetting to atmosphere")
              !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),&
              !      temperature(i,j,k),y_e(i,j,k)
              !call CCTK_WARN(1,warnline)

              
              dens(i,j,k) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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

              !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 does need to take into account the existing B-field
              !!$ with w_lorentz=1, we find tau = sqrtdet*(rho (1+eps+b^2/2)) - dens  [Press drops out]
              tau(i,j,k)  = sdet * (rho(i,j,k)*(1.0+eps(i,j,k)+b2/2.0)) - dens(i,j,k)
              
              if(tau(i,j,k).le.sdet*b2*0.5d0)then
                tau(i,j,k) = GRHydro_tau_min + sdet*b2*0.5d0
              endif

              cycle
              
           end if


           if(evolve_temper.eq.0) then
            

              if(sqrtdet_thr.gt.0d0 .and. sdet.ge.sqrtdet_thr) then
                    d2 = dens(i,j,k)**2
                    s2 = uxx*scon(i,j,k,1)**2 + uyy*scon(i,j,k,2)**2 &
                                              + uzz*scon(i,j,k,3)**2 &
                       + 2.0d0*uxy*scon(i,j,k,1)*scon(i,j,k,2) &
                       + 2.0d0*uxz*scon(i,j,k,1)*scon(i,j,k,3) &
                       + 2.0d0*uyz*scon(i,j,k,2)*scon(i,j,k,3) 
                   oob = 1.0d0/sqrt(b2)
                 bxhat = oob*Bprim(i,j,k,1)
                 byhat = oob*Bprim(i,j,k,2)
                 bzhat = oob*Bprim(i,j,k,3)
                 bhatscon = bxhat*scon(i,j,k,1)+byhat*scon(i,j,k,2) &
                                               +bzhat*scon(i,j,k,3)
                 bscon = Bprim(i,j,k,1)*scon(i,j,k,1) &
                       + Bprim(i,j,k,2)*scon(i,j,k,2) &
                       + Bprim(i,j,k,3)*scon(i,j,k,3)
                 ! Initial guesses for iterative procedure to find Wm:
                 Wm0 = sdet*sqrt(bhatscon**2+d2)
                 s2m0 = (Wm0**2*s2+bhatscon**2*(b2+2.0d0*Wm0)) &
                      / (Wm0+b2)**2 
                 Wm = sdet*sqrt(s2m0+d2)
                 s2m = (Wm**2*s2+bscon**2*(b2+2.0d0*Wm)) &
                     / (Wm+b2)**2 
                 s2m_resid = 1.0d60
                 Wm_resid = 1.0d60
                 niter = 0
                 do while((s2m_resid.ge.ITER_TOL.and.Wm_resid.ge.ITER_TOL).and.&
                          niter.le.MAXITER)
                   Wmold = Wm
                   s2mold = s2m
                   Wm = sdet*sqrt(s2m+d2)
                   s2m = (Wm**2*s2+bscon**2*(b2+2.0d0*Wm)) &
                       / (Wm+b2)**2 
                   Wm_resid = abs(Wmold-Wm)
                   s2m_resid = abs(s2mold-s2m)
                   niter = niter + 1
                 end do
                 !TODO: abort execution if niter .eq. MAXITER and warn user
                 taum = tau(i,j,k) - 0.5d0*sdet*b2 -0.5d0*(b2*s2-bscon**2)/ &
                                                         (sdet*(Wm+b2)**2) 
                 s2max = taum*(taum+2.0d0*dens(i,j,k))
                 if(taum.lt.GRHydro_tau_min)then
                   tau(i,j,k) = GRHydro_tau_min + 0.5d0*sdet*b2 + 0.5d0* &
                                (b2*s2-bscon**2)/(sdet*(Wm+b2)**2)
                 end if
                 if(s2.gt.s2max) then
                   scon(i,j,k,1) = scon(i,j,k,1)*sqrt(s2max/s2)
                   scon(i,j,k,2) = scon(i,j,k,2)*sqrt(s2max/s2)
                   scon(i,j,k,3) = scon(i,j,k,3)*sqrt(s2max/s2)
                 end if
              endif 

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)

              !! We've already create B from A, construct Bcons
              Bconsx_tmp = sdet*Bvecx_tmp 
              Bconsy_tmp = sdet*Bvecy_tmp 
              Bconsz_tmp = sdet*Bvecz_tmp 

              keytemp = 0
              !Watch out for the values returned to b2. Here b2 is the Bprim^2
              !while inside the point-wise con2prim routines it is the square
              !of the comoving B-field, b^{\mu} b_{\mu}. It is overwritten 
              !in this routine, but we may need to find a better notation 
              !avoid future confusions.
             if(GRHydro_eos_handle .eq. 1 .or. GRHydro_eos_handle .eq. 2) then
             
                call GRHydro_Con2PrimM_ptold(GRHydro_eos_handle, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bconsx_tmp,Bconsy_tmp,Bconsz_tmp,rho_tmp, & 
                   velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp, &
                   Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2, w_lorentz_tmp,&
                   g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
                   
             else
              call GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp,xye(1), &
                   xtemp(1),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                   eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                   w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                   g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
              endif

              if(evolve_entropy.ne.0) then
                if(GRHydro_C2P_failed(i,j,k).ne.0) then
                  !Use previous time step for rho:
                 entropy(i,j,k) = entropycons(i,j,k)/dens(i,j,k)*rho(i,j,k)
                else
                  !Use the current correct value of rho returned by con2prim:
                  entropy(i,j,k) = entropycons(i,j,k)/dens(i,j,k)*rho_tmp
                endif
              endif

              if(GRHydro_C2P_failed(i,j,k).ne.0) then
                xrho=1.0d0; xtemp=0.0d0; xeps=1.0d0
                call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                     xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                local_K = xpress(1); 

                xrho=10.0d0; xeps=1.0d0
                call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                     xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                local_pgam=log(xpress(1)/local_K)/log(xrho(1))
                sc = local_K*dens(i,j,k)

                if(sqrtdet_thr.gt.0d0 .and. sdet.ge.sqrtdet_thr) then
                  GRHydro_C2P_failed(i,j,k) = 0

                  rho_tmp = rho(i,j,k)
                  press_tmp = press(i,j,k)
                  eps_tmp = eps(i,j,k)
                  velx_tmp = vup(i,j,k,1)
                  vely_tmp = vup(i,j,k,2)
                  velz_tmp = vup(i,j,k,3)
                  w_lorentz_tmp = w_lorentz(i,j,k)
                  Bvecx_tmp = Bprim(i,j,k,1)
                  Bvecy_tmp = Bprim(i,j,k,2)
                  Bvecz_tmp = Bprim(i,j,k,3)
                  Bconsx_tmp = sdet*Bvecx_tmp 
                  Bconsy_tmp = sdet*Bvecy_tmp 
                  Bconsz_tmp = sdet*Bvecz_tmp 

                  call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, &
                       dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                       Bconsx_tmp, Bconsy_tmp, Bconsz_tmp,rho_tmp,&
                       velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                       Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                       g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                       uxx,uxy,uxz,uyy,uyz,uzz,det, &
                       epsnegative,GRHydro_C2P_failed(i,j,k))

                  if(GRHydro_C2P_failed(i,j,k).ne.0) then
                    GRHydro_C2P_failed(i,j,k) = 0
                    call prim2conAM(GRHydro_eos_handle,g11(i,j,k),g12(i,j,k), &
                         g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),det, &
                       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), &
                  Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
                    cycle
                  end if
                end if

                bdotv=g11(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,1)+ &
                      g22(i,j,k)*Bprim(i,j,k,2)*vup(i,j,k,2)+ &
                      g33(i,j,k)*Bprim(i,j,k,3)*vup(i,j,k,3)+ &
                 2.0*(g12(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,2)+ &
                      g13(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,3)+ &
                      g23(i,j,k)*Bprim(i,j,k,2)*vup(i,j,k,3))

                magpress = 0.5d0*(b2/w_lorentz(i,j,k)**2+bdotv**2)

                if(rho(i,j,k)*eps(i,j,k)*max_magnetic_to_gas_pressure_ratio.le.magpress) then
                  GRHydro_C2P_failed(i,j,k) = 0

                  if(evolve_entropy.ne.0) then
                    local_K = entropycons(i,j,k)/dens(i,j,k) 
                    xrho=10.0d0; xeps=1.0d0
                    call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                         xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                    local_pgam=log(xpress(1)/local_K)/log(xrho(1))
                    sc = local_K*dens(i,j,k)
                  end if

                  rho_tmp = rho(i,j,k)
                  press_tmp = press(i,j,k)
                  eps_tmp = eps(i,j,k)
                  velx_tmp = vup(i,j,k,1)
                  vely_tmp = vup(i,j,k,2)
                  velz_tmp = vup(i,j,k,3)
                  w_lorentz_tmp = w_lorentz(i,j,k)
                  Bvecx_tmp = Bprim(i,j,k,1)
                  Bvecy_tmp = Bprim(i,j,k,2)
                  Bvecz_tmp = Bprim(i,j,k,3)
                  Bconsx_tmp = sdet*Bvecx_tmp
                  Bconsy_tmp = sdet*Bvecy_tmp
                  Bconsz_tmp = sdet*Bvecz_tmp

                  if(evolve_entropy.ne.0) then
                    call GRHydro_Con2PrimM_ptee(GRHydro_eos_handle, keytemp, &
                         GRHydro_eos_rf_prec, local_gam(1), dens(i,j,k), &
                         scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                         Bconsx_tmp,Bconsy_tmp,Bconsz_tmp, &
                         entropycons(i,j,k), xye(1), &
                         xtemp(1),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                         eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                         w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                         g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                         uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                         epsnegative,GRHydro_C2P_failed(i,j,k))
                  else
                  call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, &
                       dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                       Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, rho_tmp,&
                       velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                       Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                       g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                       uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                       epsnegative,GRHydro_C2P_failed(i,j,k))
                  end if 

                  rho(i,j,k) = rho_tmp 
                  press(i,j,k) = press_tmp 
                  eps(i,j,k) = eps_tmp 
                  vup(i,j,k,1) = velx_tmp 
                  vup(i,j,k,2) = vely_tmp 
                  vup(i,j,k,3) = velz_tmp 
                  w_lorentz(i,j,k) = w_lorentz_tmp 
                  Bprim(i,j,k,1) = Bvecx_tmp 
                  Bprim(i,j,k,2) = Bvecy_tmp 
                  Bprim(i,j,k,3) = Bvecz_tmp 
                  cycle
                end if
              end if

           else    ! if(evolve_temper.eq.0) then

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)
              Bconsx_tmp = sdet*Bvecx_tmp
              Bconsy_tmp = sdet*Bvecy_tmp
              Bconsz_tmp = sdet*Bvecz_tmp

              keytemp = 0 

              call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, GRHydro_reflevel, int(i,ik), int(j,ik), int(k,ik), x(i,j,k), y(i,j,k), z(i,j,k), keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, Y_e(i,j,k), &
                   temperature(i,j,k),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                   eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                   w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                   g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
              if(GRHydro_C2P_failed(i,j,k).ne.0) 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
                local_perc_ptol = GRHydro_eos_rf_prec*100.0d0
                ! Use the previous primitive values as initial guesses
                rho_tmp = rho(i,j,k)
                press_tmp = press(i,j,k)
                eps_tmp = eps(i,j,k)
                velx_tmp = vup(i,j,k,1)
                vely_tmp = vup(i,j,k,2)
                velz_tmp = vup(i,j,k,3)
                w_lorentz_tmp = w_lorentz(i,j,k)
                Bvecx_tmp = Bprim(i,j,k,1)
                Bvecy_tmp = Bprim(i,j,k,2)
                Bvecz_tmp = Bprim(i,j,k,3)
                Bconsx_tmp = sdet*Bvecx_tmp
                Bconsy_tmp = sdet*Bvecy_tmp
                Bconsz_tmp = sdet*Bvecz_tmp
              call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, GRHydro_reflevel, int(i,ik), int(j,ik), int(k,ik), x(i,j,k), y(i,j,k), z(i,j,k), keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                     scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                     Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, Y_e(i,j,k), &
                     temperature(i,j,k),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                     eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                     w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                     g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                     uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                     epsnegative,GRHydro_C2P_failed(i,j,k))
                if(GRHydro_C2P_failed(i,j,k).ne.0) then
                  !$OMP CRITICAL
                  if (GRHydro_reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
                     call CCTK_WARN(1,"Convergence problem in c2p")
                     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),&
                          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
           endif    ! if(evolve_temper.eq.0) then

           
           if (epsnegative .ne. 0) 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) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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)

              b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
                   2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
                   g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))
              
              
              ! w_lorentz=1, so the expression for tau reduces to [see above]:
              tau(i,j,k)  = sdet * (rho(i,j,k)*(1.0+eps(i,j,k)+b2/2.0)) - 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
              
              xrho=1.0d0; xtemp=0.0d0; xeps=1.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1); 

              xrho=10.0d0; xeps=1.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              sc = local_K*dens(i,j,k)

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)
              Bconsx_tmp = sdet*Bvecx_tmp
              Bconsy_tmp = sdet*Bvecy_tmp
              Bconsz_tmp = sdet*Bvecz_tmp

            call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp,rho_tmp,&
                   velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                   Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                   g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))

#endif          
              
           end if    ! if (epsnegative .ne. 0) then  

           rho(i,j,k) = rho_tmp 
           press(i,j,k) = press_tmp 
           eps(i,j,k) = eps_tmp 
           vup(i,j,k,1) = velx_tmp 
           vup(i,j,k,2) = vely_tmp 
           vup(i,j,k,3) = velz_tmp 
           w_lorentz(i,j,k) = w_lorentz_tmp 
           Bprim(i,j,k,1) = Bvecx_tmp 
           Bprim(i,j,k,2) = Bvecy_tmp 
           Bprim(i,j,k,3) = Bvecz_tmp 
          
           if ( rho(i,j,k) .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance)) then
!           if ( rho(i,j,k) .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) .or. GRHydro_C2P_failed(i,j,k) .ge. 1) then
               
              b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
                   2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
                   g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))
              
              dens(i,j,k) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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 does need to take into account the existing B-field
              !!$ with w_lorentz=1, we find tau = sqrtdet*(rho (1+eps+b^2/2)) - dens  [Press drops out]
              tau(i,j,k)  = sdet * (rho(i,j,k)*eps(i,j,k)+b2/2.0)

           end if

        end do
     end do
  end do
  !$OMP END PARALLEL DO
  
  return
#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 Conservative2PrimitiveAM


 /*@@
   @routine    Conservative2PrimitiveBoundariesAM
   @date       Sep 15, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Conservative2PrimitiveBoundsAM(CCTK_ARGUMENTS)
  
  use Con2PrimM_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, pmin(1), epsmin(1)
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  CCTK_REAL :: b2minus, b2plus, local_gam(1), local_pgam,local_K,scminus,scplus
  CCTK_INT :: epsnegative
  CCTK_REAL :: Bconsx_tmp, Bconsy_tmp, Bconsz_tmp
  character(len=100) warnline
 
  CCTK_REAL :: local_min_tracer

! begin EOS Omni vars                                            
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xtemp(1),xye(1),xeps(1),xrho(1),one(1)=1.0d0
! end EOS Omni vars                       

  ! 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
#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

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

  ! this is a poly call
  xrho(1)=GRHydro_rho_min 
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,one,xtemp,xye,pmin,keyerr,anyerr)

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

  call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
         one,one,xtemp,xye,local_gam,keyerr,anyerr)
  local_gam=local_gam+1.0

  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 = 0
           
           avg_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
           avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
           call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl*avg_sdetl,&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
           call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr*avg_sdetr,&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        
           
!!$ Tracers get no update for MHD!
           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

           Bconsx_tmp = avg_sdetl*Bvecxminus(i,j,k)
           Bconsy_tmp = avg_sdetl*Bvecyminus(i,j,k)
           Bconsz_tmp = avg_sdetl*Bveczminus(i,j,k)
           call GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), densminus(i,j,k), &
                sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), tauminus(i,j,k), &
                Bconsx_tmp, Bconsy_tmp, Bconsz_tmp,  xye(1), xtemp(1), rhominus(i,j,k),&
                velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),&
                Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
           
           if (epsnegative .ne. 0) then
              !$OMP CRITICAL
              call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!')
              !$OMP END CRITICAL
              
              xrho=10.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   one,one,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1)

              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,one,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              scminus = local_K*densminus(i,j,k)

              call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, densminus(i,j,k), &
                   sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), scminus, &
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, rhominus(i,j,k),&
                   velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),&
                   Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                   gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                   uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                   epsnegative,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 = 0

           Bconsx_tmp = avg_sdetr*Bvecxplus(i,j,k)
           Bconsy_tmp = avg_sdetr*Bvecyplus(i,j,k)
           Bconsz_tmp = avg_sdetr*Bveczplus(i,j,k)
           call GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), densplus(i,j,k), &
                sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), tauplus(i,j,k), &
                Bconsx_tmp, Bconsy_tmp, Bconsz_tmp,  xye(1), xtemp(1), rhoplus(i,j,k),&
                velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),&
                Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k),b2plus, w_lorentzplus(i,j,k),&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
 
           if (epsnegative .ne. 0) then
              !$OMP CRITICAL
              call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!!')
              !$OMP END CRITICAL

              xrho=10.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   one,one,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1)

              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,one,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              scplus = local_K*densplus(i,j,k)

              call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, densplus(i,j,k), &
                   sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), scplus,&
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, rhoplus(i,j,k),&
                   velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),&
                   Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k),b2plus, w_lorentzplus(i,j,k),&
                   gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                   uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                   epsnegative,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
  
#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 Conservative2PrimitiveBoundsAM

/*@@
@routine    Con2PrimPolytypeAM
@date       Sep 16, 2010
@author     SCott Noble, Joshua Faber, Bruno Mundim, Ian Hawke
@desc 
All routines below are identical to those above, just
specialised from polytropic type EOS.
@enddesc 
@calls     
@calledby   
@history 

@endhistory 

@@*/

subroutine Conservative2PrimitivePolytypeAM(CCTK_ARGUMENTS)
  
  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, sdet,b2

  CCTK_INT :: epsnegative
  CCTK_REAL :: Bconsx_tmp, Bconsy_tmp, Bconsz_tmp
  
  CCTK_REAL :: local_min_tracer, local_pgam,local_K, sc
  !  character(len=400) :: warnline
  
! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,xeps,xrho
! end EOS Omni vars                 

  ! 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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)

  call GRHydro_BvecfromAvec(CCTK_PASS_FTOF)

  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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    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 betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

! begin EOS Omni vars                                                                                       
  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                 
  
  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, sdet, epsnegative, &
  !$OMP Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, &
  !$OMP b2, xrho, xpress, local_K, local_pgam, sc)
  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
           
           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))        

!!$ No MHD changes to tracers
           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
           
           xrho=10.0d0
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                1.d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_K = xpress
           
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                xrho,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_pgam=log(xpress/local_K)/log(xrho)
           sc = local_K*dens(i,j,k)
           Bconsx_tmp = sdet*Bprim(i,j,k,1)
           Bconsy_tmp = sdet*Bprim(i,j,k,2)
           Bconsz_tmp = sdet*Bprim(i,j,k,3)
           
           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                   Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, 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),&
                   Bprim(i,j,k,1), Bprim(i,j,k,2), Bprim(i,j,k,3),b2, w_lorentz(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), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
            
        end do
     end do
  end do
  
  !$OMP END PARALLEL DO
  
  return

#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 Conservative2PrimitivePolytypeAM


 /*@@
   @routine    Cons2PrimBoundsPolytypeAM
   @date       Sep 16, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Con2PrimBoundsPolytypeAM(CCTK_ARGUMENTS)
  
  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_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  CCTK_REAL :: b2minus, b2plus
  CCTK_REAL :: Bconsx_tmp, Bconsy_tmp, Bconsz_tmp
  CCTK_INT :: epsnegative

  CCTK_REAL :: local_pgam,local_K,scplus,scminus

! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,xeps,xrho
! end EOS Omni vars                       

  ! 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
#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

! begin EOS Omni vars                                            
  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                 
  
  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_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
           avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
           call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl*avg_sdetl,&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
           call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr*avg_sdetr,&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        

           xrho=10.0d0
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                1.d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_K = xpress
           
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                xrho,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_pgam=log(xpress/local_K)/log(xrho)
           scminus = local_K*densminus(i,j,k)
           scplus = local_K*densplus(i,j,k)
           Bconsx_tmp = avg_sdetl*Bvecxminus(i,j,k)
           Bconsy_tmp = avg_sdetl*Bvecyminus(i,j,k)
           Bconsz_tmp = avg_sdetl*Bveczminus(i,j,k)

           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam,densminus(i,j,k), &
                sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), scminus,&
                Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, rhominus(i,j,k),&
                velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),&
                Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                epsnegative,GRHydro_C2P_failed(i,j,k))

           Bconsx_tmp = avg_sdetr*Bvecxplus(i,j,k)
           Bconsy_tmp = avg_sdetr*Bvecyplus(i,j,k)
           Bconsz_tmp = avg_sdetr*Bveczplus(i,j,k)
           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam,densplus(i,j,k), &
                sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), scplus,&
                Bconsx_tmp, Bconsy_tmp, Bconsz_tmp, rhoplus(i,j,k),&
                velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),&
                Bvecxplus(i,j,k), Bvecyplus(i,j,k),Bveczplus(i,j,k),b2plus,w_lorentzplus(i,j,k),&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
        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 Con2PrimBoundsPolytypeAM

!!$ Con2Prim_ptTracer, Con2Prim_BoundsTracer, and Con2Prim_ptBoundsTracer need not be rewritten!


```

GRHydro_EoSChangeGamma.F90:
```
/*@@
@file      GRHydro_EOSResetHydro.F90
@date      Sat Jan 26 01:36:57 2002
@author     Ian Hawke
@desc 
   This routine will reset the specific internal energy using the polytropic
   EOS that will be used at evolution. This is wanted if the EoS changes
   between setting up the initial data and evolving
  @enddesc 
  @@*/
  
#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 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_EOSResetHydro
   @date       Sat Jan 26 01:38:12 2002
   @author     Ian Hawke
   @desc 
   see above
   @enddesc 
   @calls     
   @calledby   
   @history 
   
   @endhistory 

@@*/


subroutine GRHydro_EoSChangeGamma(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  
  CCTK_REAL :: local_gamma

  ! 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)

!!$  Set up the fluid constants
! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
  
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,xeps,keyerr,anyerr)

  ! 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
  
  local_Gamma = 1.0d0 + xpress/xeps
  press = poly_k * &
       rho**local_Gamma 
  eps = press / (rho * (local_Gamma - 1.d0))

!!$  Change the pressure and specific internal energy

!!$  Get the conserved variables. Hardwired polytrope EoS!!!
!!$  Note that this call also sets pressure and eps
    
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        call prim2conpolytype(GRHydro_polytrope_handle,g11(i,j,k),g12(i,j,k),&
             g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),w_lorentz(i,j,k))

      end do
    end do
  end do


end subroutine GRHydro_EoSChangeGamma

 /*@@
   @routine    GRHydro_EoSChangeK
   @date       Mon Oct 20 12:56:14 2003
   @author     Ian Hawke
   @desc 
   Reset the hydro variables when K is changed.
   Unlike the routine above, this actually gives a solution to
   the constraints.

   Only two cases are given as the general case is transcendental.
   We find this by holding rho * enthalpy fixed and assuming a
   polytropic EOS.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_EoSChangeK(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  
  CCTK_REAL :: local_gamma, local_k
  
  CCTK_REAL, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: Q

  ! 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)

!!$  Set up the fluid constants
! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
  
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,xeps,keyerr,anyerr)

  local_Gamma = 1.0d0 + xpress/xeps
  local_K = xpress

  call CCTK_INFO("Adjusting EOS via K change!")

  if (abs(local_Gamma - 2.d0) < 1.d-10) then

    rho = -0.5d0/local_k+sqrt(0.25d0/local_k**2+(rho+initial_k*rho**2)/local_k)

  else if (abs(local_Gamma - 3.d0) < 1.d-10) then

     call CCTK_ERROR("This part of the code is not tested!")
     STOP

!!$ This code is probably just wrong. We have never used it anyway.
    Q = -9.d0 * local_k**2 * rho * (2.d0 + 3.d0 * initial_k * rho**2) + &
         sqrt(local_k**3 * (32.d0 + 81.d0 * local_k * rho**2 * &
         (2.d0 + 3.d0 * initial_k * rho**2)**2))
    
    Q = Q**(1.d0/3.d0)
    
    rho = (2**(7.d0/3.d0) * local_k - 2**(2.d0/3.d0) * Q**2) / &
         (6.d0 * local_k * Q)

  else
    call CCTK_ERROR("EoSChangeK only knows how to do Gamma=2 or 3!")
    STOP
  end if
 
  press = local_k * rho**local_gamma
  eps = local_k / (local_gamma - 1.d0) * rho**(local_gamma-1.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

  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        call prim2conpolytype(GRHydro_polytrope_handle,g11(i,j,k),g12(i,j,k),&
             g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),w_lorentz(i,j,k))

      end do
    end do
  end do



end subroutine GRHydro_EoSChangeK



 /*@@
   @routine    GRHydro_EoSChangeGammaK_Shibata
   @date       Jan. 2005
   @author     Christian D. Ott
   @desc 
   Reset the hydro variables when K and Gamma are changed.

   This is according to Shibata in astro-ph/0412243 (PRD71 024014) in
   which he switches K and Gamma after initial data setup,
   but keeps the internal energy constant.

   Note: this works only with one refinement level

   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_EoSChangeGammaK_Shibata(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  
  CCTK_REAL :: local_Gamma, local_k, eos_k_initial

  ! 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,xeps,xtemp,xye
  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

!!$  Set up the fluid constants
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
  
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       1.0d0,1.0d0,xtemp,xye,xpress,xeps,keyerr,anyerr)

  ! 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

  local_Gamma = 1.0d0 + xpress/xeps
  local_K    = xpress

  eos_k_initial = initial_k

  press = (local_Gamma - 1.d0) / (initial_Gamma - 1.0d0 ) * eos_k_initial * &
               rho ** initial_Gamma

  eps = eos_k_initial * & 
     rho ** initial_Gamma / &
     (rho * (initial_Gamma - 1.0d0))

  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        call prim2con(GRHydro_eos_handle,g11(i,j,k),g12(i,j,k),&
             g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdetg(i,j,k), dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),w_lorentz(i,j,k))

      end do
    end do
  end do


end subroutine GRHydro_EoSChangeGammaK_Shibata

```

GRHydro_Reconstruct_drv_impl.hh:
```
#ifndef _GRHYDRO_RECONSTRUCT_DRV_IMPL_H
#define _GRHYDRO_RECONSTRUCT_DRV_IMPL_H

#include <cmath>
#include <vector>
#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))

#include "SpaceMask.h"

#include "GRHydro_Reconstruct_drv_cxx.hh"

#define velx (&vup[0])
#define vely (&vup[N])
#define velz (&vup[2*N])

#define Bvecx (&Bprim[0])
#define Bvecy (&Bprim[N])
#define Bvecz (&Bprim[2*N])


using namespace std;

extern "C" CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

/// transform back to vel if Wv was used
template <int dir>
static inline void undo_Wv(const int nx,
                   CCTK_REAL* const velxminus,
                   CCTK_REAL* const velyminus,
                   CCTK_REAL* const velzminus,
                   CCTK_REAL* const velxplus,
                   CCTK_REAL* const velyplus,
                   CCTK_REAL* const velzplus,
                   const CCTK_REAL* const gxx,
                   const CCTK_REAL* const gxy,
                   const CCTK_REAL* const gxz,
                   const CCTK_REAL* const gyy,
                   const CCTK_REAL* const gyz,
                   const CCTK_REAL* const gzz,
                   const cGH* const cctkGH,
                   const int j, const int k)
{
   DECLARE_CCTK_PARAMETERS;

   // TODO: check index bounds!!
   for (int i = GRHydro_stencil-1; i < nx - GRHydro_stencil+1; ++i) {
   
      const int ijk = dir == 0 ? CCTK_GFINDEX3D(cctkGH, i, j, k) : dir == 1 ? CCTK_GFINDEX3D(cctkGH, j, i, k) : CCTK_GFINDEX3D(cctkGH, j, k, i);
   
      // 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)
      {
      const int ijk_m = 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 agxx = 0.5*( gxx[ijk] + gxx[ijk_m] );
      const CCTK_REAL agxy = 0.5*( gxy[ijk] + gxy[ijk_m] );
      const CCTK_REAL agxz = 0.5*( gxz[ijk] + gxz[ijk_m] );
      const CCTK_REAL agyy = 0.5*( gyy[ijk] + gyy[ijk_m] );
      const CCTK_REAL agyz = 0.5*( gyz[ijk] + gyz[ijk_m] );
      const CCTK_REAL agzz = 0.5*( gzz[ijk] + gzz[ijk_m] );
      const CCTK_REAL w = sqrt( 1.0 + agxx*velxminus[ijk]*velxminus[ijk] +
                                      agyy*velyminus[ijk]*velyminus[ijk] +
                                      agzz*velzminus[ijk]*velzminus[ijk] +
                                  2.0*agxy*velxminus[ijk]*velyminus[ijk] +
                                  2.0*agxz*velxminus[ijk]*velzminus[ijk] +
                                  2.0*agyz*velyminus[ijk]*velzminus[ijk] );
      velxminus[ijk] = velxminus[ijk]/w;
      velyminus[ijk] = velyminus[ijk]/w;
      velzminus[ijk] = velzminus[ijk]/w;
      }

      {
      const int ijk_p = 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 agxx = 0.5*( gxx[ijk] + gxx[ijk_p] );
      const CCTK_REAL agxy = 0.5*( gxy[ijk] + gxy[ijk_p] );
      const CCTK_REAL agxz = 0.5*( gxz[ijk] + gxz[ijk_p] );
      const CCTK_REAL agyy = 0.5*( gyy[ijk] + gyy[ijk_p] );
      const CCTK_REAL agyz = 0.5*( gyz[ijk] + gyz[ijk_p] );
      const CCTK_REAL agzz = 0.5*( gzz[ijk] + gzz[ijk_p] );
      const CCTK_REAL w = sqrt( 1.0 + agxx*velxplus[ijk]*velxplus[ijk] +
                                      agyy*velyplus[ijk]*velyplus[ijk] +
                                      agzz*velzplus[ijk]*velzplus[ijk] +
                                  2.0*agxy*velxplus[ijk]*velyplus[ijk] +
                                  2.0*agxz*velxplus[ijk]*velzplus[ijk] +
                                  2.0*agyz*velyplus[ijk]*velzplus[ijk] );
     velxplus[ijk] = velxplus[ijk]/w;
     velyplus[ijk] = velyplus[ijk]/w;
     velzplus[ijk] = velzplus[ijk]/w;
     }
   }
}


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

// TODO: remove all templatization from this reoutine since they are only used
// in the 2d loops and bloat the source code by a factor of 12
// TODO: measure if 1d slicing slows things down since this would buy a factor
// of 3 in source code size again
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)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  const CCTK_REAL * restrict vup;
  const CCTK_REAL * restrict Bprim;
  const CCTK_REAL * restrict g11;
  const CCTK_REAL * restrict g12;
  const CCTK_REAL * restrict g13;
  const CCTK_REAL * restrict g22;
  const CCTK_REAL * restrict g23;
  const CCTK_REAL * restrict g33;

  //Multipatch related pointers
  if(GRHydro_UseGeneralCoordinates(cctkGH)) {
    vup=lvel;
    g11=gaa; g12=gab; g13=gac;
    g22=gbb; g23=gbc;
    g33=gcc;
    Bprim=lBvec;
  } else {
    vup=vel;
    g11=gxx; g12=gxy; g13=gxz;
    g22=gyy; g23=gyz;
    g33=gzz;
    Bprim=Bvec;
  }

  const int nx=cctk_lsh[0];
  const int ny=cctk_lsh[1];
  const int nz=cctk_lsh[2];

  const int N = nx*ny*nz;

  int type_bitsx,type_bitsy,type_bitsz;
  // UNUSED:   int trivialx,trivialy,trivialz;
  int not_trivialx,not_trivialy,not_trivialz;

  type_bitsx = SpaceMask_GetTypeBits("Hydro_RiemannProblemX");
  //  trivialx = SpaceMask_GetStateBits("Hydro_RiemannProblemX","trivial");
  not_trivialx = SpaceMask_GetStateBits("Hydro_RiemannProblemX","not_trivial");

  type_bitsy = SpaceMask_GetTypeBits("Hydro_RiemannProblemY");
  //  trivialy = SpaceMask_GetStateBits("Hydro_RiemannProblemY","trivial");
  not_trivialy = SpaceMask_GetStateBits("Hydro_RiemannProblemY","not_trivial");

  type_bitsz = SpaceMask_GetTypeBits("Hydro_RiemannProblemZ");
  //  trivialz = SpaceMask_GetStateBits("Hydro_RiemannProblemZ","trivial");
  not_trivialz = SpaceMask_GetStateBits("Hydro_RiemannProblemZ","not_trivial");
  
  
  vector<CCTK_REAL> Wvx(0);
  vector<CCTK_REAL> Wvy(0);
  vector<CCTK_REAL> Wvz(0);
  // allocate temp memory for Wv reconstruction
  // TODO: measure impact of C++ intializing the vector to zero and write
  // custom wrapper around new/delete if required
  // template<class T> class pod_vector {
  //   pod_vector() {data = NULL;};
  //   ~pod_vecotr() {delete[] data;};
  //   T& operator[](size_t i) {return data[i];};
  //   void allocate(size_t sz) {data = new T[sz];};
  // private:
  //   pod_vector(const pod_vector&);
  //   pod_vector& operator=(const pod_vector&);
  // };
  if (do_reconstruct_Wv) {
     Wvx.resize(N, 0);
     Wvy.resize(N, 0);
     Wvz.resize(N, 0);
     #pragma omp parallel for
     for (int i=0; i < N; ++i) {
        Wvx[i] = w_lorentz[i]*velx[i];
        Wvy[i] = w_lorentz[i]*vely[i];
        Wvz[i] = w_lorentz[i]*velz[i];
     }
  }

// Reconstruction starts:
  if (flux_direction[0] == 1) {
    #pragma omp parallel for
    for(int k = GRHydro_stencil-1; k < nz - GRHydro_stencil+1+transport_constraints; ++k) {
      for(int j = GRHydro_stencil-1; j < ny - GRHydro_stencil+1+transport_constraints; ++j) {

        RECONSTRUCT::template apply<0>(nx, rho, rhominus, rhoplus, cctkGH, j, k);
        RECONSTRUCT::template apply<0>(nx, eps, epsminus, epsplus, cctkGH, j, k);

        if (do_reconstruct_Wv) {
           RECONSTRUCT::template apply<0>(nx, &Wvx[0], velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, &Wvy[0], velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, &Wvz[0], velzminus, velzplus, cctkGH, j, k);
           undo_Wv<0>(nx, velxminus, velyminus, velzminus,
                          velxplus, velyplus, velzplus,
                          g11, g12, g13, g22, g23, g33,
                          cctkGH, j, k);
        } else {
           RECONSTRUCT::template apply<0>(nx, velx, velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, vely, velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, velz, velzminus, velzplus, cctkGH, j, k);
        }
        
        if (do_Ye)
           RECONSTRUCT::template apply<0>(nx, Y_e, Y_e_minus, Y_e_plus, cctkGH, j, k);
        if (do_temp)
           RECONSTRUCT::template apply<0>(nx, temperature, tempminus, tempplus, cctkGH, j, k);
        if (do_mhd) {
           RECONSTRUCT::template apply<0>(nx, Bvecx, Bvecxminus, Bvecxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, Bvecy, Bvecyminus, Bvecyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<0>(nx, Bvecz, Bveczminus, Bveczplus, cctkGH, j, k);
           if (do_clean_divergence)
              RECONSTRUCT::template apply<0>(nx, psidc, psidcminus, psidcplus, cctkGH, j, k);
        }

        for (int i=0; i<nx; ++i) {
          SpaceMask_SetStateBits(space_mask, i+j*nx+k*nx*ny, type_bitsx, not_trivialx);
        }
      }
    }  

  } else if (flux_direction[0]==2) {
    //Make sure to doublecheck the bounds here!
    #pragma omp parallel for
    for(int k = GRHydro_stencil-1; k < nz - GRHydro_stencil+1+transport_constraints; ++k) {
      for(int j = GRHydro_stencil-1; j < nx - GRHydro_stencil+1+transport_constraints; ++j) {
        
        RECONSTRUCT::template apply<1>(ny, rho, rhominus, rhoplus, cctkGH, j, k);
        RECONSTRUCT::template apply<1>(ny, eps, epsminus, epsplus, cctkGH, j, k);

        if (do_reconstruct_Wv) {
           RECONSTRUCT::template apply<1>(ny, &Wvx[0], velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, &Wvy[0], velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, &Wvz[0], velzminus, velzplus, cctkGH, j, k);
           undo_Wv<1>(ny, velyminus, velzminus, velxminus,
                          velyplus, velzplus, velxplus,
                          g22, g23, g12, g33, g13, g11,
                          cctkGH, j, k);
        } else {
           RECONSTRUCT::template apply<1>(ny, velx, velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, vely, velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, velz, velzminus, velzplus, cctkGH, j, k);
        }
        
        if (do_Ye)
           RECONSTRUCT::template apply<1>(ny, Y_e, Y_e_minus, Y_e_plus, cctkGH, j, k);
        if (do_temp)
           RECONSTRUCT::template apply<1>(ny, temperature, tempminus, tempplus, cctkGH, j, k);
        if (do_mhd) {
           RECONSTRUCT::template apply<1>(ny, Bvecx, Bvecxminus, Bvecxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, Bvecy, Bvecyminus, Bvecyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<1>(ny, Bvecz, Bveczminus, Bveczplus, cctkGH, j, k);
           if (do_clean_divergence)
              RECONSTRUCT::template apply<1>(ny, psidc, psidcminus, psidcplus, cctkGH, j, k);
        }

        for (int i=0; i<ny; ++i) {
          SpaceMask_SetStateBits(space_mask, j+i*nx+k*nx*ny, type_bitsy, not_trivialy);
        }
        
      }
    }
    
  } else if (flux_direction[0]==3) {
    //Make sure to doublecheck the bounds here!
    #pragma omp parallel for
    for(int k = GRHydro_stencil-1; k < ny - GRHydro_stencil+1+transport_constraints; ++k) {
      for(int j = GRHydro_stencil-1; j < nx - GRHydro_stencil+1+transport_constraints; ++j) {
        
        RECONSTRUCT::template apply<2>(nz, rho, rhominus, rhoplus, cctkGH, j, k);
        RECONSTRUCT::template apply<2>(nz, eps, epsminus, epsplus, cctkGH, j, k);

        if (do_reconstruct_Wv) {
           RECONSTRUCT::template apply<2>(nz, &Wvx[0], velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, &Wvy[0], velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, &Wvz[0], velzminus, velzplus, cctkGH, j, k);
           undo_Wv<2>(nz, velzminus, velxminus, velyminus,
                          velzplus, velxplus, velyplus,
                          g33, g13, g23, g11, g12, g22,
                          cctkGH, j, k);
        } else {
           RECONSTRUCT::template apply<2>(nz, velx, velxminus, velxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, vely, velyminus, velyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, velz, velzminus, velzplus, cctkGH, j, k);
        }
        
        if (do_Ye)
           RECONSTRUCT::template apply<2>(nz, Y_e, Y_e_minus, Y_e_plus, cctkGH, j, k);
        if (do_temp)
           RECONSTRUCT::template apply<2>(nz, temperature, tempminus, tempplus, cctkGH, j, k);
        if (do_mhd) {
           RECONSTRUCT::template apply<2>(nz, Bvecx, Bvecxminus, Bvecxplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, Bvecy, Bvecyminus, Bvecyplus, cctkGH, j, k);
           RECONSTRUCT::template apply<2>(nz, Bvecz, Bveczminus, Bveczplus, cctkGH, j, k);
           if (do_clean_divergence)
              RECONSTRUCT::template apply<2>(nz, psidc, psidcminus, psidcplus, cctkGH, j, k);
        }
        
        for (int i=0; i<nz; ++i) {
          SpaceMask_SetStateBits(space_mask, j+k*nx+i*nx*ny, type_bitsz, not_trivialz);
        }
        
      }
    }
    
  }
}

#endif // _GRHYDRO_RECONSTRUCT_DRV_IMPL_H

```

GRHydro_Con2PrimM.F90:
```
/*@@
   @file      GRHydro_Con2PrimM.F90
   @date      Sep 3, 2010
   @author    Scott Noble, Joshua Faber, Bruno Mundim
   @desc 
   The routines for converting conservative to primitive variables.
   @enddesc 
 @@*/

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

#define ITER_TOL (1.0e-8)
#define MAXITER (50)

 /*@@
   @routine    Conservative2PrimitiveM
   @date       Sep 3, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Conservative2PrimitiveM(CCTK_ARGUMENTS)

  use Con2PrimM_fortran_interfaces

  implicit none
  TARGET gaa, gab, gac, gbb, gbc, gcc
  TARGET gxx, gxy, gxz, gyy, gyz, gzz
  TARGET lvel, vel
  TARGET lBvec, Bvec

  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, sdet, pmin(1), epsmin(1)
  CCTK_REAL :: oob, b2, d2, s2, bscon, bxhat, byhat, bzhat, bhatscon
  CCTK_REAL :: Wm, Wm0, Wm_resid, Wmold
  CCTK_REAL :: s2m, s2m0, s2m_resid, s2mold, s2max, taum, dummy1, dummy2
  CCTK_INT :: niter
  CCTK_INT :: epsnegative
  character(len=100) warnline
  
  CCTK_REAL :: local_min_tracer, local_gam(1), local_pgam,local_K, sc
  CCTK_REAL :: local_perc_ptol

! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xtemp(1),xye(1),xeps(1),xrho(1),one(1)=1.0d0
! end EOS Omni vars                 

  ! 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
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup, Bprim
  pointer (pg11, g11), (pg12, g12), (pg13, g13), (pg22, g22), (pg23, g23), (pg33, g33)
  pointer (pvup, vup), (pBprim, Bprim)

  logical :: posdef

  CCTK_REAL :: g11c, g12c, g13c, g22c, g23c, g33c
  CCTK_REAL :: tmp1

  ! Save the primitive variables to temporary functions before calling the
  ! con2prim pointwise routines:
  CCTK_REAL :: rho_tmp, press_tmp, eps_tmp
  CCTK_REAL :: velx_tmp, vely_tmp, velz_tmp, w_lorentz_tmp
  CCTK_REAL :: Bvecx_tmp, Bvecy_tmp, Bvecz_tmp

  CCTK_REAL :: bdotv, magpress

  ! Assume 3-metric is positive definite. Check deep inside the horizon 
  ! if this is actually satisfied and if it is not then cast the metric 
  !as conformally flat only for con2prim inversion purposes.
  posdef = .true.  

  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) ; pBprim = loc(lBvec)
  else
    pg11 = loc(gxx) ; pg12 = loc(gxy) ; pg13 = loc(gxz)
    pg22 = loc(gyy) ; pg23 = loc(gyz) ; pg33 = loc(gzz)
    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 betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

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

  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

!  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)
  ! 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,pmin,keyerr,anyerr)
  call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,xeps,xtemp,xye,pmin,epsmin,keyerr,anyerr)

  call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
         one,one,xtemp,xye,local_gam,keyerr,anyerr)
  local_gam = local_gam+1.d0

  !$OMP PARALLEL DO PRIVATE(i,j,k,itracer,&
  !$OMP uxx, uxy, uxz, uyy, uyz, uzz, epsnegative, &
  !$OMP b2,xrho,xeps,xpress,xtemp,local_K,local_pgam,sc,keyerr,anyerr,keytemp, &
  !$OMP local_perc_ptol,posdef,g11c,g12c,g13c,g22c,g23c,g33c,tmp1, &
  !$OMP sdet,d2,s2,oob,bscon,bxhat,byhat,bzhat, &
  !$OMP bhatscon,Wm,Wm0,Wm_resid,Wmold,s2m,s2m0,s2m_resid,s2mold,s2max, &
  !$OMP taum,niter,rho_tmp,press_tmp,eps_tmp,velx_tmp,vely_tmp,velz_tmp, &
  !$OMP w_lorentz_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,bdotv,magpress, dummy1, dummy2)
  do k = 1, nz 
     do j = 1, ny 
        do i = 1, nx
           
           !do not compute if in atmosphere region!
           if (atmosphere_mask(i,j,k) .gt. 0) cycle
           
           epsnegative = 0
           
           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))        
           
!!$ Tracers don't need an MHD treatment!
           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

           
           b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
           2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
           g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))

           
           if ( (GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .gt. 0)) .or. (dens(i,j,k) .le. sdet*GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance))) then
              
              !call CCTK_WARN(1,"Con2Prim: Resetting to atmosphere")
              !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),&
              !      temperature(i,j,k),y_e(i,j,k)
              !call CCTK_WARN(1,warnline)

              
              dens(i,j,k) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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
              
              Bprim(i,j,k,:) = 0.0d0
              Bcons(i,j,k,:) = 0.0d0
              b2 = 0
              
              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

              !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 does need to take into account the existing B-field
              !!$ with w_lorentz=1, we find tau = sqrtdet*(rho (1+eps+b^2/2)) - dens  [Press drops out]
              tau(i,j,k)  = sdet * (rho(i,j,k)*(1.0+eps(i,j,k)+b2/2.0)) - dens(i,j,k)
              
              if(tau(i,j,k).le.sdet*b2*0.5d0)then
                tau(i,j,k) = GRHydro_tau_min + sdet*b2*0.5d0
              endif

              cycle
              
           end if


           
           
           if(evolve_temper.eq.0) then
            

              if(sqrtdet_thr.gt.0d0 .and. sdet.ge.sqrtdet_thr) then
                    d2 = dens(i,j,k)**2
                    s2 = uxx*scon(i,j,k,1)**2 + uyy*scon(i,j,k,2)**2 &
                                              + uzz*scon(i,j,k,3)**2 &
                       + 2.0d0*uxy*scon(i,j,k,1)*scon(i,j,k,2) &
                       + 2.0d0*uxz*scon(i,j,k,1)*scon(i,j,k,3) &
                       + 2.0d0*uyz*scon(i,j,k,2)*scon(i,j,k,3) 
                   oob = 1.0d0/sqrt(b2)
                 bxhat = oob*Bprim(i,j,k,1)
                 byhat = oob*Bprim(i,j,k,2)
                 bzhat = oob*Bprim(i,j,k,3)
                 bhatscon = bxhat*scon(i,j,k,1)+byhat*scon(i,j,k,2) &
                                               +bzhat*scon(i,j,k,3)
                 bscon = Bprim(i,j,k,1)*scon(i,j,k,1) &
                       + Bprim(i,j,k,2)*scon(i,j,k,2) &
                       + Bprim(i,j,k,3)*scon(i,j,k,3)
                 ! Initial guesses for iterative procedure to find Wm:
                 Wm0 = sdet*sqrt(bhatscon**2+d2)
                 s2m0 = (Wm0**2*s2+bhatscon**2*(b2+2.0d0*Wm0)) &
                      / (Wm0+b2)**2 
                 Wm = sdet*sqrt(s2m0+d2)
                 s2m = (Wm**2*s2+bscon**2*(b2+2.0d0*Wm)) &
                     / (Wm+b2)**2 
                 s2m_resid = 1.0d60
                 Wm_resid = 1.0d60
                 niter = 0
                 do while((s2m_resid.ge.ITER_TOL.and.Wm_resid.ge.ITER_TOL).and.&
                          niter.le.MAXITER)
                   Wmold = Wm
                   s2mold = s2m
                   Wm = sdet*sqrt(s2m+d2)
                   s2m = (Wm**2*s2+bscon**2*(b2+2.0d0*Wm)) &
                       / (Wm+b2)**2 
                   Wm_resid = abs(Wmold-Wm)
                   s2m_resid = abs(s2mold-s2m)
                   niter = niter + 1
                 end do
                 !TODO: abort execution if niter .eq. MAXITER and warn user
                 taum = tau(i,j,k) - 0.5d0*sdet*b2 -0.5d0*(b2*s2-bscon**2)/ &
                                                         (sdet*(Wm+b2)**2) 
                 s2max = taum*(taum+2.0d0*dens(i,j,k))
                 if(taum.lt.GRHydro_tau_min)then
                   tau(i,j,k) = GRHydro_tau_min + 0.5d0*sdet*b2 + 0.5d0* &
                                (b2*s2-bscon**2)/(sdet*(Wm+b2)**2)
                 end if
                 if(s2.gt.s2max) then
                   scon(i,j,k,1) = scon(i,j,k,1)*sqrt(s2max/s2)
                   scon(i,j,k,2) = scon(i,j,k,2)*sqrt(s2max/s2)
                   scon(i,j,k,3) = scon(i,j,k,3)*sqrt(s2max/s2)
                 end if
              endif 

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)

              keytemp = 0
              !Watch out for the values returned to b2. Here b2 is the Bprim^2
              !while inside the point-wise con2prim routines it is the square
              !of the comoving B-field, b^{\mu} b_{\mu}. It is overwritten 
              !in this routine, but we may need to find a better notation 
              !avoid future confusions.
             if(GRHydro_eos_handle .eq. 1 .or. GRHydro_eos_handle .eq. 2) then
             
                call GRHydro_Con2PrimM_ptold(GRHydro_eos_handle, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),rho_tmp, & 
                   velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp, &
                   Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2, w_lorentz_tmp,&
                   g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
                   
             else
                call GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),xye(1), &
                   xtemp(1),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                   eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                   w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                   g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
             endif

              if(evolve_entropy.ne.0) then
                if(GRHydro_C2P_failed(i,j,k).ne.0) then
                  !Use previous time step for rho:
                  entropy(i,j,k) = entropycons(i,j,k)/dens(i,j,k)*rho(i,j,k)
                else
                  !Use the current correct value of rho returned by con2prim:
                  entropy(i,j,k) = entropycons(i,j,k)/dens(i,j,k)*rho_tmp
                endif
              endif

              if(GRHydro_C2P_failed(i,j,k).ne.0) then
                xrho=1.0d0; xtemp=0.0d0; xeps=1.0d0
                call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                     xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                local_K = xpress(1); 

                xrho=10.0d0; xeps=1.0d0
                call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                     xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                local_pgam=log(xpress(1)/local_K)/log(xrho(1))
                sc = local_K*dens(i,j,k)

                if(sqrtdet_thr.gt.0d0 .and. sdet.ge.sqrtdet_thr) then
                  GRHydro_C2P_failed(i,j,k) = 0

                  rho_tmp = rho(i,j,k)
                  press_tmp = press(i,j,k)
                  eps_tmp = eps(i,j,k)
                  velx_tmp = vup(i,j,k,1)
                  vely_tmp = vup(i,j,k,2)
                  velz_tmp = vup(i,j,k,3)
                  w_lorentz_tmp = w_lorentz(i,j,k)
                  Bvecx_tmp = Bprim(i,j,k,1)
                  Bvecy_tmp = Bprim(i,j,k,2)
                  Bvecz_tmp = Bprim(i,j,k,3)

                  call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, &
                       dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                       Bcons(i,j,k,1), Bcons(i,j,k,2), Bcons(i,j,k,3),rho_tmp,&
                       velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                       Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                       g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                       uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                       epsnegative,GRHydro_C2P_failed(i,j,k))

                  if(GRHydro_C2P_failed(i,j,k).ne.0) then
                    GRHydro_C2P_failed(i,j,k) = 0
                    call prim2conM(GRHydro_eos_handle,g11(i,j,k),g12(i,j,k), &
                         g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),sdet, &
                       dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), &
                      tau(i,j,k),Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3), &
                          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), &
                  Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
                    cycle
                  end if
                end if

                bdotv=g11(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,1)+ &
                      g22(i,j,k)*Bprim(i,j,k,2)*vup(i,j,k,2)+ &
                      g33(i,j,k)*Bprim(i,j,k,3)*vup(i,j,k,3)+ &
                 2.0*(g12(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,2)+ &
                      g13(i,j,k)*Bprim(i,j,k,1)*vup(i,j,k,3)+ &
                      g23(i,j,k)*Bprim(i,j,k,2)*vup(i,j,k,3))

                magpress = 0.5d0*(b2/w_lorentz(i,j,k)**2+bdotv**2)

                if(rho(i,j,k)*eps(i,j,k)*max_magnetic_to_gas_pressure_ratio.le.magpress) then
                  GRHydro_C2P_failed(i,j,k) = 0

                  if(evolve_entropy.ne.0) then
                    local_K = entropycons(i,j,k)/dens(i,j,k) 
                    xrho=10.0d0; xeps=1.0d0
                    call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                         xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
                    local_pgam=log(xpress(1)/local_K)/log(xrho(1))
                    sc = local_K*dens(i,j,k)
                  end if

                  rho_tmp = rho(i,j,k)
                  press_tmp = press(i,j,k)
                  eps_tmp = eps(i,j,k)
                  velx_tmp = vup(i,j,k,1)
                  vely_tmp = vup(i,j,k,2)
                  velz_tmp = vup(i,j,k,3)
                  w_lorentz_tmp = w_lorentz(i,j,k)
                  Bvecx_tmp = Bprim(i,j,k,1)
                  Bvecy_tmp = Bprim(i,j,k,2)
                  Bvecz_tmp = Bprim(i,j,k,3)

                  if(evolve_entropy.ne.0) then
                    call GRHydro_Con2PrimM_ptee(GRHydro_eos_handle, keytemp, &
                         GRHydro_eos_rf_prec, local_gam(1), dens(i,j,k), &
                         scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                         Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3), &
                         entropycons(i,j,k), xye(1), &
                         xtemp(1),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                         eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                         w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                         g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                         uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                         epsnegative,GRHydro_C2P_failed(i,j,k))
                  else
                    call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, &
                         dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                         Bcons(i,j,k,1), Bcons(i,j,k,2), Bcons(i,j,k,3),rho_tmp,&
                         velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                         Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                         g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                         uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                         epsnegative,GRHydro_C2P_failed(i,j,k))
                  end if 

                  rho(i,j,k) = rho_tmp 
                  press(i,j,k) = press_tmp 
                  eps(i,j,k) = eps_tmp 
                  vup(i,j,k,1) = velx_tmp 
                  vup(i,j,k,2) = vely_tmp 
                  vup(i,j,k,3) = velz_tmp 
                  w_lorentz(i,j,k) = w_lorentz_tmp 
                  Bprim(i,j,k,1) = Bvecx_tmp 
                  Bprim(i,j,k,2) = Bvecy_tmp 
                  Bprim(i,j,k,3) = Bvecz_tmp 
                  cycle
                end if
              end if

           else    ! if(evolve_temper.eq.0) then

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)

              keytemp = 0 

              call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, GRHydro_reflevel, int(i,ik), int(j,ik), int(k,ik), x(i,j,k), y(i,j,k), z(i,j,k), keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                   Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3), Y_e(i,j,k), &
                   temperature(i,j,k),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                   eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                   w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                   g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
              if(GRHydro_C2P_failed(i,j,k).ne.0) 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
                local_perc_ptol = GRHydro_eos_rf_prec*100.0d0
                ! Use the previous primitive values as initial guesses
                rho_tmp = rho(i,j,k)
                press_tmp = press(i,j,k)
                eps_tmp = eps(i,j,k)
                velx_tmp = vup(i,j,k,1)
                vely_tmp = vup(i,j,k,2)
                velz_tmp = vup(i,j,k,3)
                w_lorentz_tmp = w_lorentz(i,j,k)
                Bvecx_tmp = Bprim(i,j,k,1)
                Bvecy_tmp = Bprim(i,j,k,2)
                Bvecz_tmp = Bprim(i,j,k,3)
              call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, GRHydro_reflevel, int(i,ik), int(j,ik), int(k,ik), x(i,j,k), y(i,j,k), z(i,j,k), keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), dens(i,j,k), &
                     scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), &
                     Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3), Y_e(i,j,k), &
                     temperature(i,j,k),rho_tmp,velx_tmp,vely_tmp,velz_tmp,&
                     eps_tmp,press_tmp,Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,&
                     w_lorentz_tmp,g11(i,j,k),g12(i,j,k),g13(i,j,k),&
                     g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                     uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                     epsnegative,GRHydro_C2P_failed(i,j,k))
                if(GRHydro_C2P_failed(i,j,k).ne.0) then
                  !$OMP CRITICAL
                  if (GRHydro_reflevel.ge.GRHydro_c2p_warn_from_reflevel) then
                     call CCTK_WARN(1,"Convergence problem in c2p")
                     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),&
                          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
           endif    ! if(evolve_temper.eq.0) then

           
           if (epsnegative .ne. 0) 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) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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)

              b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
                   2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
                   g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))
              
              
              ! w_lorentz=1, so the expression for tau reduces to [see above]:
              tau(i,j,k)  = sdet * (rho(i,j,k)*(1.0+eps(i,j,k)+b2/2.0)) - 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
              
              xrho=1.0d0; xtemp=0.0d0; xeps=1.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1); 

              xrho=10.0d0; xeps=1.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,xeps,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              sc = local_K*dens(i,j,k)

              rho_tmp = rho(i,j,k)
              press_tmp = press(i,j,k)
              eps_tmp = eps(i,j,k)
              velx_tmp = vup(i,j,k,1)
              vely_tmp = vup(i,j,k,2)
              velz_tmp = vup(i,j,k,3)
              w_lorentz_tmp = w_lorentz(i,j,k)
              Bvecx_tmp = Bprim(i,j,k,1)
              Bvecy_tmp = Bprim(i,j,k,2)
              Bvecz_tmp = Bprim(i,j,k,3)

            call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                   Bcons(i,j,k,1), Bcons(i,j,k,2), Bcons(i,j,k,3),rho_tmp,&
                   velx_tmp,vely_tmp,velz_tmp,eps_tmp,press_tmp,&
                   Bvecx_tmp,Bvecy_tmp,Bvecz_tmp,b2,w_lorentz_tmp,&
                   g11(i,j,k),g12(i,j,k),g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))

#endif          
              
           end if    ! if (epsnegative .ne. 0) then  

           rho(i,j,k) = rho_tmp 
           press(i,j,k) = press_tmp 
           eps(i,j,k) = eps_tmp 
           vup(i,j,k,1) = velx_tmp 
           vup(i,j,k,2) = vely_tmp 
           vup(i,j,k,3) = velz_tmp 
           w_lorentz(i,j,k) = w_lorentz_tmp 
           Bprim(i,j,k,1) = Bvecx_tmp 
           Bprim(i,j,k,2) = Bvecy_tmp 
           Bprim(i,j,k,3) = Bvecz_tmp 
          
           if ( rho(i,j,k) .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance)) then
!           if ( rho(i,j,k) .le. GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) .or. GRHydro_C2P_failed(i,j,k) .ge. 1) then
               
              b2=g11(i,j,k)*Bprim(i,j,k,1)**2+g22(i,j,k)*Bprim(i,j,k,2)**2+g33(i,j,k)*Bprim(i,j,k,3)**2+ &
                   2.0*(g12(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,2)+g13(i,j,k)*Bprim(i,j,k,1)*Bprim(i,j,k,3)+ &
                   g23(i,j,k)*Bprim(i,j,k,2)*Bprim(i,j,k,3))
              
              dens(i,j,k) = sdet*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance)
              rho(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 does need to take into account the existing B-field
              !!$ with w_lorentz=1, we find tau = sqrtdet*(rho (1+eps+b^2/2)) - dens  [Press drops out]
              tau(i,j,k)  = sdet * (rho(i,j,k)*eps(i,j,k)+b2/2.0)

           end if

        end do
     end do
  end do
  !$OMP END PARALLEL DO
  
  return
#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 Conservative2PrimitiveM


 /*@@
   @routine    Conservative2PrimitiveBoundariesM
   @date       Sep 15, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Conservative2PrimitiveBoundsM(CCTK_ARGUMENTS)
  
  use Con2PrimM_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, pmin(1), epsmin(1)
  CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  CCTK_REAL :: b2minus, b2plus, local_gam(1), local_pgam,local_K,scminus,scplus
  CCTK_INT :: epsnegative
  character(len=100) warnline
 
  CCTK_REAL :: local_min_tracer

! begin EOS Omni vars                                            
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress(1),xtemp(1),xye(1),xeps(1),xrho(1),one(1)=1.0d0
! end EOS Omni vars                       

  ! 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
#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

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

  ! this is a poly call
  xrho(1)=GRHydro_rho_min 
  call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
       xrho,one,xtemp,xye,pmin,keyerr,anyerr)

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

  call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
         one,one,xtemp,xye,local_gam,keyerr,anyerr)
  local_gam=local_gam+1.0

  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 = 0
           
           avg_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
           avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
           call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl*avg_sdetl,&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
           call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr*avg_sdetr,&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        
           
!!$ Tracers get no update for MHD!
           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 GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), densminus(i,j,k), &
                sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), tauminus(i,j,k), &
                Bconsxminus(i,j,k), Bconsyminus(i,j,k), Bconszminus(i,j,k),  xye(1), xtemp(1), rhominus(i,j,k),&
                velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),&
                Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
           
           if (epsnegative .ne. 0) then
              !$OMP CRITICAL
              call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!')
              !$OMP END CRITICAL
              
              xrho=10.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   one,one,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1)

              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,one,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              scminus = local_K*densminus(i,j,k)

              call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, densminus(i,j,k), &
                   sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), scminus, &
                   Bconsxminus(i,j,k), Bconsyminus(i,j,k), Bconszminus(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),&
                   Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                   gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                   uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                   epsnegative,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 = 0

                call GRHydro_Con2PrimM_pt2(GRHydro_eos_handle, keytemp, GRHydro_eos_rf_prec, GRHydro_perc_ptol, local_gam(1), densplus(i,j,k), &
                sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), tauplus(i,j,k), &
                Bconsxplus(i,j,k), Bconsyplus(i,j,k), Bconszplus(i,j,k),  xye(1), xtemp(1), rhoplus(i,j,k),&
                velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),&
                Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k),b2plus, w_lorentzplus(i,j,k),&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
 
           if (epsnegative .ne. 0) then
              !$OMP CRITICAL
              call CCTK_WARN(GRHydro_NaN_verbose+2, 'Specific internal energy just went below 0, trying polytype!!')
              !$OMP END CRITICAL

              xrho=10.0d0
              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   one,one,xtemp,xye,xpress,keyerr,anyerr)
              local_K = xpress(1)

              call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   xrho,one,xtemp,xye,xpress,keyerr,anyerr)
              local_pgam=log(xpress(1)/local_K)/log(xrho(1))
              scplus = local_K*densplus(i,j,k)

              call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, densplus(i,j,k), &
                   sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), scplus,&
                   Bconsxplus(i,j,k), Bconsyplus(i,j,k), Bconszplus(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),&
                   Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k),b2plus, w_lorentzplus(i,j,k),&
                   gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                   uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                   epsnegative,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
  
#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 Conservative2PrimitiveBoundsM

/*@@
@routine    Con2PrimPolytypeM
@date       Sep 16, 2010
@author     SCott Noble, Joshua Faber, Bruno Mundim, Ian Hawke
@desc 
All routines below are identical to those above, just
specialised from polytropic type EOS.
@enddesc 
@calls     
@calledby   
@history 

@endhistory 

@@*/

subroutine Conservative2PrimitivePolytypeM(CCTK_ARGUMENTS)
  
  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, sdet,b2

  CCTK_INT :: epsnegative
  
  CCTK_REAL :: local_min_tracer, local_pgam,local_K, sc
  !  character(len=400) :: warnline
  
! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,xeps,xrho
! end EOS Omni vars                 

  ! 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
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup, Bprim
  pointer (pg11, g11), (pg12, g12), (pg13, g13), (pg22, g22), (pg23, g23), (pg33, g33)
  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)
    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)
    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 betax faulty_betax
#define betay faulty_betay
#define betaz faulty_betaz
#define vel faulty_vel
#define Bvec faulty_Bvec

! begin EOS Omni vars                                                                                       
  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                 
  
  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, sdet, epsnegative, &
  !$OMP b2, xrho, xpress, local_K, local_pgam, sc)
  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
           
           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))        

!!$ No MHD changes to tracers
           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
           
           xrho=10.0d0
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                1.d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_K = xpress
           
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                xrho,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_pgam=log(xpress/local_K)/log(xrho)
           sc = local_K*dens(i,j,k)
           
           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam, dens(i,j,k), &
                   scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), sc, &
                   Bcons(i,j,k,1), Bcons(i,j,k,2), Bcons(i,j,k,3), 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),&
                   Bprim(i,j,k,1), Bprim(i,j,k,2), Bprim(i,j,k,3),b2, w_lorentz(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), &
                   uxx,uxy,uxz,uyy,uyz,uzz,sdet, &
                   epsnegative,GRHydro_C2P_failed(i,j,k))
            
        end do
     end do
  end do
  
  !$OMP END PARALLEL DO
  
  return

#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 Conservative2PrimitivePolytypeM


 /*@@
   @routine    Cons2PrimBoundsPolytypeM
   @date       Sep 16, 2010
   @author     Scott Noble, Joshua Faber, Bruno Mundim, 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 Con2PrimBoundsPolytypeM(CCTK_ARGUMENTS)
  
  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_sdetl,&
       gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_sdetr
  CCTK_REAL :: b2minus, b2plus
  CCTK_INT :: epsnegative

  CCTK_REAL :: local_pgam,local_K,scplus,scminus

! begin EOS Omni vars                                                                                       
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xtemp,xye,xeps,xrho
! end EOS Omni vars                       

  ! 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
#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

! begin EOS Omni vars                                            
  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                 
  
  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_sdetl = sqrt(SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl))
           avg_sdetr = sqrt(SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr))
           call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl*avg_sdetl,&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl)        
           call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr*avg_sdetr,&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr)        

           xrho=10.0d0
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                1.d0,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_K = xpress
           
           call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                xrho,1.0d0,xtemp,xye,xpress,keyerr,anyerr)
           local_pgam=log(xpress/local_K)/log(xrho)
           scminus = local_K*densminus(i,j,k)
           scplus = local_K*densplus(i,j,k)
           
           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam,densminus(i,j,k), &
                sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), scminus,&
                Bconsxminus(i,j,k), Bconsyminus(i,j,k), Bconszminus(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),&
                Bvecxminus(i,j,k), Bvecyminus(i,j,k), Bveczminus(i,j,k),b2minus, w_lorentzminus(i,j,k),&
                gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, &
                uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_sdetl, &
                epsnegative,GRHydro_C2P_failed(i,j,k))

           call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, local_pgam,densplus(i,j,k), &
                sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), scplus,&
                Bconsxplus(i,j,k), Bconsyplus(i,j,k), Bconszplus(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),&
                Bvecxplus(i,j,k), Bvecyplus(i,j,k),Bveczplus(i,j,k),b2plus,w_lorentzplus(i,j,k),&
                gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, &
                uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_sdetr, &
                epsnegative,GRHydro_C2P_failed(i,j,k))
        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 Con2PrimBoundsPolytypeM

!!$ Con2Prim_ptTracer, Con2Prim_BoundsTracer, and Con2Prim_ptBoundsTracer need not be rewritten!


```

GRHydro_Prim2ConM.F90:
```
  /*@@
   @file      primitive2conservative
   @date      Aug 31, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Primitive to conservative routine
   @enddesc 
 @@*/

#include "cctk.h"
#include "cctk_Arguments.h"
#include "cctk_Parameters.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 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) 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 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)

#define DOT(x1,y1,z1,x2,y2,z2)   ( DOTP(gxx,gxy,gxz,gyy,gyz,gzz,x1,y1,z1,x2,y2,z2) )
#define DOT2(x1,y1,z1)           ( DOTP2(gxx,gxy,gxz,gyy,gyz,gzz,x1,y1,z1) )
#define DOTPT(x1,y1,z1,x2,y2,z2) ( DOTP(gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt,x1,y1,z1,x2,y2,z2) )
#define DOTPT2(x1,y1,z1)         ( DOTP2(gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt,x1,y1,z1) )

 /*@@
   @routine   primitive2conservativeM
   @date      Aug 31
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts primitive to conserved variables for the boundary extended data.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine primitive2conservativeM(CCTK_ARGUMENTS)

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

  integer :: i, j, k
  CCTK_REAL :: g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
       g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr
  CCTK_REAL :: xtemp(1)
  character(len=256) NaN_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)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: Bprim
  pointer (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)
    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)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  
  ! constraint transport needs to be able to average fluxes in the directions
  ! other that flux_direction, which in turn need the primitives on interfaces

  if(evolve_temper.ne.1) then

  !$OMP PARALLEL DO PRIVATE(k,j,i,avg_sdetl,avg_sdetr,&
  !$OMP                      g11l,g12l,g13l,g22l,g23l,g33l,&
  !$OMP                      g11r,g12r,g13r,g22r,g23r,g33r)
  do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
    do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
      do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
        
        g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))

        call prim2conM(GRHydro_eos_handle, g11l,g12l,g13l,g22l,g23l,g33l, &
             avg_sdetl,densminus(i,j,k),sxminus(i,j,k),&
             syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),&
             Bconsxminus(i,j,k),Bconsyminus(i,j,k),Bconszminus(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),Bvecxminus(i,j,k), &
             Bvecyminus(i,j,k), Bveczminus(i,j,k), w_lorentzminus(i, j, k))
 
        call prim2conM(GRHydro_eos_handle, g11r,g12r,g13r,g22r,g23r,g33r, &
             avg_sdetr, densplus(i,j,k),sxplus(i,j,k),&
             syplus(i,j,k),szplus(i,j ,k),tauplus(i,j,k),&
             Bconsxplus(i,j,k),Bconsyplus(i,j,k),Bconszplus(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),&
             Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k), &
             w_lorentzplus(i,j,k)) 

        if(evolve_entropy.ne.0) then
          entropyconsminus(i,j,k) = avg_sdetl*entropyminus(i,j,k)*w_lorentzminus(i,j,k)
          entropyconsplus(i,j,k) = avg_sdetr*entropyplus(i,j,k)*w_lorentzplus(i,j,k)
        end if

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

  else

     !$OMP PARALLEL DO PRIVATE(i, j, k, avg_sdetl, avg_sdetr, xtemp,&
     !$OMP                      g11l,g12l,g13l,g22l,g23l,g33l, &
     !$OMP                      g11r,g12r,g13r,g22r,g23r,g33r)
     do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
       do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
         do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
              
              g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
              g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
              g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
              g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
              g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
              g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
              g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
              g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
              g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
              g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
              g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
              g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))
              
              avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l,g23l,g33l))
              avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r,g23r,g33r))

              if (y_e_minus(i,j,k) .le. 0.0d0 .or. y_e_plus(i,j,k) .le. 0.0d0) then
              !$OMP CRITICAL
                  write(NaN_WarnLine,'(a100,7g15.6)') '(y_e_minus,y_e_plus,x,y,z,rho)', y_e(i,j,k), y_e_minus(i,j,k), y_e_plus(i,j,k), x(i,j,k),y(i,j,k),z(i,j,k),rho(i,j,k)
                  call CCTK_WARN(1, NaN_WarnLine)
              !$OMP END CRITICAL
              endif 
              call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                   int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k), g11l,g12l,g13l,g22l,g23l,g33l, &
                   avg_sdetl,densminus(i,j,k),sxminus(i,j,k),&
                   syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),&
                   Bconsxminus(i,j,k),Bconsyminus(i,j,k),Bconszminus(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),Bvecxminus(i,j,k), &
                   Bvecyminus(i,j,k), Bveczminus(i,j,k), w_lorentzminus(i, j, k), tempminus(i,j,k), y_e_minus(i,j,k))
  
              call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                   int(i,ik),int(j,ik),int(k,ik),x(i,j,k),y(i,j,k),z(i,j,k), g11r,g12r,g13r,g22r,g23r,g33r, &
                   avg_sdetr, densplus(i,j,k),sxplus(i,j,k),&
                   syplus(i,j,k),szplus(i,j,k),tauplus(i,j,k),&
                   Bconsxplus(i,j,k),Bconsyplus(i,j,k),Bconszplus(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),&
                   Bvecxplus(i,j,k), Bvecyplus(i,j,k), Bveczplus(i,j,k), &
                   w_lorentzplus(i,j,k), tempplus(i,j,k), y_e_plus(i,j,k)) 
             
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  endif

end subroutine primitive2conservativeM

 /*@@
   @routine    prim2conM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2conM_hot(handle, GRHydro_reflevel, ii, jj, kk, &
     x, y, z, gxx, gxy, gxz, gyy, gyz, gzz, sdet, ddens, &
     dsx, dsy, dsz, dtau , dBconsx, dBconsy, dBconsz, drho, &
     dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, w, temp, ye) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL, dimension(1) :: ddens, dsx, dsy, dsz, dtau, &
       dBconsx, dBconsy, dBconsz, &
       drho, dvelx, dvely, dvelz,&
       deps, dpress, dBvcx, dBvcy, dBvcz, vlowx, vlowy, vlowz   
  CCTK_REAL :: temp(1),ye(1), yein(1), x, y, z
  CCTK_INT :: handle, GRHydro_reflevel, ii, jj, kk
  CCTK_REAL :: w
  CCTK_REAL, dimension(1) :: Bdotv,ab0,b2,blowx,blowy,blowz
  character(len=256) NaN_WarnLine
  character(len=512) warnline

! begin EOS Omni vars
  CCTK_INT  :: n, keytemp, anyerr, keyerr(1)
 ! CCTK_REAL :: xpress(1),xeps(1),xtemp(1),xye(1)
  CCTK_REAL :: temp0(1)
  n = 1; keytemp = reconstruct_temper; anyerr = 0; keyerr(1) = 0
  !xpress = 0.0d0; xeps = 0.0d0; xtemp = 0.0d0; xye = 0.0d0
! end EOS Omni vars
  
  temp0 = temp
  w = 1.d0 / sqrt(1.d0 - DOT2(dvelx(1),dvely(1),dvelz(1)))

!!$ BEGIN: Check for NaN value
  if (w .ne. w) then
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a100,6g15.6)') 'NaN produced in sqrt(): (gxx,gxy,gxz,gyy,gyz,gzz)', gxx, gxy, gxz, gyy, gyz, gzz
    call CCTK_WARN(1, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (dvelx,dvely,dvelz)', dvelx, dvely, dvelz
    call CCTK_WARN(1, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (x,y,z)', x, y, z
    call CCTK_WARN(1, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,g15.6)') 'NaN produced in sqrt(): v2', DOT2(dvelx(1),dvely(1),dvelz(1))
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
  endif
!!$ END: Check for NaN value

  ye = max(min(ye,GRHydro_Y_e_max),GRHydro_Y_e_min)
 
  yein = ye 
 
  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,temp,ye,dpress,keyerr,anyerr)  
  ! error handling
  if(anyerr.ne.0) then
     if(GRHydro_reflevel.lt.GRHydro_c2p_warn_from_reflevel) then
        ! in this case (coarse grid error that is hopefully restricted
        ! away), we use the average temperature between cells and call
        ! the EOS with keytemp=1
        keytemp=1-reconstruct_temper
        temp = temp0
        call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
             drho,deps,temp,ye,dpress,keyerr,anyerr)  
        keytemp=reconstruct_temper
     else
        ! This is a way of recovering even on finer refinement levels:
        ! Use the average temperature at the interface instead of the
        ! reconstructed specific internal energy.
        keytemp=1-reconstruct_temper
        temp = temp0
        call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
             drho,deps,temp,ye,dpress,keyerr,anyerr)  
        keytemp=reconstruct_temper
        if(anyerr.ne.0) then
           !$OMP CRITICAL
           call CCTK_WARN(1,"EOS error in prim2con_hot")
           write(warnline,"(3i5,1P10E15.6)") ii,jj,kk,x,y,z
           call CCTK_WARN(1,warnline)
           write(warnline,"(1P10E15.6)") drho,deps,temp,ye
           call CCTK_WARN(1,warnline)
           write(warnline,"(A7,i8)") "code: ",keyerr(1)
           call CCTK_WARN(1,warnline)
           write(warnline,"(A10,i5)") "reflevel: ", GRHydro_reflevel
           call CCTK_WARN(1,warnline)
           call CCTK_ERROR("Aborting!!!")
           STOP
           !$OMP END CRITICAL
        endif
     endif
  endif

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 

  dBconsx = sdet*dBvcx
  dBconsy = sdet*dBvcy
  dBconsz = sdet*dBvcz

  !!$OMP CRITICAL
  !write(NaN_WarnLine,'(a100,3g15.6)') '(dens out, sqrt(det), w:)', ddens,sqrt(det),w
  !call CCTK_WARN(1, NaN_WarnLine)
  !!$OMP END CRITICAL
end subroutine prim2conM_hot


subroutine prim2conM(handle, gxx, gxy, gxz, gyy, gyz, gzz, sdet, ddens, &
     dsx, dsy, dsz, dtau , dBconsx, dBconsy, dBconsz, drho, &
     dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, w) 
  
  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL, dimension(1) :: ddens, dsx, dsy, dsz, dtau, &
       dBconsx, dBconsy, dBconsz, &
       drho, dvelx, dvely, dvelz,&
       deps, dpress, dBvcx, dBvcy, dBvcz, vlowx, vlowy, vlowz   
  CCTK_REAL :: w
  CCTK_REAL, dimension(1) :: Bdotv,ab0,b2,blowx,blowy,blowz
  CCTK_INT :: handle
  character(len=256) NaN_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
  
  w = 1.d0 / sqrt(1.d0 - DOT2(dvelx(1),dvely(1),dvelz(1)))

!!$ BEGIN: Check for NaN value
  if (w .ne. w) then
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a100,6g15.6)') 'NaN produced in sqrt(): (gxx,gxy,gxz,gyy,gyz,gzz)', gxx, gxy, gxz, gyy, gyz, gzz
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    write(NaN_WarnLine,'(a100,3g15.6)') 'NaN produced in sqrt(): (dvelx,dvely,dvelz)', dvelx, dvely, dvelz
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
  endif
!!$ END: Check for NaN value

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,deps,xtemp,xye,dpress,keyerr,anyerr)  

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 

  dBconsx = sdet*dBvcx
  dBconsy = sdet*dBvcy
  dBconsz = sdet*dBvcz

end subroutine prim2conM


 /*@@
   @routine    Primitive2ConservativeCellsM
   @date       Aug 31, 2010
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine Primitive2ConservativeCellsM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  CCTK_REAL :: maxtau0
  ! 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)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: Bprim
  pointer (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)
    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)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  
  
  maxtau0 = -1.0d60
  
  if(evolve_temper.ne.1) then

  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet), REDUCTION(MAX:maxtau0)
  do k = 1,cctk_lsh(3)
    do j = 1,cctk_lsh(2)
      do i = 1,cctk_lsh(1)
        
         sdet = sdetg(i,j,k)

        call prim2conM(GRHydro_eos_handle,g11(i,j,k),&
             g12(i,j,k),g13(i,j,k),&
             g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),Bconsx(i,j,k),Bconsy(i,j,k),Bconsz(i,j,k),&
             rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),Bvecx(i,j,k), &
             Bvecy(i,j,k), Bvecz(i,j,k), w_lorentz(i,j,k))

        if(evolve_entropy.ne.0) then
          entropycons(i,j,k) = sdet*entropy(i,j,k)*w_lorentz(i,j,k)
        end if

        maxtau0 = max(maxtau0,tau(i,j,k))

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

  ! TODO: to actually reduce GRHydro_tau_min over all Carpet components
  ! we need to modify Carpet looping to allow this function to be called
  ! on all AMR levels before calling any other function. The best would be
  ! to set a special bin where functions would be called on all levels first
  ! instead of calling all functions per level. The workaround for this problem
  ! is to set GRHydro_tau_min to a user specified value as it was set in 
  ! GRHydro_Minima.F90. Once this issue is solved, then uncomment the line
  ! below and create two other routines to be run in global mode so that 
  ! GRHydro_tau_min can be properly initialized and reduced.

  !GRHydro_tau_min = GRHydro_tau_min * maxtau0 

  else 
  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet)
  do k = 1,cctk_lsh(3)
    do j = 1,cctk_lsh(2)
      do i = 1,cctk_lsh(1)
        
         sdet = sdetg(i,j,k)

         call prim2conM_hot(GRHydro_eos_handle,GRHydro_reflevel,&
              i,j,k,x(i,j,k),y(i,j,k),z(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),&
              sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
              tau(i,j,k),Bconsx(i,j,k),Bconsy(i,j,k),Bconsz(i,j,k),&
              rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
              eps(i,j,k),press(i,j,k),Bvecx(i,j,k), &
              Bvecy(i,j,k), Bvecz(i,j,k), w_lorentz(i,j,k), temperature(i,j,k), Y_e(i,j,k))

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

  if(evolve_Y_e.ne.0) then
     !$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)
                Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif



end subroutine Primitive2ConservativeCellsM


 /*@@
   @routine    Prim2ConservativePolytypeM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   Same as first routine, only for polytropes.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Prim2ConservativePolytypeM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  integer :: i, j, k
  CCTK_REAL :: g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
       g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr
  ! 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)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: Bprim
  pointer (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)
    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)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  
  
  ! 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, g11l,g12l,g13l,g22l,g23l,g33l,avg_sdetl,&
  !$OMP g11r,g12r,g13r,g22r,g23r,g33r,avg_sdetr)
  do k = GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil+1 + transport_constraints*(1-zoffset)
    do j = GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil+1 + transport_constraints*(1-yoffset)
      do i = GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil+1 + transport_constraints*(1-xoffset)
        
        g11l = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
        g12l = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
        g13l = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
        g22l = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
        g23l = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
        g33l = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
        g11r = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
        g12r = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
        g13r = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
        g22r = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
        g23r = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
        g33r = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))

        avg_sdetl = sqrt(SPATIAL_DETERMINANT(g11l,g12l,g13l,g22l, g23l,g33l))
        avg_sdetr = sqrt(SPATIAL_DETERMINANT(g11r,g12r,g13r,g22r, g23r,g33r))

        call prim2conpolytypeM(GRHydro_eos_handle, g11l,g12l,g13l,&
             g22l,g23l,g33l, &
             avg_sdetl,densminus(i,j,k),sxminus(i,j,k),&
             syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),&
             Bconsxminus(i,j,k),Bconsyminus(i,j,k),Bconszminus(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),Bvecxminus(i,j,k), &
             Bvecyminus(i,j,k),Bveczminus(i,j,k),w_lorentzminus(i, j, k))
 
        call prim2conpolytypeM(GRHydro_eos_handle, g11r,g12r,g13r,&
             g22r,g23r,g33r, &
             avg_sdetr,densplus(i,j,k),sxplus(i,j,k),&
             syplus(i,j,k),szplus(i,j,k),tauplus(i,j,k),&
             Bconsxplus(i,j,k),Bconsyplus(i,j,k),Bconszplus(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),Bvecxplus(i,j,k), &
             Bvecyplus(i,j,k),Bveczplus(i,j,k),w_lorentzplus(i, j, k))

        if (densminus(i,j,k) .ne. densminus(i,j,k)) then
        !$OMP CRITICAL
        call CCTK_WARN(1, "NaN in densminus(i,j,k) (Prim2Con)")
        !$OMP END CRITICAL
        endif
      end do
    end do
  end do
  !$OMP END PARALLEL DO
end subroutine Prim2ConservativePolytypeM

 /*@@
   @routine    prim2conpolytypeM
   @date       Aug 31, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   Converts from primitive to conservative at a single point
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine prim2conpolytypeM(handle, gxx, gxy, gxz, gyy, gyz, &
     gzz, sdet, ddens, dsx, dsy, dsz, dtau, dBconsx, dBconsy, dBconsz, &
     drho, dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, w) 
  
  implicit none
  
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, sdet
  CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, dBconsx, dBconsy, dBconsz, &
       drho, dvelx, dvely, dvelz, deps, dpress, dBvcx, dBvcy, dBvcz, &
       w_tmp, w, vlowx, vlowy, vlowz
  CCTK_INT :: handle
  CCTK_REAL :: Bdotv,ab0,b2,blowx,blowy,blowz
  character(len=256) NaN_WarnLine

! begin EOS Omni vars
  CCTK_INT  :: n, keytemp, anyerr, keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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
  
  w_tmp = DOT2(dvelx,dvely,dvelz)

  if (w_tmp .ge. 1.d0) then
    ! In theory this should not happen, and even when accepting the fact
    ! that numerically it can, one might be tempted to set w to some large
    ! value in that case. However, this would lead to completely bogus
    ! and hard to trace wrong values below. There is no good value to
    ! choose in this case, but something small is probably the best of
    ! all bad choices.
    !$OMP CRITICAL
    write(NaN_WarnLine,'(a80,2g15.6)') 'Infinite Lorentz factor reset. rho, w_tmp: ', drho, w_tmp
    call CCTK_WARN(GRHydro_NaN_verbose, NaN_WarnLine)
    !$OMP END CRITICAL
    w = 1.d-20
  else
    w = 1.d0 / sqrt(1.d0 - w_tmp)
  endif

  call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,keyerr,anyerr)

  call EOS_Omni_EpsFromPress(handle,keytemp,GRHydro_eos_rf_prec,n,&
       drho,xeps,xtemp,xye,dpress,deps,keyerr,anyerr)

  vlowx = gxx*dvelx + gxy*dvely + gxz*dvelz
  vlowy = gxy*dvelx + gyy*dvely + gyz*dvelz
  vlowz = gxz*dvelx + gyz*dvely + gzz*dvelz

  Bdotv=DOT(dvelx,dvely,dvelz,dBvcx,dBvcy,dBvcz)
  ab0=w*Bdotv
  b2 = DOT2(dBvcx,dBvcy,dBvcz)/w**2+Bdotv**2
  blowx = (gxx*dBvcx + gxy*dBvcy + gxz*dBvcz)/w + &
       w*Bdotv*vlowx
  blowy = (gxy*dBvcx + gyy*dBvcy + gyz*dBvcz)/w + &
       w*Bdotv*vlowy
  blowz = (gxz*dBvcx + gyz*dBvcy + gzz*dBvcz)/w + &
       w*Bdotv*vlowz

  ddens = sdet * drho * w 
  dsx = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - &
       ab0*blowx)
  dsy = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - &
       ab0*blowy)
  dsz = sdet * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - &
       ab0*blowz)
  dtau = sdet * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens 
  
  dBconsx = sdet*dBvcx
  dBconsy = sdet*dBvcy
  dBconsz = sdet*dBvcz

end subroutine prim2conpolytypeM


 /*@@
   @routine    Primitive2ConservativePolyCellsM
   @date       Aug 31, 2010
   @author     
   @desc 
   Wrapper function that converts primitive to conservative at the 
     cell centres. 
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine Primitive2ConservativePolyCellsM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  ! 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)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: Bprim
  pointer (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)
    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)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  
  !$OMP PARALLEL DO PRIVATE(k,j,i,sdet)
  do k = 1,cctk_lsh(3)
    do j = 1,cctk_lsh(2)
      do i = 1,cctk_lsh(1)
        
        sdet = sdetg(i,j,k)

        call prim2conpolytypeM(GRHydro_eos_handle,g11(i,j,k),g12(i,j,k),&
             g13(i,j,k),g22(i,j,k),g23(i,j,k),g33(i,j,k),&
             sdet, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),&
             tau(i,j,k),Bconsx(i,j,k),Bconsy(i,j,k),Bconsz(i,j,k),&
             rho(i,j,k),velx(i,j,k),vely(i,j,k),velz(i,j,k),&
             eps(i,j,k),press(i,j,k),Bvecx(i,j,k), Bvecy(i,j,k), &
             Bvecz(i,j,k), w_lorentz(i,j,k))

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

  if(evolve_Y_e.ne.0) 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
           do i = GRHydro_stencil,cctk_lsh(1)-GRHydro_stencil+1
              Y_e_con(i,j,k) = Y_e(i,j,k) * dens(i,j,k)
           enddo
        enddo
     enddo
     !$OMP END PARALLEL DO
  endif


end subroutine Primitive2ConservativePolyCellsM

!!$
!!$ Prim2Con doesn't change for tracers with the addition of a B-field!
!!$


```

GRHydro_Startup.F90:
```
 /*@@
   @file      GRHydro_Startup.F90
   @date      Sun Feb 10 00:02:52 2002
   @author    Ian Hawke
   @desc 
   Startup banner.
   @enddesc 
 @@*/

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

#include "util_ErrorCodes.h"
#include "util_Table.h"

 /*@@
   @routine    GRHydro_Startup
   @date       Sun Feb 10 00:03:09 2002
   @author     Ian Hawke
   @desc 
   Startup banner.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

integer function GRHydro_Startup()

  USE GRHydro_Scalars

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS
  
  CCTK_INT :: ierr

  call CCTK_RegisterBanner(ierr, "GRHydro: relativistic hydrodynamics, no ice.")
  
  GRHydro_Startup = 0

end function GRHydro_Startup

```

GRHydro_TrivialReconstruct.hh:
```
#ifndef _GRHYDRO_TRIVIALRECONSTRUCT_HH
#define _GRHYDRO_TRIVIALRECONSTRUCT_HH

#include "cctk.h"

/**
   Trivial first-order reconstruction operator.
*/
struct GRHydro_TrivialReconstruct1d {
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_TRIVIALRECONSTRUCT_HH

```

GRHydro_Reconstruct.F90:
```
 /*@@
   @file      GRHydro_Reconstruct.F90
   @date      Sat Jan 26 02:13:25 2002
   @author    Bruno Mundim, Josh Faber, Christian D. Ott
   @desc 
   Wrapper routine to perform the reconstruction.
   @enddesc 
 @@*/

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

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

subroutine Reconstruction(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT  :: i,j,k
  CCTK_REAL :: local_min_tracer, dummy1, dummy2
  CCTK_INT :: type_bits, not_trivial
  CCTK_REAL :: agxx, agxy, agxz, agyy, agyz, agzz, w

  ! 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)

  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
  
  ! 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)
           ! 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
    ! this handles MHD and non-MHD
    call GRHydro_TVDReconstruct_drv(CCTK_PASS_FTOF)

  else if (CCTK_EQUALS(recon_method,"ppm")) then

    if(use_optimized_ppm.eq.0) then
      if(evolve_mhd.ne.0) then
        call GRHydro_PPMMReconstruct_drv(CCTK_PASS_FTOF)
      else
        call GRHydro_PPMReconstruct_drv(CCTK_PASS_FTOF)
      end if 
    else 
      call GRHydro_PPMReconstruct_drv_opt(cctkGH)
    end if

  else if (CCTK_EQUALS(recon_method,"eno")) then
    ! this handles MHD and non-MHD
    call GRHydro_ENOReconstruct_drv(CCTK_PASS_FTOF)

  else if (CCTK_EQUALS(recon_method,"weno") .or. CCTK_EQUALS(recon_method,"weno-z")) then
    ! this handles MHD and non-MHD
    call GRHydro_WENOReconstruct_drv(CCTK_PASS_FTOF)
  
  else if (CCTK_EQUALS(recon_method,"mp5")) then
    ! this handles MHD and non-MHD
    call GRHydro_MP5Reconstruct_drv(CCTK_PASS_FTOF)
  
  else
    call CCTK_ERROR("Reconstruction method not recognized!")
    STOP
  
  end if

  if (evolve_tracer .ne. 0) then
    if (use_min_tracer .ne. 0) then
      local_min_tracer = min_tracer
    else
      local_min_tracer = 0.0d0
    end if
  else
    ! pacify compiler warning about unintialized local_min_tracer
    local_min_tracer = 1d42
  end if


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

  !$OMP PARALLEL DO PRIVATE(i,j,k, agxx, agxy, agxz, agyy, agyz, agzz, w, dummy1, dummy2)
  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
         SET_ATMO_MIN(dummy2, GRHydro_rho_min, r(i,j,k))
         if(rhoplus(i,j,k).lt.dummy2 .or. &
            rhominus(i,j,k).lt.dummy2) then
            !.or. epsplus(i,j,k) .lt. 0.0d0 .or. epsminus(i,j,k) .lt. 0.0d0) then
                 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)
                 if (reconstruct_Wv.ne.0) then
                    ! divide out the Loretnz factor 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)
                    velxplus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,1)
                    velyplus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,2)
                    velzplus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,3)
                    agxx = 0.5d0 * (g11(i,j,k) + g11(i+xoffset,j+yoffset,k+zoffset))
                    agxy = 0.5d0 * (g12(i,j,k) + g12(i+xoffset,j+yoffset,k+zoffset))
                    agxz = 0.5d0 * (g13(i,j,k) + g13(i+xoffset,j+yoffset,k+zoffset))
                    agyy = 0.5d0 * (g22(i,j,k) + g22(i+xoffset,j+yoffset,k+zoffset))
                    agyz = 0.5d0 * (g23(i,j,k) + g23(i+xoffset,j+yoffset,k+zoffset))
                    agzz = 0.5d0 * (g33(i,j,k) + g33(i+xoffset,j+yoffset,k+zoffset))
                    w = sqrt( 1.d0 + agxx*velxplus(i,j,k)*velxplus(i,j,k) &
                                   + agyy*velyplus(i,j,k)*velyplus(i,j,k) &
                                   + agzz*velzplus(i,j,k)*velzplus(i,j,k) &
                                   + 2.d0*agxy*velxplus(i,j,k)*velyplus(i,j,k) &
                                   + 2.d0*agxz*velxplus(i,j,k)*velzplus(i,j,k) &
                                   + 2.d0*agyz*velyplus(i,j,k)*velzplus(i,j,k) )
                    velxplus(i,j,k) = velxplus(i,j,k)/w
                    velyplus(i,j,k) = velyplus(i,j,k)/w
                    velzplus(i,j,k) = velzplus(i,j,k)/w
 
                    velxminus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,1)
                    velyminus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,2)
                    velzminus(i,j,k) = w_lorentz(i,j,k)*vup(i,j,k,3)
                    agxx = 0.5d0 * (g11(i,j,k) + g11(i-xoffset,j-yoffset,k-zoffset))
                    agxy = 0.5d0 * (g12(i,j,k) + g12(i-xoffset,j-yoffset,k-zoffset))
                    agxz = 0.5d0 * (g13(i,j,k) + g13(i-xoffset,j-yoffset,k-zoffset))
                    agyy = 0.5d0 * (g22(i,j,k) + g22(i-xoffset,j-yoffset,k-zoffset))
                    agyz = 0.5d0 * (g23(i,j,k) + g23(i-xoffset,j-yoffset,k-zoffset))
                    agzz = 0.5d0 * (g33(i,j,k) + g33(i-xoffset,j-yoffset,k-zoffset))
                    w = sqrt( 1.d0 + agxx*velxminus(i,j,k)*velxminus(i,j,k) &
                                   + agyy*velyminus(i,j,k)*velyminus(i,j,k) &
                                   + agzz*velzminus(i,j,k)*velzminus(i,j,k) &
                                   + 2.d0*agxy*velxminus(i,j,k)*velyminus(i,j,k) &
                                   + 2.d0*agxz*velxminus(i,j,k)*velzminus(i,j,k) &
                                   + 2.d0*agyz*velyminus(i,j,k)*velzminus(i,j,k) )
                    velxminus(i,j,k) = velxminus(i,j,k)/w
                    velyminus(i,j,k) = velyminus(i,j,k)/w
                    velzminus(i,j,k) = velzminus(i,j,k)/w
                 else
                    ! This is the standard way of doing it
                    velxplus(i,j,k) = vup(i,j,k,1)
                    velyplus(i,j,k) = vup(i,j,k,2)
                    velzplus(i,j,k) = vup(i,j,k,3)
                    velxminus(i,j,k) = vup(i,j,k,1)
                    velyminus(i,j,k) = vup(i,j,k,2)
                    velzminus(i,j,k) = vup(i,j,k,3)
                 endif
                 if(evolve_y_e.ne.0) then
                    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_tracer.ne.0) then
                    where(tracerplus(i,j,k,:).le.local_min_tracer .or. &
                         tracerminus(i,j,k,:).le.local_min_tracer)
                       tracerplus(i,j,k,:) = tracer(i,j,k,:)
                       tracerminus(i,j,k,:) = tracer(i,j,k,:)
                    end where
                 end if
              end if
              
              ! Check if epsilon became negative for ideal gas EOS.
              if (evolve_temper.eq.0) then
                 if (epsplus(i,j,k) .lt. 0.0d0) then
                    epsplus(i,j,k) = eps(i,j,k)
                 endif
                 if (epsminus(i,j,k) .lt. 0.0d0) then
                    epsminus(i,j,k) = eps(i,j,k)
                 endif
              endif
              
              ! Riemann problem might not be trivial anymore!!!!
              SpaceMask_SetStateBitsF90(space_mask, i-xoffset, j-yoffset, k-zoffset, type_bits, not_trivial)
              SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bits, not_trivial)
              
      enddo
    enddo
  enddo
  !$OMP END PARALLEL DO
  
  if (CCTK_EQUALS(recon_vars,"primitive").or.&
       CCTK_EQUALS(recon_method,"ppm")) then
     if(evolve_mhd.ne.0) then
        call primitive2conservativeM(CCTK_PASS_FTOF)
     else
        call GRHydro_Primitive2Conservative_CforF(cctkGH)
     endif
  else if (CCTK_EQUALS(recon_vars,"conservative")) then
     if(evolve_mhd.ne.0) then
        call Conservative2PrimitiveBoundsM(CCTK_PASS_FTOF)
     else
        call Conservative2PrimitiveBounds(CCTK_PASS_FTOF)
     endif
  else
    call CCTK_ERROR("Variable type to reconstruct not recognized.")
    STOP
  end if

  return

end subroutine Reconstruction



```

GRHydro_Flux.F90:
```
/*@@
@file      GRHydro_Flux.F90
@date      Sat Jan 26 01:36:57 2002
@author    Pedro Montero, Ian Hawke
@desc 
The routine to calculate the numerical flux function given a 
  specific state
  @enddesc 
  @@*/
  
#include "cctk.h"
#include "cctk_Parameters.h"
#include "cctk_Arguments.h"
 
 /*@@
   @routine    num_flux
   @date       Sat Jan 26 01:38:12 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   A general routine that works out the correct direction and returns
   the appropriate flux function
   @enddesc 
   @calls     
   @calledby   
   @history 
   Called from GR3D, original author Mark Miller.
   @endhistory 

@@*/
 
subroutine num_flux(xoffset,yoffset,zoffset,dens,sx,sy,sz,tau,&
     densf,sxf,syf,szf,tauf,velx,vely,velz,press,det,alp,beta)

  implicit none
  
  CCTK_REAL :: dens,sx,sy,sz,tau,velx,vely,velz,det
  CCTK_REAL :: densf,sxf,syf,szf,tauf
  CCTK_REAL :: alp,beta,press 
  integer :: xoffset,yoffset,zoffset

  densf = dens * ( (velx*xoffset + vely*yoffset + &
       velz*zoffset)  - beta / alp )
               
  sxf = sx * ( (velx*xoffset + vely*yoffset +&
       velz*zoffset)  - beta/alp) + &
       sqrt(det)*press*xoffset
               
  syf = sy * ( (velx*xoffset + vely*yoffset +&
       velz*zoffset)  - beta/alp) + &
       sqrt(det)*press*yoffset
              
  szf = sz * ( (velx*xoffset + vely*yoffset +&
       velz*zoffset)  - beta/alp ) + &
       sqrt(det)*press*zoffset
               
  tauf = tau * ( (velx*xoffset + vely*yoffset +&
       velz*zoffset)  - beta/alp ) + &
       sqrt(det)*press*(velx*xoffset +&
       vely*yoffset + velz*zoffset) 
 
end subroutine num_flux

 /*@@
   @routine    num_x_flux
   @date       Sat Jan 26 01:38:55 2002
   @author     Pedro Montero, Ian Hawke
   @desc 
   The numerical flux just along the x direction. Used for
   fluxes along the y,z direction by permuting the appropriate 
   arguments in the subroutine call.
   @enddesc 
   @calls     
   @calledby   
   @history 
   Culled and altered from GR3D, original author Mark Miller.
   @endhistory 

@@*/


subroutine num_x_flux(dens,sx,sy,sz,tau,&
     densf,sxf,syf,szf,tauf,vel,press,det,alp,beta)

  implicit none

  CCTK_REAL :: dens,sx,sy,sz,tau,vel,det
  CCTK_REAL :: densf,sxf,syf,szf,tauf
  CCTK_REAL :: alp,beta,press 
  CCTK_REAL :: velmbetainvalp,sqrtdetpress

  velmbetainvalp = vel - beta / alp
  sqrtdetpress = sqrt(det)*press
  densf = dens * ( velmbetainvalp )

  sxf = sx * velmbetainvalp + sqrtdetpress

  syf = sy * velmbetainvalp

  szf = sz * velmbetainvalp

  tauf = tau * velmbetainvalp + sqrtdetpress*vel
 
end subroutine num_x_flux













```

GRHydro_UpdateMaskM.F90:
```
 /*@@
   @file      GRHydro_UpdateMaskM.F90
   @date      Sep 2, 2010
   @author    
   @desc 
   Alter the update terms if inside the atmosphere or excision region
   @enddesc 
 @@*/

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

#include "GRHydro_Macros.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 velx_p(i,j,k) vup_p(i,j,k,1)
#define vely_p(i,j,k) vup_p(i,j,k,2)
#define velz_p(i,j,k) vup_p(i,j,k,3)
#define velx_p_p(i,j,k) vup_p_p(i,j,k,1)
#define vely_p_p(i,j,k) vup_p_p(i,j,k,2)
#define velz_p_p(i,j,k) vup_p_p(i,j,k,3)

!!$ We don't need to adapt GRHydroUpdateAtmosphereMask, GRHydro_SetupMask, or  
!!$ since we need to evolve Bvec in the atmosphere

!!$ In GRHydro_AtmosphereResetM, we just need to switch the P2C calls to MHD

 /*@@
   @routine    GRHydro_AtmosphereResetM
   @date       Sep 2, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   After MoL has evolved, if a point is supposed to be reset then do so.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_AtmosphereResetM(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet

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

  ! 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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)

! begin EOS Omni vars
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    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 vel faulty_vel
#define Bvec faulty_Bvec

  if (verbose.eq.1) call CCTK_INFO("Entering AtmosphereReset.")

!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
         
        if (atmosphere_mask(i, j, k) .ne. 0) then

          rho(i,j,k) = GRHydro_rho_min
          vup(i,j,k,1) = 0.0d0
          vup(i,j,k,2) = 0.0d0
          vup(i,j,k,3) = 0.0d0
          sdet = sdetg(i,j,k)

          Bprim(i,j,k,:) = 0.0d0
          
          if(evolve_temper.ne.0) then

             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)
             call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                  i,j,k,x(i,j,k),y(i,j,k),z(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),&
                  sdet, dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3),&
                  tau(i,j,k),Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                  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),Bprim(i,j,k,1), &
                  Bprim(i,j,k,2), Bprim(i,j,k,3), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)

          else

            call prim2conpolytypeM(GRHydro_polytrope_handle, &
                 g11(i,j,k), g12(i,j,k), g13(i,j,k), &
                 g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
                 dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), &
                 tau(i,j,k), Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                 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), &
                 Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
            if (wk_atmosphere .eq. 0) then
              atmosphere_mask(i, j, k) = 0
              atmosphere_mask_real(i, j, k) = 0
            end if

          end if
        endif

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

!!$  call GRHydro_BoundariesM(CCTK_PASS_FTOF)
#undef faulty_gxx
#undef faulty_gxy
#undef faulty_gxz
#undef faulty_gyy
#undef faulty_gyz
#undef faulty_gzz
#undef faulty_vel
#undef faulty_Bvec
  
end subroutine GRHydro_AtmosphereResetM

subroutine GRHydro_InitialAtmosphereResetM(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  CCTK_REAL :: rho_min

  CCTK_INT :: eos_handle


  ! 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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p, g12_p, g13_p, g22_p, &
                                          g23_p, g33_p
  pointer (pg11_p,g11_p), (pg12_p,g12_p), (pg13_p,g13_p), (pg22_p,g22_p), &
                                          (pg23_p,g23_p), (pg33_p,g33_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p, Bprim_p
  pointer (pvup_p,vup_p), (pBprim_p,Bprim_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p_p, g12_p_p, g13_p_p, g22_p_p, &
                                          g23_p_p, g33_p_p
  pointer (pg11_p_p,g11_p_p), (pg12_p_p,g12_p_p), (pg13_p_p,g13_p_p), (pg22_p_p,g22_p_p), &
                                          (pg23_p_p,g23_p_p), (pg33_p_p,g33_p_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p_p, Bprim_p_p
  pointer (pvup_p_p,vup_p_p), (pBprim_p_p,Bprim_p_p)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  if (timelevels .gt. 1) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p = loc(gaa_p)
      pg12_p = loc(gab_p)
      pg13_p = loc(gac_p)
      pg22_p = loc(gbb_p)
      pg23_p = loc(gbc_p)
      pg33_p = loc(gcc_p)
      pvup_p = loc(lvel_p)
      pBprim_p = loc(Bvec_p)
    else
      pg11_p = loc(gxx_p)
      pg12_p = loc(gxy_p)
      pg13_p = loc(gxz_p)
      pg22_p = loc(gyy_p)
      pg23_p = loc(gyz_p)
      pg33_p = loc(gzz_p)
      pvup_p = loc(vel_p)
      pBprim_p = loc(Bvec_p)
    end if
  end if 
  if (timelevels .gt. 2) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p_p = loc(gaa_p_p)
      pg12_p_p = loc(gab_p_p)
      pg13_p_p = loc(gac_p_p)
      pg22_p_p = loc(gbb_p_p)
      pg23_p_p = loc(gbc_p_p)
      pg33_p_p = loc(gcc_p_p)
      pvup_p_p = loc(lvel_p_p)
      pBprim_p_p = loc(lBvec_p_p)
    else
      pg11_p_p = loc(gxx_p_p)
      pg12_p_p = loc(gxy_p_p)
      pg13_p_p = loc(gxz_p_p)
      pg22_p_p = loc(gyy_p_p)
      pg23_p_p = loc(gyz_p_p)
      pg33_p_p = loc(gzz_p_p)
      pvup_p_p = loc(vel_p_p)
      pBprim_p_p = loc(Bvec_p_p)
    end if
  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 vel faulty_vel
#define Bvec faulty_Bvec
#define gxx_p faulty_gxx_p
#define gxy_p faulty_gxy_p
#define gxz_p faulty_gxz_p
#define gyy_p faulty_gyy_p
#define gyz_p faulty_gyz_p
#define gzz_p faulty_gzz_p
#define vel_p faulty_vel_p
#define Bvec_p faulty_Bvec_p
#define gxx_p_p faulty_gxx_p_p
#define gxy_p_p faulty_gxy_p_p
#define gxz_p_p faulty_gxz_p_p
#define gyy_p_p faulty_gyy_p_p
#define gyz_p_p faulty_gyz_p_p
#define gzz_p_p faulty_gzz_p_p
#define vel_p_p faulty_vel_p_p
#define Bvec_p_p faulty_Bvec_p_p


  eos_handle = GRHydro_polytrope_handle
  
  rho_min = GRHydro_rho_min
  if (initial_atmosphere_factor .gt. 0) then
    rho_min = rho_min * initial_atmosphere_factor
  endif
  
!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        if (rho(i,j,k) .le. rho_min .or. &
            (GRHydro_enable_internal_excision .ne. 0 .and. &
             hydro_excision_mask(i,j,k) .ne. 0) )  then
          rho(i,j,k) = rho_min
          vup(i,j,k,1) = 0.0d0
          vup(i,j,k,2) = 0.0d0
          vup(i,j,k,3) = 0.0d0

          sdet = sdetg(i,j,k)

          if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)
             call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                  i,j,k,x(i,j,k),y(i,j,k),z(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),&
                  sdet, dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3),&
                  tau(i,j,k),Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                  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),Bprim(i,j,k,1), &
                  Bprim(i,j,k,2), Bprim(i,j,k,3), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)

          else

          keytemp = 0
          call EOS_Omni_press(eos_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(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                 rho(i,j,k),xeps,xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)

          call prim2conpolytypeM(eos_handle, &
               g11(i,j,k), g12(i,j,k), g13(i,j,k), &
               g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
               dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), &
               tau(i,j,k), Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
               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), &
               Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
          end if
        end if
        if (timelevels .gt. 1) then
          if (rho_p(i,j,k) .le. rho_min) then
            rho_p(i,j,k) = rho_min
            vup_p(i,j,k,1) = 0.0d0
            vup_p(i,j,k,2) = 0.0d0
            vup_p(i,j,k,3) = 0.0d0

            sdet = sqrt(SPATIAL_DETERMINANT(g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), \
                 g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k)))

            if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
               temperature_p(i,j,k) = grhydro_hot_atmo_temp
               y_e_p(i,j,k) = grhydro_hot_atmo_Y_e
               keytemp = 1
               call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p(i,j,k),eps_p(i,j,k),temperature_p(i,j,k),y_e_p(i,j,k),&
                    press_p(i,j,k),keyerr,anyerr)
               call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                    i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),g11_p(i,j,k),&
                    g12_p(i,j,k),g13_p(i,j,k),g22_p(i,j,k),g23_p(i,j,k),g33_p(i,j,k),&
                    sdet, dens_p(i,j,k),scon_p(i,j,k,1),scon_p(i,j,k,2),scon_p(i,j,k,3),&
                    tau_p(i,j,k),Bcons_p(i,j,k,1),Bcons_p(i,j,k,2),Bcons_p(i,j,k,3),&
                    rho_p(i,j,k),vup_p(i,j,k,1),vup_p(i,j,k,2),vup_p(i,j,k,3),&
                    eps_p(i,j,k),press_p(i,j,k),Bprim_p(i,j,k,1), &
                    Bprim_p(i,j,k,2), Bprim_p(i,j,k,3), w_lorentz_p(i,j,k),&
                    temperature_p(i,j,k),y_e_p(i,j,k))
               y_e_con_p(i,j,k) = dens_p(i,j,k) * y_e_p(i,j,k)

            else

            keytemp = 0
            call EOS_Omni_press(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p(i,j,k),eps_p(i,j,k),xtemp,xye,press_p(i,j,k),keyerr,anyerr)
            call EOS_Omni_EpsFromPress(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p(i,j,k),xeps,xtemp,xye,press_p(i,j,k),eps_p(i,j,k),keyerr,anyerr)

            call prim2conpolytypeM(eos_handle, &
                 g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), &
                 g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k), sdet, &
                 dens_p(i,j,k), scon_p(i,j,k,1), scon_p(i,j,k,2), scon_p(i,j,k,3), &
                 tau_p(i,j,k), Bcons_p(i,j,k,1),Bcons_p(i,j,k,2),Bcons_p(i,j,k,3),&
                 rho_p(i,j,k), vup_p(i,j,k,1), vup_p(i,j,k,2), &
                 vup_p(i,j,k,3), eps_p(i,j,k), press_p(i,j,k), &
                 Bprim_p(i,j,k,1),Bprim_p(i,j,k,2),Bprim_p(i,j,k,3),w_lorentz_p(i,j,k))
            end if
          end if
        end if

        if (timelevels .gt. 2) then
          if (rho_p_p(i,j,k) .le. rho_min) then
            rho_p_p(i,j,k) = rho_min
            vup_p_p(i,j,k,1) = 0.0d0
            vup_p_p(i,j,k,2) = 0.0d0
            vup_p_p(i,j,k,3) = 0.0d0

            sdet = sqrt(SPATIAL_DETERMINANT(g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), \
                 g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k)))

            if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
               temperature_p_p(i,j,k) = grhydro_hot_atmo_temp
               y_e_p_p(i,j,k) = grhydro_hot_atmo_Y_e
               keytemp = 1
               call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p_p(i,j,k),eps_p_p(i,j,k),temperature_p_p(i,j,k),y_e_p_p(i,j,k),&
                    press_p_p(i,j,k),keyerr,anyerr)
               call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                    i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),g11_p_p(i,j,k),&
                    g12_p_p(i,j,k),g13_p_p(i,j,k),g22_p_p(i,j,k),g23_p_p(i,j,k),g33_p_p(i,j,k),&
                    sdet, dens_p_p(i,j,k),scon_p_p(i,j,k,1),scon_p_p(i,j,k,2),scon_p_p(i,j,k,3),&
                    tau_p_p(i,j,k),Bcons_p_p(i,j,k,1),Bcons_p_p(i,j,k,2),Bcons_p_p(i,j,k,3),&
                    rho_p_p(i,j,k),vup_p_p(i,j,k,1),vup_p_p(i,j,k,2),vup_p_p(i,j,k,3),&
                    eps_p_p(i,j,k),press_p_p(i,j,k),Bprim_p_p(i,j,k,1), &
                    Bprim_p_p(i,j,k,2), Bprim_p_p(i,j,k,3), w_lorentz_p_p(i,j,k),&
                    temperature_p_p(i,j,k),y_e_p_p(i,j,k))
               y_e_con_p_p(i,j,k) = dens_p_p(i,j,k) * y_e_p_p(i,j,k)

            else

            keytemp = 0
            call EOS_Omni_press(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p_p(i,j,k),eps_p_p(i,j,k),xtemp,xye,press_p_p(i,j,k),keyerr,anyerr)
            call EOS_Omni_EpsFromPress(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p_p(i,j,k),xeps,xtemp,xye,press_p_p(i,j,k),eps_p_p(i,j,k),keyerr,anyerr)

            call prim2conpolytypeM(eos_handle, &
                 g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), &
                 g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k), sdet, &
                 dens_p_p(i,j,k), scon_p_p(i,j,k,1), scon_p_p(i,j,k,2), scon_p_p(i,j,k,3), &
                 tau_p_p(i,j,k), Bcons_p_p(i,j,k,1),Bcons_p_p(i,j,k,2),Bcons_p_p(i,j,k,3),&
                 rho_p_p(i,j,k), vup_p_p(i,j,k,1), vup_p_p(i,j,k,2), &
                 vup_p_p(i,j,k,3), eps_p_p(i,j,k), press_p_p(i,j,k), &
                 Bprim_p_p(i,j,k,1),Bprim_p_p(i,j,k,2),Bprim_p_p(i,j,k,3),w_lorentz_p_p(i,j,k))
            end if
          end if
        end if

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

  write(*,*) "     GRHydro_InitialAtmosphereReset"
!!$  call GRHydro_BoundariesM(CCTK_PASS_FTOF)
#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 GRHydro_InitialAtmosphereResetM


 /*@@
   @routine    GRHydro_AtmosphereResetAM
   @date       Sep 2, 2010
   @author     Tanja Bode, Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   After MoL has evolved, if a point is supposed to be reset then do so.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_AtmosphereResetAM(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet

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

  ! 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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)

! begin EOS Omni vars
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    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 vel faulty_vel
#define Bvec faulty_Bvec

  if (verbose.eq.1) call CCTK_INFO("Entering AtmosphereReset.")

!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
         
        if (atmosphere_mask(i, j, k) .ne. 0) then

          rho(i,j,k) = GRHydro_rho_min
          vup(i,j,k,1) = 0.0d0
          vup(i,j,k,2) = 0.0d0
          vup(i,j,k,3) = 0.0d0
          sdet = sdetg(i,j,k)

          if(evolve_temper.ne.0) then

             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)
             call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                  i,j,k,x(i,j,k),y(i,j,k),z(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),&
                  sdet, dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3),&
                  tau(i,j,k),Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                  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),Bprim(i,j,k,1), &
                  Bprim(i,j,k,2), Bprim(i,j,k,3), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)

          else

            call prim2conpolytypeM(GRHydro_polytrope_handle, &
                 g11(i,j,k), g12(i,j,k), g13(i,j,k), &
                 g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
                 dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), &
                 tau(i,j,k), Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                 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), &
                 Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
            if (wk_atmosphere .eq. 0) then
              atmosphere_mask(i, j, k) = 0
              atmosphere_mask_real(i, j, k) = 0
            end if

          end if
        endif

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

!!$  call GRHydro_BoundariesM(CCTK_PASS_FTOF)
#undef faulty_gxx
#undef faulty_gxy
#undef faulty_gxz
#undef faulty_gyy
#undef faulty_gyz
#undef faulty_gzz
#undef faulty_vel
#undef faulty_Bvec
  
end subroutine GRHydro_AtmosphereResetAM

subroutine GRHydro_InitialAtmosphereResetAM(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  CCTK_REAL :: rho_min

  CCTK_INT :: eos_handle


  ! 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, Bprim
  pointer (pvup,vup), (pBprim,Bprim)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p, g12_p, g13_p, g22_p, &
                                          g23_p, g33_p
  pointer (pg11_p,g11_p), (pg12_p,g12_p), (pg13_p,g13_p), (pg22_p,g22_p), &
                                          (pg23_p,g23_p), (pg33_p,g33_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p, Bprim_p
  pointer (pvup_p,vup_p), (pBprim_p,Bprim_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p_p, g12_p_p, g13_p_p, g22_p_p, &
                                          g23_p_p, g33_p_p
  pointer (pg11_p_p,g11_p_p), (pg12_p_p,g12_p_p), (pg13_p_p,g13_p_p), (pg22_p_p,g22_p_p), &
                                          (pg23_p_p,g23_p_p), (pg33_p_p,g33_p_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p_p, Bprim_p_p
  pointer (pvup_p_p,vup_p_p), (pBprim_p_p,Bprim_p_p)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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)
    pBprim = loc(lBvec)
  else
    pg11 = loc(gxx)
    pg12 = loc(gxy)
    pg13 = loc(gxz)
    pg22 = loc(gyy)
    pg23 = loc(gyz)
    pg33 = loc(gzz)
    pvup = loc(vel)
    pBprim = loc(Bvec)
  end if
  if (timelevels .gt. 1) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p = loc(gaa_p)
      pg12_p = loc(gab_p)
      pg13_p = loc(gac_p)
      pg22_p = loc(gbb_p)
      pg23_p = loc(gbc_p)
      pg33_p = loc(gcc_p)
      pvup_p = loc(lvel_p)
      pBprim_p = loc(Bvec_p)
    else
      pg11_p = loc(gxx_p)
      pg12_p = loc(gxy_p)
      pg13_p = loc(gxz_p)
      pg22_p = loc(gyy_p)
      pg23_p = loc(gyz_p)
      pg33_p = loc(gzz_p)
      pvup_p = loc(vel_p)
      pBprim_p = loc(Bvec_p)
    end if
  end if 
  if (timelevels .gt. 2) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p_p = loc(gaa_p_p)
      pg12_p_p = loc(gab_p_p)
      pg13_p_p = loc(gac_p_p)
      pg22_p_p = loc(gbb_p_p)
      pg23_p_p = loc(gbc_p_p)
      pg33_p_p = loc(gcc_p_p)
      pvup_p_p = loc(lvel_p_p)
      pBprim_p_p = loc(lBvec_p_p)
    else
      pg11_p_p = loc(gxx_p_p)
      pg12_p_p = loc(gxy_p_p)
      pg13_p_p = loc(gxz_p_p)
      pg22_p_p = loc(gyy_p_p)
      pg23_p_p = loc(gyz_p_p)
      pg33_p_p = loc(gzz_p_p)
      pvup_p_p = loc(vel_p_p)
      pBprim_p_p = loc(Bvec_p_p)
    end if
  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 vel faulty_vel
#define Bvec faulty_Bvec
#define gxx_p faulty_gxx_p
#define gxy_p faulty_gxy_p
#define gxz_p faulty_gxz_p
#define gyy_p faulty_gyy_p
#define gyz_p faulty_gyz_p
#define gzz_p faulty_gzz_p
#define vel_p faulty_vel_p
#define Bvec_p faulty_Bvec_p
#define gxx_p_p faulty_gxx_p_p
#define gxy_p_p faulty_gxy_p_p
#define gxz_p_p faulty_gxz_p_p
#define gyy_p_p faulty_gyy_p_p
#define gyz_p_p faulty_gyz_p_p
#define gzz_p_p faulty_gzz_p_p
#define vel_p_p faulty_vel_p_p
#define Bvec_p_p faulty_Bvec_p_p


  eos_handle = GRHydro_polytrope_handle
  
  rho_min = GRHydro_rho_min
  if (initial_atmosphere_factor .gt. 0) then
    rho_min = rho_min * initial_atmosphere_factor
  endif
  
!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        if (rho(i,j,k) .le. rho_min .or. &
            (GRHydro_enable_internal_excision .ne. 0 .and. &
             hydro_excision_mask(i,j,k) .ne. 0) )  then
          rho(i,j,k) = rho_min
          vup(i,j,k,1) = 0.0d0
          vup(i,j,k,2) = 0.0d0
          vup(i,j,k,3) = 0.0d0

          sdet = sdetg(i,j,k)

          if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)
             call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                  i,j,k,x(i,j,k),y(i,j,k),z(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),&
                  sdet, dens(i,j,k),scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3),&
                  tau(i,j,k),Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
                  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),Bprim(i,j,k,1), &
                  Bprim(i,j,k,2), Bprim(i,j,k,3), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)

          else

          keytemp = 0
          call EOS_Omni_press(eos_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(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                 rho(i,j,k),xeps,xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)

          call prim2conpolytypeM(eos_handle, &
               g11(i,j,k), g12(i,j,k), g13(i,j,k), &
               g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
               dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), &
               tau(i,j,k), Bcons(i,j,k,1),Bcons(i,j,k,2),Bcons(i,j,k,3),&
               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), &
               Bprim(i,j,k,1),Bprim(i,j,k,2),Bprim(i,j,k,3),w_lorentz(i,j,k))
          end if
        end if
        if (timelevels .gt. 1) then
          if (rho_p(i,j,k) .le. rho_min) then
            rho_p(i,j,k) = rho_min
            vup_p(i,j,k,1) = 0.0d0
            vup_p(i,j,k,2) = 0.0d0
            vup_p(i,j,k,3) = 0.0d0

            sdet = sqrt(SPATIAL_DETERMINANT(g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), \
                 g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k)))

            if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
               temperature_p(i,j,k) = grhydro_hot_atmo_temp
               y_e_p(i,j,k) = grhydro_hot_atmo_Y_e
               keytemp = 1
               call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p(i,j,k),eps_p(i,j,k),temperature_p(i,j,k),y_e_p(i,j,k),&
                    press_p(i,j,k),keyerr,anyerr)
               call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                    i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),g11_p(i,j,k),&
                    g12_p(i,j,k),g13_p(i,j,k),g22_p(i,j,k),g23_p(i,j,k),g33_p(i,j,k),&
                    sdet, dens_p(i,j,k),scon_p(i,j,k,1),scon_p(i,j,k,2),scon_p(i,j,k,3),&
                    tau_p(i,j,k),Bcons_p(i,j,k,1),Bcons_p(i,j,k,2),Bcons_p(i,j,k,3),&
                    rho_p(i,j,k),vup_p(i,j,k,1),vup_p(i,j,k,2),vup_p(i,j,k,3),&
                    eps_p(i,j,k),press_p(i,j,k),Bprim_p(i,j,k,1), &
                    Bprim_p(i,j,k,2), Bprim_p(i,j,k,3), w_lorentz_p(i,j,k),&
                    temperature_p(i,j,k),y_e_p(i,j,k))
               y_e_con_p(i,j,k) = dens_p(i,j,k) * y_e_p(i,j,k)

            else

            keytemp = 0
            call EOS_Omni_press(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p(i,j,k),eps_p(i,j,k),xtemp,xye,press_p(i,j,k),keyerr,anyerr)
            call EOS_Omni_EpsFromPress(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p(i,j,k),xeps,xtemp,xye,press_p(i,j,k),eps_p(i,j,k),keyerr,anyerr)

            call prim2conpolytypeM(eos_handle, &
                 g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), &
                 g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k), sdet, &
                 dens_p(i,j,k), scon_p(i,j,k,1), scon_p(i,j,k,2), scon_p(i,j,k,3), &
                 tau_p(i,j,k), Bcons_p(i,j,k,1),Bcons_p(i,j,k,2),Bcons_p(i,j,k,3),&
                 rho_p(i,j,k), vup_p(i,j,k,1), vup_p(i,j,k,2), &
                 vup_p(i,j,k,3), eps_p(i,j,k), press_p(i,j,k), &
                 Bprim_p(i,j,k,1),Bprim_p(i,j,k,2),Bprim_p(i,j,k,3),w_lorentz_p(i,j,k))
            end if
          end if
        end if

        if (timelevels .gt. 2) then
          if (rho_p_p(i,j,k) .le. rho_min) then
            rho_p_p(i,j,k) = rho_min
            vup_p_p(i,j,k,1) = 0.0d0
            vup_p_p(i,j,k,2) = 0.0d0
            vup_p_p(i,j,k,3) = 0.0d0

            sdet = sqrt(SPATIAL_DETERMINANT(g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), \
                 g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k)))

            if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
               temperature_p_p(i,j,k) = grhydro_hot_atmo_temp
               y_e_p_p(i,j,k) = grhydro_hot_atmo_Y_e
               keytemp = 1
               call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p_p(i,j,k),eps_p_p(i,j,k),temperature_p_p(i,j,k),y_e_p_p(i,j,k),&
                    press_p_p(i,j,k),keyerr,anyerr)
               call prim2conM_hot(GRHydro_eos_handle, GRHydro_reflevel,&
                    i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),g11_p_p(i,j,k),&
                    g12_p_p(i,j,k),g13_p_p(i,j,k),g22_p_p(i,j,k),g23_p_p(i,j,k),g33_p_p(i,j,k),&
                    sdet, dens_p_p(i,j,k),scon_p_p(i,j,k,1),scon_p_p(i,j,k,2),scon_p_p(i,j,k,3),&
                    tau_p_p(i,j,k),Bcons_p_p(i,j,k,1),Bcons_p_p(i,j,k,2),Bcons_p_p(i,j,k,3),&
                    rho_p_p(i,j,k),vup_p_p(i,j,k,1),vup_p_p(i,j,k,2),vup_p_p(i,j,k,3),&
                    eps_p_p(i,j,k),press_p_p(i,j,k),Bprim_p_p(i,j,k,1), &
                    Bprim_p_p(i,j,k,2), Bprim_p_p(i,j,k,3), w_lorentz_p_p(i,j,k),&
                    temperature_p_p(i,j,k),y_e_p_p(i,j,k))
               y_e_con_p_p(i,j,k) = dens_p_p(i,j,k) * y_e_p_p(i,j,k)

            else

            keytemp = 0
            call EOS_Omni_press(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p_p(i,j,k),eps_p_p(i,j,k),xtemp,xye,press_p_p(i,j,k),keyerr,anyerr)
            call EOS_Omni_EpsFromPress(eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                   rho_p_p(i,j,k),xeps,xtemp,xye,press_p_p(i,j,k),eps_p_p(i,j,k),keyerr,anyerr)

            call prim2conpolytypeM(eos_handle, &
                 g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), &
                 g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k), sdet, &
                 dens_p_p(i,j,k), scon_p_p(i,j,k,1), scon_p_p(i,j,k,2), scon_p_p(i,j,k,3), &
                 tau_p_p(i,j,k), Bcons_p_p(i,j,k,1),Bcons_p_p(i,j,k,2),Bcons_p_p(i,j,k,3),&
                 rho_p_p(i,j,k), vup_p_p(i,j,k,1), vup_p_p(i,j,k,2), &
                 vup_p_p(i,j,k,3), eps_p_p(i,j,k), press_p_p(i,j,k), &
                 Bprim_p_p(i,j,k,1),Bprim_p_p(i,j,k,2),Bprim_p_p(i,j,k,3),w_lorentz_p_p(i,j,k))
            end if
          end if
        end if

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

  write(*,*) "     GRHydro_InitialAtmosphereReset"
!!$  call GRHydro_BoundariesM(CCTK_PASS_FTOF)
#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 GRHydro_InitialAtmosphereResetAM


```

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

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

#define SQR(x) ((x)*(x))

/* helper routine to let Fortran code test for the presence of Multipatch.
 * Required since Fortran cannot access grid scalars via pointers returned by CCTK_VarDataPtrI
 * Returns 0 when no general coordinates are used 
 * Returns 1 when general coordinates are used 
 */ 
CCTK_FCALL CCTK_INT CCTK_FNAME(GRHydro_UseGeneralCoordinates)(CCTK_POINTER ptr_to_cctkGH);
CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

CCTK_FCALL CCTK_INT CCTK_FNAME(GRHydro_UseGeneralCoordinates)(CCTK_POINTER ptr_to_cctkGH)
{
   return GRHydro_UseGeneralCoordinates(*(cGH **)ptr_to_cctkGH);
}

CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH)
{
   static CCTK_INT idxGeneral_coordinates = -1;
   static CCTK_INT coordinates_active_set = 0;
   static CCTK_INT coordinates_active;

   if (!coordinates_active_set) {
      coordinates_active = CCTK_IsImplementationActive("Coordinates");
      coordinates_active_set = 1;
   }

   if (idxGeneral_coordinates == -1)
   {
      idxGeneral_coordinates = CCTK_VarIndex("Coordinates::general_coordinates");
      assert(!coordinates_active || idxGeneral_coordinates >= 0);
   }

   /* are coordinates relly not Cartesian? */
   return coordinates_active && *(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxGeneral_coordinates);
}  

void GRHydroTransformADMToLocalBasis(CCTK_ARGUMENTS)
{
   DECLARE_CCTK_ARGUMENTS;
   DECLARE_CCTK_PARAMETERS;

   int i,j,k;
   static CCTK_INT idxJacobian = -1, idxiJacobian = -1;
   static CCTK_INT idxJacobian_state = -1, idxiJacobian_state = -1;
   static CCTK_INT idxGeneral_coordinates = -1;
   CCTK_REAL *J11, *J12, *J13, *J21, *J22, *J23, *J31, *J32, *J33;
   CCTK_REAL *iJ11, *iJ12, *iJ13, *iJ21, *iJ22, *iJ23, *iJ31, *iJ32, *iJ33;

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

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxGeneral_coordinates))
      return; /* corodinates are Cartesian */

   if (idxJacobian == -1)
   {
      idxJacobian = CCTK_FirstVarIndex("Coordinates::jacobian");
      assert(idxJacobian >= 0);
   }

   if (idxiJacobian == -1)
   {
      idxiJacobian = CCTK_FirstVarIndex("Coordinates::inverse_jacobian");
      assert(idxiJacobian >= 0);
   }

   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))
      CCTK_WARN(0,"No storage for Jacobians allocated! Tell your coordinates implemetation to store Jacobians!");

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian_state))
      CCTK_WARN(0,"No storage for inverse Jacobians allocated! Tell your coordinates implemetation to store inverse Jacobians!");

   /* Cactus guarantess that variables in a group are consecutive, and
    * ReflectionSymmetry etc. require the order we use */
   J11 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+0);
   J12 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+1);
   J13 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+2);
   J21 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+3);
   J22 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+4);
   J23 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+5);
   J31 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+6);
   J32 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+7);
   J33 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+8);
   assert(J11 && J12 && J13 && J21 && J22 && J23 && J31 && J32 && J33);
   iJ11 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+0);
   iJ12 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+1);
   iJ13 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+2);
   iJ21 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+3);
   iJ22 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+4);
   iJ23 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+5);
   iJ31 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+6);
   iJ32 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+7);
   iJ33 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+8);
   assert(iJ11 && iJ12 && iJ13 && iJ21 && iJ22 && iJ23 && iJ31 && iJ32 && iJ33);

   #pragma omp parallel for private (i,j,k)
   for (k=0 ; k<cctk_lsh[2] ; k++)
   {
      for (j=0 ;  j<cctk_lsh[1] ; j++)
      {
         for (i=0 ;  i<cctk_lsh[0] ; i++)
         {
            CCTK_INT idx = CCTK_GFINDEX3D(cctkGH, i,j,k);

            gaa[idx] = SQR(iJ11[idx]) * gxx[idx] +
                 2.0 * iJ11[idx] * iJ21[idx] * gxy[idx] +
                 2.0 * iJ11[idx] * iJ31[idx] * gxz[idx] + SQR(iJ21[idx]) * gyy[idx] +
                 2.0 * iJ21[idx] * iJ31[idx] * gyz[idx] + SQR(iJ31[idx]) * gzz[idx];

            gab[idx] = iJ11[idx] * iJ12[idx] * gxx[idx] +
                 (iJ11[idx] * iJ22[idx] + iJ21[idx] * iJ12[idx]) * gxy[idx] +
                 (iJ11[idx] * iJ32[idx] + iJ31[idx] * iJ12[idx]) * gxz[idx] +
                 iJ21[idx] * iJ22[idx] * gyy[idx] + (iJ21[idx] * iJ32[idx] +
                 iJ31[idx] * iJ22[idx]) * gyz[idx] + iJ31[idx] * iJ32[idx] * gzz[idx];

            gac[idx] = iJ11[idx] * iJ13[idx] * gxx[idx] + (iJ11[idx] * iJ23[idx] +
                 iJ21[idx] * iJ13[idx]) * gxy[idx] +
                 (iJ11[idx] * iJ33[idx] + iJ31[idx] * iJ13[idx]) * gxz[idx] +
                 iJ21[idx] * iJ23[idx] * gyy[idx] +
                 (iJ21[idx] * iJ33[idx] + iJ31[idx] * iJ23[idx]) * gyz[idx] +
                 iJ31[idx] * iJ33[idx] * gzz[idx];

            gbb[idx] = SQR(iJ12[idx]) * gxx[idx] +
                 2.0 * iJ12[idx] * iJ22[idx] * gxy[idx] +
                 2.0 * iJ12[idx] * iJ32[idx] * gxz[idx] + SQR(iJ22[idx]) * gyy[idx] +
                 2.0 * iJ22[idx] * iJ32[idx] * gyz[idx] + SQR(iJ32[idx]) * gzz[idx];

            gbc[idx] = iJ12[idx] * iJ13[idx] * gxx[idx] +
                 (iJ12[idx] * iJ23[idx] + iJ22[idx] * iJ13[idx]) * gxy[idx] +
                 (iJ12[idx] * iJ33[idx] + iJ32[idx] * iJ13[idx]) * gxz[idx] +
                 iJ22[idx] * iJ23[idx] * gyy[idx] +
                 (iJ22[idx]* iJ33[idx] + iJ32[idx] * iJ23[idx]) * gyz[idx] +
                 iJ32[idx] * iJ33[idx] * gzz[idx];

            gcc[idx] = SQR(iJ13[idx]) * gxx[idx] +
                 2.0 * iJ13[idx] * iJ23[idx] * gxy[idx] +
                 2.0 * iJ13[idx] * iJ33[idx] * gxz[idx] +
                 SQR(iJ23[idx]) * gyy[idx] +
                 2.0 * iJ23[idx] * iJ33[idx] * gyz[idx] +
                 SQR(iJ33[idx]) * gzz[idx];

            /* Transform extrinsic curvature from global to local basis.
             * Since extrinsic has covariant indices, use inverse Jacobian */
            kaa[idx] = SQR(iJ11[idx]) * kxx[idx] +
                 2.0 * iJ11[idx] * iJ21[idx] * kxy[idx] +
                 2.0 * iJ11[idx] * iJ31[idx] * kxz[idx] +
                 SQR(iJ21[idx]) * kyy[idx] +
                 2.0 * iJ21[idx] * iJ31[idx] * kyz[idx] +
                 SQR(iJ31[idx]) * kzz[idx];

            kab[idx] = iJ11[idx] * iJ12[idx] * kxx[idx] +
                 (iJ11[idx] * iJ22[idx] + iJ21[idx] * iJ12[idx]) * kxy[idx] +
                 (iJ11[idx] * iJ32[idx] + iJ31[idx] * iJ12[idx]) * kxz[idx] +
                 iJ21[idx] * iJ22[idx] * kyy[idx] +
                 (iJ21[idx] * iJ32[idx] + iJ31[idx] * iJ22[idx]) * kyz[idx] +
                 iJ31[idx] * iJ32[idx] * kzz[idx];


            kac[idx] = iJ11[idx] * iJ13[idx] * kxx[idx] +
                 (iJ11[idx] * iJ23[idx] + iJ21[idx] * iJ13[idx]) * kxy[idx] +
                 (iJ11[idx] * iJ33[idx] + iJ31[idx] * iJ13[idx]) * kxz[idx] +
                 iJ21[idx] * iJ23[idx] * kyy[idx] +
                 (iJ21[idx] * iJ33[idx] + iJ31[idx] * iJ23[idx]) * kyz[idx] +
                 iJ31[idx] * iJ33[idx] * kzz[idx];

            kbb[idx] = SQR(iJ12[idx]) * kxx[idx] +
                 2.0 * iJ12[idx] * iJ22[idx] * kxy[idx] +
                 2.0 * iJ12[idx] * iJ32[idx] * kxz[idx] +
                 SQR(iJ22[idx]) * kyy[idx] +
                 2.0 * iJ22[idx] * iJ32[idx] * kyz[idx] +
                 SQR(iJ32[idx]) * kzz[idx];

            kbc[idx] = iJ12[idx] * iJ13[idx] * kxx[idx] +
                 (iJ12[idx] * iJ23[idx] + iJ22[idx] * iJ13[idx]) * kxy[idx] +
                 (iJ12[idx] * iJ33[idx] + iJ32[idx] * iJ13[idx]) * kxz[idx] +
                 iJ22[idx] * iJ23[idx] * kyy[idx] +
                 (iJ22[idx] * iJ33[idx] + iJ32[idx] * iJ23[idx]) * kyz[idx] +
                 iJ32[idx] * iJ33[idx] * kzz[idx];

            kcc[idx] = SQR(iJ13[idx]) * kxx[idx] +
                 2.0 * iJ13[idx] * iJ23[idx] * kxy[idx] +
                 2.0 * iJ13[idx] * iJ33[idx] * kxz[idx] +
                 SQR(iJ23[idx]) * kyy[idx] +
                 2.0 * iJ23[idx] * iJ33[idx] * kyz[idx] +
                 SQR(iJ33[idx]) * kzz[idx];
            
            /* Transform shift from global to local basis.
             * Since shift has contravariant index, use Jacobian */
            betaa[idx] = betax[idx]*J11[idx] + betay[idx]*J12[idx] + betaz[idx]*J13[idx];
            betab[idx] = betax[idx]*J21[idx] + betay[idx]*J22[idx] + betaz[idx]*J23[idx];
            betac[idx] = betax[idx]*J31[idx] + betay[idx]*J32[idx] + betaz[idx]*J33[idx];
         }
      }
   }

}



void GRHydroTransformPrimToLocalBasis(CCTK_ARGUMENTS)
{
   
   DECLARE_CCTK_ARGUMENTS;
   DECLARE_CCTK_PARAMETERS;

   CCTK_INT i,j,k;
   static CCTK_INT idxJacobian = -1, idxiJacobian = -1;
   static CCTK_INT idxGeneral_coordinates = -1;
   static CCTK_INT idxJacobian_state = -1, idxiJacobian_state = -1;
   CCTK_REAL *J11, *J12, *J13, *J21, *J22, *J23, *J31, *J32, *J33;
   CCTK_REAL *iJ11, *iJ12, *iJ13, *iJ21, *iJ22, *iJ23, *iJ31, *iJ32, *iJ33;

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

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

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxGeneral_coordinates))
      return; /* corodinates are Cartesian */

   if (idxJacobian == -1)
   {
      idxJacobian = CCTK_FirstVarIndex("Coordinates::jacobian");
      assert(idxJacobian >= 0);
   }

   if (idxiJacobian == -1)
   {
      idxiJacobian = CCTK_FirstVarIndex("Coordinates::inverse_jacobian");
      assert(idxiJacobian >= 0);
   }

   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))
      CCTK_WARN(0,"No storage for Jacobians allocated! Tell your coordinates implemetation to store Jacobians!");

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian_state))
      CCTK_WARN(0,"No storage for inverse Jacobians allocated! Tell your coordinates implemetation to store inverse Jacobians!");

   /* CCTK_INFO("Transforming primitives to local basis."); */

   /* Cactus guarantess that variables in a group are consecutive, and
    * ReflectionSymmetry etc. require the order we use */
   J11 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+0);
   J12 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+1);
   J13 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+2);
   J21 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+3);
   J22 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+4);
   J23 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+5);
   J31 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+6);
   J32 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+7);
   J33 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+8);
   assert(J11 && J12 && J13 && J21 && J22 && J23 && J31 && J32 && J33);
   iJ11 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+0);
   iJ12 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+1);
   iJ13 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+2);
   iJ21 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+3);
   iJ22 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+4);
   iJ23 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+5);
   iJ31 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+6);
   iJ32 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+7);
   iJ33 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+8);
   assert(iJ11 && iJ12 && iJ13 && iJ21 && iJ22 && iJ23 && iJ31 && iJ32 && iJ33);

   #pragma omp parallel for private (i,j,k)
   for (k=0 ; k<cctk_lsh[2] ; k++)
   {
      for (j=0 ;  j<cctk_lsh[1] ; j++)
      {
         for (i=0 ;  i<cctk_lsh[0] ; i++)
         {
            CCTK_INT idx = CCTK_GFINDEX3D(cctkGH, i,j,k);
            CCTK_INT idx1 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,0);
            CCTK_INT idx2 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,1);
            CCTK_INT idx3 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,2);
   
            /* Transform primitive velocity from global to local basis.
             * Since velocity has contravariant index, use Jacobian */
            lvel[idx1] = vel[idx1]*J11[idx] + vel[idx2]*J12[idx] + vel[idx3]*J13[idx];
            lvel[idx2] = vel[idx1]*J21[idx] + vel[idx2]*J22[idx] + vel[idx3]*J23[idx];
            lvel[idx3] = vel[idx1]*J31[idx] + vel[idx2]*J32[idx] + vel[idx3]*J33[idx];
            
            if(*evolve_MHD)
            {
              /* Transform primitive B-field from global to local basis.
               * Since B-field has contravariant index, use Jacobian */
              lBvec[idx1] = Bvec[idx1]*J11[idx] + Bvec[idx2]*J12[idx] + Bvec[idx3]*J13[idx];
              lBvec[idx2] = Bvec[idx1]*J21[idx] + Bvec[idx2]*J22[idx] + Bvec[idx3]*J23[idx];
              lBvec[idx3] = Bvec[idx1]*J31[idx] + Bvec[idx2]*J32[idx] + Bvec[idx3]*J33[idx];
            }
         }
      }
   }

}



void GRHydroTransformPrimToGlobalBasis(CCTK_ARGUMENTS)
{
   
   DECLARE_CCTK_ARGUMENTS;
   DECLARE_CCTK_PARAMETERS;

   CCTK_INT i,j,k;
   
   static CCTK_INT idxJacobian = -1, idxiJacobian = -1;
   static CCTK_INT idxJacobian_state = -1, idxiJacobian_state = -1;
   static CCTK_INT idxGeneral_coordinates = -1;
   CCTK_REAL *J11, *J12, *J13, *J21, *J22, *J23, *J31, *J32, *J33;
   CCTK_REAL *iJ11, *iJ12, *iJ13, *iJ21, *iJ22, *iJ23, *iJ31, *iJ32, *iJ33;

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

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxGeneral_coordinates))
      return; /* corodinates are Cartesian */

   if (idxJacobian == -1)
   {
      idxJacobian = CCTK_FirstVarIndex("Coordinates::jacobian");
      assert(idxJacobian >= 0);
   }

   if (idxiJacobian == -1)
   {
      idxiJacobian = CCTK_FirstVarIndex("Coordinates::inverse_jacobian");
      assert(idxiJacobian >= 0);
   }

   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))
      CCTK_WARN(0,"No storage for Jacobians allocated! Tell your coordinates implemetation to store Jacobians!");

   if (!*(CCTK_INT *)CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian_state))
      CCTK_WARN(0,"No storage for inverse Jacobians allocated! Tell your coordinates implemetation to store inverse Jacobians!");

   /* CCTK_INFO("Transforming primitives to global basis."); */

   /* Cactus guarantess that variables in a group are consecutive, and
    * ReflectionSymmetry etc. require the order we use */
   J11 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+0);
   J12 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+1);
   J13 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+2);
   J21 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+3);
   J22 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+4);
   J23 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+5);
   J31 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+6);
   J32 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+7);
   J33 = CCTK_VarDataPtrI(cctkGH, 0, idxJacobian+8);
   assert(J11 && J12 && J13 && J21 && J22 && J23 && J31 && J32 && J33);
   iJ11 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+0);
   iJ12 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+1);
   iJ13 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+2);
   iJ21 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+3);
   iJ22 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+4);
   iJ23 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+5);
   iJ31 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+6);
   iJ32 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+7);
   iJ33 = CCTK_VarDataPtrI(cctkGH, 0, idxiJacobian+8);
   assert(iJ11 && iJ12 && iJ13 && iJ21 && iJ22 && iJ23 && iJ31 && iJ32 && iJ33);

   #pragma omp parallel for private (i,j,k)
   for (k=0 ; k<cctk_lsh[2] ; k++)
   {
      for (j=0 ;  j<cctk_lsh[1] ; j++)
      {
         for (i=0 ;  i<cctk_lsh[0] ; i++)
         {
            CCTK_INT idx = CCTK_GFINDEX3D(cctkGH, i,j,k);
            CCTK_INT idx1 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,0);
            CCTK_INT idx2 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,1);
            CCTK_INT idx3 = CCTK_VECTGFINDEX3D(cctkGH, i,j,k,2);
   
            /* Transform primitive velocity from local to global basis.
             * Since velocity has contravariant index, use inverse Jacobian */
            vel[idx1] = lvel[idx1]*iJ11[idx] + lvel[idx2]*iJ12[idx] + lvel[idx3]*iJ13[idx];
            vel[idx2] = lvel[idx1]*iJ21[idx] + lvel[idx2]*iJ22[idx] + lvel[idx3]*iJ23[idx];
            vel[idx3] = lvel[idx1]*iJ31[idx] + lvel[idx2]*iJ32[idx] + lvel[idx3]*iJ33[idx];

            if(*evolve_MHD)
            {
              /* Transform primitive B-field from local to global basis.
               * Since B-field has contravariant index, use inverse Jacobian */
              Bvec[idx1] = lBvec[idx1]*iJ11[idx] + lBvec[idx2]*iJ12[idx] + lBvec[idx3]*iJ13[idx];
              Bvec[idx2] = lBvec[idx1]*iJ21[idx] + lBvec[idx2]*iJ22[idx] + lBvec[idx3]*iJ23[idx];
              Bvec[idx3] = lBvec[idx1]*iJ31[idx] + lBvec[idx2]*iJ32[idx] + lBvec[idx3]*iJ33[idx];
            }
            
         }
      }
   }

}






```

GRHydro_ePPM.cc:
```
#include <cmath>
#include <algorithm>
#include <vector>
#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))

#define MIN3(a,b,c) (MIN(a, MIN(b, c)))
#define MIN4(a,b,c,d) (MIN(a, MIN(b, MIN(c, d))))

#define MAX5(a,b,c,d,e) (MAX(a, MAX(b, MAX(c, MAX(d, e)))))

using namespace std;


/**
   ePPM Reconstruction (see Reisswig et al. 2013) based on McCorquodale & Colella (2011).
   Note: This routine differs from the Fortran routine (and the algorithm described in Reisswig et al. 2013)
         in the following way: We do not treat the specific internal energy "epsilon" in any special way.
         Rather, to avoid reconstruction to eps<0 for gamma-laws, we rely on
         'eps<0'-error checks after reconstruction (a similar treatment is also necessary for other reconstruction methods such as WENO5 and MP5).
*/


/*
  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 double approx_at_cell_interface(const double* const restrict 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 double limit(const double* const restrict a, const double ah, const double C, const int i) 
{
  if ((MIN(a[i],a[i+1]) <= ah) && (ah <= MAX(a[i],a[i+1]))) {
     return ah;
  } else {
     const double D2a  = 3.0 * ((a[i]   + a[i+1]) - 2.0*ah    );
     const double D2aL =       ((a[i-1] + a[i+1]) - 2.0*a[i]  );
     const double D2aR =       ((a[i]   + a[i+2]) - 2.0*a[i+1]);
     const double D2aLim = copysign(1.0, D2a)*MIN3(C*fabs(D2aL), C*fabs(D2aR), fabs(D2a)) * 1.0/3.0;
     if (D2a*D2aR >= 0 && D2a*D2aL >= 0)
        return 0.5*(a[i]+a[i+1]) - D2aLim;
     else
        return 0.5*(a[i]+a[i+1]);
  }
  return 0;
}


/// 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!
static inline void monotonize(double* const restrict aminus,
			      const double* const restrict a,
			      double* const restrict aplus,
                              const double C,
			      const int i) 
{
   double D2aLim = 0; 
   double rhi = 0;
   const double daplus  = aplus[i]-a[i];
   const double daminus = a[i]-aminus[i];
   if (daplus*daminus <= 0 || (a[i-2]-a[i])*(a[i]-a[i+2]) <= 0) {
      const double D2a  = - (12.0*a[i] - 6.0*(aminus[i]+aplus[i]));
      const double D2aC = (a[i-1] + a[i+1]) - 2.0*a[i];
      const double D2aL = (a[i-2] + a[i]  ) - 2.0*a[i-1];
      const double D2aR = (a[i]   + a[i+2]) - 2.0*a[i+1];
      if (copysign(1.0, D2a) == copysign(1.0, D2aC) && copysign(1.0, D2a) == copysign(1.0, D2aL) && copysign(1.0, D2a) == copysign(1.0, D2aR))
         D2aLim = copysign(1.0, D2a) * MIN4(C*fabs(D2aL), C*fabs(D2aR), C*fabs(D2aC), fabs(D2a));
      if (!(fabs(D2a) <= 1e-12*MAX5(fabs(a[i-2]), fabs(a[i-1]), fabs(a[i]), fabs(a[i+1]), fabs(a[i+2]))))
         rhi = D2aLim / D2a;
      if (! (rhi >= 1.0 - 1e-12)) {
            if (daplus*daminus < 0) {
               aplus[i]  = a[i] + daplus * rhi;
               aminus[i] = a[i] - daminus * rhi;
            } else if (fabs(daminus) >= 2.0*fabs(daplus)) {
               aminus[i]  = a[i] - (2.0*(1.0-rhi)*daplus + rhi*daminus);
            } else if (fabs(daplus) >= 2.0*fabs(daminus)) {
               aplus[i]  = a[i] + (2.0*(1.0-rhi)*daminus + rhi*daplus);
            }
      }
      //trivial_rp(i-1) = .false.
      //trivial_rp(i) = .false.
   } else {
         if (fabs(daplus) >= 2.0*fabs(daminus))
            aplus[i] = a[i] + 2.0*daminus;
         else if (fabs(daminus) >= 2.0*fabs(daplus))
            aminus[i] = a[i] - 2.0*daplus;
      //trivial_rp(i-1) = .false.
      //trivial_rp(i) = .false.
   }
   
   return;
}


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* 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;


  // 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.
  for (int i=1; i < nx-2; ++i) {
         rhoplus[i] = approx_at_cell_interface(rho, i);
         rhoplus[i] = limit(rho, rhoplus[i], enhanced_ppm_C2, i);
         rhominus[i+1] = rhoplus[i];
  
         epsplus[i] = approx_at_cell_interface(eps, i);
         epsplus[i] = limit(eps, epsplus[i], enhanced_ppm_C2, i);
         epsminus[i+1] = epsplus[i];
         
         velxplus[i] = approx_at_cell_interface(velx, i);
         velxplus[i] = limit(velx, velxplus[i], enhanced_ppm_C2, i);
         velxminus[i+1] = velxplus[i];
         
         velyplus[i] = approx_at_cell_interface(vely, i);
         velyplus[i] = limit(vely, velyplus[i], enhanced_ppm_C2, i);
         velyminus[i+1] = velyplus[i];
         
         velzplus[i] = approx_at_cell_interface(velz, i);
         velzplus[i] = limit(velz, velzplus[i], enhanced_ppm_C2, i);
         velzminus[i+1] = velzplus[i];
         
         if(do_ye) {
            if(do_temp) {
              tempplus[i] = approx_at_cell_interface(temp, i);
              tempplus[i] = limit(temp, tempplus[i], enhanced_ppm_C2, i);
              tempminus[i+1] = tempplus[i];
            }
            yeplus[i] = approx_at_cell_interface(ye, i);
            yeplus[i] = limit(ye, yeplus[i], enhanced_ppm_C2, i);
            yeminus[i+1] = yeplus[i];
         }
         if(do_mhd) {
            Bvcxplus[i] = approx_at_cell_interface(Bvcx, i);
            Bvcxplus[i] = limit(Bvcx, Bvcxplus[i], enhanced_ppm_C2, i);
            Bvcxminus[i+1] = Bvcxplus[i];
            
            Bvcyplus[i] = approx_at_cell_interface(Bvcy, i);
            Bvcyplus[i] = limit(Bvcy, Bvcyplus[i], enhanced_ppm_C2, i);
            Bvcyminus[i+1] = Bvcyplus[i];
            
            Bvczplus[i] = approx_at_cell_interface(Bvcz, i);
            Bvczplus[i] = limit(Bvcz, Bvczplus[i], enhanced_ppm_C2, i);
            Bvczminus[i+1] = Bvczplus[i];
            
            if(dc_flag) {
               psidcplus[i] = approx_at_cell_interface(psidc, i);
               psidcplus[i] = limit(psidc, psidcplus[i], enhanced_ppm_C2, i);
               psidcminus[i+1] = psidcplus[i];
            }
         }
         
   }

  // Monotonize
  for(int i=GRHydro_stencil-1; i<nx-GRHydro_stencil+1; ++i) {
    monotonize(rhominus,rho,rhoplus,enhanced_ppm_C2,i);
    monotonize(epsminus,eps,epsplus,enhanced_ppm_C2,i);
    monotonize(velxminus,velx,velxplus,enhanced_ppm_C2,i);
    monotonize(velyminus,vely,velyplus,enhanced_ppm_C2,i);
    monotonize(velzminus,velz,velzplus,enhanced_ppm_C2,i);
    if(do_ye) {
      if(do_temp) {
	monotonize(tempminus,temp,tempplus,enhanced_ppm_C2,i);
      }
      monotonize(yeminus,ye,yeplus,enhanced_ppm_C2,i);
    }
    if(do_mhd) {
      monotonize(Bvcxminus,Bvcx,Bvcxplus,enhanced_ppm_C2,i);
      monotonize(Bvcyminus,Bvcy,Bvcyplus,enhanced_ppm_C2,i);
      monotonize(Bvczminus,Bvcz,Bvczplus,enhanced_ppm_C2,i);
      if(dc_flag) {
	monotonize(psidcminus,psidc,psidcplus,enhanced_ppm_C2,i);
      }
    }
  }

  
  // Finally, apply flattening
  vector<double> dpress(nx,0);
  for(int i=1; i<nx-1; ++i)
    dpress[i] = (press[i+1]-press[i-1]);
  
  vector<double> tilde_flatten(nx,0);
  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
  
  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_eppm1d_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_Loop.F90:
```
 /*@@
   @file      GRHydro_Loop.F90
   @date      Sat Jan 26 01:50:14 2002
   @author    
   @desc 
   Routines controlling loop counters and direction offsets
   @enddesc 
 @@*/

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

 /*@@
   @routine    GRHydroStartLoop
   @date       Sat Jan 26 01:50:46 2002
   @author     Ian Hawke
   @desc 
   Set up the counters before the loop
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydroStartLoop(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  
  flux_direction = 3
  
  xoffset = 0
  yoffset = 0
  zoffset = 1

end subroutine GRHydroStartLoop

 /*@@
   @routine    Advance the counters whilst in the loop
   @date       Sat Jan 26 01:51:29 2002
   @author     Ian Hawke
   @desc 
   Just increments the counter and resets the directions.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydroAdvanceLoop(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  
  flux_direction = flux_direction-1
  
  if (flux_direction .eq. 2) then
    
    xoffset = 0
    yoffset = 1
    zoffset = 0
    
  else if (flux_direction .eq. 1) then
    
    xoffset = 1
    yoffset = 0
    zoffset = 0
    
  else
    
    xoffset = -1000000
    yoffset = -1000000
    zoffset = -1000000
    
  end if
  
end subroutine GRHydroAdvanceLoop

```

GRHydro_PPMReconstruct_drv_opt.cc:
```
#include <cmath>
#include <algorithm>
#include <vector>
#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))

#include "SpaceMask.h"
#include "GRHydro_PPM_opt.h"
#include "GRHydro_Reconstruct_drv_impl.hh" 

#undef velx
#undef vely
#undef velz

using namespace std;

extern "C" CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

static inline void oned_slice(const int npt, const int nstart, const int nstride, CCTK_REAL const * const restrict vec3d, vector<CCTK_REAL>& vec1d)
{
  for (int i=0; i<npt; ++i)
     vec1d[i] = vec3d[nstart+i*nstride];
}

static inline void oned_unslice(const int npt, const int nstart, const int nstride, const vector<CCTK_REAL>& vec1d, CCTK_REAL * const restrict vec3d)
{
  for (int i=0; i<npt; ++i)
     vec3d[nstart+i*nstride]=vec1d[i];
}

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

extern "C"
void CCTK_FNAME(GRHydro_PPMReconstruct_drv_opt)(cGH const * const restrict & /*restrict*/ cctkGH)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  //Multipatch related pointers
  const CCTK_REAL * restrict vup;
  const CCTK_REAL * restrict Bprim;
  const CCTK_REAL * restrict g11;
  const CCTK_REAL * restrict g12;
  const CCTK_REAL * restrict g13;
  const CCTK_REAL * restrict g22;
  const CCTK_REAL * restrict g23;
  const CCTK_REAL * restrict g33;
  
  if(GRHydro_UseGeneralCoordinates(cctkGH)) {
    vup=lvel;
    Bprim=lBvec;
    g11=gaa; g12=gab; g13=gac;
    g22=gbb; g23=gbc;
    g33=gcc;
  } else {
    vup=vel;
    Bprim=Bvec;
    g11=gxx; g12=gxy; g13=gxz;
    g22=gyy; g23=gyz;
    g33=gzz;
  }

  const int nx=cctk_ash[0];
  const int ny=cctk_ash[1];
  const int nz=cctk_ash[2];
  const int nxy=nx*ny;
  const int nxyz=nxy*nz;

  const int nmax_xyz=MAX(nx,MAX(ny,nz));

  // bit masks and patterns for trivial Riemann Problem spacemask
  const int type_bitsx = SpaceMask_GetTypeBits("Hydro_RiemannProblemX");
  //  trivialx = SpaceMask_GetStateBits("Hydro_RiemannProblemX","trivial");
  const int not_trivialx = SpaceMask_GetStateBits("Hydro_RiemannProblemX",
                                                  "not_trivial");

  const int type_bitsy = SpaceMask_GetTypeBits("Hydro_RiemannProblemY");
  //  trivialy = SpaceMask_GetStateBits("Hydro_RiemannProblemY","trivial");
  const int not_trivialy = SpaceMask_GetStateBits("Hydro_RiemannProblemY",
                                                  "not_trivial");

  const int type_bitsz = SpaceMask_GetTypeBits("Hydro_RiemannProblemZ");
  //  trivialz = SpaceMask_GetStateBits("Hydro_RiemannProblemZ","trivial");
  const int not_trivialz = SpaceMask_GetStateBits("Hydro_RiemannProblemZ",
                                                  "not_trivial");
    
  //   if use_enhanced_ppm, allow old PPM on one level
  bool apply_enhanced_ppm = false;
  if (GRHydro_oppm_reflevel == (-1) ||
      *GRHydro_reflevel != GRHydro_oppm_reflevel)
      apply_enhanced_ppm = use_enhanced_ppm != 0;
  else
      apply_enhanced_ppm = false;
  
  
  typedef
  void (*ppm1d_cxx_ptr_t)(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);
  static ppm1d_cxx_ptr_t ppm1d_cxx_funcs[64];
  ppm1d_cxx_ptr_t ppm1d_cxx_func;

  #define MKINDEX(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect,do_eppm) ((do_eppm<<5)|(do_temp<<4)|(do_ye<<3)|(do_mhd<<2)|(dc_flag<<1)|(do_ppm_detect))
  #define SETPOINTER(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect,do_eppm) \
                     if (!do_eppm) \
                        ppm1d_cxx_funcs[MKINDEX(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect, do_eppm)] = \
                        GRHydro_ppm1d_cxx<do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect>; \
                     else \
                        ppm1d_cxx_funcs[MKINDEX(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect, do_eppm)] = \
                        GRHydro_eppm1d_cxx<do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect>;
                        
  //  --- original PPM
  // first stuff without MHD
  SETPOINTER(false,false,false,false,false,false);
  SETPOINTER(false,false,false,false,true,false);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,false,false,false,false);
  SETPOINTER(true,true,false,false,true,false);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,false,false,false,false);
  SETPOINTER(false,true,false,false,true,false);

  // with MHD, but dc_flag false
  SETPOINTER(false,false,true,false,false,false);
  SETPOINTER(false,false,true,false,true,false);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,true,false,false,false);
  SETPOINTER(true,true,true,false,true,false);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,true,false,false,false);
  SETPOINTER(false,true,true,false,true,false);

  // with MHD, dc_flag true
  SETPOINTER(false,false,true,true,false,false);
  SETPOINTER(false,false,true,true,true,false);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,true,true,false,false);
  SETPOINTER(true,true,true,true,true,false);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,true,true,false,false);
  SETPOINTER(false,true,true,true,true,false);

  // ---- enhanced PPM
  // first stuff without MHD
  SETPOINTER(false,false,false,false,false,true);
  SETPOINTER(false,false,false,false,true,true);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,false,false,false,true);
  SETPOINTER(true,true,false,false,true,true);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,false,false,false,true);
  SETPOINTER(false,true,false,false,true,true);

  // with MHD, but dc_flag false
  SETPOINTER(false,false,true,false,false,true);
  SETPOINTER(false,false,true,false,true,true);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,true,false,false,true);
  SETPOINTER(true,true,true,false,true,true);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,true,false,false,true);
  SETPOINTER(false,true,true,false,true,true);

  // with MHD, dc_flag true
  SETPOINTER(false,false,true,true,false,true);
  SETPOINTER(false,false,true,true,true,true);
  // do_temp can only be true of do_ye is also true
  SETPOINTER(true,true,true,true,false,true);
  SETPOINTER(true,true,true,true,true,true);
  // but do_ye can be true and do_temp can be false
  SETPOINTER(false,true,true,true,false,true);
  SETPOINTER(false,true,true,true,true,true);
  
  
  const bool do_temp = *evolve_temper;
  const bool do_ye = *evolve_Y_e;
  const bool do_mhd = *evolve_MHD;
  const bool dc_flag = clean_divergence;
  const bool do_ppm_detect = ppm_detect;
  const bool do_Avec = CCTK_Equals(Bvec_evolution_method,"GRHydro_Avec");
  ppm1d_cxx_func = ppm1d_cxx_funcs[MKINDEX(do_temp,do_ye,do_mhd,dc_flag,do_ppm_detect,apply_enhanced_ppm)];
  if(ppm1d_cxx_func == NULL) {
    CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING,
                "Combination do_temp = %d do_ye = %d do_mhd = %d dc_flag = %d do_ppm_detect = %d do_eppm = %d is not supported for PPM. Please instantiate the respective template",
                do_temp, do_ye, do_mhd, dc_flag, do_ppm_detect, apply_enhanced_ppm);
  }

  //index = i + j*nx + k*nx*ny;

  vector<CCTK_REAL> Wvup(0);
  // allocate temp memory for Wv reconstruction
  if (reconstruct_Wv) {
     Wvup.resize(3*nxyz, 0);
     #pragma omp parallel for
     for (int i=0; i < nxyz; ++i) {
        Wvup[i]        = w_lorentz[i]*vup[i];
        Wvup[i+nxyz]   = w_lorentz[i]*vup[i+nxyz];
        Wvup[i+2*nxyz] = w_lorentz[i]*vup[i+2*nxyz];
     }
  }
  
// PPM starts:
  if (*flux_direction == 1) {
    #pragma omp parallel
    {
    vector<CCTK_REAL> rho1d(nmax_xyz), eps1d(nmax_xyz), press1d(nmax_xyz);
    vector<CCTK_REAL> velx1d(nmax_xyz), vely1d(nmax_xyz), velz1d(nmax_xyz);
    vector<CCTK_REAL> temp1d(nmax_xyz), ye1d(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d(nmax_xyz), Bvcy1d(nmax_xyz), Bvcz1d(nmax_xyz);
    vector<CCTK_REAL> psidc1d(nmax_xyz);

    vector<CCTK_REAL> rho1d_plus(nmax_xyz), eps1d_plus(nmax_xyz), 
                      press1d_plus(nmax_xyz);
    vector<CCTK_REAL> velx1d_plus(nmax_xyz), vely1d_plus(nmax_xyz),
                      velz1d_plus(nmax_xyz);
    vector<CCTK_REAL> temp1d_plus(nmax_xyz), ye1d_plus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_plus(nmax_xyz), Bvcy1d_plus(nmax_xyz),
                      Bvcz1d_plus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_plus(nmax_xyz);

    vector<CCTK_REAL> rho1d_minus(nmax_xyz), eps1d_minus(nmax_xyz), 
                      press1d_minus(nmax_xyz);
    vector<CCTK_REAL> velx1d_minus(nmax_xyz), vely1d_minus(nmax_xyz), 
                      velz1d_minus(nmax_xyz);
    vector<CCTK_REAL> temp1d_minus(nmax_xyz), ye1d_minus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_minus(nmax_xyz), Bvcy1d_minus(nmax_xyz),
                      Bvcz1d_minus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_minus(nmax_xyz);

    #pragma omp for
    for(int k = GRHydro_stencil-1; k < nz - GRHydro_stencil + 1 + transport_constraints; ++k) {
      for(int j = GRHydro_stencil-1; j < ny - GRHydro_stencil + 1 + transport_constraints; ++j) {
        
        // TODO: there is no need to slice in the x direction, we can just point into the array

        //For reference, the slicing call is:
        //void oned_slice(int npt,int nstart,int nstride,CCTK_REAL* vec3d,CCTK_REAL* vec1d)
        const int nstart=nx*(j+k*ny);
        
        oned_slice(nx,nstart,1,rho,rho1d);
        
        // TODO: reconstruct_Wv is not yet templated!
        if (!reconstruct_Wv) {
          oned_slice(nx,nstart,       1,vup,velx1d);
          oned_slice(nx,nstart+nxyz,  1,vup,vely1d);
          oned_slice(nx,nstart+2*nxyz,1,vup,velz1d);
        } else {
          oned_slice(nx,nstart,       1,&Wvup.front(),velx1d);
          oned_slice(nx,nstart+nxyz,  1,&Wvup.front(),vely1d);
          oned_slice(nx,nstart+2*nxyz,1,&Wvup.front(),velz1d);
        }
        oned_slice(nx,nstart,1,eps,eps1d);
        oned_slice(nx,nstart,1,press,press1d);
        
        if(do_ye) {
          oned_slice(nx,nstart,1,Y_e,ye1d);
          if(do_temp){
            oned_slice(nx,nstart,1,temperature,temp1d);
          } 
        }
        
        if(do_mhd) {
          oned_slice(nx,nstart,       1,Bprim,Bvcx1d);
          oned_slice(nx,nstart+nxyz,  1,Bprim,Bvcy1d);
          oned_slice(nx,nstart+2*nxyz,1,Bprim,Bvcz1d);
          if(clean_divergence) {
            oned_slice(nx,nstart,1,psidc,psidc1d);
          }
          if (do_Avec)
            CCTK_WARN(0, "Someone needs to figure out which variables to pass for Avec");
        }
        
        ppm1d_cxx_func(cctk_lsh[0],CCTK_DELTA_SPACE(0),
           &rho1d[0],&velx1d[0],&vely1d[0],&velz1d[0],&eps1d[0],&press1d[0],&temp1d[0],
           &ye1d[0],&Bvcx1d[0],&Bvcy1d[0],&Bvcz1d[0],&psidc1d[0],
           &rho1d_minus[0],&velx1d_minus[0],&vely1d_minus[0],&velz1d_minus[0],&eps1d_minus[0],&temp1d_minus[0],
           &ye1d_minus[0],&Bvcx1d_minus[0],&Bvcy1d_minus[0],&Bvcz1d_minus[0],&psidc1d_minus[0],
           &rho1d_plus[0],&velx1d_plus[0],&vely1d_plus[0],&velz1d_plus[0],&eps1d_plus[0],&temp1d_plus[0],
           &ye1d_plus[0],&Bvcx1d_plus[0],&Bvcy1d_plus[0],&Bvcz1d_plus[0],&psidc1d_plus[0]);
        
        
        oned_unslice(nx,nstart,1,rho1d_minus,rhominus);
        oned_unslice(nx,nstart,1,rho1d_plus,rhoplus);
        
        oned_unslice(nx,nstart,1,velx1d_minus,velxminus);
        oned_unslice(nx,nstart,1,vely1d_minus,velyminus);
        oned_unslice(nx,nstart,1,velz1d_minus,velzminus);
        oned_unslice(nx,nstart,1,velx1d_plus,velxplus);
        oned_unslice(nx,nstart,1,vely1d_plus,velyplus);
        oned_unslice(nx,nstart,1,velz1d_plus,velzplus);
        if (reconstruct_Wv)
           undo_Wv<0>(nx, velxminus, velyminus, velzminus,
                          velxplus, velyplus, velzplus,
                          g11, g12, g13, g22, g23, g33,
                          cctkGH, j, k); 
        
        oned_unslice(nx,nstart,1,eps1d_minus,epsminus);
        oned_unslice(nx,nstart,1,eps1d_plus,epsplus);
        
        if(do_ye) {
          oned_unslice(nx,nstart,1,ye1d_minus,Y_e_minus);
          oned_unslice(nx,nstart,1,ye1d_plus,Y_e_plus);
          if(do_temp) {
            oned_unslice(nx,nstart,1,temp1d_minus,tempminus);
            oned_unslice(nx,nstart,1,temp1d_plus,tempplus);
          }
        }
        
        if(do_mhd) {
          oned_unslice(nx,nstart,1,Bvcx1d_minus,Bvecxminus);
          oned_unslice(nx,nstart,1,Bvcy1d_minus,Bvecyminus);
          oned_unslice(nx,nstart,1,Bvcz1d_minus,Bveczminus);
          oned_unslice(nx,nstart,1,Bvcx1d_plus,Bvecxplus);
          oned_unslice(nx,nstart,1,Bvcy1d_plus,Bvecyplus);
          oned_unslice(nx,nstart,1,Bvcz1d_plus,Bveczplus);
          if(clean_divergence) {
            oned_unslice(nx,nstart,1,psidc1d_minus,psidcminus);
            oned_unslice(nx,nstart,1,psidc1d_plus,psidcplus);
          }
        }
        for (int i=0; i<nx; ++i) {
          SpaceMask_SetStateBits(space_mask, CCTK_GFINDEX3D(cctkGH, i,j,k), type_bitsx, not_trivialx);
        }
      }
    }  
    } // pragma omp parallel

  } else if (*flux_direction==2) {

    #pragma omp parallel
    {
    vector<CCTK_REAL> rho1d(nmax_xyz), eps1d(nmax_xyz), press1d(nmax_xyz);
    vector<CCTK_REAL> velx1d(nmax_xyz), vely1d(nmax_xyz), velz1d(nmax_xyz);
    vector<CCTK_REAL> temp1d(nmax_xyz), ye1d(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d(nmax_xyz), Bvcy1d(nmax_xyz), Bvcz1d(nmax_xyz);
    vector<CCTK_REAL> psidc1d(nmax_xyz);

    vector<CCTK_REAL> rho1d_plus(nmax_xyz), eps1d_plus(nmax_xyz), 
                      press1d_plus(nmax_xyz);
    vector<CCTK_REAL> velx1d_plus(nmax_xyz), vely1d_plus(nmax_xyz),
                      velz1d_plus(nmax_xyz);
    vector<CCTK_REAL> temp1d_plus(nmax_xyz), ye1d_plus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_plus(nmax_xyz), Bvcy1d_plus(nmax_xyz),
                      Bvcz1d_plus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_plus(nmax_xyz);

    vector<CCTK_REAL> rho1d_minus(nmax_xyz), eps1d_minus(nmax_xyz), 
                      press1d_minus(nmax_xyz);
    vector<CCTK_REAL> velx1d_minus(nmax_xyz), vely1d_minus(nmax_xyz), 
                      velz1d_minus(nmax_xyz);
    vector<CCTK_REAL> temp1d_minus(nmax_xyz), ye1d_minus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_minus(nmax_xyz), Bvcy1d_minus(nmax_xyz),
                      Bvcz1d_minus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_minus(nmax_xyz);

    #pragma omp for
    for (int k = GRHydro_stencil-1; k < nz - GRHydro_stencil + 1 + transport_constraints; ++k) {
      for (int j = GRHydro_stencil-1; j < nx - GRHydro_stencil + 1 + transport_constraints; ++j) {
        
        const int nstart=j+k*nx*ny;
        
        oned_slice(ny,nstart,nx,rho,rho1d);
        
        if (!reconstruct_Wv) {
          oned_slice(ny,nstart,       nx,vup,velx1d);
          oned_slice(ny,nstart+nxyz,  nx,vup,vely1d);
          oned_slice(ny,nstart+2*nxyz,nx,vup,velz1d);
        } else {
          oned_slice(ny,nstart,       nx,&Wvup.front(),velx1d);
          oned_slice(ny,nstart+nxyz,  nx,&Wvup.front(),vely1d);
          oned_slice(ny,nstart+2*nxyz,nx,&Wvup.front(),velz1d);
        }
        oned_slice(ny,nstart,nx,eps,eps1d);
        oned_slice(ny,nstart,nx,press,press1d);
        
        if(do_ye) {
          oned_slice(ny,nstart,nx,Y_e,ye1d);
          if(do_temp){
            oned_slice(ny,nstart,nx,temperature,temp1d);
          } 
        }
        
        if(do_mhd) {
          oned_slice(ny,nstart,       nx,Bprim,Bvcx1d);
          oned_slice(ny,nstart+nxyz,  nx,Bprim,Bvcy1d);
          oned_slice(ny,nstart+2*nxyz,nx,Bprim,Bvcz1d);
          if(clean_divergence) {
            oned_slice(ny,nstart,nx,psidc,psidc1d);
          }
          if (do_Avec)
            CCTK_WARN(0, "Someone needs to figure out which variables to pass for Avec");
        }
        
        ppm1d_cxx_func
          (cctk_lsh[1],CCTK_DELTA_SPACE(1),
           &rho1d[0],&vely1d[0],&velz1d[0],&velx1d[0],&eps1d[0],&press1d[0],&temp1d[0],
           &ye1d[0],&Bvcy1d[0],&Bvcz1d[0],&Bvcx1d[0],&psidc1d[0],
           &rho1d_minus[0],&vely1d_minus[0],&velz1d_minus[0],&velx1d_minus[0],&eps1d_minus[0],&temp1d_minus[0],
           &ye1d_minus[0],&Bvcy1d_minus[0],&Bvcz1d_minus[0],&Bvcx1d_minus[0],&psidc1d_minus[0],
           &rho1d_plus[0],&vely1d_plus[0],&velz1d_plus[0],&velx1d_plus[0],&eps1d_plus[0],&temp1d_plus[0],
           &ye1d_plus[0],&Bvcy1d_plus[0],&Bvcz1d_plus[0],&Bvcx1d_plus[0],&psidc1d_plus[0]);
        
        
        oned_unslice(ny,nstart,nx,rho1d_minus,rhominus);
        oned_unslice(ny,nstart,nx,rho1d_plus,rhoplus);
        
        oned_unslice(ny,nstart,nx,velx1d_minus,velxminus);
        oned_unslice(ny,nstart,nx,vely1d_minus,velyminus);
        oned_unslice(ny,nstart,nx,velz1d_minus,velzminus);
        oned_unslice(ny,nstart,nx,velx1d_plus,velxplus);
        oned_unslice(ny,nstart,nx,vely1d_plus,velyplus);
        oned_unslice(ny,nstart,nx,velz1d_plus,velzplus);
        if (reconstruct_Wv)
           undo_Wv<1>(ny, velyminus, velzminus, velxminus,
                          velyplus, velzplus, velxplus,
                          g22, g23, g12, g33, g13, g11,
                          cctkGH, j, k);
        
        oned_unslice(ny,nstart,nx,eps1d_minus,epsminus);
        oned_unslice(ny,nstart,nx,eps1d_plus,epsplus);
        
        if(do_ye) {
          oned_unslice(ny,nstart,nx,ye1d_minus,Y_e_minus);
          oned_unslice(ny,nstart,nx,ye1d_plus,Y_e_plus);
          if(do_temp) {
            oned_unslice(ny,nstart,nx,temp1d_minus,tempminus);
            oned_unslice(ny,nstart,nx,temp1d_plus,tempplus);
          }
        }
        
        if(do_mhd) {
          oned_unslice(ny,nstart,nx,Bvcx1d_minus,Bvecxminus);
          oned_unslice(ny,nstart,nx,Bvcy1d_minus,Bvecyminus);
          oned_unslice(ny,nstart,nx,Bvcz1d_minus,Bveczminus);
          oned_unslice(ny,nstart,nx,Bvcx1d_plus,Bvecxplus);
          oned_unslice(ny,nstart,nx,Bvcy1d_plus,Bvecyplus);
          oned_unslice(ny,nstart,nx,Bvcz1d_plus,Bveczplus);
          if(clean_divergence) {
            oned_unslice(ny,nstart,nx,psidc1d_minus,psidcminus);
            oned_unslice(ny,nstart,nx,psidc1d_plus,psidcplus);
          }
        }
        for (int i=0; i<ny; ++i) {
          SpaceMask_SetStateBits(space_mask, CCTK_GFINDEX3D(cctkGH, j,i,k), type_bitsy, not_trivialy);
        }
        
      }
    }
    } // pragma omp parallel
    
  } else if (*flux_direction==3) {

    #pragma omp parallel
    {
    vector<CCTK_REAL> rho1d(nmax_xyz), eps1d(nmax_xyz), press1d(nmax_xyz);
    vector<CCTK_REAL> velx1d(nmax_xyz), vely1d(nmax_xyz), velz1d(nmax_xyz);
    vector<CCTK_REAL> temp1d(nmax_xyz), ye1d(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d(nmax_xyz), Bvcy1d(nmax_xyz), Bvcz1d(nmax_xyz);
    vector<CCTK_REAL> psidc1d(nmax_xyz);

    vector<CCTK_REAL> rho1d_plus(nmax_xyz), eps1d_plus(nmax_xyz), 
                      press1d_plus(nmax_xyz);
    vector<CCTK_REAL> velx1d_plus(nmax_xyz), vely1d_plus(nmax_xyz),
                      velz1d_plus(nmax_xyz);
    vector<CCTK_REAL> temp1d_plus(nmax_xyz), ye1d_plus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_plus(nmax_xyz), Bvcy1d_plus(nmax_xyz),
                      Bvcz1d_plus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_plus(nmax_xyz);

    vector<CCTK_REAL> rho1d_minus(nmax_xyz), eps1d_minus(nmax_xyz), 
                      press1d_minus(nmax_xyz);
    vector<CCTK_REAL> velx1d_minus(nmax_xyz), vely1d_minus(nmax_xyz), 
                      velz1d_minus(nmax_xyz);
    vector<CCTK_REAL> temp1d_minus(nmax_xyz), ye1d_minus(nmax_xyz);
    vector<CCTK_REAL> Bvcx1d_minus(nmax_xyz), Bvcy1d_minus(nmax_xyz),
                      Bvcz1d_minus(nmax_xyz);
    vector<CCTK_REAL> psidc1d_minus(nmax_xyz);

    #pragma omp for
    for(int k = GRHydro_stencil-1; k < ny - GRHydro_stencil + 1 + transport_constraints; ++k) {
      for(int j = GRHydro_stencil-1; j < nx - GRHydro_stencil + 1 + transport_constraints; ++j) {
        
        const int nstart=j+k*nx;

        oned_slice(nz,nstart,nxy,rho,rho1d);
        
        if (!reconstruct_Wv) {
          oned_slice(nz,nstart,       nxy,vup,velx1d);
          oned_slice(nz,nstart+nxyz,  nxy,vup,vely1d);
          oned_slice(nz,nstart+2*nxyz,nxy,vup,velz1d);
        } else {
          oned_slice(nz,nstart,       nxy,&Wvup.front(),velx1d);
          oned_slice(nz,nstart+nxyz,  nxy,&Wvup.front(),vely1d);
          oned_slice(nz,nstart+2*nxyz,nxy,&Wvup.front(),velz1d);
        }
        
        oned_slice(nz,nstart,nxy,eps,eps1d);
        oned_slice(nz,nstart,nxy,press,press1d);
        
        if(do_ye) {
          oned_slice(nz,nstart,nxy,Y_e,ye1d);
          if(do_temp){
            oned_slice(nz,nstart,nxy,temperature,temp1d);
          } 
        }
        
        if(do_mhd) {
          oned_slice(nz,nstart,       nxy,Bprim,Bvcx1d);
          oned_slice(nz,nstart+nxyz,  nxy,Bprim,Bvcy1d);
          oned_slice(nz,nstart+2*nxyz,nxy,Bprim,Bvcz1d);
          if(clean_divergence) {
            oned_slice(nz,nstart,nxy,psidc,psidc1d);
          }
          if (do_Avec)
            CCTK_WARN(0, "Someone needs to figure out which variables to pass for Avec");
        }
        
        ppm1d_cxx_func
          (cctk_lsh[2],CCTK_DELTA_SPACE(2),
           &rho1d[0],&velz1d[0],&velx1d[0],&vely1d[0],&eps1d[0],&press1d[0],&temp1d[0],
           &ye1d[0],&Bvcz1d[0],&Bvcx1d[0],&Bvcy1d[0],&psidc1d[0],
           &rho1d_minus[0],&velz1d_minus[0],&velx1d_minus[0],&vely1d_minus[0],&eps1d_minus[0],&temp1d_minus[0],
           &ye1d_minus[0],&Bvcz1d_minus[0],&Bvcx1d_minus[0],&Bvcy1d_minus[0],&psidc1d_minus[0],
           &rho1d_plus[0],&velz1d_plus[0],&velx1d_plus[0],&vely1d_plus[0],&eps1d_plus[0],&temp1d_plus[0],
           &ye1d_plus[0],&Bvcz1d_plus[0],&Bvcx1d_plus[0],&Bvcy1d_plus[0],&psidc1d_plus[0]);
        
        
        oned_unslice(nz,nstart,nxy,rho1d_minus,rhominus);
        oned_unslice(nz,nstart,nxy,rho1d_plus,rhoplus);
        
        oned_unslice(nz,nstart,nxy,velx1d_minus,velxminus);
        oned_unslice(nz,nstart,nxy,vely1d_minus,velyminus);
        oned_unslice(nz,nstart,nxy,velz1d_minus,velzminus);
        oned_unslice(nz,nstart,nxy,velx1d_plus,velxplus);
        oned_unslice(nz,nstart,nxy,vely1d_plus,velyplus);
        oned_unslice(nz,nstart,nxy,velz1d_plus,velzplus);
        if (reconstruct_Wv)
           undo_Wv<2>(nz, velzminus, velxminus, velyminus,
                          velzplus, velxplus, velyplus,
                          g33, g13, g23, g11, g12, g22,
                          cctkGH, j, k);
        
        oned_unslice(nz,nstart,nxy,eps1d_minus,epsminus);
        oned_unslice(nz,nstart,nxy,eps1d_plus,epsplus);
        
        if(do_ye) {
          oned_unslice(nz,nstart,nxy,ye1d_minus,Y_e_minus);
          oned_unslice(nz,nstart,nxy,ye1d_plus,Y_e_plus);
          if(do_temp) {
            oned_unslice(nz,nstart,nxy,temp1d_minus,tempminus);
            oned_unslice(nz,nstart,nxy,temp1d_plus,tempplus);
          }
        }
        
        if(do_mhd) {
          oned_unslice(nz,nstart,nxy,Bvcx1d_minus,Bvecxminus);
          oned_unslice(nz,nstart,nxy,Bvcy1d_minus,Bvecyminus);
          oned_unslice(nz,nstart,nxy,Bvcz1d_minus,Bveczminus);
          oned_unslice(nz,nstart,nxy,Bvcx1d_plus,Bvecxplus);
          oned_unslice(nz,nstart,nxy,Bvcy1d_plus,Bvecyplus);
          oned_unslice(nz,nstart,nxy,Bvcz1d_plus,Bveczplus);
          if(clean_divergence) {
            oned_unslice(nz,nstart,nxy,psidc1d_minus,psidcminus);
            oned_unslice(nz,nstart,nxy,psidc1d_plus,psidcplus);
          }
        }
        for (int i=0; i<nz; ++i) {
          SpaceMask_SetStateBits(space_mask, CCTK_GFINDEX3D(cctkGH, j,k,i), type_bitsz, not_trivialz);
        }
        
      }
    }
    } // pragma omp parallel

  }
}

```

GRHydro_Minima.cc:
```
 /*@@
   @file      GRHydro_Minima.cc
   @date      Tue Aug 29 18:52:10 2006
   @author    
   @desc 
        Sets up the scalars used for the atmosphere, after initial data.
   @enddesc 
 @@*/

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

//#include "Carpet/Carpet/src/carpet.hh"
#include "carpet.hh"

#ifdef HAVE_CARPET
using namespace Carpet;
#endif

#ifdef __cplusplus
  extern "C" {
#endif
    
    /* Scheduled functions */
    void GRHydro_Rho_Minima_Setup_Final(CCTK_ARGUMENTS);

    void GRHydro_Rho_Minima_Setup_Final_PUGH(CCTK_ARGUMENTS);
    
#ifdef __cplusplus
  } /* extern "C" */
#endif

 /*@@
   @routine    GRHydro_Rho_Minima_Setup_Final
   @date       Tue Aug 29 18:54:05 2006
   @author     Luca Baiotti
   @desc 
        After initial data, set up the scalar GRHydro_rho_min used for checking the atmosphere.
        This is computed taking into account the actual maximum rest-mass density on the grid.
        Version for Carpet.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 
@@*/

void GRHydro_Rho_Minima_Setup_Final(CCTK_ARGUMENTS)
{

#ifdef HAVE_CARPET

  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  CCTK_REAL  max_rho;

  static int flag = true;
  
  if (flag) // Actually run this reduction only the first time the routine is called.
    {
      if (rho_abs_min > 0.0)
        {
          *GRHydro_rho_min = rho_abs_min;
        }
      else
        {          
          // Go to global mode

          BEGIN_GLOBAL_MODE (cctkGH) {

            // Find the global maximum of rho

            const int Reduction_Handle = CCTK_ReductionHandle ("maximum");
            
            const CCTK_INT input_array_variable_indices= {CCTK_VarIndex("HydroBase::rho")};
            
            const int ierr = CCTK_Reduce(cctkGH,
                                         -1, // target processors; -1 -> all
                                         Reduction_Handle,
                                         1,  // number of output variables
                                         CCTK_VARIABLE_REAL,
                                         &max_rho,
                                         1,  // number of variables to be reduced
                                         input_array_variable_indices);
            
            if (ierr != 0)
              {
                CCTK_WARN(0, "Failed to compute the global maximum of rho");
              }
            
            *GRHydro_rho_min = max_rho * rho_rel_min;
            
            // Go back to local mode
          } END_GLOBAL_MODE;
          
        }
      // After this has run once, set the flag so that this does not run again
      flag = false;
    } // end if (flag)
  else
    {
      return;
    }

#endif

  //Debug stuff
  // char warnline;

  //CCTK_VInfo (CCTK_THORNSTRING, "STEP 2: compute rho max; rho min: %13.12e \n",*GRHydro_rho_min);

 //  printf(warnline,"STEP 2: compute rho max; rho min: %13.12e \n",*GRHydro_rho_min);
 //CCTK_WARN(1,warnline);

  //  printf(warnline,"STEP 3: recompute ID with new atmosphere; rho min: ', GRHydro_rho_min, 'reflev: ',%i), GRHydro_rho_min, GRHydro_reflevel);



}


 /*@@
   @routine    GRHydro_Rho_Minima_Setup_Final_PUGH
   @date       Tue Aug 29 18:57:42 2006
   @author     Luca Baiotti
   @desc 
         As above, but for PUGH.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 
@@*/

void GRHydro_Rho_Minima_Setup_Final_PUGH(CCTK_ARGUMENTS)
{ 
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;
  
  CCTK_REAL  max_rho;
  
  if (rho_abs_min > 0.0)
    {
      *GRHydro_rho_min = rho_abs_min;
    }
  else
    {      
      // Find the global maximum of rho
      
      const int Reduction_Handle = CCTK_ReductionHandle("maximum");
            
      const CCTK_INT input_array_variable_indices={CCTK_VarIndex("HydroBase::rho")};
      
      const int ierr = CCTK_Reduce(cctkGH,
                         -1, // target processors; -1 -> all
                         Reduction_Handle,
                         1,  // number of output variables   
                         CCTK_VARIABLE_REAL,
                         &max_rho,
                         1,  // number of variables to be reduced
                         input_array_variable_indices);
      
      if (ierr != 0)
        {
          CCTK_WARN(0, "Failed to compute the global maximum of rho");
        }
      
      *GRHydro_rho_min = max_rho * rho_rel_min;     
    }
}


```

GRHydro_Source.cc:
```
 /*@@
   @file      GRHydro_Source.cc
   @date      Nov 29, 2013
   @author    Christian Reisswig, Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   The geometric source terms for the matter evolution
   @enddesc 
 @@*/




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

#include <cstring>
#include <cassert>

#define velx vup
#define vely (&vup[N])
#define velz (&vup[2*N])
#define Bvecx Bprim
#define Bvecy (&Bprim[N])
#define Bvecz (&Bprim[2*N])
#define Avecx Avec
#define Avecy (&Avec[N])
#define Avecz (&Avec[2*N])
#define Avecrhsx Avecrhs
#define Avecrhsy (&Avecrhs[N])
#define Avecrhsz (&Avecrhs[2*N])
#define Bconsx Bcons
#define Bconsy (&Bcons[N])
#define Bconsz (&Bcons[2*N])
#define Bconsrhsx Bconsrhs
#define Bconsrhsy (&Bconsrhs[N])
#define Bconsrhsz (&Bconsrhs[2*N])


extern "C" CCTK_INT GRHydro_UseGeneralCoordinates(const cGH * cctkGH);

template <typename T> static inline T SQR (T const & x) { return x*x; }


struct alldiff2 {
  static void apply(const cGH* const restrict cctkGH,
                    CCTK_REAL dvars[][3],
                    const CCTK_REAL* const restrict * const restrict vars, 
                    const int i, const int j, const int k,
                    const CCTK_REAL* restrict const ih,
                    const int nvars)
  {
     for (int n=0; n < nvars; ++n) {
        dvars[n][0] = (vars[n][CCTK_GFINDEX3D(cctkGH, i+1,j,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i-1,j,k)]) * 0.5 * ih[0];
        dvars[n][1] = (vars[n][CCTK_GFINDEX3D(cctkGH, i,j+1,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j-1,k)]) * 0.5 * ih[1];
        dvars[n][2] = (vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k+1)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k-1)]) * 0.5 * ih[2];
     }
  }
};

struct alldiff4 {
  static void apply(const cGH* const restrict cctkGH,
                    CCTK_REAL dvars[][3],
                    const CCTK_REAL* const restrict * const restrict vars, 
                    const int i, const int j, const int k,
                    const CCTK_REAL* restrict const ih,
                    const int nvars)
  {
     for (int n=0; n < nvars; ++n) {
        dvars[n][0] = (        vars[n][CCTK_GFINDEX3D(cctkGH, i-2,j,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i+2,j,k)]
                      + 8.0 * (vars[n][CCTK_GFINDEX3D(cctkGH, i+1,j,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i-1,j,k)])) * (1.0 / 12.0) * ih[0];
        dvars[n][1] = (        vars[n][CCTK_GFINDEX3D(cctkGH, i,j-2,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j+2,k)]
                      + 8.0 * (vars[n][CCTK_GFINDEX3D(cctkGH, i,j+1,k)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j-1,k)])) * (1.0 / 12.0) * ih[1];
        dvars[n][2] = (        vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k-2)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k+2)]
                      + 8.0 * (vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k+1)] - vars[n][CCTK_GFINDEX3D(cctkGH, i,j,k-1)])) * (1.0 / 12.0) * ih[2];
     }
  }
};


static inline void UpperMetric(CCTK_REAL& restrict uxx,
                                CCTK_REAL& restrict uxy,
                                CCTK_REAL& restrict uxz,
                                CCTK_REAL& restrict uyy,
                                CCTK_REAL& restrict uyz,
                                CCTK_REAL& restrict uzz,
                                const CCTK_REAL det,
                                const CCTK_REAL gxx,
                                const CCTK_REAL gxy,
                                const CCTK_REAL gxz,
                                const CCTK_REAL gyy,
                                const CCTK_REAL gyz,
                                const CCTK_REAL gzz)
{
  const CCTK_REAL invdet = 1.0 / det;
  uxx = (-gyz*gyz + gyy*gzz)*invdet;
  uxy = (gxz*gyz - gxy*gzz)*invdet;
  uxz = (-gxz*gyy + gxy*gyz)*invdet;
  uyy = (-gxz*gxz + gxx*gzz)*invdet;
  uyz = (gxy*gxz - gxx*gyz)*invdet;
  uzz = (-gxy*gxy + gxx*gyy)*invdet;

  return;
}


template <class alldiff,
          bool do_mhd,
          bool do_clean_divergence,
          bool do_Avec>
static void SourceTerms_LL(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  /*
     Set up multipatch stuff
  */

  const CCTK_REAL * restrict vup;
  const CCTK_REAL * restrict Bprim;
  const CCTK_REAL * restrict g11;
  const CCTK_REAL * restrict g12;
  const CCTK_REAL * restrict g13;
  const CCTK_REAL * restrict g22;
  const CCTK_REAL * restrict g23;
  const CCTK_REAL * restrict g33;
  const CCTK_REAL * restrict k11;
  const CCTK_REAL * restrict k12;
  const CCTK_REAL * restrict k13;
  const CCTK_REAL * restrict k22;
  const CCTK_REAL * restrict k23;
  const CCTK_REAL * restrict k33;
  const CCTK_REAL * restrict beta1;
  const CCTK_REAL * restrict beta2;
  const CCTK_REAL * restrict beta3;

  //Multipatch related pointers
  if(GRHydro_UseGeneralCoordinates(cctkGH)) {
    vup=lvel;
    g11=gaa; g12=gab; g13=gac;
    g22=gbb; g23=gbc;
    g33=gcc;
    k11=kaa; k12=kab; k13=kac;
    k22=kbb; k23=kbc;
    k33=kcc;
    Bprim=lBvec;
    beta1 = betaa;
    beta2 = betab;
    beta3 = betac;
  } else {
    vup=vel;
    g11=gxx; g12=gxy; g13=gxz;
    g22=gyy; g23=gyz;
    g33=gzz;
    k11=kxx; k12=kxy; k13=kxz;
    k22=kyy; k23=kyz;
    k33=kzz;
    Bprim=Bvec;
    beta1 = betax;
    beta2 = betay;
    beta3 = betaz;
  }

  // TODO: for vectorization we might want to use cctk_ash (have to make sure
  // sensible values exist everywhere)
  const int nx=cctk_lsh[0];
  const int ny=cctk_lsh[1];
  const int nz=cctk_lsh[2];

  const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];

  const CCTK_REAL one = 1.00;
  const CCTK_REAL two = 2.00;
  const CCTK_REAL half = 0.50;
  const CCTK_REAL dx = CCTK_DELTA_SPACE(0);
  const CCTK_REAL dy = CCTK_DELTA_SPACE(1);
  const CCTK_REAL dz = CCTK_DELTA_SPACE(2);
  
  const CCTK_REAL ih[3] = { 1.0/dx, 1.0/dy, 1.0/dz };

#pragma omp parallel for
  for (int k=GRHydro_stencil; k < nz-GRHydro_stencil; ++k) {
    for (int j=GRHydro_stencil; j < ny-GRHydro_stencil; ++j) {
      for (int i=GRHydro_stencil; i < nx-GRHydro_stencil; ++i) {
        
        const int ijk = CCTK_GFINDEX3D(cctkGH, i, j, k);
        
        // TODO: these are not needed.
        const CCTK_REAL localgxx = g11[ijk];
        const CCTK_REAL localgxy = g12[ijk];
        const CCTK_REAL localgxz = g13[ijk];
        const CCTK_REAL localgyy = g22[ijk];
        const CCTK_REAL localgyz = g23[ijk];
        const CCTK_REAL localgzz = g33[ijk];

        const CCTK_REAL sqrtdet = sdetg[ijk];
        const CCTK_REAL invsqrtdet = 1./sqrtdet;
        
        CCTK_REAL uxx, uxy, uxz, uyy, uyz, uzz;
        UpperMetric(uxx, uxy, uxz, uyy, uyz, uzz, sqrtdet*sqrtdet, localgxx,
                    localgxy, localgxz, localgyy, localgyz, localgzz);
        
        const CCTK_REAL shiftx = beta1[ijk];
        const CCTK_REAL shifty = beta2[ijk];
        const CCTK_REAL shiftz = beta3[ijk];

        //  Derivatives of the lapse, metric and shift

        const int nvars = 10;
        const CCTK_REAL* const restrict vars[nvars] = { beta1, beta2, beta3, alp,
                                                     g11, g12, g13,
                                                     g22, g23,
                                                     g33 };
        CCTK_REAL dvars[nvars][3];
        
        alldiff::apply(cctkGH, dvars, vars, i, j, k, ih, nvars);
        
        const CCTK_REAL dx_betax = dvars[0][0];
        const CCTK_REAL dx_betay = dvars[1][0];
        const CCTK_REAL dx_betaz = dvars[2][0];
           
        const CCTK_REAL dy_betax = dvars[0][1];
        const CCTK_REAL dy_betay = dvars[1][1];
        const CCTK_REAL dy_betaz = dvars[2][1];
           
        const CCTK_REAL dz_betax = dvars[0][2];
        const CCTK_REAL dz_betay = dvars[1][2];
        const CCTK_REAL dz_betaz = dvars[2][2];
        
        const CCTK_REAL dx_alp = dvars[3][0];
        const CCTK_REAL dy_alp = dvars[3][1];
        const CCTK_REAL dz_alp = dvars[3][2];

        const CCTK_REAL dx_gxx = dvars[4][0];
        const CCTK_REAL dx_gxy = dvars[5][0];
        const CCTK_REAL dx_gxz = dvars[6][0];
        const CCTK_REAL dx_gyy = dvars[7][0];
        const CCTK_REAL dx_gyz = dvars[8][0];
        const CCTK_REAL dx_gzz = dvars[9][0];
        const CCTK_REAL dy_gxx = dvars[4][1];
        const CCTK_REAL dy_gxy = dvars[5][1];
        const CCTK_REAL dy_gxz = dvars[6][1];
        const CCTK_REAL dy_gyy = dvars[7][1];
        const CCTK_REAL dy_gyz = dvars[8][1];
        const CCTK_REAL dy_gzz = dvars[9][1];
        const CCTK_REAL dz_gxx = dvars[4][2];
        const CCTK_REAL dz_gxy = dvars[5][2];
        const CCTK_REAL dz_gxz = dvars[6][2];
        const CCTK_REAL dz_gyy = dvars[7][2];
        const CCTK_REAL dz_gyz = dvars[8][2];
        const CCTK_REAL dz_gzz = dvars[9][2];


        const CCTK_REAL invalp = 1.0 / alp[ijk];
        const CCTK_REAL invalp2 = SQR(invalp);
        const CCTK_REAL velxshift = velx[ijk] - shiftx*invalp;
        const CCTK_REAL velyshift = vely[ijk] - shifty*invalp;
        const CCTK_REAL velzshift = velz[ijk] - shiftz*invalp;

        // vel_i  = g_ij v^j
        // B_i = g_ij B^i

        const CCTK_REAL vlowx = g11[ijk]*velx[ijk] + g12[ijk]*vely[ijk] + g13[ijk]*velz[ijk];
        const CCTK_REAL vlowy = g12[ijk]*velx[ijk] + g22[ijk]*vely[ijk] + g23[ijk]*velz[ijk];
        const CCTK_REAL vlowz = g13[ijk]*velx[ijk] + g23[ijk]*vely[ijk] + g33[ijk]*velz[ijk];
        const CCTK_REAL Bvecxlow = do_mhd ? g11[ijk]*Bvecx[ijk] + g12[ijk]*Bvecy[ijk] + g13[ijk]*Bvecz[ijk] : 0;
        const CCTK_REAL Bvecylow = do_mhd ? g12[ijk]*Bvecx[ijk] + g22[ijk]*Bvecy[ijk] + g23[ijk]*Bvecz[ijk] : 0;
        const CCTK_REAL Bveczlow = do_mhd ? g13[ijk]*Bvecx[ijk] + g23[ijk]*Bvecy[ijk] + g33[ijk]*Bvecz[ijk] : 0;

        //  B^i v_i (= b^0/u^0)
        const CCTK_REAL Bdotv = do_mhd ? vlowx*Bvecx[ijk]+vlowy*Bvecy[ijk]+vlowz*Bvecz[ijk] : 0;

        // v^2 = v_i v^i; w=(1-v^2)^{-1/2}

        const CCTK_REAL v2 = vlowx*velx[ijk] + vlowy*vely[ijk] + vlowz*velz[ijk];
        const CCTK_REAL invw = sqrt(1.0-v2);
        const CCTK_REAL w = 1./invw;

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

        const CCTK_REAL b2 = do_mhd ? (Bvecx[ijk]*Bvecxlow+Bvecy[ijk]*Bvecylow+Bvecz[ijk]*Bveczlow)*SQR(invw)+SQR(Bdotv) : 0;

        // b_i = B_i/w +w*(B dot v)*v_i
        const CCTK_REAL bxlow = do_mhd ? Bvecxlow*invw+w*Bdotv*vlowx : 0;
        const CCTK_REAL bylow = do_mhd ? Bvecylow*invw+w*Bdotv*vlowy : 0;
        const CCTK_REAL bzlow = do_mhd ? Bveczlow*invw+w*Bdotv*vlowz : 0;


        // These are the contravariant components
        const CCTK_REAL bt = do_mhd ? w*invalp*Bdotv : 0;
        const CCTK_REAL bx = do_mhd ? Bvecx[ijk]*invw+w*Bdotv*velxshift : 0;
        const CCTK_REAL by = do_mhd ? Bvecy[ijk]*invw+w*Bdotv*velyshift : 0;
        const CCTK_REAL bz = do_mhd ? Bvecz[ijk]*invw+w*Bdotv*velzshift : 0;

        // TODO: all of these can be expressed much more easily in terms of the
        // conservatives
        const CCTK_REAL rhohstarW2 = (rho[ijk]*(one + eps[ijk]) + (press[ijk] + b2)) *
                                       SQR(w);
        const CCTK_REAL pstar = press[ijk]+0.50*b2;

        //  For a change, these are T^{ij}

        // TODO: strict IEEE compliance does not let the compiler remove "+ 0"
        // terms, so we have to do something else here
        const CCTK_REAL t00 = (rhohstarW2 - pstar)*invalp2-SQR(bt);
        const CCTK_REAL t0x = rhohstarW2*velxshift*invalp +
             pstar*shiftx*invalp2-bt*bx;
        const CCTK_REAL t0y = rhohstarW2*velyshift*invalp +
             pstar*shifty*invalp2-bt*by;
        const CCTK_REAL t0z = rhohstarW2*velzshift*invalp +
             pstar*shiftz*invalp2-bt*bz;
        const CCTK_REAL txx = rhohstarW2*velxshift*velxshift +
             pstar*(uxx - shiftx*shiftx*invalp2)-SQR(bx);
        const CCTK_REAL txy = rhohstarW2*velxshift*velyshift +
             pstar*(uxy - shiftx*shifty*invalp2)-bx*by;
        const CCTK_REAL txz = rhohstarW2*velxshift*velzshift +
             pstar*(uxz - shiftx*shiftz*invalp2)-bx*bz;
        const CCTK_REAL tyy = rhohstarW2*velyshift*velyshift +
             pstar*(uyy - shifty*shifty*invalp2)-SQR(by);
        const CCTK_REAL tyz = rhohstarW2*velyshift*velzshift +
             pstar*(uyz - shifty*shiftz*invalp2)-by*bz;
        const CCTK_REAL tzz = rhohstarW2*velzshift*velzshift +
             pstar*(uzz - shiftz*shiftz*invalp2)-SQR(bz);

//        Contract the shift with the extrinsic curvature

        const CCTK_REAL shiftshiftk = shiftx*shiftx*k11[ijk] +
                                      shifty*shifty*k22[ijk] +
                                      shiftz*shiftz*k33[ijk] +
             two*(shiftx*shifty*k12[ijk] +
                  shiftx*shiftz*k13[ijk] +
                  shifty*shiftz*k23[ijk]);

        const CCTK_REAL shiftkx = shiftx*k11[ijk] + shifty*k12[ijk] + shiftz*k13[ijk];
        const CCTK_REAL shiftky = shiftx*k12[ijk] + shifty*k22[ijk] + shiftz*k23[ijk];
        const CCTK_REAL shiftkz = shiftx*k13[ijk] + shifty*k23[ijk] + shiftz*k33[ijk];

//        Contract the matter terms with the extrinsic curvature

        const CCTK_REAL sumTK = txx*k11[ijk] + tyy*k22[ijk] + tzz*k33[ijk]
                         + two*(txy*k12[ijk] + txz*k13[ijk] + tyz*k23[ijk]);

//        Update term for tau
        
        const CCTK_REAL 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

        const CCTK_REAL 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;
        const CCTK_REAL 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;
        const CCTK_REAL 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

        const CCTK_REAL halfTdgx = half*(txx*dx_gxx + tyy*dx_gyy + tzz*dx_gzz) +
             txy*dx_gxy + txz*dx_gxz + tyz*dx_gyz;
        const CCTK_REAL halfTdgy = half*(txx*dy_gxx + tyy*dy_gyy + tzz*dy_gzz) +
             txy*dy_gxy + txz*dy_gxz + tyz*dy_gyz;
        const CCTK_REAL halfTdgz = half*(txx*dz_gxx + tyy*dz_gyy + tzz*dz_gzz) +
             txy*dz_gxy + txz*dz_gxz + tyz*dz_gyz;

     
       const CCTK_REAL sx_source = t00*
             (halfshiftdgx - alp[ijk]*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);
        
       const CCTK_REAL sy_source = t00*
             (halfshiftdgy - alp[ijk]*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);

       const CCTK_REAL sz_source = t00*
             (halfshiftdgz - alp[ijk]*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);

        densrhs[ijk] = 0.0;
        srhs[ijk]        = alp[ijk]*sqrtdet*sx_source;
        srhs[ijk + N]    = alp[ijk]*sqrtdet*sy_source;
        srhs[ijk + 2*N]  = alp[ijk]*sqrtdet*sz_source;
        taurhs[ijk]      = alp[ijk]*sqrtdet*tau_source;

        if (do_Avec) {

          // B^i and A^i both live in cell centers currently
          const CCTK_REAL Avcx_source = alp[ijk]*sqrtdet*(velyshift*Bvecz[ijk] - velzshift*Bvecy[ijk]);
          const CCTK_REAL Avcy_source = alp[ijk]*sqrtdet*(velzshift*Bvecx[ijk] - velxshift*Bvecz[ijk]);
          const CCTK_REAL Avcz_source = alp[ijk]*sqrtdet*(velxshift*Bvecy[ijk] - velyshift*Bvecx[ijk]);

          Avecrhsx[ijk] = Avcx_source;
          Avecrhsy[ijk] = Avcy_source;
          Avecrhsz[ijk] = Avcz_source;

        }

        if(do_clean_divergence) {
   
           // g^{jk} d_i g_{kj} = d_i (g) / det
           const CCTK_REAL dx_det_bydet = uxx*dx_gxx + uyy*dx_gyy + uzz*dx_gzz +
                two*(uxy*dx_gxy+uxz*dx_gxz+uyz*dx_gyz);
           const CCTK_REAL dy_det_bydet = uxx*dy_gxx + uyy*dy_gyy + uzz*dy_gzz +
                two*(uxy*dy_gxy+uxz*dy_gxz+uyz*dy_gyz);
           const CCTK_REAL dz_det_bydet = uxx*dz_gxx + uyy*dz_gyy + uzz*dz_gzz +
                two*(uxy*dz_gxy+uxz*dz_gxz+uyz*dz_gyz);

           // g^{ik} d_k g_{li}
           const CCTK_REAL gdg_x = uxx*dx_gxx + uxy*dy_gxx + uxz*dz_gxx +
                   uxy*dx_gxy + uyy*dy_gxy + uyz*dz_gxy +
                   uxz*dx_gxz + uyz*dy_gxz + uzz*dz_gxz;

           const CCTK_REAL gdg_y = uxx*dx_gxy + uxy*dy_gxy + uxz*dz_gxy +
                   uxy*dx_gyy + uyy*dy_gyy + uyz*dz_gyy +
                   uxz*dx_gyz + uyz*dy_gyz + uzz*dz_gyz;

           const CCTK_REAL gdg_z = uxx*dx_gxz + uxy*dy_gxz + uxz*dz_gxz +
                   uxy*dx_gyz + uyy*dy_gyz + uyz*dz_gyz +
                   uxz*dx_gzz + uyz*dy_gzz + uzz*dz_gzz;

           CCTK_REAL bvcx_source, bvcy_source, bvcz_source;
           psidcrhs[ijk] = -one * (kap_dc*alp[ijk] + 
                dx_betax + dy_betay + dz_betaz ) * psidc[ijk] + 
                Bconsx[ijk] * (dx_alp - half*alp[ijk] * 
                 ( uxx*dx_gxx + uyy*dx_gyy + uzz*dx_gzz + two*uxy*dx_gxy + 
                   two*uxz*dx_gxz + two*uyz*dx_gyz ) )*invsqrtdet + 
                Bconsy[ijk] * (dy_alp - half*alp[ijk] * 
                 ( uxx*dy_gxx + uyy*dy_gyy + uzz*dy_gzz + two*uxy*dy_gxy + 
                   two*uxz*dy_gxz + two*uyz*dy_gyz ) )*invsqrtdet + 
                Bconsz[ijk] * (dz_alp - half*alp[ijk] * 
                 ( uxx*dz_gxx + uyy*dz_gyy + uzz*dz_gzz + two*uxy*dz_gxy + 
                   two*uxz*dz_gxz + two*uyz*dz_gyz ) )*invsqrtdet;

           bvcx_source = -one * ( Bconsx[ijk]*dx_betax + 
                Bconsy[ijk]*dy_betax + Bconsz[ijk]*dz_betax ) + 
                psidc[ijk]*sqrtdet*(( uxx*dx_alp+uxy*dy_alp+uxz*dz_alp ) + 
                alp[ijk]*(half*( uxx*dx_det_bydet + 
                  uxy*dy_det_bydet + uxz*dz_det_bydet) - 
                ( uxx*gdg_x + uxy*gdg_y + uxz*gdg_z )));

           bvcy_source = -one * ( Bconsx[ijk]*dx_betay + 
                Bconsy[ijk]*dy_betay + Bconsz[ijk]*dz_betay ) + 
                psidc[ijk]*sqrtdet*(( uxy*dx_alp+uyy*dy_alp+uyz*dz_alp ) + 
                alp[ijk]*(half*( uxy*dx_det_bydet + 
                  uyy*dy_det_bydet + uyz*dz_det_bydet ) - 
                ( uxy*gdg_x + uyy*gdg_y + uyz*gdg_z )));

           bvcz_source = -one * ( Bconsx[ijk]*dx_betaz + 
                Bconsy[ijk]*dy_betaz + Bconsz[ijk]*dz_betaz ) + 
                psidc[ijk]*sqrtdet*(( uxz*dx_alp+uyz*dy_alp+uzz*dz_alp ) + 
                alp[ijk]*(half*( uxz*dx_det_bydet + 
                  uyz*dy_det_bydet + uzz*dz_det_bydet ) - 
                ( uxz*gdg_x + uyz*gdg_y + uzz*gdg_z )));

           Bconsrhsx[ijk] = bvcx_source;
           Bconsrhsy[ijk] = bvcy_source;
           Bconsrhsz[ijk] = bvcz_source;
        } // if(do_clean_divergence)

      } // for(i
    } // for(j
  } // for(k

#if(0) // poison edges of domain
  static int last_iteration_seen = -1;
  static int reflevel = -1;
  static int mol_substep;
  if(last_iteration_seen != cctk_iteration || reflevel != *GRHydro_reflevel) {
    last_iteration_seen = cctk_iteration;
    reflevel = *GRHydro_reflevel;
    mol_substep = 0;
  } else {
    mol_substep += 1;
  }
  for(k = 0 ; k < GRHydro_stencil*mol_substep ; ++k) {
    for(j = 0 ; j < cctk_ash[1] ; ++j) {
      for(i = 0 ; i < cctk_ash[0] ; ++i) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
  for(k = cctk_ash[2]-GRHydro_stencil*mol_substep ; k < cctk_ash[2] ; ++k) {
    for(j = 0 ; j < cctk_ash[1] ; ++j) {
      for(i = 0 ; i < cctk_ash[0] ; ++i) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
  for(i = 0 ; i < GRHydro_stencil*mol_substep ; ++i) {
    for(k = 0 ; k < cctk_ash[2] ; ++k) {
      for(j = 0 ; j < cctk_ash[1] ; ++j) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
  for(i = cctk_ash[0]-GRHydro_stencil*mol_substep ; i < cctk_ash[0] ; ++i) {
    for(k = 0 ; k < cctk_ash[2] ; ++k) {
      for(j = 0 ; j < cctk_ash[1] ; ++j) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
  for(j = 0 ; j < GRHydro_stencil*mol_substep ; ++j) {
    for(i = 0 ; i < cctk_ash[0] ; ++i) {
      for(k = 0 ; k < cctk_ash[2] ; ++k) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
  for(j = cctk_ash[1]-GRHydro_stencil*mol_substep ; j < cctk_ash[1] ; ++j) {
    for(i = 0 ; i < cctk_ash[0] ; ++i) {
      for(k = 0 ; k < cctk_ash[2] ; ++k) {
        dens[CCTK_GFINDEX3D(i,j,k)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
        Scon[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        tau[CCTK_GFINDEX3D(i,j,k)] = -1e100
        if(do_mhd) {
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,0)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,1)] = -1e100
          Bcons[CCTK_VECTGFINDEX3D(i,j,k,2)] = -1e100
        }
        if(do_clean_divergene)
          psidc[CCTK_GFINDEX3D(i,j,k)] = -1e100
      }
    }
  }
#endif
}

extern "C" void SourceTerms(CCTK_ARGUMENTS)
{
  DECLARE_CCTK_ARGUMENTS;
  DECLARE_CCTK_PARAMETERS;

  void (*sources)(CCTK_ARGUMENTS) = NULL;
  const bool do_Avec = CCTK_EQUALS(Bvec_evolution_method, "GRHydro_Avec");
#define T(e,t) (!!(e)==(t))
#define T3(t1,t2,t3)                \
        (T(*evolve_MHD,t1)      &&  \
         T(clean_divergence,t2) &&  \
         T(do_Avec,t3))
#define SET_SOURCES(df,t1,t2,t3) \
        if(T3(t1,t2,t3))         \
          sources=SourceTerms_LL<df,t1,t2,t3>;
  enum do_t {noMHD=0,MHD=1,noDC=0,DC=1,noAVec=0,AVec=1};

  // order of arguments:
  // do_MHD do_clean_divergence do_Avec
  if(sources_spatial_order == 4) {
    // no MHD
    SET_SOURCES(alldiff4,noMHD,noDC,noAVec)

    // not all combinations make sense for MHD, we list the ones that do
    SET_SOURCES(alldiff4,  MHD,noDC,noAVec)
    SET_SOURCES(alldiff4,  MHD,  DC,noAVec)
    SET_SOURCES(alldiff4,  MHD,  DC,noAVec)
    SET_SOURCES(alldiff4,  MHD,noDC,  AVec)
  } else if(sources_spatial_order == 2) {
    // no MHD
    SET_SOURCES(alldiff2,noMHD,noDC,noAVec)

    // not all combinations make sense for MHD, we list the ones that do
    SET_SOURCES(alldiff2,  MHD,noDC,noAVec)
    SET_SOURCES(alldiff2,  MHD,  DC,noAVec)
    SET_SOURCES(alldiff2,  MHD,  DC,noAVec)
    SET_SOURCES(alldiff2,  MHD,noDC,  AVec)
  }

  if(sources == NULL) {
    CCTK_VError(__LINE__, __FILE__, CCTK_THORNSTRING, 
                "No source terms can be computed for combination "
                "do_mhd = %d "
                "do_clean_divergence = %d "
                "do_Avec = %d sources_spatial_order = %d",
                int(*evolve_MHD),
                int(clean_divergence),
                int(do_Avec), int(sources_spatial_order));
  }

  // do some non-time critial operations here to reduce the number of templates 
  if(transport_constraints) {
    const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];
    // not much need to OpenMP parallelize this since it is pure memory access
    // and memset is highly optimized
    memset(Evec, 0, sizeof(Evec[0])*3*N);
    // I think IEEE requires an all zero byte double to be 0.
    assert(Evec[0] == 0.);
  }
  if(*evolve_Y_e) {
    const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];
    // not much need to OpenMP parallelize this since it is pure memory access
    // and memset is highly optimized
    memset(Y_e_con_rhs, 0, sizeof(Y_e_con_rhs[0])*N);
    // I think IEEE requires an all zero byte double to be 0.
    assert(Y_e_con_rhs[0] == 0.);
  }
  if(number_of_tracers>0) {
    const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];
    // not much need to OpenMP parallelize this since it is pure memory access
    // and memset is highly optimized
    memset(cons_tracerrhs, 0, sizeof(cons_tracerrhs[0])*number_of_tracers*N);
    // I think IEEE requires an all zero byte double to be 0.
    assert(cons_tracerrhs[0] == 0.);
  }
  if(*evolve_entropy) {
    const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];
    // not much need to OpenMP parallelize this since it is pure memory access
    // and memset is highly optimized
    memset(entropyrhs, 0, sizeof(entropyrhs[0])*N);
    // I think IEEE requires an all zero byte double to be 0.
    assert(entropyrhs[0] == 0.);
  }
  if(track_divB) {
    const int N = cctk_ash[0]*cctk_ash[1]*cctk_ash[2];
    // not much need to OpenMP parallelize this since it is pure memory access
    // and memset is highly optimized
    memset(divB, 0, sizeof(divB[0])*N);
    // I think IEEE requires an all zero byte double to be 0.
    assert(divB[0] == 0.);
  }

  sources(CCTK_PASS_CTOC);
}



```

GRHydro_UpdateMask.F90:
```
 /*@@
   @file      GRHydro_UpdateMask.F90
   @date      Wed Mar 13 14:18:38 2002
   @author    
   @desc 
   Alter the update terms if inside the atmosphere or excision region
   @enddesc 
 @@*/

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

#include "GRHydro_Macros.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 velx_p(i,j,k) vup_p(i,j,k,1)
#define vely_p(i,j,k) vup_p(i,j,k,2)
#define velz_p(i,j,k) vup_p(i,j,k,3)
#define velx_p_p(i,j,k) vup_p_p(i,j,k,1)
#define vely_p_p(i,j,k) vup_p_p(i,j,k,2)
#define velz_p_p(i,j,k) vup_p_p(i,j,k,3)

subroutine GRHydroUpdateAtmosphereMask(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k
  CCTK_REAL :: frac
  logical :: evolve_Bvec
  logical :: evolve_Avec

  frac = CCTK_DELTA_TIME

  evolve_Bvec = .false.
  evolve_Avec = .false.

  if (CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then
     evolve_Bvec = .true.
  elseif  (CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec") .or. CCTK_EQUALS(Bvec_evolution_method,"GRHydro_Avec_centered")) then
     evolve_Avec = .true.
  endif

  if(evolve_temper.ne.1.and.evolve_Y_e.ne.1) then
     !$OMP PARALLEL DO PRIVATE(k,j,i)
     do k = 1+GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil
        do j = 1+GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil
           do i = 1+GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil
              if ( GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0) .or. &
                   (atmosphere_mask(i,j,k) .ne. 0) .or. &
                      (tau(i,j,k) + frac * taurhs(i,j,k) .le. 0.d0) .or. &
                      (dens(i,j,k) + frac * densrhs(i,j,k) .le. 0.d0) ) then
                 densrhs(i,j,k) = 0.0d0
                 srhs(i,j,k,:)   = 0.0d0
                 taurhs(i,j,k)  = 0.0d0
                 
                 if (evolve_Bvec) then
                    Bconsrhs(i,j,k,:) = 0.0d0
                 endif
                 if (evolve_Avec) then
                    Avecrhs(i,j,k,:) = 0.0d0
                 endif
                 
                 ! TODO: Need to set Avecrhs and Aphirhs to zero for centered / or staggered case if vector potential is evolved

                 ! Set real-valued mask! This will be sync'ed and right after syncing translated to
                 ! our standard integer based mask (so that atmosphere_mask is still valid!).
                 atmosphere_mask_real(i,j,k) = 1
              end if
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  else
     ! allow negative total energy
     !$OMP PARALLEL DO PRIVATE(k,j,i)
     do k = 1+GRHydro_stencil, cctk_lsh(3)-GRHydro_stencil
        do j = 1+GRHydro_stencil, cctk_lsh(2)-GRHydro_stencil
           do i = 1+GRHydro_stencil, cctk_lsh(1)-GRHydro_stencil
              if ( GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0) .or. &
                   (atmosphere_mask(i,j,k) .ne. 0) .or. &
                      (dens(i,j,k) + frac * densrhs(i,j,k) .le. 0.d0) ) then
                 y_e_con_rhs(i,j,k) = 0.0d0
                 densrhs(i,j,k) = 0.0d0
                 srhs(i,j,k,:)   = 0.0d0
                 taurhs(i,j,k)  = 0.0d0
                 
                 if (evolve_Bvec) then
                    Bconsrhs(i,j,k,:) = 0.0d0
                 endif
                 if (evolve_Avec) then
                    Avecrhs(i,j,k,:) = 0.0d0
                 endif

                 ! TODO: Need to set Avecrhs and Aphirhs to zero for centered / or staggered case if vector potential is evolved

                 ! Set real-valued mask! This will be sync'ed and right after syncing translated to
                 ! our standard integer based mask (so that atmosphere_mask is still valid!).
                 atmosphere_mask_real(i,j,k) = 1
              end if
           end do
        end do
     end do
     !$OMP END PARALLEL DO
  endif

end subroutine GRHydroUpdateAtmosphereMask


subroutine GRHydroPostSyncAtmosphereMask(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k

!! This sets the integer atmo mask based on the real-valued (and sync'ed) atmo mask

   !$OMP PARALLEL DO PRIVATE(k,j,i)
   do k = 1, cctk_lsh(3)
      do j = 1, cctk_lsh(2)
         do i = 1, cctk_lsh(1)
            if ( abs(atmosphere_mask_real(i,j,k)) .gt. 0.5) then
               atmosphere_mask(i,j,k) = 1
            end if
         end do
      end do
   end do
   !$OMP END PARALLEL DO

end subroutine GRHydroPostSyncAtmosphereMask


 /*@@
   @routine    GRHydroCopyIntegerMask
   @date       Wed Jul  4 15:40:16 PDT 2012
   @author     Roland Haas
   @desc 
   Initializes real valued mask with integer valued one.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydroCopyIntegerMask(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i,j,k

!! This sets the real atmo mask based on the integer-valued atmo mask

   !$OMP PARALLEL DO PRIVATE(k,j,i)
   do k = 1, cctk_lsh(3)
      do j = 1, cctk_lsh(2)
         do i = 1, cctk_lsh(1)
            atmosphere_mask_real(i,j,k) = atmosphere_mask(i,j,k)
         end do
      end do
   end do
   !$OMP END PARALLEL DO

end subroutine GRHydroCopyIntegerMask


 /*@@
   @routine    GRHydro_SetupMask
   @date       Thu Jun 20 13:27:28 2002
   @author     Ian Hawke
   @desc 
   Initialize the mask to be zero.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_SetupMask(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  atmosphere_mask = 0
  atmosphere_mask_real = 0
  
  call CCTK_INFO("Setting up the atmosphere mask: all points are not_atmosphere")
  
end subroutine GRHydro_SetupMask

 /*@@
   @routine    GRHydro_InitAtmosMask
   @date       Thu Jun 20 13:27:28 2002
   @author     Ian Hawke
   @desc 
   Initialize the mask based on rho_min. This is used only if wk_atmosphere=yes.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_InitAtmosMask(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  DECLARE_CCTK_PARAMETERS

  CCTK_INT :: i,j,k
  CCTK_REAL :: dummy1, dummy2
  
  !$OMP PARALLEL DO PRIVATE(i,j,k, dummy1,dummy2)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        !if (rho(i,j,k) .le. GRHydro_rho_min) then
        IF_BELOW_ATMO(rho(i,j,k), GRHydro_rho_min, 0.0, r(i,j,k)) then
          atmosphere_mask(i,j,k) = 1
          atmosphere_mask_real(i,j,k) = 1
        end if
      end do
    end do
  end do
  !$OMP END PARALLEL DO

  call CCTK_INFO("Setting up the atmosphere mask: points with rho<rho_min are set to be atmosphere")
  
end subroutine GRHydro_InitAtmosMask

 /*@@
   @routine    GRHydro_AtmosphereReset
   @date       Thu Jun 20 13:30:51 2002
   @author     Ian Hawke
   @desc 
   After MoL has evolved, if a point is supposed to be reset then do so.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_AtmosphereReset(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS
  DECLARE_CCTK_PARAMETERS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet, dummy1, dummy2


  ! 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,xeps,xtemp,xye
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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

  if (verbose.eq.1) call CCTK_INFO("Entering AtmosphereReset.")

!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr, dummy1, dummy2)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        if (atmosphere_mask(i, j, k) .ne. 0) then

          SET_ATMO_MIN(rho(i,j,k), GRHydro_rho_min, r(i,j,k))
          velx(i,j,k) = 0.0d0
          vely(i,j,k) = 0.0d0
          velz(i,j,k) = 0.0d0
          sdet = sdetg(i,j,k)
          
          if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)

             call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                  cctk_iteration,i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(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), &
                  sdet,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), velx(i,j,k), vely(i,j,k), &
                  velz(i,j,k), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)
          else
             call prim2conpolytype(GRHydro_polytrope_handle, &
                  g11(i,j,k), g12(i,j,k), g13(i,j,k), &
                  g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
                  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), velx(i,j,k), vely(i,j,k), &
                  velz(i,j,k), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k))
             if (wk_atmosphere .eq. 0) then
                atmosphere_mask(i, j, k) = 0
                atmosphere_mask_real(i, j, k) = 0
             end if
          endif

        end if

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


end subroutine GRHydro_AtmosphereReset

subroutine GRHydro_InitialAtmosphereReset(CCTK_ARGUMENTS)

  implicit none

  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_INT :: i, j, k
  CCTK_REAL :: sdet
  CCTK_REAL :: rho_min, dummy1, dummy2

  CCTK_INT :: eos_handle


  ! 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)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p, g12_p, g13_p, g22_p, &
                                          g23_p, g33_p
  pointer (pg11_p,g11_p), (pg12_p,g12_p), (pg13_p,g13_p), (pg22_p,g22_p), &
                                          (pg23_p,g23_p), (pg33_p,g33_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p
  pointer (pvup_p,vup_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3) :: g11_p_p, g12_p_p, g13_p_p, g22_p_p, &
                                          g23_p_p, g33_p_p
  pointer (pg11_p_p,g11_p_p), (pg12_p_p,g12_p_p), (pg13_p_p,g13_p_p), (pg22_p_p,g22_p_p), &
                                          (pg23_p_p, g23_p_p), (pg33_p_p, g33_p_p)
  CCTK_REAL, DIMENSION(cctk_ash1,cctk_ash2,cctk_ash3,3) :: vup_p_p
  pointer (pvup_p_p,vup_p_p)

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  n=1;keytemp=0;anyerr=0;keyerr(1)=0
  xpress=0.0d0;xye=0.0d0;xeps=0.0d0;xtemp=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
  if (timelevels .gt. 1) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p = loc(gaa_p)
      pg12_p = loc(gab_p)
      pg13_p = loc(gac_p)
      pg22_p = loc(gbb_p)
      pg23_p = loc(gbc_p)
      pg33_p = loc(gcc_p)
      pvup_p = loc(lvel_p)
    else
      pg11_p = loc(gxx_p)
      pg12_p = loc(gxy_p)
      pg13_p = loc(gxz_p)
      pg22_p = loc(gyy_p)
      pg23_p = loc(gyz_p)
      pg33_p = loc(gzz_p)
      pvup_p = loc(vel_p)
    end if
  end if 
  if (timelevels .gt. 2) then
    if (GRHydro_UseGeneralCoordinates(cctkGH).ne.0) then
      pg11_p_p = loc(gaa_p_p)
      pg12_p_p = loc(gab_p_p)
      pg13_p_p = loc(gac_p_p)
      pg22_p_p = loc(gbb_p_p)
      pg23_p_p = loc(gbc_p_p)
      pg33_p_p = loc(gcc_p_p)
      pvup_p_p = loc(lvel_p_p)
    else
      pg11_p_p = loc(gxx_p_p)
      pg12_p_p = loc(gxy_p_p)
      pg13_p_p = loc(gxz_p_p)
      pg22_p_p = loc(gyy_p_p)
      pg23_p_p = loc(gyz_p_p)
      pg33_p_p = loc(gzz_p_p)
      pvup_p_p = loc(vel_p_p)
    end if
  end if 


  eos_handle = GRHydro_polytrope_handle
  
  rho_min = GRHydro_rho_min
  if (initial_atmosphere_factor .gt. 0) then
    rho_min = rho_min * initial_atmosphere_factor
  endif

!$OMP PARALLEL DO PRIVATE(sdet,keytemp,i,j,k,anyerr,keyerr, dummy1, dummy2)
  do k = 1, cctk_lsh(3)
    do j = 1, cctk_lsh(2)
      do i = 1, cctk_lsh(1)
        
        SET_ATMO_MIN(dummy2, rho_min, r(i,j,k))
        if (rho(i,j,k) .le. dummy2 .or. &
            GRHydro_enable_internal_excision /= 0 .and. &
            hydro_excision_mask(i,j,k) .ne. 0) then 
          SET_ATMO_MIN(rho(i,j,k), dummy2, r(i,j,k))
          sdet = sdetg(i,j,k)

          velx(i,j,k) = 0.0d0
          vely(i,j,k) = 0.0d0
          velz(i,j,k) = 0.0d0

          if(evolve_temper.ne.0) then
!             ! set the temperature to be relatively low
             temperature(i,j,k) = grhydro_hot_atmo_temp
             y_e(i,j,k) = grhydro_hot_atmo_Y_e
             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)

             call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                  cctk_iteration,i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(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), &
                  sdet,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), velx(i,j,k), vely(i,j,k), &
                  velz(i,j,k), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k),&
                  temperature(i,j,k),y_e(i,j,k))
             y_e_con(i,j,k) = dens(i,j,k) * y_e(i,j,k)
          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),xeps,xtemp,xye,press(i,j,k),eps(i,j,k),keyerr,anyerr)
             call prim2conpolytype(eos_handle, &
                  g11(i,j,k), g12(i,j,k), g13(i,j,k), &
                  g22(i,j,k), g23(i,j,k), g33(i,j,k), sdet, &
                  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), velx(i,j,k), vely(i,j,k), &
                  velz(i,j,k), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k))
          endif
        end if
        if (timelevels .gt. 1) then
          if (rho_p(i,j,k) .le. dummy2) then
            SET_ATMO_MIN(rho_p(i,j,k), dummy2, r(i,j,k))
            velx_p(i,j,k) = 0.0d0
            vely_p(i,j,k) = 0.0d0
            velz_p(i,j,k) = 0.0d0

            sdet = sqrt(SPATIAL_DETERMINANT(g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), \
                  g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k)))

            if(evolve_temper.ne.0) then
             ! set the temperature to be relatively low
             temperature_p(i,j,k) = grhydro_hot_atmo_temp
             y_e_p(i,j,k) = grhydro_hot_atmo_Y_e
             keytemp = 1
             call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                  rho_p(i,j,k),eps_p(i,j,k),temperature_p(i,j,k),y_e_p(i,j,k),&
                  press_p(i,j,k),keyerr,anyerr)

             call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                  cctk_iteration,i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k),&
                  g11_p(i,j,k),g12_p(i,j,k),&
                  g13_p(i,j,k),g22_p(i,j,k),g23_p(i,j,k),g33_p(i,j,k), &
                  sdet,dens_p(i,j,k),scon_p(i,j,k,1), scon_p(i,j,k,2), scon_p(i,j,k,3), &
                  tau_p(i,j,k), rho_p(i,j,k), velx_p(i,j,k), vely_p(i,j,k), &
                  velz_p(i,j,k), eps_p(i,j,k), press_p(i,j,k), w_lorentz_p(i,j,k),&
                  temperature_p(i,j,k),y_e_p(i,j,k))
             y_e_con_p(i,j,k) = dens_p(i,j,k) * y_e_p(i,j,k)
            else
               keytemp = 0
               call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p(i,j,k),eps_p(i,j,k),xtemp,xye,press_p(i,j,k),keyerr,anyerr)
               call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p(i,j,k),xeps,xtemp,xye,press_p(i,j,k),eps_p(i,j,k),keyerr,anyerr)
               call prim2conpolytype(eos_handle, &
                    g11_p(i,j,k), g12_p(i,j,k), g13_p(i,j,k), &
                    g22_p(i,j,k), g23_p(i,j,k), g33_p(i,j,k), sdet, &
                    dens_p(i,j,k), scon_p(i,j,k,1), scon_p(i,j,k,2), scon_p(i,j,k,3), &
                    tau_p(i,j,k), rho_p(i,j,k), velx_p(i,j,k), vely_p(i,j,k), &
                    velz_p(i,j,k), eps_p(i,j,k), press_p(i,j,k), w_lorentz_p(i,j,k))
            endif

          endif
        end if
        if (timelevels .gt. 2) then
          if (rho_p_p(i,j,k) .le. dummy2) then
            SET_ATMO_MIN(rho_p_p(i,j,k), dummy2, r(i,j,k))
            velx_p_p(i,j,k) = 0.0d0
            vely_p_p(i,j,k) = 0.0d0
            velz_p_p(i,j,k) = 0.0d0
            sdet = sqrt(SPATIAL_DETERMINANT(g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), \
                  g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k)))

            if(evolve_temper.ne.0) then
             ! set the temperature to be relatively low
             temperature_p_p(i,j,k) = grhydro_hot_atmo_temp
             y_e_p_p(i,j,k) = grhydro_hot_atmo_Y_e
             keytemp = 1
             call EOS_Omni_press(GRHydro_eos_handle,keytemp,GRHydro_eos_rf_prec,n,&
                  rho_p_p(i,j,k),eps_p_p(i,j,k),temperature_p_p(i,j,k),y_e_p_p(i,j,k),&
                  press_p_p(i,j,k),keyerr,anyerr)
             call prim2con_hot(GRHydro_eos_handle, keytemp, GRHydro_reflevel,&
                  cctk_iteration,i,j,k,x(i,j,k),y(i,j,k),z(i,j,k),r(i,j,k),&
                  g11_p_p(i,j,k),g12_p_p(i,j,k),&
                  g13_p_p(i,j,k),g22_p_p(i,j,k),g23_p_p(i,j,k),g33_p_p(i,j,k), &
                  sdet,dens_p_p(i,j,k),scon_p_p(i,j,k,1), scon_p_p(i,j,k,2), scon_p_p(i,j,k,3), &
                  tau_p_p(i,j,k), rho_p_p(i,j,k), velx_p_p(i,j,k), vely_p_p(i,j,k), &
                  velz_p_p(i,j,k), eps_p_p(i,j,k), press_p_p(i,j,k), w_lorentz_p_p(i,j,k),&
                  temperature_p_p(i,j,k),y_e_p_p(i,j,k))
             y_e_con_p_p(i,j,k) = dens_p_p(i,j,k) * y_e_p_p(i,j,k)
            else
               keytemp = 0
               call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p_p(i,j,k),eps_p_p(i,j,k),xtemp,xye,press_p_p(i,j,k),keyerr,anyerr)
               call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,&
                    rho_p_p(i,j,k),xeps,xtemp,xye,press_p_p(i,j,k),eps_p_p(i,j,k),keyerr,anyerr)
               call prim2conpolytype(eos_handle, &
                    g11_p_p(i,j,k), g12_p_p(i,j,k), g13_p_p(i,j,k), &
                    g22_p_p(i,j,k), g23_p_p(i,j,k), g33_p_p(i,j,k), sdet, &
                    dens_p_p(i,j,k), scon_p_p(i,j,k,1), scon_p_p(i,j,k,2), scon_p_p(i,j,k,3), &
                    tau_p_p(i,j,k), rho_p_p(i,j,k), velx_p_p(i,j,k), vely_p_p(i,j,k), &
                    velz_p_p(i,j,k), eps_p_p(i,j,k), press_p_p(i,j,k), w_lorentz_p_p(i,j,k))
            endif
          endif
        endif

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

end subroutine GRHydro_InitialAtmosphereReset


```

GRHydro_WENOScalars.F90:
```
 /*@@
   @file      GRHydro_WENOScalars.F90
   @date      Fri Jan  3 2013
   @author    Ian Hawke, Christian Reisswig
   @desc 
   Module containing the coefficient array for WENO reconstruction.
   @enddesc 
 @@*/

#include "cctk.h"

 module GRHydro_WENOScalars

   implicit none

   CCTK_REAL, allocatable, save :: weno_coeffs(:, :)
   CCTK_REAL, allocatable, save :: beta_shu(:, :)
   
 end module GRHydro_WENOScalars

```

GRHydro_RiemannSolveAM.F90:
```
 /*@@
   @file      GRHydro_RiemannSolveAM.F90
   @date      Sep 1, 2010
   @author    
   @desc 
   A wrapper routine to call the correct Riemann solver
   @enddesc 
 @@*/

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

 /*@@
   @routine    RiemannSolveAM
   @date       Sep 1, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Pedro Montero, Ian Hawke
   @desc 
   A wrapper routine to switch between the different Riemann solvers.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine RiemannSolveAM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (CCTK_EQUALS(riemann_solver,"HLLE").or.CCTK_EQUALS(riemann_solver,"LLF")) then
     
     call GRHydro_HLLE_AM(CCTK_PASS_FTOF)
     
     if (evolve_tracer .ne. 0) then
        
!!$ There are no special calls for tracers, which care not one whit about B-fields!    
!!$ Just call the standard version...
        
        call GRHydro_HLLE_Tracer(CCTK_PASS_FTOF)
        
     end if
     
!!$  else if (CCTK_EQUALS(riemann_solver,"Roe")) then   
!!$    
!!$    call GRHydro_RoeSolveAM(CCTK_PASS_FTOF)
!!$
!!$    if (evolve_tracer .ne. 0) then
!!$    
!!$      call GRHydro_HLLE_Tracer(CCTK_PASS_FTOF)
!!$
!!$    end if
!!$    
!!$  else if (CCTK_EQUALS(riemann_solver,"Marquina")) then   
!!$   
!!$    call GRHydro_MarquinaM(CCTK_PASS_FTOF)
     
!!$    Tracers are built directly in to the Marquina solver
     
  else
     
     call CCTK_ERROR("Roe and Marquina not implemented in MHD yet!!!")
     STOP
     
  end if
  
end subroutine RiemannSolveAM

 /*@@
   @routine    RiemannSolvePolytypeAM
   @date       Sep 1, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc 
   The same as above, just specializing to polytropic type EOS.
   Currently there is no point to this routine right now.
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/


subroutine RiemannSolvePolytypeAM(CCTK_ARGUMENTS)

  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  if (CCTK_EQUALS(riemann_solver,"HLLE")) then
    
     call GRHydro_HLLE_AM(CCTK_PASS_FTOF)
     
     if (evolve_tracer .ne. 0) then
        
!!$ Call the non-MHD version - see above
        
        call GRHydro_HLLE_Tracer(CCTK_PASS_FTOF)
        
     end if
     
!!$  else if (CCTK_EQUALS(riemann_solver,"Roe")) then   
!!$    
!!$    call GRHydro_RoeSolve(CCTK_PASS_FTOF)
!!$
!!$    if (evolve_tracer .ne. 0) then
!!$    
!!$      call GRHydro_HLLE_Tracer(CCTK_PASS_FTOF)
!!$
!!$    end if
!!$    
!!$  else if (CCTK_EQUALS(riemann_solver,"Marquina")) then   
!!$    
!!$    call GRHydro_Marquina(CCTK_PASS_FTOF)
     
!!$    Tracers are built directly in to the Marquina solver
     
  else
     
     call CCTK_ERROR("Roe and Marquina not implemented in MHD yet!!!")
     STOP

  end if
  
end subroutine RiemannSolvePolytypeAM






```

GRHydro_DivergenceClean.F90:
```
 /*@@
   @file      GRHydro_DivergenceClean.F90
   @date      Nov 24, 2010
   @author    
   @desc 
   Routines controlling divergence cleaning
   @enddesc 
 @@*/

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

 /*@@
   @routine    GRHydro_InitDivergenceClean
   @date       Nov 24, 2010
   @author     Joshua Faber
   @desc 
   Set Psi=0 initially for use with divergence cleaning
   @enddesc 
   @calls     
   @calledby   
   @history 
 
   @endhistory 

@@*/

subroutine GRHydro_InitDivergenceClean(CCTK_ARGUMENTS)
  
  implicit none
  
  DECLARE_CCTK_ARGUMENTS
  DECLARE_CCTK_FUNCTIONS

  psidc=0.0

end subroutine GRHydro_InitDivergenceClean

  


```

GRHydro_Con2PrimM_pt_EOSOmni.c.hopefullyfixed.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 ;
} ;

struct eosomnivars {
  CCTK_INT eoshandle,eoskeytemp;
  CCTK_REAL eosprec,eos_y_e[1],eos_temp[1];
  CCTK_INT eoskeyerr[1],eosanyerr[1];
} ;

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

void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt) (
    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 *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        =  \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 *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 *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;
  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 = *sdetg;
  CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; 
  CCTK_INT i,j, i_increase ;

  DECLARE_CCTK_PARAMETERS;
  
  struct LocGlob lg; 
  struct eosomnivars eosvars;

  eosvars.eoshandle = *handle;
  //printf("handle = %i\n",*handle);
  eosvars.eoskeytemp = *keytemp;
  eosvars.eosprec = *prec;
  eosvars.eos_y_e[0] = *y_e_in;
  eosvars.eos_temp[0] = *temp_in;
  eosvars.eoskeyerr[0] = 0;
  eosvars.eosanyerr[0] = 0;

  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," *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)) ;
  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.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    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;

  if (*handle==1 || *handle==2) {     
    p = pressure_rho0_u(rho0,u,gammaeos) ;  // EOS
  } else {
    p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
  }
  
  w = rho0 + u + p ;

  W_last = w*gammasq ;

  //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.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    return;
  }
  else{
    if(W <= 0. || W > W_TOO_BIG) {
      *retval = 3.;
      fprintf(stdout," *retval      = %26.16e \n", *retval      );
      return;
    }
  }

  // Calculate v^2:
  if( vsq >= 1. ) {
    *retval = 4.;
    fprintf(stdout," *retval      = %26.16e \n", *retval      );
    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) ;
  } else {
    u=x_3d[2];
    *epsilon = u/rho0;
    CCTK_REAL dum1,dum2;
    p = pressure_rho0_eps_eosomni(rho0,*epsilon,&dum1,&dum2,&eosvars) ;  // EOSOMNI
   // printf("%g %g %g %g\n",rho0,u,*epsilon,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((*handle==1 || *handle==2) &&  (rho0 <= 0.) || (u <= 0.)) {
    *epsnegative = 1; 
    fprintf(stdout," *epsnegative = %10d    \n", *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                );
    return;
  } else  if(rho0 <= 0.) { 
//    *epsnegative = 1; 
    fprintf(stdout," *epsnegative = %10d    \n", *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                );
    return;
  }

  *rho = rho0;

  if(*handle==1 || *handle==2) {     
    *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 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, 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);
  } 

  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) <= 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);

}

/**********************************************************************/
/*********************************************************************************
   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  W, vsq, u, p_tmp,epsilon,Wsq, dPdvsq, dPdW;
  CCTK_REAL res0, 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;


  W = x[0];
  vsq = x[1];
  u = x[2];
  
  Wsq = W*W;
  
  LorInv = sqrt(1.0-vsq);
  rho0 = lgp->D * LorInv;
  epsilon = u/rho0;
  p_tmp = pressure_rho0_eps_eosomni(rho0,epsilon,&dpdrho,&dpdeps,eosvars);

  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_RoeAverage.F90:
```
 /*@@
   @file      GRHydro_RoeAverage.F90
   @date      Sat Jan 26 01:54:09 2002
   @author    
   @desc 
   Calculates the Roe average of two states.
   @enddesc 
 @@*/

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

 /*@@
   @routine roeaverage    
   @date       Sat Jan 26 01:54:46 2002
   @author     Ian Hawke
   @desc 
   Calculate the Roe average of two states. Currently just 
   arithmetic averaging.
   @enddesc 
   @calls     
   @calledby   
   @history
   
   @endhistory 

@@*/

subroutine roeaverage(l, r, ave)
  
  implicit none
  
  CCTK_REAL, dimension(5) :: l, r, ave
  
  ave = 0.5d0 * (l + r)
  
end subroutine roeaverage
  

```

GRHydro_MP5Reconstruct.hh:
```
#ifndef _GRHYDRO_MP5RECONSTRUCT_HH
#define _GRHYDRO_MP5RECONSTRUCT_HH

#include "cctk.h"

using namespace std;


/**
   MP5 reconstruction operator.
*/
template <bool do_MP5_adaptive_epsilon>
struct GRHydro_MP5Reconstruct1d_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_MP5RECONSTRUCT_HH

```

util/Riemann1d-main.c:
```
void CCTK_FNAME(Riemann1d)(void);

int main(void)
{
  CCTK_FNAME(Riemann1d)();
  return 0;
}

```

util/Riemann1d.f90:
```
!!$/*@@
!!$  @file      Riemann1d.F90
!!$  @date      Tue Apr 29 11:42:30 2003
!!$  @author    Ian Hawke
!!$  @desc 
!!$  An old 1d Riemann solver for ideal relativistic hydro.
!!$  @enddesc 
!!$@@*/

subroutine Riemann1d

  implicit none
  
  integer :: mn, i, step, test
  real(kind=8) :: tol, pmin, pmax, dvel1, dvel2, check, gamma, t, &
       &gm1, mtol, xi, rad, vshockl, vshockr, csl, csls, csrs, &
       &csr, vels, ul, uls, urs, ur, hl, hls, hrs, hr, &
       &v12, sqrtgm1, v12ss, v12sr, eps, v1, v2, p1, p2
  real(kind=8), dimension(3) :: left, right, starl, starr, guess
  real(kind=8), dimension(5) :: waves, pwaves
  real(kind=8), dimension(4, 400) :: final
  integer :: method
  
!!$Parameters
  
  mn = 400
!!$  tol = 1.d-8
  
!!$Machine precision
  
  mtol = 1.d0
  do while (1.d0 + mtol > 1.d0)
     mtol = mtol / 2.d0
  end do
!!$  tol = mtol
  tol = 1.d-8
  eps = 1.d-6

!!$Initial Data

  t = 3.75d-1
  test = 3
  method = 3

  if (test == 1) then
    gamma = 5.d0 / 3.d0
    left(1) = 1.d0
    left(2) = 0.d0
    left(3) = 1.d2
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 1.d0
  else if (test == 2) then
    gamma = 4.d0 / 3.d0
    left(1) = 1.d0
    left(2) = 0.9d0
    left(3) = 1.d0
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 1.d1
  else if (test == 3) then
    gamma = 5.d0 / 3.d0
    left(1) = 1.d0
    left(2) = 0.d0
    left(3) = 1.d3
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 1.d-2
  else if (test == 4) then
    gamma = 5.d0 / 3.d0
    left(1) = 1.d0
    left(2) = -0.6d0
    left(3) = 1.d1
    right(1) = 1.d1
    right(2) = 0.5d0
    right(3) = 2.d1
  else if (test == 5) then
    gamma = 5.d0 / 3.d0
    left(1) = 25.d0
    left(2) = 0.d0
    left(3) = 5.d1
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 6.d0 
  else if (test == 6) then
    gamma = 5.d0 / 3.d0
    left(1) = 1.d0
    left(2) = 0.d0
    left(3) = 1.d0
    right(1) = 1.01d0
    right(2) = 0.01d0
    right(3) = 1.01d0 
  else if (test == 7) then
    gamma = 5.d0 / 3.d0
    left(1) = 1.0139158702550264d0
    left(2) = 6.57962037903012369d-3
    left(3) = 1.0309221446370552d-1
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 1.d-1
  else if (test == 8) then !!$ shock_case = Simple
    gamma = 5.d0 / 3.d0
    left(1) = 1.d1
    left(2) = 0.d0
    left(3) = 13.333333333333333333333d0
    right(1) = 1.d0
    right(2) = 0.d0
    right(3) = 6.666666666666666d-7
  else 
    write(*,*) "Test unrecognized"
    stop
  end if
  
  gm1 = gamma - 1.d0
  
!!$Find interval in which intermediate pressure lies

!!$The loop was from when I was doing efficiency testing
  
  do i = 1, 1
    
    if (method == 1) then
      
!!$This is standard interval bisection. 
!!$First we find an interval that contains the root.

      guess = 0.5d0 * (left + right)
      
      pmin = guess(3)
      pmax = pmin
      check = 1.d0
      
      step = 0
      
      do while (check > 0.d0)
        
        pmin = 0.5d0 * max(pmin, 0.d0)
        pmax = 2.d0 * pmax
        
        call getdvel(gamma, left, right, guess, pmin, dvel1, step)
        call getdvel(gamma, left, right, guess, pmax, dvel2, step)
        
        check = dvel1 * dvel2
        
      end do
      
!!$Find the intermediate pressure - and hence velocity
      
      call getp(mtol, gamma, pmin, pmax, tol, left, right, starl, &
           &starr, guess, step)
      
    else if (method==2) then

!!$This is Newton-Raphson method
      
      guess = (0.5d0 - eps) * (left + right)
      
      call getp2(gamma, tol, left, right, starl, starr, guess, &
           &step)
      
    else

!!$This is Rezzolla-Zanotti approach
      
      guess = 0.d0
      starr = 0.d0
      starl = 0.d0
      vshockl = 0.d0
      vshockr = 0.d0
      
      sqrtgm1 = sqrt(gm1)
      
      if (left(3) > right(3)) then
        v1 = left(2)
        v2 = right(2)
        p1 = left(3)
        p2 = right(3)
        guess = left
        call getvel(gamma, right, guess, 1.d0)
        v12ss = (guess(2) - right(2)) / (1.d0 - guess(2) * right(2))
        guess = right
        call getvel(gamma, left, guess, -1.d0)
        v12sr = -(guess(2) - left(2)) / (1.d0 - guess(2) * left(2))
      else
        v2 = -left(2)
        v1 = -right(2)
        p2 = left(3)
        p1 = right(3)
        guess = right
        call getvel(gamma, left, guess, -1.d0)
        v12ss = -(guess(2) - left(2)) / (1.d0 - guess(2) * left(2))
        guess = left
        call getvel(gamma, right, guess, 1.d0)
        v12sr = (guess(2) - right(2)) / (1.d0 - guess(2) * right(2))
      end if
      
      v12 = (v1 - v2) / (1.d0 - v1 * v2)
      
      if (v12 > v12ss) then
        
        pmin = max(p1, p2)
        pmax = pmin
        check = 1.d0
        do while (check > 0.d0)
          
          pmax = 2.d0 * pmax
          
          call getdvel(gamma, left, right, guess, pmin, dvel1, step)
          call getdvel(gamma, left, right, guess, pmax, dvel2, step)
          
          check = dvel1 * dvel2
          
        end do
        
      else if (v12 > v12sr) then
        
        pmin = min(p1, p2)
        pmax = max(p1, p2)
        
      else
        
        pmin = 1.d-20
        pmax = min(p1, p2)
        
      end if
      
!!$Safety!
      
      pmin = pmin * (1.d0 - eps)
      pmax = pmax * (1.d0 + eps)
      
!!$Find the intermediate pressure - and hence velocity
      
      call getp(mtol, gamma, pmin, pmax, tol, left, right, &
           &starl, starr, guess, step)
      
    end if
    
  end do
  
  call vshock(gamma, left, starl, starr, right)
  
  ul = left(3) / gm1 / left(1)
  uls = starl(3) / gm1 / starl(1)
  urs = starr(3) / gm1 / starr(1)
  ur = right(3) / gm1 / right(1)
  
  hl = 1.d0 + ul + left(3) / left(1)
  hls = 1.d0 + uls + starl(3) / starl(1)
  hrs = 1.d0 + urs + starr(3) / starr(1)
  hr = 1.d0 + ur + right(3) / right(1)

  csl = sqrt(gamma * left(3) / left(1) / hl)
  csls = sqrt(gamma * starl(3) / starl(1) / hls)
  csrs = sqrt(gamma * starr(3) / starr(1) / hrs)
  csr = sqrt(gamma * right(3) / right(1) / hr)

  vels = 0.5d0 * (starl(2) + starr(2))

!!$Find the characteristic speeds

  if (left(3) > starl(3)) then

!!$Left rarefaction

    waves(1) = (left(2) - csl) / (1.d0 - left(2) * csl)
    waves(2) = (starl(2) - csls) / (1.d0 - starl(2) * csls)

  else

!!$Left shock

    waves(1) = vshockl
    waves(2) = waves(1)

  end if

  waves(3) = vels
  
  if (right(3) > starl(3)) then

!!$Right rarefaction

    waves(4) = (starr(2) + csrs) / (1.d0 + starr(2) * csrs)
    waves(5) = (right(2) + csr) / (1.d0 + right(2) * csr)

  else

!!$Right shock

    waves(4) = vshockr
    waves(5) = waves(4)

  end if

  do i = 1, 2
    if (abs(waves(i)) > 1.d10) waves(i) = -1.d10
  end do
  do i = 4, 5
    if (abs(waves(i)) > 1.d10) waves(i) = 1.d10
  end do

  pwaves = 0.5d0 + t * waves

  do i = 1, mn

    rad = real(i) / real(mn)
    final(1, i) = rad

    if (rad < pwaves(1)) then

      final(2, i) = left(1)
      final(3, i) = left(2)
      final(4, i) = left(3)
      
    else if (rad < pwaves(2)) then
      
      xi = (rad - 0.5d0) / t
      
      call raref(gamma, xi, left, final(:, i), 1)
      
    else if (rad < pwaves(3)) then
      
      final(2, i) = starl(1)
      final(3, i) = starl(2)
      final(4, i) = starl(3)
      
    else if (rad < pwaves(4)) then
      
      final(2, i) = starr(1)
      final(3, i) = starr(2)
      final(4, i) = starr(3)
      
    else if (rad < pwaves(5)) then
      
      xi = (rad - 0.5d0) / t
      
      call raref(gamma, xi, right, final(:, i), -1)
      
    else
      
      final(2, i) = right(1)
      final(3, i) = right(2)
      final(4, i) = right(3)
      
    end if
    
  end do
  
  open(10, file='Exact_rho.dat')
  
  do i = 1, mn
    write(10, '(2e20.12)') final(1, i), final(2, i)
  end do
  
  close(10)

  open(11, file='Exact_velx.dat')
  
  do i = 1, mn
    write(11, '(2e20.12)') final(1, i), final(3, i)
  end do
  
  close(11)

  open(12, file='Exact_press.dat')
  
  do i = 1, mn
    write(12, '(2e20.12)') final(1, i), final(4, i)
  end do
  
  close(12)

contains
  
!!$Given a right and left state and a guess of the intermediate pressure, 
!!$returns the difference between the intermediate velocities connecting 
!!$right and left states. 

  subroutine getdvel(gamma, left, right, guess, pguess, dvel, step)

    implicit none

    real(kind=8), dimension(3) :: left, right, guess
    real(kind=8) :: dvel, pguess, gamma
    integer :: step
    
    step = step + 1
    
    guess(3) = pguess

!!$Left wave
      
    call getvel(gamma, left, guess, -1.d0)

    dvel = guess(2)

!!$Right wave

    call getvel(gamma, right, guess, 1.d0)

    dvel = dvel - guess(2)

  end subroutine getdvel

!!$Given a prewave state (known) and a postwave state (guess, with pressure
!!$and density guessed) returns with the postwave velocity. Sign indicates
!!$left (-) or right (+) wave

  subroutine getvel(gamma, known, guess, sign)

    implicit none

    real(kind=8), dimension(3) :: known, guess
    real(kind=8) :: gamma, gm1, cs, sign, a, b, c, h, e, ea, ua,&
         &ha, csa, k, sqgl1, v12
    
    gm1 = gamma - 1.d0
    ua = known(3) / gm1 / known(1)
    ea = known(1) + known(3) / gm1  
    ha = 1.d0 + ua + known(3) / known(1)
    csa = sqrt(gamma * known(3) / known(1) / ha) 
    
    if (guess(3) > known(3)) then
      
!!$Shock
      
      a = 1.d0 + gm1 * (known(3) - guess(3)) / gamma / guess(3)
      b = 1.d0 - a
      c = ha * (known(3) - guess(3)) / known(1) - ha * ha
      
      if (c > b * b / 4.d0 / a) then
        write (*,*) "unphysical enthalpy"
        stop
      endif
      
      h = (-b + sqrt(b * b - 4.d0 * a * c)) / 2.d0 / a
      
      guess(1) = gamma * guess(3) / gm1 / (h - 1.d0)
      e = guess(1) + guess(3) / gm1
      
      v12 = -sign * sqrt((guess(3) - known(3)) * (e - ea) / &
           &(ea + guess(3)) / (e + known(3)))
      
!!$         pp = guess(3) - known(3)
!!$         n = pp * ( guess(3) * (ha - 1.d0) * (gm1 + h) - &
!!$              &known(3) * (h - 1.d0) * (gm1 + ha) )
!!$         d = (ha - 1.d0) * (ea + guess(3)) * ( (gm1 + h) * pp + &
!!$              &gamma * h * known(3) )
!!$
!!$         v12 = -sign * sqrt(n / d)

      guess(2) = (known(2) - v12) / (1.d0 - known(2) * v12)

    else

!!$Rarefaction

      k = known(3) / known(1)**gamma
      
      guess(1) = (guess(3) / k)**(1.d0 / gamma)
      cs = sqrt(gamma * guess(3) / (guess(1) + gamma * guess(3) / gm1))
      sqgl1 = sqrt(gm1)
      a = (1.d0 + known(2)) / (1.d0 - known(2)) * &
           &((sqgl1 + csa) / (sqgl1 - csa) * (sqgl1 - cs) / &
           &(sqgl1 + cs))**(-sign * 2.d0 / sqgl1)
      guess(2) = (a - 1.d0) / (a + 1.d0)
      
    end if
    
  end subroutine getvel

!!$Given an interval, computes the correct intermediate pressure and 
!!$returns the intermediate state in star
    
  subroutine getp(mtol, gamma, pmin, pmax, tol, left, right, starl, &
       &starr, guess, step)
    
    implicit none
    
    real(kind=8), dimension(3) :: left, right, guess, starl, starr
    real(kind=8) :: pmin, pmax, tol, gamma, mtol, a, b, c, d, e, &
         &fa, fb, fc, tol1, xm, p, q, r, s
    logical :: flag
    integer :: step
    
    a = pmin
    b = pmax
    call getdvel(gamma, left, right, guess, a, fa, step)
    call getdvel(gamma, left, right, guess, b, fb, step)
    
    do
      
      c = a
      fc = fa
      d = b - a
      e = d
      
      flag = .false.
      
      do
        
        if (abs(fc) < abs(fb)) then
          a = b
          b = c
          c = a
          fa = fb
          fb = fc
          fc = fa
        end if

!!$Convergence test
        
        tol1 = 2.d0 * mtol * abs(b) + 0.5d0 * tol
        xm = 0.5d0 * (c - b)
        
        if ((abs(xm).le.tol1).or.(fb == 0.d0)) then
          flag = .true.
          exit
        end if
        
!!$Is bisection necessary?
        
        if ( (abs(e) .ge. tol1).and.(abs(fa) > abs(fb)) ) then
          
!!$If quadratic interpolation is impossible (a =  c) then do linear
          
          if (a == c) then
            
            s = fb / fa
            p = 2.d0 * xm * s
            q = 1.d0 - s
            
          else
            
            q = fa / fc
            r = fb / fc
            s = fb / fa
            p = s * ( 2.d0 * xm * q * (q - r) - (b - a) * (r - 1.d0) )
            q = (q - 1.d0) * (r - 1.d0) * (s - 1.d0)
            
          end if

!!$Adjust the signs
            
          if (p > 0.d0) q = -q
          p = abs(p)
          
!!$Is the interpolation acceptable?

          if ( (2.d0 * p < 3.d0 * xm * q - abs(tol1 * q)).and.&
               &(p < abs(0.5d0 * e * q)) ) then
            
            e = d
            d = p / q
            
          else
            
!!$Bisection
                  
            d = xm
            e = d
                  
          end if

        else

          d = xm
          e = d
          
        end if

!!$Complete the step
            
        a = b
        fa = fb
        
        if (abs(d) > tol1) then
          
          b = b + d
          
        else
          
          b = b + sign(tol1, xm)
          
        end if
        
        call getdvel(gamma, left, right, guess, b, fb, step)
        
        if ( fb * fc / abs(fc) > 0.d0 ) exit
        
      end do
      
      if (flag) exit
      
    end do

    starl(3) = b
    starr(3) = b
      
    guess = starl
      
    call getvel(gamma, left, guess, -1.d0)
    
    starl(1:2) = guess(1:2)
    
    guess = starr

    call getvel(gamma, right, guess, 1.d0)

    starr(1:2) = guess(1:2)

  end subroutine getp

  subroutine raref(gamma, xi, known, out, sign)

    implicit none
    
    real(kind=8), intent(in) :: gamma, xi
    real(kind=8), dimension(3) :: known
    real(kind=8), dimension(4) :: out
    integer, intent(in) :: sign
    real(kind=8) :: gm1, b, c, d, k, l, v, ua, ha, csa, cs2, &
         &ocs2, fcs2, dfdcs2, tol
    
    gm1 = gamma - 1.d0
    tol = 1.d-8
    ua = known(3) / gm1 / known(1)
    ha = 1.d0 + ua + known(3) / known(1)
    csa = sqrt(gamma * known(3) / known(1) / ha)
    b = sqrt(gm1)
    c = (b + csa) / (b - csa)
    d = -sign * b / 2.d0
    k = (1.d0 + xi) / (1.d0 - xi)
    l = c * k**d
    v = ((1.d0 - known(2)) / (1.d0 + known(2)))**d
    
    ocs2 = csa
    
    do
      
      fcs2 = l * v * (1.d0 + sign * ocs2)**d * (ocs2 - b) + &
           &(1.d0 - sign * ocs2)**d * (ocs2 + b)
      dfdcs2 = l * v * (1.d0 + sign * ocs2)**d * &
           &(1.d0 + sign * d * (ocs2 - b) / (1.d0 + sign * ocs2)) + &
           &(1.d0 - sign * ocs2)**d * (1.d0 - sign * d * (ocs2 + b) / &
           &(1.d0 - sign * ocs2)) 
      
      cs2 = ocs2 - fcs2 / dfdcs2
      
      if (abs(cs2 - ocs2) / ocs2 < tol) then
        
        exit
        
      else
        
        ocs2 = cs2
        
      end if
      
    end do
    
    out(3) = (xi + sign * cs2) / (1.d0 + sign * xi * cs2)
    out(2) = known(1) * ((cs2 * cs2 * (gm1 - csa * csa)) / &
         &(csa * csa * (gm1 - cs2 * cs2)))**(1.d0/gm1)
    out(4) = cs2 * cs2 * gm1 * out(2) / (gm1 - cs2 * cs2) / gamma
    
  end subroutine raref
  
!!$Given a right and left state and a guess of the intermediate pressure, 
!!$returns the difference between the intermediate velocities connecting 
!!$right and left states. 

  subroutine getdvel2(gamma, left, right, guess, pguess, dvel, step, &
       &dfdp)
    
    implicit none
    
    real(kind=8), dimension(3) :: left, right, guess
    real(kind=8) :: dvel, pguess, gamma, &
         &dfdp, dfdp1
    integer :: step
    
    step = step + 1
    
    guess(3) = pguess
    
!!$Left wave
    
    call getvel2(gamma, left, guess, -1.d0, dfdp1)
    
    dvel = guess(2)
    dfdp = dfdp1
    
!!$Right wave
    
    call getvel2(gamma, right, guess, 1.d0, dfdp1)
    
    dvel = dvel - guess(2)
    dfdp = dfdp - dfdp1
    
  end subroutine getdvel2
  
!!$Given a prewave state (known) and a postwave state (guess, with pressure
!!$and density guessed) returns with the postwave velocity. Sign indicates
!!$left (-) or right (+) wave
  
  subroutine getvel2(gamma, known, guess, sign, dfdp)

    implicit none

    real(kind=8), dimension(3) :: known, guess
    real(kind=8) :: gamma, gm1, cs, sign, a, b, c, h, ua, &
         &ha, csa, wa, k, sqgl1, dfdp, dhdp, &
         &dadp, e, dbdp, dcdp, &
         &dv12dp, v12, dedp, ea

    gm1 = gamma - 1.d0
    ua = known(3) / gm1 / known(1)
    ea = known(1) + known(3) / gm1 
    ha = 1.d0 + ua + known(3) / known(1)
    csa = sqrt(gamma * known(3) / known(1) / ha)
    wa = 1.d0 / sqrt(1.d0 - known(2) * known(2)) 

    if (guess(3) > known(3)) then

!!$Shock

      a = 1.d0 + gm1 * (known(3) - guess(3)) / gamma / guess(3)
      b = 1.d0 - a
      c = ha * (known(3) - guess(3)) / known(1) - ha * ha

      if (c > b * b / 4.d0 / a) then
        write(*,*) "unphysical enthalpy"
        stop
      endif

      h = (-b + sqrt(b * b - 4.d0 * a * c)) / 2.d0 / a

      dadp = -gm1 / gamma * known(3) / guess(3) / guess(3)
      dbdp = - dadp
      dcdp = - ha / known(1)
      dhdp = - (h * h * dadp + h * dbdp + dcdp) / (2.d0 * a * h + b)

      guess(1) = gamma * guess(3) / gm1 / (h - 1.d0)
      e = guess(1) + guess(3) / gm1

      dedp = gamma / gm1 * (h - 1.d0 - guess(3) * dhdp) / &
           &(h - 1.d0) / (h - 1.d0) + 1.d0 / gm1

      v12 = -sign * sqrt((guess(3) - known(3)) * (e - ea) / &
           &(ea + guess(3)) / (e + known(3)))

      dv12dp = (ea + known(3)) / 2.d0 / (ea + guess(3)) / &
           &(e + known(3)) * ( (e + known(3)) / (guess(3) - known(3)) + &
           &dedp * (ea + guess(3)) / (e - ea) )

      guess(2) = (known(2) - v12) / (1.d0 - known(2) * v12)

      dfdp = dv12dp * (known(2) * known(2) - 1.d0) / &
           &(known(2) * v12 - 1.d0)

    else

!!$Rarefaction

      k = known(3) / known(1)**gamma

      guess(1) = (guess(3) / k)**(1.d0 / gamma)
      cs = sqrt(gamma * guess(3) / (guess(1) + gamma * guess(3) / gm1))
      sqgl1 = sqrt(gm1)
      a = (1.d0 + known(2)) / (1.d0 - known(2)) * &
           &((sqgl1 + csa) / (sqgl1 - csa) * (sqgl1 - cs) / &
           &(sqgl1 + cs))**(-sign * 2.d0 / sqgl1)
      guess(2) = (a - 1.d0) / (a + 1.d0)

      dfdp = sign * cs / guess(3) * (1.d0 - guess(2) * guess(2))

    end if

  end subroutine getvel2

!!$Given an interval, computes the correct intermediate pressure and 
!!$returns the intermediate state in star
    
  subroutine getp2(gamma, tol, left, right, starl, &
       &starr, guess, step)

    implicit none

    real(kind=8), dimension(3) :: left, right, guess, starl, starr
    real(kind=8) :: tol, gamma, f, dfdp
    integer :: step

    step = 0

    if (guess(3) > 1.d-8) guess(3) = guess(3) - 1.d-8

    do

      if (step > 200) stop

      call getdvel2(gamma, left, right, guess, guess(3), f, &
           &step, dfdp)

      if (abs(f) < tol) then

        exit

      else

        guess(3) = guess(3) - f / dfdp  

        if (guess(3) < 1.d-20) guess(3) = 1.d-20

      end if

    end do

    starl(3) = guess(3)
    starr(3) = guess(3)

    guess = starl

    call getvel2(gamma, left, guess, -1.d0, dfdp)

    starl(1:2) = guess(1:2)

    guess = starr

    call getvel2(gamma, right, guess, 1.d0, dfdp)

    starr(1:2) = guess(1:2)

  end subroutine getp2

!!$Quick routine to find the shock velocities

  subroutine vshock(gamma, l, sl, sr, r)

    implicit none

    real(kind=8), dimension(3) :: l, sl, sr, r
    real(kind=8) :: h, j, gamma, gm1, &
         &ha, wa2, a, b

    gm1 = gamma - 1.d0
    vshockl = 0.d0
    vshockr = 0.d0

    if (sl(3) > l(3)) then

      wa2 = 1.d0 / (1.d0 - l(2) * l(2))
      ha = 1.d0 + l(3) / l(1) * gamma / gm1
      h = 1.d0 + sl(3) / sl(1) * gamma / gm1
      j = - sqrt((sl(3) - l(3)) / (ha / l(1) - h / sl(1)))
      a = j * j + l(1) * l(1) * wa2
      b = - l(2) * l(1) * l(1) * wa2
      vshockl = (-b - j * j * sqrt(1.d0 + l(1) * l(1) / j / j)) / a

    end if

    if (sr(3) > r(3)) then

      wa2 = 1.d0 / (1.d0 - r(2) * r(2))
      ha = 1.d0 + r(3) / r(1) * gamma / gm1
      h = 1.d0 + sr(3) / sr(1) * gamma / gm1
      j = sqrt((sr(3) - r(3)) / (ha / r(1) - h / sr(1)))
      a = j * j + r(1) * r(1) * wa2
      b = - r(2) * r(1) * r(1) * wa2
      vshockr = (-b + j * j * sqrt(1.d0 + r(1) * r(1) / j / j)) / a

    end if

  end subroutine vshock
    
end subroutine Riemann1d

```


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 solution:
src_code:  /*@@
   @file      GRHydro_EigenproblemM.F90
   @date      August 30, 2010
   @author    Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke, Pedro Montero, Joachim Frieben
   @desc
   Computes the spectral decomposition of a given state.
   Implements the analytical scheme devised by J. M. Ibanez
   et al., "Godunov Methods: Theory and Applications", New
   York, 2001, 485-503. The optimized method for computing
   the Roe flux in the special relativistic case is due to
   M. A. Aloy et al., Comput. Phys. Commun. 120 (1999)
   115-121, and has been extended to the general relativistic
   case as employed in this subroutine by J. Frieben, J. M.
   Ibanez, and J. Pons (in preparation).
   @enddesc
 @@*/

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

module GRHydro_EigenproblemM
  implicit none


 /*@@
   @routine    eigenvaluesM
   @date       Aug 30, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc
   Computes the eigenvalues of the Jacobian matrix evaluated
   at the given state.
   @enddesc
   @calls
   @calledby
   @history
   Culled from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

CONTAINS

subroutine eigenvaluesM(handle,rho,velx,vely,velz,eps,press,w_lorentz,&
     Bvcx,Bvcy,Bvcz,lam,gxx,gxy,gxz,gyy,gyz,gzz,u,alp,beta)
  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL, intent(in) :: rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL, intent(in) :: Bvcx,Bvcy,Bvcz
  CCTK_REAL, intent(out) :: lam(5)
  CCTK_REAL, intent(in) :: gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL, intent(in) :: alp,beta,u

  CCTK_REAL cs2,one,two,U2
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_INT, intent(in) :: handle
  CCTK_REAL dpdrho,dpdeps,press

  CCTK_REAL Bvcxlow,Bvcylow,Bvczlow,Bvc2,rhohstar,va2
  CCTK_REAL Bdotv,b2

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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            

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities


  call EOS_Omni_DPressByDEps(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdeps,keyerr,anyerr)

  call EOS_Omni_DPressByDRho(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,xtemp,xye,dpdrho,keyerr,anyerr)

  cs2 = (dpdrho + press * dpdeps / (rho**2))/ &
       (1.0d0 + eps + press/rho)

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

!!$ Lower the B-field, and square of the magnitude
  Bvcxlow = gxx*Bvcx + gxy*Bvcy + gxz*Bvcz
  Bvcylow = gxy*Bvcx + gyy*Bvcy + gyz*Bvcz
  Bvczlow = gxz*Bvcx + gyz*Bvcy + gzz*Bvcz
  Bvc2 = Bvcxlow*Bvcx + Bvcylow*Bvcy + Bvczlow*Bvcz

  Bdotv = Bvcxlow*velx + Bvcylow*vely + Bvczlow*velz
  w = w_lorentz

  b2=Bvc2/w**2+Bdotv**2

 
!!$ rhohstar is the term that appears in Tmunu as well = rho*enth + b^2
  rhohstar = rho*(1.0+eps)+press+b2

!!$ Alfven velocity squared
  va2 = b2/(rhohstar)

!!$ The following combination always comes up in the wavespeed calculation:
!!$ U2 = v_a^2 + c_s^2(1-v_a^2)
!!$ In the unmagnetized case, it reduces to cs2
  U2 = va2+cs2*(1.d0-va2)

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-U2) + sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)
  lamm_nobeta = (velx*(one-U2) - sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp

end subroutine eigenvaluesM

subroutine eigenvaluesM_hot(handle,ii,jj,kk,rho,velx,vely,velz,eps,press,w_lorentz,&
                             Bvcx,Bvcy,Bvcz,temp,ye,lam,gxx,gxy,gxz,gyy,gyz,gzz,u,alp,beta)
  implicit none

  DECLARE_CCTK_PARAMETERS
  !!DECLARE_CCTK_FUNCTIONS

  CCTK_REAL, intent(in) :: rho,velx,vely,velz,eps,w_lorentz
  CCTK_REAL, intent(in) :: Bvcx,Bvcy,Bvcz
  CCTK_REAL, intent(out) :: lam(5)
  CCTK_REAL, intent(in) :: gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL, intent(in) :: alp,beta,u
  CCTK_REAL, intent(in) :: temp,ye
  CCTK_REAL, intent(in) :: press

  CCTK_REAL cs2,one,two,U2
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta
  CCTK_INT, intent(in) :: handle, ii,jj,kk

  CCTK_REAL Bvcxlow,Bvcylow,Bvczlow,Bvc2,rhohstar,va2
  CCTK_REAL Bdotv,b2

! begin EOS Omni vars
  CCTK_INT  :: n,keytemp,anyerr,keyerr(1)
  CCTK_REAL :: xpress,xeps,xtemp,xye
  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            

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities

  call EOS_Omni_cs2(handle,keytemp,GRHydro_eos_rf_prec,n,&
       rho,eps,temp,ye,cs2,keyerr,anyerr)

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

!!$ Lower the B-field, and square of the magnitude
  Bvcxlow = gxx*Bvcx + gxy*Bvcy + gxz*Bvcz
  Bvcylow = gxy*Bvcx + gyy*Bvcy + gyz*Bvcz
  Bvczlow = gxz*Bvcx + gyz*Bvcy + gzz*Bvcz
  Bvc2 = Bvcxlow*Bvcx + Bvcylow*Bvcy + Bvczlow*Bvcz

  Bdotv = Bvcxlow*velx + Bvcylow*vely + Bvczlow*velz
  w = w_lorentz

  b2=Bvc2/w**2+Bdotv**2

 
!!$ rhohstar is the term that appears in Tmunu as well = rho*enth + b^2
  rhohstar = rho*(1.0+eps)+press+b2

!!$ Alfven velocity squared
  va2 = b2/(rhohstar)

!!$ The following combination always comes up in the wavespeed calculation:
!!$ U2 = v_a^2 + c_s^2(1-v_a^2)
!!$ In the unmagnetized case, it reduces to cs2
  U2 = va2+cs2*(1.d0-va2)

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-U2) + sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)
  lamm_nobeta = (velx*(one-U2) - sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp

end subroutine eigenvaluesM_hot
 
!!$ WE need to implement eigenproblem and eigenproblem_leftright!!!!


 /*@@
   @routine    eigenvalues_generalM
   @date       Aug 30, 2010
   @author     Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke
   @desc
   Computes the eigenvalues of the Jacobian matrix evaluated
   at the given state.
   @enddesc
   @calls
   @calledby
   @history
   Culled from the routines in GR3D, author Mark Miller.
   @endhistory

@@*/

subroutine eigenvalues_generalM(&
     velx,vely,velz,cs2,va2,&
     lam,&
     gxx,gxy,gxz,gyy,gyz,gzz,&
     u,alp,beta)

  implicit none

  DECLARE_CCTK_PARAMETERS
  DECLARE_CCTK_FUNCTIONS

  CCTK_REAL velx,vely,velz
  CCTK_REAL lam(5)
  CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz
  CCTK_REAL alp,beta,u,U2

  CCTK_REAL cs2,va2,one,two
  CCTK_REAL vlowx,vlowy,vlowz,v2,w
  CCTK_REAL lam1,lam2,lam3,lamm,lamp,lamm_nobeta,lamp_nobeta

  one = 1.0d0
  two = 2.0d0

!!$  Set required fluid quantities

  vlowx = gxx*velx + gxy*vely + gxz*velz
  vlowy = gxy*velx + gyy*vely + gyz*velz
  vlowz = gxz*velx + gyz*vely + gzz*velz
  v2 = vlowx*velx + vlowy*vely + vlowz*velz

  w = one / sqrt(one - v2)

  U2 = va2+cs2*(1-va2)

!!$  Calculate eigenvalues

  lam1 = velx - beta/alp
  lam2 = velx - beta/alp
  lam3 = velx - beta/alp
  lamp_nobeta = (velx*(one-U2) + sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)
  lamm_nobeta = (velx*(one-U2) - sqrt(U2*(one-v2)*&
       (u*(one-v2*U2) - velx**2*(one-U2))))/(one-v2*U2)

  lamp = lamp_nobeta - beta/alp
  lamm = lamm_nobeta - beta/alp

  lam(1) = lamm
  lam(2) = lam1
  lam(3) = lam2
  lam(4) = lam3
  lam(5) = lamp

end subroutine eigenvalues_generalM


!!$ We'll need to implement eigenproblem_general

end module GRHydro_EigenproblemM