diff options
| author | bmundim <bmundim@c83d129a-5a75-4d5a-9c4d-ed3a5855bf45> | 2010-09-29 21:47:21 +0000 |
|---|---|---|
| committer | bmundim <bmundim@c83d129a-5a75-4d5a-9c4d-ed3a5855bf45> | 2010-09-29 21:47:21 +0000 |
| commit | d95f7bc4e19ff9d991e17417b63318ea63d18491 (patch) | |
| tree | 66e5076c45f9755c76392ce7b9e1151cbca39c80 | |
| parent | 2a6108bcba664c662dde90c1893d87a6f5e7211d (diff) | |
Current RIT GRMHD code contributions:
Add the magnetized counterparts for several GRHydro routines.
Adjust interface.ccl, param.ccl and schedule.ccl appropriately.
git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinEvolve/GRHydro/trunk@158 c83d129a-5a75-4d5a-9c4d-ed3a5855bf45
28 files changed, 8614 insertions, 186 deletions
diff --git a/interface.ccl b/interface.ccl index 4cc35be..03f3c10 100644 --- a/interface.ccl +++ b/interface.ccl @@ -97,12 +97,40 @@ void FUNCTION Prim2ConPoly(CCTK_INT IN handle, \ 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 IN Bvecx, CCTK_REAL IN Bvecy, \ + CCTK_REAL IN Bvecz, 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 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 IN Bvecx, CCTK_REAL IN Bvecy, \ + CCTK_REAL IN Bvecz, 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) + PROVIDES FUNCTION SpatialDet WITH SpatialDeterminant LANGUAGE Fortran PROVIDES FUNCTION UpperMet WITH UpperMetric LANGUAGE Fortran #PROVIDES FUNCTION Con2Prim WITH Con2Prim_pt LANGUAGE Fortran PROVIDES FUNCTION Con2PrimPoly WITH Con2Prim_ptPolytype LANGUAGE Fortran PROVIDES FUNCTION Prim2ConGen WITH prim2con LANGUAGE Fortran PROVIDES FUNCTION Prim2ConPoly WITH prim2conpolytype LANGUAGE Fortran +PROVIDES FUNCTION Prim2ConGenM WITH prim2conM LANGUAGE Fortran +PROVIDES FUNCTION Prim2ConPolyM WITH prim2conpolytypeM LANGUAGE Fortran #################################################### ### Functions provided by MoL for registration ### @@ -274,9 +302,9 @@ real tau type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolo real scon[3] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="D" tensorweight=+1.0 interpolator="matter"' "generalized momenta" -real bcom[3] type = GF Timelevels = 3 tags='Prolongation="none" tensortypealias="D" tensorweight=+1.0 interpolator="matter"' "comoving magnetic field components" +#real bcom[3] type = GF Timelevels = 3 tags='Prolongation="none" tensortypealias="D" tensorweight=+1.0 interpolator="matter"' "comoving magnetic field components" -real bcom0 type = GF Timelevels = 3 tags='Prolongation="none" tensortypealias="Scalar"' "0 component of the comoving magnetic field" +#real bcom0 type = GF Timelevels = 3 tags='Prolongation="none" tensortypealias="Scalar"' "0 component of the comoving magnetic field" real GRHydro_tracers[number_of_tracers] type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase::prolongation_type" tensortypealias="Scalar"' { @@ -288,6 +316,7 @@ real w_lorentz type = GF Timelevels = 3 tags='ProlongationParameter="HydroBase:: 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 Bvecrhs[3] type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' "Update term for Bvec" ################################################## ### These variables are only protected so that ### @@ -344,6 +373,11 @@ real GRHydro_fluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoin densflux, sxflux, syflux, szflux, tauflux } "Fluxes for each conserved variable" +real GRHydro_Bfluxes type = GF Timelevels = 1 tags='Prolongation="None" checkpoint="no"' +{ + Bvecxflux, Bvecyflux, Bveczflux +} "Fluxes for each B-field variable" + private: int MHD type = SCALAR tags='checkpoint="no"' "Are we doing MHD? Set in ParamCheck" @@ -356,6 +390,11 @@ real GRHydro_con_bext type = GF Timelevels = 1 tags='Prolongation="None" checkpo 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"' +{ + Bvecxplus,Bvecyplus,Bveczplus,Bvecxminus,Bvecyminus,Bveczminus +} "Conservative variables extended to the cell boundaries" + # real fluxweightvolume type = GF Timelevels = 1 # { # cell_volume @@ -68,7 +68,7 @@ CCTK_INT GRHydro_hydro_excision "Turns excision automatically on in HydroBase" A CCTK_INT GRHydro_MaxNumEvolvedVars "The maximum number of evolved variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_Evolved_Vars { - 5:8 :: "dens scon[3] tau" + 5:8 :: "dens scon[3] tau Bvec[3]" } 5 CCTK_INT GRHydro_MaxNumConstrainedVars "The maximum number of constrained variables used by GRHydro" ACCUMULATOR-BASE=MethodofLines::MoL_Num_Constrained_Vars diff --git a/schedule.ccl b/schedule.ccl index 798bb05..8f17354 100644 --- a/schedule.ccl +++ b/schedule.ccl @@ -25,8 +25,7 @@ if (timelevels == 3) STORAGE: ADMBase::lapse[3] if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - STORAGE:bcom0[3] - STORAGE:bcom[3] + STORAGE: HydroBase::Bvec[3] } } else @@ -43,8 +42,7 @@ else STORAGE: ADMBase::lapse[2] if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - STORAGE:bcom0[2] - STORAGE:bcom[2] + STORAGE: HydroBase::Bvec[2] } } STORAGE:MHD @@ -52,6 +50,7 @@ STORAGE:GRHydro_reflevel STORAGE:densrhs STORAGE:taurhs STORAGE:srhs +STORAGE:Bvecrhs STORAGE:GRHydro_eos_scalars STORAGE:GRHydro_minima STORAGE:GRHydro_scalars @@ -165,14 +164,30 @@ schedule GRHydro_ParamCheck AT PARAMCHECK LANG: Fortran } "Check parameters" +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) +{ + schedule GRHydro_ParamCheckM AT PARAMCHECK AFTER GRHydro_ParamCheck + { + LANG: Fortran + } "Check parameters - MHD version" +} + ###################################### ### Standard symmetry registration ### ###################################### -schedule GRHydro_InitSymBound AT BASEGRID +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran -} "Schedule symmetries" + schedule GRHydro_InitSymBoundM AT BASEGRID + { + LANG: Fortran + } "Schedule symmetries - MHD version" +} else { + schedule GRHydro_InitSymBound AT BASEGRID + { + LANG: Fortran + } "Schedule symmetries" +} ########################################################## ### Schedule the flux weighting calculation at initial ### @@ -191,11 +206,21 @@ SCHEDULE GROUP GZPatchSystem_register { } "Tell Cactus that this group exists, but is not scheduled from here" -SCHEDULE GRHydro_register_GZPatchSystem IN GZPatchSystem_register +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: C - OPTIONS: meta -} "register to-be-interpatch-synchronized variables with GZPatchSystem" + SCHEDULE GRHydro_register_GZPatchSystemM IN GZPatchSystem_register + { + LANG: C + OPTIONS: meta + } "register to-be-interpatch-synchronized variables with GZPatchSystem - MHD version" + +} else { + SCHEDULE GRHydro_register_GZPatchSystem IN GZPatchSystem_register + { + LANG: C + OPTIONS: meta + } "register to-be-interpatch-synchronized variables with GZPatchSystem" +} ################################## ### Set the handle for the EOS ### @@ -228,27 +253,57 @@ if (rho_abs_min_after_recovery > 0.0) } "Set up minimum for the rest-mass density in the atmosphere (before intial data)" } -if (CCTK_IsThornActive("PUGH" )) +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - schedule GRHydro_Rho_Minima_Setup_Final_PUGH AT CCTK_PostInitial BEFORE MoL_PostStep - { - LANG: C - } "Set the value of the rest-mass density of the atmosphere which will be used during the evolution (PUGH)" - schedule GRHydro_InitialAtmosphereReset AT CCTK_PostInitial BEFORE 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_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_InitialAtmosphereReset AT CCTK_PostPostInitial BEFORE Con2Prim AFTER GRHydro_Rho_Minima_Setup_Final - { - LANG: Fortran - } "Use mask to enforce atmosphere at initial time" + + if (CCTK_IsThornActive("PUGH" )) + { + schedule GRHydro_Rho_Minima_Setup_Final_PUGH AT CCTK_PostInitial BEFORE MoL_PostStep + { + LANG: C + } "Set the value of the rest-mass density of the atmosphere which will be used during the evolution (PUGH)" + schedule GRHydro_InitialAtmosphereResetM AT CCTK_PostInitial BEFORE 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_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_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_IsThornActive("PUGH" )) + { + schedule GRHydro_Rho_Minima_Setup_Final_PUGH AT CCTK_PostInitial BEFORE MoL_PostStep + { + LANG: C + } "Set the value of the rest-mass density of the atmosphere which will be used during the evolution (PUGH)" + schedule GRHydro_InitialAtmosphereReset AT CCTK_PostInitial BEFORE 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_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_InitialAtmosphereReset AT CCTK_PostPostInitial BEFORE Con2Prim AFTER GRHydro_Rho_Minima_Setup_Final + { + LANG: Fortran + } "Use mask to enforce atmosphere at initial time" + } + } @@ -334,10 +389,18 @@ if (EoS_Change) ### Standard registration of variables to MoL ### ################################################# -schedule GRHydro_Register IN MoL_Register +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: C -} "Register variables for MoL" + schedule GRHydro_RegisterM IN MoL_Register + { + LANG: C + } "Register variables for MoL - MHD version" +} else { + schedule GRHydro_Register IN MoL_Register + { + LANG: C + } "Register variables for MoL" +} #################################################### ### Setup of any scalars for efficiency purposes ### @@ -423,17 +486,33 @@ schedule group GRHydroRHS IN HydroBase_RHS # 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 # -# schedule Primitive2ConservativeCells AT CCTK_POSTINITIAL AFTER GZPatchSystem_cxform BEFORE MoL_PostStep -# { -# LANG: Fortran -# } "Convert to conserved variables" +# 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" +# } # #============================================== @@ -457,11 +536,18 @@ if (number_of_particles) ### over the different directions ### #################################################################### -schedule SourceTerms IN GRHydroRHS BEFORE FluxTerms +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran -} "Source term calculation" - + schedule SourceTermsM IN GRHydroRHS BEFORE FluxTerms + { + LANG: Fortran + } "Source term calculation - MHD version" +} else { + schedule SourceTerms IN GRHydroRHS BEFORE FluxTerms + { + LANG: Fortran + } "Source term calculation" +} ################################################################# ### Initial setup for the loop over the different directions. ### ################################################################# @@ -487,27 +573,56 @@ schedule GRHydroStartLoop IN GRHydroRHS BEFORE FluxTerms if (CCTK_Equals(method_type, "RSA FV")) { - + if (evolve_tracer) { - 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" + 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_Bfluxes + 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 { - schedule group FluxTerms IN GRHydroRHS WHILE GRHydro::flux_direction + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - STORAGE:GRHydro_prim_bext - STORAGE:GRHydro_con_bext - STORAGE:GRHydro_fluxes - } "Calculation of intercell fluxes" + 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_Bfluxes + } "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" + } } ############################################################## @@ -516,19 +631,34 @@ if (CCTK_Equals(method_type, "RSA FV")) if (CCTK_Equals(GRHydro_eos_type,"General")) { - schedule Reconstruction IN FluxTerms AS Reconstruct + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - } "Reconstruct the functions at the cell boundaries" + schedule ReconstructionM IN FluxTerms AS Reconstruct + { + LANG: Fortran + } "Reconstruct the functions at the cell boundaries - MHD version" + } 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 + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - } "Reconstruct the functions at the cell boundaries" - + schedule ReconstructionPolytypeM IN FluxTerms AS Reconstruct + { + LANG: Fortran + } "Reconstruct the functions at the cell boundaries - MHD version" + } else { + schedule ReconstructionPolytype IN FluxTerms AS Reconstruct + { + LANG: Fortran + } "Reconstruct the functions at the cell boundaries" + } } if (set_trivial_rp_grid_function) @@ -547,21 +677,38 @@ if (CCTK_Equals(method_type, "RSA FV")) if (use_eosgeneral) { - schedule RiemannSolveGeneral IN FluxTerms AFTER Reconstruct AS Riemann + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - STORAGE: EOS_temps - STORAGE: RoeAverage_temps - } "Solve the local Riemann problems" + schedule RiemannSolveGeneralM IN FluxTerms AFTER Reconstruct AS Riemann + { + LANG: Fortran + STORAGE: EOS_temps + STORAGE: RoeAverage_temps + } "Solve the local Riemann problems - MHD Version" + } else { + schedule RiemannSolveGeneral IN FluxTerms AFTER Reconstruct AS Riemann + { + LANG: Fortran + STORAGE: EOS_temps + STORAGE: RoeAverage_temps + } "Solve the local Riemann problems" + } } else if (CCTK_Equals(GRHydro_eos_type,"General")) { - - schedule RiemannSolve IN FluxTerms AFTER Reconstruct AS Riemann + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - STORAGE: EOS_temps - } "Solve the local Riemann problems" - + schedule RiemannSolve IN FluxTerms AFTER Reconstruct AS Riemann + { + LANG: Fortran + STORAGE: EOS_temps + } "Solve the local Riemann problems - 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")) { @@ -576,6 +723,10 @@ if (CCTK_Equals(method_type, "RSA FV")) else if (CCTK_Equals(method_type, "Flux split FD")) { + +##########################################3 +### MHD not implemented yet for Flux split FD !!! +########################################## STORAGE:fs_alpha if (evolve_tracer) @@ -629,16 +780,24 @@ else if (CCTK_Equals(method_type, "Flux split FD")) ### After calculating the fluxes, calculate the update. ### ########################################################### -schedule UpdateCalculation IN FluxTerms AFTER Riemann +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran -} "Calculate the update term from the fluxes" + schedule UpdateCalculationM IN FluxTerms AFTER Riemann AS UpdateCalcul + { + LANG: Fortran + } "Calculate the update term from the fluxes - MHD version" +} else { + 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 UpdateCalculation +schedule GRHydroAdvanceLoop IN FluxTerms AFTER UpdateCalcul { LANG: Fortran OPTIONS: level @@ -715,64 +874,117 @@ if (use_eosgeneral) SYNC: metric_temps } "Set the temporary metric terms" - - if (CCTK_Equals(GRHydro_eos_type,"General")) + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - - schedule Conservative2PrimitiveGeneral IN HydroBase_Con2Prim AS Con2Prim + if (CCTK_Equals(GRHydro_eos_type,"General")) { - LANG: Fortran - STORAGE: Con2Prim_temps - } "Convert back to primitive variables (general)" - - schedule Primitive2ConservativeCellsGeneral IN HydroBase_Prim2ConInitial + schedule Conservative2PrimitiveGeneralM IN HydroBase_Con2Prim AS Con2Prim + { + LANG: Fortran + STORAGE: Con2Prim_temps + } "Convert back to primitive variables (general) - MHD version" + + schedule Primitive2ConservativeCellsGeneralM IN HydroBase_Prim2ConInitial + { + LANG: Fortran + } "Convert initial data given in primive variables to conserved variables - MHD version" + } + else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) { - LANG: Fortran - } "Convert initial data given in primive variables to conserved variables" - } - else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) - { - - schedule Con2PrimPolytypeGeneral IN HydroBase_Con2Prim AS Con2Prim + schedule Con2PrimPolytypeGeneralM IN HydroBase_Con2Prim AS Con2Prim + { + LANG: Fortran + STORAGE: Con2Prim_temps + } "Convert back to primitive variables (polytype) - MHD version" + + schedule Primitive2ConservativeCellsGeneralM IN HydroBase_Prim2ConInitial + { + LANG: Fortran + } "Convert initial data given in primive variables to conserved variables - MHD version" + } + } else { + if (CCTK_Equals(GRHydro_eos_type,"General")) { - LANG: Fortran - STORAGE: Con2Prim_temps - } "Convert back to primitive variables (polytype)" + schedule Conservative2PrimitiveGeneral IN HydroBase_Con2Prim AS Con2Prim + { + LANG: Fortran + STORAGE: Con2Prim_temps + } "Convert back to primitive variables (general)" + + schedule Primitive2ConservativeCellsGeneral IN HydroBase_Prim2ConInitial + { + LANG: Fortran + } "Convert initial data given in primive variables to conserved variables" - schedule Primitive2ConservativeCellsGeneral IN HydroBase_Prim2ConInitial + } + else if (CCTK_Equals(GRHydro_eos_type,"Polytype")) { - LANG: Fortran - } "Convert initial data given in primive variables to conserved variables" - } + schedule Con2PrimPolytypeGeneral IN HydroBase_Con2Prim AS Con2Prim + { + LANG: Fortran + STORAGE: Con2Prim_temps + } "Convert back to primitive variables (polytype)" + + schedule Primitive2ConservativeCellsGeneral IN HydroBase_Prim2ConInitial + { + LANG: Fortran + } "Convert initial data given in primive variables to conserved variables" + } + } } else if (CCTK_Equals(GRHydro_eos_type,"General")) { - schedule Conservative2Primitive IN HydroBase_Con2Prim AS Con2Prim - { - LANG: Fortran - } "Convert back to primitive variables (general)" - - schedule Primitive2ConservativeCells IN HydroBase_Prim2ConInitial + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - } "Convert initial data given in primive variables to conserved variables" + schedule Conservative2PrimitiveM IN HydroBase_Con2Prim AS Con2Prim + { + 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 { + schedule Conservative2Primitive IN HydroBase_Con2Prim AS Con2Prim + { + 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")) { - schedule Conservative2PrimitivePolytype IN HydroBase_Con2Prim AS Con2Prim - { - LANG: Fortran - } "Convert back to primitive variables (polytype)" - - - schedule Primitive2ConservativePolyCells IN HydroBase_Prim2ConInitial + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - } "Convert initial data given in primive variables to conserved variables" + schedule Conservative2PrimitivePolytypeM IN HydroBase_Con2Prim AS Con2Prim + { + 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 { + schedule Conservative2PrimitivePolytype IN HydroBase_Con2Prim AS Con2Prim + { + 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" + } } ################################################################# @@ -794,10 +1006,18 @@ if (evolve_tracer) if (outflow_boundaries) { - schedule GRHydro_OutflowBoundaries IN HydroBase_PostStep BEFORE GRHydro_Boundaries + if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran - } "Outflow boundaries over only some of the domain" + schedule GRHydro_OutflowBoundariesM IN HydroBase_PostStep BEFORE GRHydro_Bound + { + LANG: Fortran + } "Outflow boundaries over only some of the domain - MHD version" + } else { + schedule GRHydro_OutflowBoundaries IN HydroBase_PostStep BEFORE GRHydro_Bound + { + LANG: Fortran + } "Outflow boundaries over only some of the domain" + } } # This should not be used anymore and should be removed after some time @@ -805,38 +1025,77 @@ schedule group Do_GRHydro_Boundaries IN HydroBase_Boundaries { } "GRHydro Boundary conditions group" -if (evolve_tracer) + +if(CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries + if (evolve_tracer) { - LANG: Fortran - OPTIONS: LEVEL - SYNC: dens - SYNC: tau - SYNC: scon - SYNC: w_lorentz - SYNC: HydroBase::rho - SYNC: HydroBase::press - SYNC: HydroBase::eps - SYNC: HydroBase::vel - SYNC: GRHydro_cons_tracers - SYNC: GRHydro_tracers - } "Select GRHydro boundary conditions" -} else -{ - schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries + schedule GRHydro_BoundariesM IN HydroBase_Select_Boundaries AS GRHydro_Bound + { + LANG: Fortran + OPTIONS: LEVEL + SYNC: dens + SYNC: tau + SYNC: scon + SYNC: w_lorentz + SYNC: HydroBase::rho + SYNC: HydroBase::press + SYNC: HydroBase::eps + SYNC: HydroBase::vel + SYNC: HydroBase::Bvec + SYNC: GRHydro_cons_tracers + SYNC: GRHydro_tracers + } "Select GRHydro boundary conditions - MHD version" + } else { + schedule GRHydro_BoundariesM IN HydroBase_Select_Boundaries AS GRHydro_Bound + { + LANG: Fortran + OPTIONS: LEVEL + SYNC: dens + SYNC: tau + SYNC: scon + SYNC: w_lorentz + SYNC: HydroBase::rho + SYNC: HydroBase::press + SYNC: HydroBase::eps + SYNC: HydroBase::vel + SYNC: HydroBase::Bvec + } "Select GRHydro boundary conditions - MHD version" + } +} else { + if (evolve_tracer) { - LANG: Fortran - OPTIONS: LEVEL - SYNC: dens - SYNC: tau - SYNC: scon - SYNC: w_lorentz - SYNC: HydroBase::rho - SYNC: HydroBase::press - SYNC: HydroBase::eps - SYNC: HydroBase::vel - } "Select GRHydro boundary conditions" + schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries AS GRHydro_Bound + { + LANG: Fortran + OPTIONS: LEVEL + SYNC: dens + SYNC: tau + SYNC: scon + SYNC: w_lorentz + SYNC: HydroBase::rho + SYNC: HydroBase::press + SYNC: HydroBase::eps + SYNC: HydroBase::vel + SYNC: GRHydro_cons_tracers + SYNC: GRHydro_tracers + } "Select GRHydro boundary conditions" + } else + { + schedule GRHydro_Boundaries IN HydroBase_Select_Boundaries AS GRHydro_Bound + { + LANG: Fortran + OPTIONS: LEVEL + SYNC: dens + SYNC: tau + SYNC: scon + SYNC: w_lorentz + SYNC: HydroBase::rho + SYNC: HydroBase::press + SYNC: HydroBase::eps + SYNC: HydroBase::vel + } "Select GRHydro boundary conditions" + } } ############################################################ @@ -866,10 +1125,18 @@ if (evolve_tracer) ### move along. ### ################################################################ -schedule GRHydro_AtmosphereReset IN MoL_Evolution AFTER MoL_Step BEFORE HydroBase_Boundaries AFTER MoL_RestoreSandR +if (CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran -} "Reset the atmosphere" + schedule GRHydro_AtmosphereResetM IN MoL_Evolution AFTER MoL_Step BEFORE HydroBase_Boundaries AFTER MoL_RestoreSandR + { + LANG: Fortran + } "Reset the atmosphere - MHD version" +} else { + schedule GRHydro_AtmosphereReset IN MoL_Evolution AFTER MoL_Step BEFORE HydroBase_Boundaries AFTER MoL_RestoreSandR + { + LANG: Fortran + } "Reset the atmosphere" +} schedule group HydroBase_Boundaries IN MoL_Evolution AFTER MoL_Step { @@ -932,10 +1199,19 @@ 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" -schedule GRHydro_Tmunu IN AddToTmunu + +if (CCTK_Equals(Bvec_evolution_method,"GRHydro")) { - LANG: Fortran -} "Compute the energy-momentum tensor" + schedule GRHydro_TmunuM IN AddToTmunu + { + LANG: Fortran + } "Compute the energy-momentum tensor - MHD version" +} else { + schedule GRHydro_Tmunu IN AddToTmunu + { + LANG: Fortran + } "Compute the energy-momentum tensor" +} #the following is necessary because TmunuBase does not have enough schedule diff --git a/src/GRHydro_BoundariesM.F90 b/src/GRHydro_BoundariesM.F90 new file mode 100644 index 0000000..42c2055 --- /dev/null +++ b/src/GRHydro_BoundariesM.F90 @@ -0,0 +1,333 @@ + /*@@ + @file GRHydro_BoundariesM.F90 + @date Aug 30, 2010 + @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" + +#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) + + /*@@ + @routine GRHydro_InitSymBoundM + @date Aug 30, 2010 + @author Joshua Faber, 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_InitSymBoundM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + + integer, dimension(3) :: sym + integer :: ierr + integer :: itracer + + character(len=100) tracername + character(len=100) tracerindex + + sym(1) = 1 + sym(2) = 1 + sym(3) = 1 + + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::rho") + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::press") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::dens") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::tau") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::w_lorentz") + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::eps") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::GRHydro_C2P_failed") + +!!$ handle multiple tracer variables + if(evolve_tracer.eq.1) then + call SetCartSymGN(ierr, cctkGH, sym, "GRHydro::GRHydro_tracers") + call SetCartSymGN(ierr, cctkGH, sym, "GRHydro::GRHydro_cons_tracers") + endif + + sym(1) = -1 + sym(2) = 1 + sym(3) = 1 + + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[0]") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[0]") + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[0]") + + + sym(1) = 1 + sym(2) = -1 + sym(3) = 1 + + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[1]") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[1]") + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[1]") + + sym(1) = 1 + sym(2) = 1 + sym(3) = -1 + + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::vel[2]") + call SetCartSymVN(ierr, cctkGH, sym, "GRHydro::scon[2]") + call SetCartSymVN(ierr, cctkGH, sym, "HydroBase::Bvec[2]") + +end subroutine GRHydro_InitSymBoundM + + /*@@ + @routine GRHydro_BoundariesM + @date Aug 30, 2010 + @author + @desc + Calls the appropriate boundary routines + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + +subroutine GRHydro_BoundariesM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + integer, dimension(3) :: sw + integer :: ierr + CCTK_REAL :: pi = 3.141569d0 + integer :: i,j,k + + CCTK_INT, parameter :: faces=CCTK_ALL_FACES + CCTK_INT, parameter :: ione=1 + + sw = GRHydro_stencil + +!!$Flat boundaries if required + + if (CCTK_EQUALS(bound,"flat")) then + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::dens", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::tau", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::scon", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::w_lorentz", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::rho", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::press", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::eps", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::vel", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::Bvec", "Flat") + + + if(evolve_tracer .ne. 0) then + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::GRHydro_tracers", "Flat") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::GRHydro_cons_tracers", "Flat") + endif + + endif + + if (CCTK_EQUALS(bound,"none")) then + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::dens", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::tau", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::scon", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::w_lorentz", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::rho", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::press", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::eps", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::vel", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "HydroBase::Bvec", "None") + + if(evolve_tracer .ne. 0) then + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::GRHydro_tracers", "None") + ierr = Boundary_SelectGroupForBC(cctkGH, faces, GRHydro_stencil, -ione, & + "GRHydro::GRHydro_cons_tracers", "None") + endif + + end if + + if (CCTK_EQUALS(bound,"scalar")) then + call CCTK_WARN(0, "Until somebody uses this I see no reason to support it") + end if + + if (ierr < 0) call CCTK_WARN(0, "problems with applying the chosen boundary condition") + +end subroutine GRHydro_BoundariesM + + + /*@@ + @routine GRHydro_OutflowBoundariesM + @date Aug 30, 2010 + @author Joshua Faber, Ian Hawke + @desc + Set outflow boundaries over only part of the domain. + This is designed to be used with GZPatchSystem. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + +subroutine GRHydro_OutflowBoundariesM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + integer, dimension(3) :: sw + integer :: ierr + integer :: i,j,k + + CCTK_REAL, dimension(3) :: posn + + CCTK_REAL :: det,psi4pt + + sw = GRHydro_stencil + + if (r(1,1,1) < r(1,1,cctk_lsh(3))) then + + if (cctk_bbox(6) .ne. 0) then + + do k = cctk_lsh(3) - sw(3), cctk_lsh(3) + do j = 1, cctk_lsh(2) + do i = 1, cctk_lsh(1) + + posn(1) = x(i,j,k) + posn(2) = y(i,j,k) + posn(3) = z(i,j,k) + + if (dot_product(outflowboundary_normal, posn) > 0.d0) then + + rho(i,j,k) = rho(i,j,k-1) + velx(i,j,k) = velx(i,j,k-1) + vely(i,j,k) = vely(i,j,k-1) + velz(i,j,k) = velz(i,j,k-1) + eps(i,j,k) = eps(i,j,k-1) + press(i,j,k) = press(i,j,k-1) + w_lorentz(i,j,k) = w_lorentz(i,j,k-1) + Bvecx(i,j,k) = Bvecx(i,j,k-1) + Bvecy(i,j,k) = Bvecy(i,j,k-1) + Bvecz(i,j,k) = Bvecz(i,j,k-1) + + psi4pt = 1.d0 + det=SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + + call prim2conM(GRHydro_eos_handle,psi4pt*gxx(i,j,k),& + psi4pt*gxy(i,j,k),psi4pt*gxz(i,j,k),& + psi4pt*gyy(i,j,k),psi4pt*gyz(i,j,k),psi4pt*gzz(i,j,k),& + det, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),& + tau(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(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 if + + end do + end do + end do + + end if + + else + + if (cctk_bbox(5) .ne. 0) then + + do k = sw(3), 1, -1 + do j = 1, cctk_lsh(2) + do i = 1, cctk_lsh(1) + + posn(1) = x(i,j,k) + posn(2) = y(i,j,k) + posn(3) = z(i,j,k) + + if (dot_product(outflowboundary_normal, posn) > 0.d0) then + + rho(i,j,k) = rho(i,j,k+1) + velx(i,j,k) = velx(i,j,k+1) + vely(i,j,k) = vely(i,j,k+1) + velz(i,j,k) = velz(i,j,k+1) + eps(i,j,k) = eps(i,j,k+1) + press(i,j,k) = press(i,j,k+1) + w_lorentz(i,j,k) = w_lorentz(i,j,k+1) + Bvecx(i,j,k) = Bvecx(i,j,k-1) + Bvecy(i,j,k) = Bvecy(i,j,k-1) + Bvecz(i,j,k) = Bvecz(i,j,k-1) + + psi4pt = 1.d0 + det=SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + + call prim2con(GRHydro_eos_handle,psi4pt*gxx(i,j,k),& + psi4pt*gxy(i,j,k),psi4pt*gxz(i,j,k),& + psi4pt*gyy(i,j,k),psi4pt*gyz(i,j,k),psi4pt*gzz(i,j,k),& + det, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),& + tau(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(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 if + + end do + end do + end do + + end if + + end if + +end subroutine GRHydro_OutflowBoundariesM + + + diff --git a/src/GRHydro_CalcUpdateM.F90 b/src/GRHydro_CalcUpdateM.F90 new file mode 100644 index 0000000..fab2b55 --- /dev/null +++ b/src/GRHydro_CalcUpdateM.F90 @@ -0,0 +1,247 @@ + /*@@ + @file GRHydro_CalcUpdateM.F90 + @date Aug 30, 2010 + @author Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke + @desc + Calculates the update terms given the fluxes. Moved to here so that + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_Arguments.h" +#include "cctk_Parameters.h" +#include "cctk_Functions.h" +#include "SpaceMask.h" + + /*@@ + @routine UpdateCalculationM + @date Aug 30, 2010 + @author Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke + @desc + Calculates the update terms from the fluxes. + @enddesc + @calls + @calledby + @history + Moved out of the Riemann solver routines to make the FishEye / + weighted flux calculation easier. + @endhistory + +@@*/ + + +subroutine UpdateCalculationM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i,j,k,itracer + CCTK_REAL :: idx, alp_l, alp_r + + CCTK_INT :: type_bits, atmosphere, not_atmosphere + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere",& + "in_atmosphere") + call SpaceMask_GetStateBits(not_atmosphere, "Hydro_Atmosphere",& + "not_in_atmosphere") + + idx = 1.d0 / CCTK_DELTA_SPACE(flux_direction) + + if (CCTK_EQUALS(method_type, "RSA FV")) then + + if (use_weighted_fluxes == 0) then + + !$OMP PARALLEL DO PRIVATE(i,j,itracer,alp_l, alp_r) + do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil + + alp_l = 0.5d0 * (alp(i,j,k) + & + alp(i-xoffset,j-yoffset,k-zoffset)) + alp_r = 0.5d0 * (alp(i,j,k) + & + alp(i+xoffset,j+yoffset,k+zoffset)) + + densrhs(i,j,k) = densrhs(i,j,k) + & + (alp_l * densflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * densflux(i,j,k)) * idx + srhs(i,j,k,1) = srhs(i,j,k,1) + & + (alp_l * sxflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * sxflux(i,j,k)) * idx + srhs(i,j,k,2) = srhs(i,j,k,2) + & + (alp_l * syflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * syflux(i,j,k)) * idx + srhs(i,j,k,3) = srhs(i,j,k,3) + & + (alp_l * szflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * szflux(i,j,k)) * idx + taurhs(i,j,k) = taurhs(i,j,k) + & + (alp_l * tauflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * tauflux(i,j,k)) * idx + Bvecrhs(i,j,k,1) = Bvecrhs(i,j,k,1) + & + (alp_l * Bvecxflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * Bvecxflux(i,j,k)) * idx + Bvecrhs(i,j,k,2) = Bvecrhs(i,j,k,2) + & + (alp_l * Bvecyflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * Bvecyflux(i,j,k)) * idx + Bvecrhs(i,j,k,3) = Bvecrhs(i,j,k,3) + & + (alp_l * Bveczflux(i-xoffset,j-yoffset,k-zoffset) - & + alp_r * Bveczflux(i,j,k)) * idx + + + if (evolve_tracer .ne. 0) then + do itracer=1,number_of_tracers + cons_tracerrhs(i,j,k,itracer) = cons_tracerrhs(i,j,k,itracer) + & + (alp_l * cons_tracerflux(i-xoffset,j-yoffset,k-zoffset,itracer) - & + alp_r * cons_tracerflux(i,j,k,itracer)) * idx + enddo +!!$ 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, cons_tracerrhs(i,j,k) +!!$ end if + + end if + + if (wk_atmosphere .eq. 1) then + + if ( (atmosphere_mask(i,j,k) .eq. 1) .or. & + (SpaceMask_CheckStateBitsF90(space_mask,i,j,k,type_bits,atmosphere)) ) then + +!!$ We are in the atmosphere so the momentum flux must vanish + + srhs(i,j,k,:) = 0.d0 + + if ( ( (atmosphere_mask(i-1,j ,k ) .eq. 1) .and. & + (atmosphere_mask(i+1,j ,k ) .eq. 1) .and. & + (atmosphere_mask(i ,j-1,k ) .eq. 1) .and. & + (atmosphere_mask(i ,j+1,k ) .eq. 1) .and. & + (atmosphere_mask(i ,j ,k-1) .eq. 1) .and. & + (atmosphere_mask(i ,j ,k+1) .eq. 1) & + ) .or. & + ( (SpaceMask_CheckStateBitsF90(space_mask,i-1,j ,k ,type_bits,atmosphere)) .and. & + (SpaceMask_CheckStateBitsF90(space_mask,i+1,j ,k ,type_bits,atmosphere)) .and. & + (SpaceMask_CheckStateBitsF90(space_mask,i ,j-1,k ,type_bits,atmosphere)) .and. & + (SpaceMask_CheckStateBitsF90(space_mask,i ,j+1,k ,type_bits,atmosphere)) .and. & + (SpaceMask_CheckStateBitsF90(space_mask,i ,j ,k-1,type_bits,atmosphere)) .and. & + (SpaceMask_CheckStateBitsF90(space_mask,i ,j ,k+1,type_bits,atmosphere)) & + ) & + ) then + +!!$ All neighbours are also atmosphere so all rhs vanish + + densrhs(i,j,k) = 0.d0 + taurhs(i,j,k) = 0.d0 +!!$ +!!$ We should still evolve the B-field in the atmosphere +!!$ + + end if + end if + + end if + + enddo + enddo + enddo + !$OMP END PARALLEL DO + + else + + call CCTK_WARN(0, "Not supported") + +!!$ do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil +!!$ do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil +!!$ do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil +!!$ +!!$ alp_l = 0.5d0 * (alp(i,j,k) + & +!!$ alp(i-xoffset,j-yoffset,k-zoffset)) +!!$ alp_r = 0.5d0 * (alp(i,j,k) + & +!!$ alp(i+xoffset,j+yoffset,k+zoffset)) +!!$ +!!$ densrhs(i,j,k) = densrhs(i,j,k) + & +!!$ (alp_l * & +!!$ &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * & +!!$ &densflux(i-xoffset,j-yoffset,k-zoffset) - & +!!$ alp_r * & +!!$ &cell_surface(i,j,k,flux_direction) * & +!!$ &densflux(i,j,k)) * idx / cell_volume(i,j,k) +!!$ sxrhs(i,j,k) = sxrhs(i,j,k) + & +!!$ (alp_l * & +!!$ &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * & +!!$ &sxflux(i-xoffset,j-yoffset,k-zoffset) - & +!!$ alp_r * & +!!$ &cell_surface(i,j,k,flux_direction) * & +!!$ &sxflux(i,j,k)) * idx / cell_volume(i,j,k) +!!$ syrhs(i,j,k) = syrhs(i,j,k) + & +!!$ (alp_l * & +!!$ &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * & +!!$ &syflux(i-xoffset,j-yoffset,k-zoffset) - & +!!$ alp_r * & +!!$ &cell_surface(i,j,k,flux_direction) * & +!!$ &syflux(i,j,k)) * idx / cell_volume(i,j,k) +!!$ szrhs(i,j,k) = szrhs(i,j,k) + & +!!$ (alp_l * & +!!$ &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * & +!!$ &szflux(i-xoffset,j-yoffset,k-zoffset) - & +!!$ alp_r * & +!!$ &cell_surface(i,j,k,flux_direction) * & +!!$ &szflux(i,j,k)) * idx / cell_volume(i,j,k) +!!$ taurhs(i,j,k) = taurhs(i,j,k) + & +!!$ (alp_l * & +!!$ &cell_surface(i-xoffset,j-yoffset,k-zoffset,flux_direction) * & +!!$ &tauflux(i-xoffset,j-yoffset,k-zoffset) - & +!!$ alp_r * & +!!$ &cell_surface(i,j,k,flux_direction) * & +!!$ &tauflux(i,j,k)) * idx / cell_volume(i,j,k) +!!$ +!!$ enddo +!!$ enddo +!!$ enddo + + end if + + else if (CCTK_EQUALS(method_type, "Flux split FD")) then + + do k = GRHydro_stencil + 1, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil + 1, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil + 1, cctk_lsh(1) - GRHydro_stencil + + densrhs(i,j,k) = densrhs(i,j,k) + & + (densflux(i-xoffset,j-yoffset,k-zoffset) - & + densflux(i,j,k)) * idx + srhs(i,j,k,1) = srhs(i,j,k,1) + & + (sxflux(i-xoffset,j-yoffset,k-zoffset) - & + sxflux(i,j,k)) * idx + srhs(i,j,k,2) = srhs(i,j,k,2) + & + (syflux(i-xoffset,j-yoffset,k-zoffset) - & + syflux(i,j,k)) * idx + srhs(i,j,k,3) = srhs(i,j,k,3) + & + (szflux(i-xoffset,j-yoffset,k-zoffset) - & + szflux(i,j,k)) * idx + taurhs(i,j,k) = taurhs(i,j,k) + & + (tauflux(i-xoffset,j-yoffset,k-zoffset) - & + tauflux(i,j,k)) * idx + Bvecrhs(i,j,k,1) = Bvecrhs(i,j,k,1) + & + (Bvecxflux(i-xoffset,j-yoffset,k-zoffset) - & + Bvecxflux(i,j,k)) * idx + Bvecrhs(i,j,k,2) = Bvecrhs(i,j,k,2) + & + (Bvecyflux(i-xoffset,j-yoffset,k-zoffset) - & + Bvecyflux(i,j,k)) * idx + Bvecrhs(i,j,k,3) = Bvecrhs(i,j,k,3) + & + (Bveczflux(i-xoffset,j-yoffset,k-zoffset) - & + Bveczflux(i,j,k)) * idx + + enddo + enddo + enddo + + end if + + return + +end subroutine UpdateCalculationM + diff --git a/src/GRHydro_Con2PrimM.F90 b/src/GRHydro_Con2PrimM.F90 index 482cd5c..401fa4d 100644 --- a/src/GRHydro_Con2PrimM.F90 +++ b/src/GRHydro_Con2PrimM.F90 @@ -1,18 +1,928 @@ +/*@@ + @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_InterfacesM.h" +#include "GRHydro_Macros.h" + + /*@@ + @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) - implicit none + use Con2PrimM_fortran_interfaces + implicit none + DECLARE_CCTK_ARGUMENTS DECLARE_CCTK_PARAMETERS + +#if !USE_EOS_OMNI +#ifdef _EOS_BASE_INC_ +#undef _EOS_BASE_INC_ +#endif +#include "EOS_Base.inc" +#endif + integer :: i, j, k, itracer, nx, ny, nz + CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, det, pmin, epsmin + CCTK_REAL :: b2 + CCTK_INT :: epsnegative + character(len=100) warnline + CCTK_INT :: type_bits, atmosphere + CCTK_INT :: type2_bits + + CCTK_REAL :: local_min_tracer +#if USE_EOS_OMNI +! begin EOS Omni vars + integer :: n = 1 + integer :: keytemp = 0 + integer :: anyerr = 0 + integer :: keyerr(1) = 0 + real*8 :: xpress = 0.0d0 + real*8 :: xeps = 0.0d0 + real*8 :: xtemp = 0.0d0 + real*8 :: xye = 0.0d0 +! end EOS Omni vars +#endif + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + 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 + +#if USE_EOS_OMNI + ! this is a poly call + call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,& + GRHydro_rho_min,xeps,xtemp,xye,pmin,keyerr,anyerr) + call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,& + GRHydro_rho_min,xeps,xtemp,xye,pmin,epsmin,keyerr,anyerr) +#else + pmin = EOS_Pressure(GRHydro_polytrope_handle, GRHydro_rho_min, 1.0d0) + epsmin = EOS_SpecificIntEnergy(GRHydro_polytrope_handle, GRHydro_rho_min, pmin) +#endif + + !$OMP PARALLEL DO PRIVATE(i,j,itracer,& + !$OMP uxx, uxy, uxz, uyy, uyz, uzz, det, epsnegative) + do k = 1, nz + do j = 1, ny + do i = 1, nx + + !do not compute if in atmosphere or in excised region + if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) .or. & + (hydro_excision_mask(i,j,k) .ne. 0)) cycle + + epsnegative = 0 + + det = SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det,& + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),& + gyz(i,j,k),gzz(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 ( dens(i,j,k) .le. sqrt(det)*GRHydro_rho_min*(1.d0+GRHydro_atmo_tolerance) ) then + + b2=gxx(i,j,k)*Bvec(i,j,k,1)**2+gyy(i,j,k)*Bvec(i,j,k,2)**2+gzz(i,j,k)*Bvec(i,j,k,3)**2+ & + 2.0*(gxy(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,2)+gxz(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,3)+ & + gyz(i,j,k)*Bvec(i,j,k,2)*Bvec(i,j,k,3)) + + dens(i,j,k) = sqrt(det)*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance) + rho(i,j,k) = GRHydro_rho_min + scon(i,j,k,:) = 0.d0 + vel(i,j,k,:) = 0.d0 + w_lorentz(i,j,k) = 1.d0 +#if USE_EOS_OMNI + 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) +#else + press(i,j,k) = EOS_Pressure(GRHydro_polytrope_handle, rho(i,j,k), eps(i,j,k)) + eps(i,j,k) = EOS_SpecificIntEnergy(GRHydro_polytrope_handle, rho(i,j,k), press(i,j,k)) +#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) = sqrt(det) * (rho(i,j,k)*(1.0+eps(i,j,k)+b2/2.0)) - dens(i,j,k) + + cycle + + end if + + + call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, dens(i,j,k), & + scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), & + rho(i,j,k),& + vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(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), & + uxx,uxy,uxz,uyy,uyz,uzz,det, & + Bvec(i,j,k,1), Bvec(i,j,k,2),Bvec(i,j,k,3),b2,& + epsnegative,GRHydro_C2P_failed(i,j,k)) + + + 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) = sqrt(det)*GRHydro_rho_min !/(1.d0+GRHydro_atmo_tolerance) + rho(i,j,k) = GRHydro_rho_min + scon(i,j,k,:) = 0.d0 + vel(i,j,k,:) = 0.d0 + w_lorentz(i,j,k) = 1.d0 +#if USE_EOS_OMNI + 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) +#else + press(i,j,k) = EOS_Pressure(GRHydro_polytrope_handle, rho(i,j,k), eps(i,j,k)) + eps(i,j,k) = EOS_SpecificIntEnergy(GRHydro_polytrope_handle, rho(i,j,k), press(i,j,k)) +#endif + b2=gxx(i,j,k)*Bvec(i,j,k,1)**2+gyy(i,j,k)*Bvec(i,j,k,2)**2+gzz(i,j,k)*Bvec(i,j,k,3)**2+ & + 2.0*(gxy(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,2)+gxz(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,3)+ & + gyz(i,j,k)*Bvec(i,j,k,2)*Bvec(i,j,k,3)) + + + ! w_lorentz=1, so the expression for tau reduces to [see above]: + tau(i,j,k) = sqrt(det) * (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 + +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, dens(i,j,k), & +!!$ scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k), & +!!$ rho(i,j,k),& +!!$ vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(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), & +!!$ uxx,uxy,uxz,uyy,uyz,uzz,det, & +!!$ Bvec(i,j,k,1), Bvec(i,j,k,2),Bvec(i,j,k,3),b2,& +!!$ epsnegative,GRHydro_C2P_failed(i,j,k)) + +#endif + + end if + end do + end do + end do + !$OMP END PARALLEL DO + + return + 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 + + integer :: i, j, k, itracer, nx, ny, nz + CCTK_REAL :: uxxl, uxyl, uxzl, uyyl, uyzl, uzzl,& + uxxr, uxyr, uxzr, uyyr, uyzr, uzzr, pmin, epsmin + CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr + CCTK_REAL :: b2minus, b2plus + CCTK_INT :: epsnegative + character(len=100) warnline + + CCTK_INT :: type_bits, atmosphere + CCTK_INT :: type2_bits + + CCTK_REAL :: local_min_tracer + +#if !USE_EOS_OMNI +#ifdef _EOS_BASE_INC_ +#undef _EOS_BASE_INC_ +#endif +#include "EOS_Base.inc" +#endif + + +#if USE_EOS_OMNI +! begin EOS omni + CCTK_INT :: keyerr(1) = 0 + CCTK_INT :: anyerr = 0 + CCTK_INT :: keytemp = 0 + CCTK_INT :: n = 1 + CCTK_REAL :: xye = 0.0d0 + CCTK_REAL :: xeps = 0.0d0 + CCTK_REAL :: xtemp = 0.0d0 +! end EOS omni +#endif + + +#if USE_EOS_OMNI + ! this is a poly call + call EOS_Omni_press(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,& + GRHydro_rho_min,1.0d0,xtemp,xye,pmin,keyerr,anyerr) + + call EOS_Omni_EpsFromPress(GRHydro_polytrope_handle,keytemp,GRHydro_eos_rf_prec,n,& + GRHydro_rho_min,epsmin,xtemp,xye,pmin,epsmin,keyerr,anyerr) +#else + pmin=EOS_Pressure(GRHydro_polytrope_handle, GRHydro_rho_min, 1.0d0) + epsmin = EOS_SpecificIntEnergy(GRHydro_polytrope_handle, GRHydro_rho_min, pmin) +#endif + + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + 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 (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) .or. & + GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle + + 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)) + + epsnegative = 0 + + avg_detl = SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl) + avg_detr = SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr) + call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl,& + gxxl,gxyl,gxzl,gyyl,gyzl,gzzl) + call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr,& + 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 + + call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, densminus(i,j,k), & + sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), tauminus(i,j,k), & + rhominus(i,j,k),& + velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),w_lorentzminus(i,j,k),& + gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, & + uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl, & + Bvecxminus(i,j,k), Bvecyminus(i,j,k),Bveczminus(i,j,k),b2minus,& + 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 +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, densminus(i,j,k), & +!!$ sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), tauminus(i,j,k), & +!!$ rhominus(i,j,k),& +!!$ velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),w_lorentzminus(i,j,k),& +!!$ gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, & +!!$ uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl, & +!!$ Bvecxminus(i,j,k), Bvecyminus(i,j,k),Bveczminus(i,j,k),b2minus,& +!!$ 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_pt(GRHydro_eos_handle, densplus(i,j,k), & + sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), tauplus(i,j,k),& + rhoplus(i,j,k),& + velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),w_lorentzplus(i,j,k),& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, & + uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr, & + Bvecxplus(i,j,k), Bvecyplus(i,j,k),Bveczplus(i,j,k),b2plus,& + 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 +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, densplus(i,j,k), & +!!$ sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), tauplus(i,j,k),& +!!$ rhoplus(i,j,k),& +!!$ velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),w_lorentzplus(i,j,k),& +!!$ gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, & +!!$ uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr, & +!!$ Bvecxplus(i,j,k), Bvecyplus(i,j,k),Bveczplus(i,j,k),b2plus,& +!!$ 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 + +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 + + integer :: i, j, k, itracer, nx, ny, nz + CCTK_REAL :: uxx, uxy, uxz, uyy, uyz, uzz, det,b2 + + CCTK_INT :: type_bits, atmosphere + CCTK_INT :: type2_bits + + CCTK_INT :: epsnegative + + CCTK_REAL :: local_min_tracer + ! character(len=400) :: warnline + + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + 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,itracer,& + !$OMP uxx, uxy, uxz, uyy, uyz, uzz, det) + do k = 1, nz + do j = 1, ny + do i = 1, nx + + !do not compute if in atmosphere or in an excised region + if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) .or. & + GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle + + det = SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det,& + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),& + gyz(i,j,k),gzz(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 + +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, dens(i,j,k), & +!!$ scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k),& +!!$ rho(i,j,k),& +!!$ vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(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), & +!!$ uxx,uxy,uxz,uyy,uyz,uzz,det, & +!!$ Bvec(i,j,k,1), Bvec(i,j,k,2),Bvec(i,j,k,3),b2,& +!!$ epsnegative,GRHydro_C2P_failed(i,j,k)) + + end do + end do + end do + + !$OMP END PARALLEL DO + + return + +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 + + integer :: i, j, k, nx, ny, nz + CCTK_REAL :: uxxl, uxyl, uxzl, uyyl, uyzl, uzzl,& + uxxr, uxyr, uxzr, uyyr, uyzr, uzzr + CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr + CCTK_REAL :: b2minus, b2plus + + CCTK_INT :: type_bits, atmosphere + CCTK_INT :: type2_bits, epsnegative + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + 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 (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) .or. & + GRHydro_enable_internal_excision /= 0 .and. (hydro_excision_mask(i,j,k) .ne. 0)) cycle + + 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_detl = SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl) + avg_detr = SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr) + call UpperMetric(uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl,& + gxxl,gxyl,gxzl,gyyl,gyzl,gzzl) + call UpperMetric(uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr,& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr) + +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, densminus(i,j,k), & +!!$ sxminus(i,j,k),syminus(i,j,k),szminus(i,j,k), tauminus(i,j,k),& +!!$ rhominus(i,j,k),& +!!$ velxminus(i,j,k),velyminus(i,j,k),velzminus(i,j,k),epsminus(i,j,k),pressminus(i,j,k),w_lorentzminus(i,j,k),& +!!$ gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, & +!!$ uxxl,uxyl,uxzl,uyyl,uyzl,uzzl,avg_detl, & +!!$ Bvecxminus(i,j,k), Bvecyminus(i,j,k),Bveczminus(i,j,k),b2minus,& +!!$ epsnegative,GRHydro_C2P_failed(i,j,k)) +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, densplus(i,j,k), & +!!$ sxplus(i,j,k),syplus(i,j,k),szplus(i,j,k), tauplus(i,j,k),& +!!$ rhoplus(i,j,k),& +!!$ velxplus(i,j,k),velyplus(i,j,k),velzplus(i,j,k),epsplus(i,j,k),pressplus(i,j,k),w_lorentzplus(i,j,k),& +!!$ gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, & +!!$ uxxr,uxyr,uxzr,uyyr,uyzr,uzzr,avg_detr, & +!!$ Bvecxplus(i,j,k), Bvecyplus(i,j,k),Bveczplus(i,j,k),b2plus,& +!!$ epsnegative,GRHydro_C2P_failed(i,j,k)) + end do + end do + end do + +end subroutine Con2PrimBoundsPolytypeM + +!!$ Con2Prim_ptTracer, Con2Prim_BoundsTracer, and Con2Prim_ptBoundsTracer need not be rewritten! + + /*@@ + @routine Conservative2PrimitiveGeneralM + @date Sep 16, 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. Converted to the EOSGeneral format + @enddesc + @calls + @calledby + @history + @endhistory + +@@*/ + +subroutine Conservative2PrimitiveGeneralM(CCTK_ARGUMENTS) + + USE GRHydro_Scalars + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i, j, k, itracer, nx, ny, nz + character(len=100) warnline + + integer :: maxerrloc(3) + integer :: ii,jj,kk + CCTK_REAL :: maxerr + + + CCTK_INT :: count + CCTK_REAL :: b2,det + CCTK_REAL :: uxx,uxy,uxz,uyy,uyz,uzz + + CCTK_INT :: type_bits, atmosphere + CCTK_INT :: type2_bits,epsnegative + + CCTK_REAL :: local_min_tracer + + CCTK_INT, dimension(3) :: loc, loc2 + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + nx = cctk_lsh(1) + ny = cctk_lsh(2) + nz = cctk_lsh(3) + + count = 0 + press_old = max(eosgeneral_pmin, press) + + if (use_min_tracer .ne. 0) then + local_min_tracer = min_tracer + else + local_min_tracer = 0d0 + end if + +!!$ Set up rho and epsilon + + do k = 1, nz + do j = 1, ny + do i = 1, nx + + 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 ( (dens(i,j,k).le.sqrt(GRHydro_Det(i,j,k)) * & + GRHydro_rho_min*(1.0d0+GRHydro_atmo_tolerance)) & + .or.(tau(i,j,k) .le. 0d0)) then + + b2=gxx(i,j,k)*Bvec(i,j,k,1)**2+gyy(i,j,k)*Bvec(i,j,k,2)**2+gzz(i,j,k)*Bvec(i,j,k,3)**2+ & + 2.0*(gxy(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,2)+gxz(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,3)+ & + gyz(i,j,k)*Bvec(i,j,k,2)*Bvec(i,j,k,3)) + + + rho(i,j,k) = GRHydro_rho_min + dens(i,j,k) = sqrt(GRHydro_det(i,j,k)) * rho(i,j,k) + scon(i,j,k,:) = 0.d0 + w_lorentz(i,j,k) = 1.d0 + press(i,j,k) = 0.1d0 * eosgeneral_pmin + ! eps(i,j,k) = press(i,j,k) / rho(i,j,k) ! Note that this should be improved + eps(i,j,k) = 1.0e-12 + tau(i,j,k) = sqrt(GRHydro_det(i,j,k)) * rho(i,j,k) * (1.0+eps(i,j,k)+b2/2.0) - dens(i,j,k) + + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) + atmosphere_mask(i,j,k) = 1 + + end if + + det=SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det,& + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),& + gyz(i,j,k),gzz(i,j,k)) + + call GRHydro_Con2PrimM_pt(GRHydro_eos_handle, dens(i,j,k), & + scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k),& + rho(i,j,k),& + vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(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), & + uxx,uxy,uxz,uyy,uyz,uzz,det, & + Bvec(i,j,k,1), Bvec(i,j,k,2),Bvec(i,j,k,3),b2,& + epsnegative,GRHydro_C2P_failed(i,j,k)) + + end do + end do + end do + + +end subroutine Conservative2PrimitiveGeneralM + + + /*@@ + @routine Conservative2PrimitivePolytypeGeneralM + @date Sep 16, 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. Converted to the EOSGeneral format + @enddesc + @calls + @calledby + @history + @endhistory + +@@*/ + +subroutine Con2PrimPolytypeGeneralM(CCTK_ARGUMENTS) + + USE GRHydro_Scalars + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i, j, k, itracer, nx, ny, nz + character(len=100) warnline + + CCTK_REAL :: b2, det + CCTK_REAL :: uxx,uxy,uxz,uyy,uyz,uzz + + CCTK_INT :: type_bits + CCTK_INT :: atmosphere + CCTK_INT :: type2_bits,epsnegative + + CCTK_REAL :: local_min_tracer + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere", "in_atmosphere") + type2_bits = -1 + + 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 + +!!$ In what follows press_temp is really rho_temp + + do k = 1, nz + do j = 1, ny + do i = 1, nx + + 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 + end if + + if (dens(i,j,k).le.sqrt(GRHydro_Det(i,j,k)) * & + GRHydro_rho_min*(1.0d0+GRHydro_atmo_tolerance)) then + + b2=gxx(i,j,k)*Bvec(i,j,k,1)**2+gyy(i,j,k)*Bvec(i,j,k,2)**2+gzz(i,j,k)*Bvec(i,j,k,3)**2+ & + 2.0*(gxy(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,2)+gxz(i,j,k)*Bvec(i,j,k,1)*Bvec(i,j,k,3)+ & + gyz(i,j,k)*Bvec(i,j,k,2)*Bvec(i,j,k,3)) + + + rho(i,j,k) = GRHydro_rho_min + dens(i,j,k) = sqrt(GRHydro_det(i,j,k)) * rho(i,j,k) + scon(i,j,k,:) = 0.d0 + w_lorentz(i,j,k) = 1.d0 + press(i,j,k) = 0.1d0 * eosgeneral_pmin + ! eps(i,j,k) = press(i,j,k) / rho(i,j,k) ! Note that this should be improved + eps(i,j,k) = 1.0e-12 + tau(i,j,k) = sqrt(GRHydro_det(i,j,k)) * rho(i,j,k) * (1.0+eps(i,j,k)+b2/2.0) - dens(i,j,k) + + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bits, atmosphere) + atmosphere_mask(i,j,k) = 1 + + end if + + det=SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + call UpperMetric(uxx,uxy,uxz,uyy,uyz,uzz,det,& + gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),gyy(i,j,k),& + gyz(i,j,k),gzz(i,j,k)) + +!!$ call GRHydro_Con2PrimM_Polytype_pt(GRHydro_eos_handle, dens(i,j,k), & +!!$ scon(i,j,k,1),scon(i,j,k,2),scon(i,j,k,3), tau(i,j,k),& +!!$ rho(i,j,k),& +!!$ vel(i,j,k,1),vel(i,j,k,2),vel(i,j,k,3),eps(i,j,k),press(i,j,k),w_lorentz(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), & +!!$ uxx,uxy,uxz,uyy,uyz,uzz,det, & +!!$ Bvec(i,j,k,1), Bvec(i,j,k,2),Bvec(i,j,k,3),b2,& +!!$ epsnegative,GRHydro_C2P_failed(i,j,k)) + + end do + end do +end do + + +end subroutine Con2PrimPolytypeGeneralM diff --git a/src/GRHydro_Con2PrimM_pt.c b/src/GRHydro_Con2PrimM_pt.c new file mode 100644 index 0000000..d9ba2a6 --- /dev/null +++ b/src/GRHydro_Con2PrimM_pt.c @@ -0,0 +1,690 @@ +/*********************************************************************************** + Copyright 2006 Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, + and Luca Del Zanna. + + PVS_GRMHD + + This file was derived from PVS_GRMHD. The authors of PVS_GRMHD include + Scott C. Noble, Charles F. Gammie, Jonathan C. McKinney, and Luca Del Zanna. + PVS_GRMHD is available under the GPL from: + http://rainman.astro.uiuc.edu/codelib/ + + You are morally obligated to cite the following paper in his/her + scientific literature that results from use of this file: + + [1] Noble, S. C., Gammie, C. F., McKinney, J. C., \& Del Zanna, L. \ 2006, + Astrophysical Journal, 641, 626. + + PVS_GRMHD is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + PVS_GRMHD is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with PVS_GRMHD; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + If the user has any questions, please direct them to Scott C. Noble at + scn@astro.rit.edu . + +***********************************************************************************/ + + + +#include <stdio.h> +#include <stdlib.h> +#include <stdarg.h> +#include <string.h> +#include <math.h> +#include <float.h> +#include <complex.h> + +#include "cctk.h" + +/* Set this to be 1 if you want debug output */ +#define DEBUG_CON2PRIMM (0) + + +/* Adiabatic index used for the state equation */ + +#define MAX_NEWT_ITER (30) /* Max. # of Newton-Raphson iterations for find_root_2D(); */ +#define NEWT_TOL (1.0e-10) /* Min. of tolerance allowed for Newton-Raphson iterations */ +#define MIN_NEWT_TOL (1.0e-10) /* Max. of tolerance allowed for Newton-Raphson iterations */ +#define EXTRA_NEWT_ITER (2) + +#define NEWT_TOL2 (1.0e-15) /* TOL of new 1D^*_{v^2} gnr2 method */ +#define MIN_NEWT_TOL2 (1.0e-10) /* TOL of new 1D^*_{v^2} gnr2 method */ + +#define W_TOO_BIG (1.e20) /* \gamma^2 (\rho_0 + u + p) is assumed + to always be smaller than this. This + is used to detect solver failures */ + +#define FAIL_VAL (1.e30) /* Generic value to which we set variables when a problem arises */ + +/************************************************** + The following functions assume a Gamma-law EOS: +***************************************************/ + +/* Local Globals */ +static CCTK_REAL Bsq,QdotBsq,Qtsq,Qdotn,D,half_Bsq ; + +// Declarations: +static CCTK_REAL vsq_calc(CCTK_REAL W); + +static CCTK_INT twod_newton_raphson( CCTK_REAL x[], + void (*funcd) (CCTK_REAL [], CCTK_REAL [], + CCTK_REAL [], CCTK_REAL [][2], + CCTK_REAL *, CCTK_REAL *) ); + +static void func_vsq( CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], CCTK_REAL [][2], + CCTK_REAL *f, CCTK_REAL *df); +static CCTK_REAL x1_of_x0(CCTK_REAL x0 ) ; + + +// EOS STUFF: +#define gam (5./3.) +#define GAMMA (gam) +static CCTK_REAL gam_m1_o_gam = ((GAMMA-1.)/GAMMA); +static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq); +/* pressure as a function of rho0 and u */ +static CCTK_REAL pressure_rho0_u(CCTK_REAL rho0, CCTK_REAL u) +{ + return((GAMMA - 1.)*u) ; +} + +/* Pressure as a function of rho0 and w = rho0 + u + p */ +static CCTK_REAL pressure_rho0_w(CCTK_REAL rho0, CCTK_REAL w) +{ + return((GAMMA-1.)*(w - rho0)/GAMMA) ; +} + + +void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt) ( + CCTK_INT *handle, + CCTK_REAL *dens_in, + CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, + CCTK_REAL *tau_in, + CCTK_REAL *rho, + CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz, + CCTK_REAL *epsilon, CCTK_REAL *pressure, + CCTK_REAL *w_lorentz, + CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, + CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, + CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz, + CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz, + CCTK_REAL *det, + CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, + CCTK_REAL *bsq, + CCTK_INT *epsnegative, + CCTK_REAL *retval); + +/**********************************************************************/ +/********************************************************************************** + + Con2PrimM_pt(): + ----------------------------- + + -- Attempts an inversion from GRMHD conserved variables to primitive variables assuming a guess. + + -- Uses the 2D method of Noble et al. (2006): + -- Solves for two independent variables (W,v^2) via a 2D + Newton-Raphson method + -- Can be used (in principle) with a general equation of state. + + -- Minimizes two residual functions using a homemade Newton-Raphson routine. + -- It is homemade so that it can catch exceptions and handle them correctly, plus it is + optimized for this particular problem. + + -- Note that the notation used herein is that of Noble et al. (2006) except for the argument + list. + + +INPUT: (using GRHydro variable defintions) + + s[x,y,z] = scons[0,1,2] = \alpha \sqrt(\gamma) T^0_i + dens, tau = as defined in GRHydro and are assumed to be densitized (i.e. with sqrt(\gamma)) + dens = D = \sqrt(\gamma) W \rho + tau = \alpha^2 \sqrt(\gamma) T^{00} - D + g[x,y,z][x,y,x] = spatial metric corresponding to \gamma + u[x,y,z][x,y,z] = inverse of the spatial metric, g[x,y,z][x,y,x] + det = sqrt(\gamma) + B[x,y,z] = Bvec[0,1,2] + bsq = b^\mu b_\mu + + epsnegative = (integer) + = 0 if rho and epsilon are positive + != 0 otherwise + + + -- (users should set B[x,y,z] = 0 for hydrodynamic runs) + + +OUTPUT: (using GRHydro variable defintions) + rho, eps = as defined in GRHydro, primitive variables + vel[x,y,z] = as defined in GRHydro, primitive variables + + +RETURN VALUE: of retval = (i*100 + j) where + i = 0 -> Newton-Raphson solver either was not called (yet or not used) + or returned successfully; + 1 -> Newton-Raphson solver did not converge to a solution with the + given tolerances; + 2 -> Newton-Raphson procedure encountered a numerical divergence + (occurrence of "nan" or "+/-inf" ; + + j = 0 -> success + 1 -> failure: some sort of failure in Newton-Raphson; + 2 -> failure: unphysical vsq = v^2 value at initial guess; + 3 -> failure: W<0 or W>W_TOO_BIG + 4 -> failure: v^2 > 1 + ( used to be 5 -> failure: rho,uu <= 0 but now sets epsnegative to non-zero ) + +**********************************************************************************/ +void CCTK_FCALL CCTK_FNAME(GRHydro_Con2PrimM_pt) ( + CCTK_INT *handle, + CCTK_REAL *dens_in, + CCTK_REAL *sx_in, CCTK_REAL *sy_in, CCTK_REAL *sz_in, + CCTK_REAL *tau_in, + CCTK_REAL *rho, + CCTK_REAL *velx, CCTK_REAL *vely, CCTK_REAL *velz, + CCTK_REAL *epsilon, CCTK_REAL *pressure, + CCTK_REAL *w_lorentz, + CCTK_REAL *gxx, CCTK_REAL *gxy, CCTK_REAL *gxz, + CCTK_REAL *gyy, CCTK_REAL *gyz, CCTK_REAL *gzz, + CCTK_REAL *uxx, CCTK_REAL *uxy, CCTK_REAL *uxz, + CCTK_REAL *uyy, CCTK_REAL *uyz, CCTK_REAL *uzz, + CCTK_REAL *det, + CCTK_REAL *Bx, CCTK_REAL *By, CCTK_REAL *Bz, + CCTK_REAL *bsq, + CCTK_INT *epsnegative, + CCTK_REAL *retval) + +{ + CCTK_REAL x_2d[2]; + CCTK_REAL sx, sy, sz; + CCTK_REAL usx, usy, usz; + CCTK_REAL tau, dens; + 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 detg = (*det); + CCTK_REAL sqrt_detg = sqrt(detg); + CCTK_REAL inv_sqrt_detg = 1./sqrt_detg; + CCTK_INT i,j, i_increase ; + + /* 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," *rho = %26.16e \n", *rho ); + fprintf(stdout," *velx = %26.16e \n", *velx ); + fprintf(stdout," *vely = %26.16e \n", *vely ); + fprintf(stdout," *velz = %26.16e \n", *velz ); + fprintf(stdout," *epsilon = %26.16e \n", *epsilon ); + fprintf(stdout," *pressure = %26.16e \n", *pressure ); + fprintf(stdout," *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," *det = %26.16e \n", *det ); + 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," *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; + + // Calculate various scalars (Q.B, Q^2, etc) from the conserved variables: + + 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)) ; + QdotBsq = QdotB*QdotB ; + + Qdotn = -(tau + dens) ; + + Qtsq = (usx * sx + usy * sy + usz * sz) ; + + D = dens; + + half_Bsq = 0.5*Bsq; + + /* calculate W from last timestep and use for guess */ + vsq = + (*gxx) * (*velx) * (*velx) + + (*gyy) * (*vely) * (*vely) + + (*gzz) * (*velz) * (*velz) + + 2*( + (*gxy) * (*velx) * (*vely) + + (*gxz) * (*velx) * (*velz) + + (*gyz) * (*vely) * (*velz) ); + + if( (vsq < 0.) && (fabs(vsq) < 1.0e-13) ) { + vsq = fabs(vsq); + } + if(vsq < 0. || vsq > 1. ) { + *retval = 2.; + return; + } + + gammasq = 1. / (1. - vsq); + gamma = sqrt(gammasq); + + // Always calculate rho from D and gamma so that using D in EOS remains consistent + // i.e. you don't get positive values for dP/d(vsq) . + rho0 = D / gamma ; + u = (*epsilon) * rho0; + p = pressure_rho0_u(rho0,u) ; // EOS + w = rho0 + u + p ; + + W_last = w*gammasq ; + + + // Make sure that W is large enough so that v^2 < 1 : + i_increase = 0; + while( (( W_last*W_last*W_last * ( W_last + 2.*Bsq ) + - QdotBsq*(2.*W_last + Bsq) ) <= W_last*W_last*(Qtsq-Bsq*Bsq)) + && (i_increase < 10) ) { + W_last *= 10.; + i_increase++; + } + + // Calculate W and vsq: + x_2d[0] = fabs( W_last ); + x_2d[1] = x1_of_x0( W_last ) ; + *retval = 1.0*twod_newton_raphson( x_2d, func_vsq ) ; + + W = x_2d[0]; + vsq = x_2d[1]; + + /* Problem with solver, so return denoting error before doing anything further */ + if( ((*retval) != 0.) || (W == FAIL_VAL) ) { + *retval = *retval*100.+1.; + return; + } + else{ + if(W <= 0. || W > W_TOO_BIG) { + *retval = 3.; + return; + } + } + + // Calculate v^2: + if( vsq >= 1. ) { + *retval = 4.; + return; + } + + // Recover the primitive variables from the scalars and conserved variables: + gtmp = sqrt(1. - vsq); + gamma = 1./gtmp ; + rho0 = D * gtmp; + + w = W * (1. - vsq) ; + p = pressure_rho0_w(rho0,w) ; // EOS + u = w - (rho0 + p) ; + + // User may want to handle this case differently, e.g. do NOT return upon + // a negative rho/u, calculate v^i so that rho/u can be floored by other routine: + if( (rho0 <= 0.) || (u <= 0.) ) { + *epsnegative = 1; + return; + } + + *rho = rho0; + *epsilon = u / rho0; + *w_lorentz = gamma; + *pressure = p ; + + g_o_WBsq = 1./(W+Bsq); + QdB_o_W = QdotB / W; + *bsq = Bsq * (1.-vsq) + QdB_o_W*QdB_o_W; + + *velx = g_o_WBsq * ( usx + QdB_o_W*(*Bx) ) ; + *vely = g_o_WBsq * ( usy + QdB_o_W*(*By) ) ; + *velz = g_o_WBsq * ( usz + QdB_o_W*(*Bz) ) ; + + +#if(DEBUG_CON2PRIMM) + fprintf(stdout,"rho = %26.16e \n",*rho ); + fprintf(stdout,"epsilon = %26.16e \n",*epsilon ); + fprintf(stdout,"pressure = %26.16e \n",*pressure ); + fprintf(stdout,"w_lorentz = %26.16e \n",*w_lorentz); + fprintf(stdout,"bsq = %26.16e \n",*bsq ); + fprintf(stdout,"velx = %26.16e \n",*velx ); + fprintf(stdout,"vely = %26.16e \n",*vely ); + fprintf(stdout,"velz = %26.16e \n",*velz ); + fprintf(stdout,"gam = %26.16e \n",gam ); + 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) +{ + CCTK_REAL Wsq,Xsq,Bsq_W; + + Wsq = W*W ; + Bsq_W = (Bsq + W); + Xsq = Bsq_W * Bsq_W; + + return( ( Wsq * Qtsq + 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 ) +{ + CCTK_REAL x1,vsq; + CCTK_REAL dv = 1.e-15; + + vsq = fabs(vsq_calc(x0)) ; // guaranteed to be positive + + return( ( vsq > 1. ) ? (1.0 - dv) : vsq ); + +} + +/******************************************************************** + + validate_x(): + + -- makes sure that x[0,1] have physical values, based upon + their definitions: + +*********************************************************************/ + +static void validate_x(CCTK_REAL x[2], CCTK_REAL x0[2] ) +{ + + const CCTK_REAL dv = 1.e-15; + + /* Always take the absolute value of x[0] and check to see if it's too big: */ + x[0] = fabs(x[0]); + x[0] = (x[0] > W_TOO_BIG) ? x0[0] : x[0]; + + x[1] = (x[1] < 0.) ? 0. : x[1]; /* if it's too small */ + x[1] = (x[1] > 1.) ? (1. - dv) : x[1]; /* if it's too big */ + + return; + +} + +/************************************************************ + + twod_newton_raphson(): + + -- performs Newton-Rapshon method on an 2d system. + + -- inspired in part by Num. Rec.'s routine newt(); + +*****************************************************************/ +static CCTK_INT twod_newton_raphson( CCTK_REAL x[], + void (*funcd) (CCTK_REAL [], CCTK_REAL [], CCTK_REAL [], + CCTK_REAL [][2], CCTK_REAL *, + CCTK_REAL *) ) +{ + 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); /* 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); + +} + + + +/**********************************************************************/ +/********************************************************************************* + 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 W, vsq, Wsq, p_tmp, dPdvsq, dPdW; + CCTK_REAL t11, t16,t18,t2,t21, t23, t24, t25, t3, t35, t36, t4, t40; + + + W = x[0]; + vsq = x[1]; + + Wsq = W*W; + + p_tmp = eos_info(W, vsq, &dPdW, &dPdvsq); + + // These expressions were calculated using Mathematica, but made into efficient + // code using Maple. Since we know the analytic form of the equations, we can + // explicitly calculate the Newton-Raphson step: + + t2 = -half_Bsq+dPdvsq; + t3 = Bsq+W; + t4 = t3*t3; + t23 = 1/W; + t16 = QdotBsq*t23*t23; + t11 = Qtsq-vsq*t4+t16*(Bsq+W+W); + t18 = -Qdotn-half_Bsq*(1.0+vsq)+0.5*t16-W+p_tmp; + t24 = t16*t23; + t25 = -1.0+dPdW-t24; + t35 = t25*t3+(Bsq-2.0*dPdvsq)*(t16+vsq*W)*t23; + // t21 = 1/t3; + // t36 = 1/t35; + t21 = 1/(t3*t35); + dx[0] = -(t2*t11+t4*t18)*t21; + t40 = -2*(vsq+t24)*t3; + dx[1] = -(-t25*t11+t40*t18)*t21; + // detJ = t3*t35; + jac[0][0] = t40; + jac[0][1] = -t4; + jac[1][0] = t25; + jac[1][1] = t2; + resid[0] = t11; + resid[1] = t18; + + *df = -resid[0]*resid[0] - resid[1]*resid[1]; + + *f = -0.5 * ( *df ); + +} + + +/********************************************************************** + ********************************************************************** + + The following routines specify the equation of state. All routines + above here should be indpendent of EOS. If the user wishes + to use another equation of state, the below functions must be replaced + by equivalent routines based upon the new EOS. + + ********************************************************************** +**********************************************************************/ + +/**********************************************************************/ +/********************************************************************** + eos_info(): + + -- returns with all the EOS-related values needed; + **********************************************************************/ +static CCTK_REAL eos_info(CCTK_REAL W, CCTK_REAL vsq, CCTK_REAL *dpdw, CCTK_REAL *dpdvsq) +{ + register double ftmp,gtmp; + + ftmp = 1. - vsq; + gtmp = sqrt(ftmp); + + *dpdw = gam_m1_o_gam * ftmp ; + *dpdvsq = gam_m1_o_gam * ( 0.5 * D/gtmp - W ) ; + + return( gam_m1_o_gam * ( W * ftmp - D * gtmp ) ); // p + +} + + +/****************************************************************************** + END + ******************************************************************************/ + + +#undef DEBUG_CON2PRIMM diff --git a/src/GRHydro_EigenproblemM.F90 b/src/GRHydro_EigenproblemM.F90 new file mode 100644 index 0000000..34499e7 --- /dev/null +++ b/src/GRHydro_EigenproblemM.F90 @@ -0,0 +1,241 @@ + /*@@ + @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" + +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,w_lorentz,& + Bvcx,Bvcy,Bvcz,lam,gxx,gxy,gxz,gyy,gyz,gzz,u,alp,beta) + implicit none + + DECLARE_CCTK_PARAMETERS + + CCTK_REAL rho,velx,vely,velz,eps,w_lorentz + CCTK_REAL Bvcx,Bvcy,Bvcz + CCTK_REAL lam(5) + CCTK_REAL gxx,gxy,gxz,gyy,gyz,gzz + CCTK_REAL 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 handle + CCTK_REAL dpdrho,dpdeps,press + + CCTK_REAL Bvcxlow,Bvcylow,Bvczlow,Bvc2,rhohstar,va2 + CCTK_REAL Bdotv,b2 + +#if !USE_EOS_OMNI +#ifdef _EOS_BASE_INC_ +#undef _EOS_BASE_INC_ +#endif +#include "EOS_Base.inc" +#endif + +#if USE_EOS_OMNI +! begin EOS Omni vars + integer :: n = 1 + integer :: keytemp = 0 + integer :: anyerr = 0 + integer :: keyerr(1) = 0 + real*8 :: xpress = 0.0d0 + real*8 :: xeps = 0.0d0 + real*8 :: xtemp = 0.0d0 + real*8 :: xye = 0.0d0 +! end EOS Omni vars +#endif + + one = 1.0d0 + two = 2.0d0 + +!!$ Set required fluid quantities + + + +#if USE_EOS_OMNI +! 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) +#else + press = EOS_Pressure(handle,rho,eps) + dpdrho = EOS_DPressByDRho(handle,rho,eps) + dpdeps = EOS_DPressByDEps(handle,rho,eps) + cs2 = (dpdrho + press * dpdeps / (rho**2))/ & + (1.0d0 + eps + press/rho) +#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 + +!!$ 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 + + +!!$ 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 + + 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 + diff --git a/src/GRHydro_FluxM.F90 b/src/GRHydro_FluxM.F90 new file mode 100644 index 0000000..77bee7a --- /dev/null +++ b/src/GRHydro_FluxM.F90 @@ -0,0 +1,67 @@ +/*@@ +@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,psiBx,psiBy,psiBz + + sdet=sqrt(det) + psipstar=pressstar*sdet + psiBx=Bx*sdet + psiBy=By*sdet + psiBz=Bz*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*psiBx/w + + syf = sy*vxt-bsuby*psiBx/w + + szf = sz*vxt-bsubz*psiBx/w + +!!$ [psi^6 tau] vtilde^i +p* v^i - alp b^0 B^i/w + tauf = tau*vxt + psipstar*velm - ab0*psiBx/w + +!!$ [psi^6 (B^k vtilde^i - B^i vtilde^k] + bxf = 0.0 + byf = psiBy * vxt - psiBx*vyt + bzf = psiBz * vxt - psiBx*vzt + +end subroutine num_x_fluxM + + + + + + + + + + + + diff --git a/src/GRHydro_HLLEM.F90 b/src/GRHydro_HLLEM.F90 new file mode 100644 index 0000000..98c4874 --- /dev/null +++ b/src/GRHydro_HLLEM.F90 @@ -0,0 +1,642 @@ + /*@@ + @file GRHydro_HLLEM.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_HLLEGeneralM + @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. + Rewritten for the new EOS interface. + @enddesc + @calls + @calledby + @history + Altered from Cactus 3 routines originally written by Toni Font. + @endhistory + +@@*/ + +subroutine GRHydro_HLLEGeneralM(CCTK_ARGUMENTS) + USE GRHydro_EigenproblemM + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + integer :: i, j, k, m + CCTK_REAL, dimension(8) :: cons_p,cons_m,fplus,fminus,f1,qdiff + CCTK_REAL, dimension(6) :: prim_p, prim_m + CCTK_REAL, dimension(5) :: lamminus,lamplus + 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, alp_l, alp_r, & + cs2_p, cs2_m, dpdeps_p, dpdeps_m + CCTK_REAL :: rhoenth_p, rhoenth_m, avg_betax, avg_betay, avg_betaz + CCTK_REAL :: vxtp,vytp,vztp,vxtm,vytm,vztm,ab0p,ab0m,b2p,b2m,bdotvp,bdotvm + CCTK_REAL :: wp,wm,v2p,v2m,bxlowp,bxlowm,bylowp,bylowm,bzlowp,bzlowm,vA2m,vA2p + CCTK_REAL :: Bvecxlowp,Bvecxlowm,Bvecylowp,Bvecylowm,Bveczlowp,Bveczlowm + CCTK_REAL :: pressstarp,pressstarm,velxlowp,velxlowm,velylowp,velylowm,velzlowp,velzlowm + + CCTK_INT :: type_bits, trivial, not_trivial + + integer tadmor + + if(CCTK_EQUALS(HLLE_type,"Tadmor")) then + tadmor = 1 + else + tadmor = 0 + endif + + + if (flux_direction == 1) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", & + &"trivial") + else if (flux_direction == 2) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", & + &"trivial") + else if (flux_direction == 3) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", & + &"trivial") + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + + f1 = 0.d0 + lamminus = 0.d0 + lamplus = 0.d0 + cons_p = 0.d0 + cons_m = 0.d0 + 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) = Bvecxplus(i,j,k) + cons_p(7) = Bvecyplus(i,j,k) + cons_p(8) = Bveczplus(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) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(7) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(8) = 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_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_p(6) = pressplus(i,j,k) + cs2_p = eos_cs2_p(i,j,k) + dpdeps_p = eos_dpdeps_p(i,j,k) + rhoenth_p = prim_p(1)*(1.0d0+prim_p(5))+prim_p(6) + + prim_m(6) = pressminus(i+xoffset,j+yoffset,k+zoffset) + cs2_m = eos_cs2_m(i+xoffset,j+yoffset,k+zoffset) + dpdeps_m = eos_dpdeps_m(i+xoffset,j+yoffset,k+zoffset) + rhoenth_m = prim_m(1)*(1.0d0+prim_m(5))+prim_m(6) + +!!$ 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 + + if (shift_state .ne. 0) then + avg_betax = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + & + betax(i,j,k)) + avg_betay = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + & + betay(i,j,k)) + avg_betaz = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + & + betaz(i,j,k)) + if (flux_direction == 1) then + avg_beta=avg_betax + else if (flux_direction == 2) then + avg_beta=avg_betay + else if (flux_direction == 3) then + avg_beta=avg_betaz + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + avg_beta = 0.d0 + avg_betax = 0.d0 + avg_betay = 0.d0 + avg_betaz = 0.d0 + end if + + avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset)) + + gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + gxx(i,j,k)) + gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + gxy(i,j,k)) + gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + gxz(i,j,k)) + gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + gyy(i,j,k)) + gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + gyz(i,j,k)) + gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + gzz(i,j,k)) + + avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh) + + vxtp = prim_p(2)-avg_betax/avg_alp + vytp = prim_p(3)-avg_betay/avg_alp + vztp = prim_p(4)-avg_betaz/avg_alp + vxtm = prim_m(2)-avg_betax/avg_alp + vytm = prim_m(3)-avg_betay/avg_alp + vztm = prim_m(4)-avg_betaz/avg_alp + + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_p(2),prim_p(3),prim_p(4),cons_p(6),cons_p(7),cons_p(8), & + velxlowp,velylowp,velzlowp,Bvecxlowp,Bvecylowp,Bveczlowp, & + bdotvp,b2p,v2p,wp,bxlowp,bylowp,bzlowp) + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_m(2),prim_m(3),prim_m(4),cons_m(6),cons_m(7),cons_m(8), & + velxlowm,velylowm,velzlowm,Bvecxlowm,Bvecylowm,Bveczlowm, & + bdotvm,b2m,v2m,wm,bxlowm,bylowm,bzlowm) + + ab0p = wp*bdotvp + ab0m = wm*bdotvm + + vA2p = b2p/(rhoenth_p+b2p) + vA2m = b2m/(rhoenth_m+b2m) + +!!$ p^* = p+b^2/2 in Anton et al. + pressstarp = prim_p(6)+0.5d0*b2p + pressstarm = prim_m(6)+0.5d0*b2m + + +!!$ If the Riemann problem is trivial, just calculate the fluxes from the +!!$ left state and skip to the next cell + + if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then + +!!$ we now pass in the B-field as conserved and flux, the vtilde's instead of v's, +!!$ pressstar instead of P, b_i, alp b^0, w, metric determinant, +!!$ alp, and beta in the flux dir + + if (flux_direction == 1) then + call num_x_fluxM(cons_m(1),cons_m(2),cons_m(3),cons_m(4),cons_m(5),& + cons_m(6),cons_m(7),cons_m(8),& + f1(1),f1(2),f1(3),f1(4),f1(5),f1(6),f1(7),f1(8),& + vxtm,vytm,vztm,pressstarm,bxlowm,bylowm,bzlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 2) then + call num_x_fluxM(cons_m(1),cons_m(3),cons_m(4),cons_m(2),cons_m(5),& + cons_m(7),cons_m(8),cons_m(6),& + f1(1),f1(3),f1(4),f1(2),f1(5),f1(7),f1(8),f1(6),& + vytm,vztm,vxtm,pressstarm,bylowm,bzlowm,bxlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 3) then + call num_x_fluxM(cons_m(1),cons_m(4),cons_m(2),cons_m(3),cons_m(5),& + cons_m(8),cons_m(6),cons_m(7),& + f1(1),f1(4),f1(2),f1(3),f1(5),f1(8),f1(6),f1(7), & + vztm,vxtm,vytm,pressstarm,bzlowm,bxlowm,bylowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + else !!! The end of this branch is right at the bottom of the routine + + call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, & + avg_det,gxxh, gxyh, gxzh, & + gyyh, gyzh, gzzh) + + if (flux_direction == 1) then + usendh = uxxh + else if (flux_direction == 2) then + usendh = uyyh + else if (flux_direction == 3) then + usendh = uzzh + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + +!!$ Calculate the jumps in the conserved variables + + qdiff(1) = cons_m(1) - cons_p(1) + qdiff(2) = cons_m(2) - cons_p(2) + qdiff(3) = cons_m(3) - cons_p(3) + qdiff(4) = cons_m(4) - cons_p(4) + qdiff(5) = cons_m(5) - cons_p(5) + qdiff(6) = cons_m(6) - cons_p(6) + qdiff(7) = cons_m(7) - cons_p(7) + qdiff(8) = cons_m(8) - cons_p(8) + +!!$ Eigenvalues and fluxes either side of the cell interface + + if (flux_direction == 1) then + call eigenvalues_generalM(& + prim_m(2),prim_m(3),prim_m(4),cs2_m,vA2m, & + lamminus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(2),prim_p(3),prim_p(4),cs2_p,vA2p, & + lamplus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),& + cons_p(6),cons_p(7),cons_p(8),& + fplus(1),fplus(2),fplus(3),fplus(4),fplus(5),fplus(6),fplus(7),fplus(8),& + vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(2),cons_m(3),cons_m(4),cons_m(5),& + cons_m(6),cons_m(7),cons_m(8),& + fminus(1),fminus(2),fminus(3),fminus(4),fminus(5),& + fminus(6),fminus(7),fminus(8),& + vxtm,vytm,vztm,pressstarm,bxlowm,bylowm,bzlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 2) then + call eigenvalues_generalM(& + prim_m(3),prim_m(4),prim_m(2),cs2_m,vA2m, & + lamminus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(3),prim_p(4),prim_p(2),cs2_p,vA2p, & + lamplus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),& + cons_p(7),cons_p(8),cons_p(6),& + fplus(1),fplus(3),fplus(4),fplus(2),fplus(5),fplus(7),fplus(8),fplus(6),& + vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(3),cons_m(4),cons_m(2),cons_m(5),& + cons_m(7),cons_m(8),cons_m(6),& + fminus(1),fminus(3),fminus(4),fminus(2),fminus(5),& + fminus(7),fminus(8),fminus(6),& + vytm,vztm,vxtm,pressstarm,bylowm,bzlowm,bxlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 3) then + call eigenvalues_generalM(& + prim_m(4),prim_m(2),prim_m(3),cs2_m,vA2m, & + lamminus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(4),prim_p(2),prim_p(3),cs2_p,vA2p, & + lamplus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),& + cons_p(8),cons_p(6),cons_p(7),& + fplus(1),fplus(4),fplus(2),fplus(3),fplus(5),fplus(8),fplus(6),fplus(7), & + vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(4),cons_m(2),cons_m(3),cons_m(5),& + cons_m(8),cons_m(6),cons_m(7),& + fminus(1),fminus(4),fminus(2),fminus(3),fminus(5), & + fminus(8),fminus(6),fminus(7), & + vztm,vxtm,vytm,pressstarm,bzlowm,bxlowm,bylowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + if(tadmor.eq.0) then + +!!$ 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,8 + + qdiff(m) = cons_m(m) - cons_p(m) + + f1(m) = (charmax * fplus(m) - charmin * fminus(m) + & + charmax * charmin * qdiff(m)) / charpm + + end do + + else + ! Tadmor's semi-discrete scheme: JcP 160, 241 (2000) + + charmax = max(abs(lamplus(1)), abs(lamplus(2)), abs(lamplus(3)), & + abs(lamplus(4)),abs(lamplus(5)),abs(lamminus(1)),abs(lamminus(2)), & + abs(lamminus(3)),abs(lamminus(4)),abs(lamminus(5))) + + do m = 1,8 + + qdiff(m) = cons_m(m) - cons_p(m) + + f1(m) = 0.5d0 * (fplus(m) + fminus(m)) - 0.5d0*charmax* & + qdiff(m) + + end do + + + end if + + + + end if !!! The end of the SpaceMask check for a trivial RP. + + densflux(i, j, k) = f1(1) + sxflux(i, j, k) = f1(2) + syflux(i, j, k) = f1(3) + szflux(i, j, k) = f1(4) + tauflux(i, j, k) = f1(5) + Bvecxflux(i, j, k) = f1(6) + Bvecyflux(i, j, k) = f1(7) + Bveczflux(i, j, k) = f1(8) + + end do + end do + end do + +end subroutine GRHydro_HLLEGeneralM + + +subroutine GRHydro_HLLE_TracerGeneralM(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(6) :: 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, alp_l, alp_r, & + cs2_p, cs2_m, dpdeps_p, dpdeps_m + CCTK_REAL :: b2p,b2m,vA2m,vA2p + + integer tadmor + + if(CCTK_EQUALS(HLLE_type,"Tadmor")) then + tadmor = 1 + else + tadmor = 0 + endif + + + 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_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_p(6) = pressplus(i,j,k) + cs2_p = eos_cs2_p(i,j,k) + dpdeps_p = eos_dpdeps_p(i,j,k) + + prim_m(6) = pressminus(i+xoffset,j+yoffset,k+zoffset) + cs2_m = eos_cs2_m(i+xoffset,j+yoffset,k+zoffset) + dpdeps_m = eos_dpdeps_m(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 (shift_state .ne. 0) then + if (flux_direction == 1) then + avg_beta = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + & + betax(i,j,k)) + else if (flux_direction == 2) then + avg_beta = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + & + betay(i,j,k)) + else if (flux_direction == 3) then + avg_beta = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + & + betaz(i,j,k)) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + avg_beta = 0.d0 + end if + + avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset)) + + gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + gxx(i,j,k)) + gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + gxy(i,j,k)) + gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + gxz(i,j,k)) + gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + gyy(i,j,k)) + gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + gyz(i,j,k)) + gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + gzz(i,j,k)) + + avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh) + +!!$ If the Riemann problem is trivial, just calculate the fluxes from the +!!$ left state and skip to the next cell + + 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_WARN(0, "Flux direction not x,y,z") + end if + +!!$ b^2 = (1-v^2)B^2+(B dot v)^2 + b2p=(1.d0-DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_p(2),prim_p(3),prim_p(4)))* & + DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_p(1),mag_p(2),mag_p(3)) + & + (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=(1.d0-DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_m(2),prim_m(3),prim_m(4)))* & + DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_m(1),mag_m(2),mag_m(3)) + & + (DOTP(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_m(2),prim_m(3),prim_m(4),mag_m(1),mag_m(2),mag_m(3)))**2 + + vA2p = b2p/(prim_p(1)*(1.0d0+prim_p(5))+prim_p(6)+b2p) + vA2m = b2m/(prim_m(1)*(1.0d0+prim_m(5))+prim_m(6)+b2m) + +!!$ Eigenvalues and fluxes either side of the cell interface + + if (flux_direction == 1) then + call eigenvalues_generalM(& + prim_m(2),prim_m(3),prim_m(4),cs2_m,vA2m, & + lamminus,& + gxxh,gxyh,gxzh,& + gyyh,gyzh,gzzh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(2),prim_p(3),prim_p(4),cs2_p,vA2p, & + lamplus,& + gxxh,gxyh,gxzh,& + gyyh,gyzh,gzzh,& + usendh,avg_alp,avg_beta) + fplus(:) = (velxplus(i,j,k) - avg_beta / avg_alp) * & + cons_tracerplus(i,j,k,:) + fminus(:) = (velxminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * & + cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:) + else if (flux_direction == 2) then + call eigenvalues_generalM(& + prim_m(3),prim_m(4),prim_m(2),cs2_m,vA2m, & + lamminus,& + gyyh,gyzh,gxyh,& + gzzh,gxzh,gxxh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(3),prim_p(4),prim_p(2),cs2_p,vA2p, & + lamplus,& + gyyh,gyzh,gxyh,& + gzzh,gxzh,gxxh,& + usendh,avg_alp,avg_beta) + fplus(:) = (velyplus(i,j,k) - avg_beta / avg_alp) * & + cons_tracerplus(i,j,k,:) + fminus(:) = (velyminus(i+xoffset,j+yoffset,k+zoffset) - avg_beta / avg_alp) * & + cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:) + else if (flux_direction == 3) then + call eigenvalues_generalM(& + prim_m(4),prim_m(2),prim_m(3),cs2_m,vA2m, & + lamminus,& + gzzh,gxzh,gyzh,& + gxxh,gxyh,gyyh,& + usendh,avg_alp,avg_beta) + call eigenvalues_generalM(& + prim_p(4),prim_p(2),prim_p(3),cs2_p,vA2p, & + 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_WARN(0, "Flux direction not x,y,z") + end if + + if(tadmor.eq.0) then + +!!$ 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 + + else + ! Tadmor's semi-descrite scheme: JcP 160, 241 (2000) + + charmax = max(abs(lamplus(1)), abs(lamplus(2)), abs(lamplus(3)), & + abs(lamplus(4)),abs(lamplus(5)),abs(lamminus(1)),abs(lamminus(2)), & + abs(lamminus(3)),abs(lamminus(4)),abs(lamminus(5))) + + do m = 1,number_of_tracers + + qdiff(m) = cons_m(m) - cons_p(m) + + f1(m) = 0.5d0 * (fplus(m) + fminus(m)) - 0.5d0*charmax* & + qdiff(m) + + end do + + + end if + + + cons_tracerflux(i,j,k,:) = f1(:) + + end do + end do + end do + +end subroutine GRHydro_HLLE_TracerGeneralM + diff --git a/src/GRHydro_HLLEPolyM.F90 b/src/GRHydro_HLLEPolyM.F90 new file mode 100644 index 0000000..997375c --- /dev/null +++ b/src/GRHydro_HLLEPolyM.F90 @@ -0,0 +1,606 @@ + /*@@ + @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 + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + + integer :: i, j, k, m + CCTK_REAL, dimension(8) :: cons_p,cons_m,fplus,fminus,f1,qdiff + CCTK_REAL, dimension(7) :: prim_p, prim_m + CCTK_REAL, dimension(5) :: lamminus,lamplus + 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, alp_l, alp_r, & + cs2_p, cs2_m, dpdeps_p, dpdeps_m + CCTK_REAL :: rhoenth_p, rhoenth_m, avg_betax, avg_betay, avg_betaz + CCTK_REAL :: vxtp,vytp,vztp,vxtm,vytm,vztm,ab0p,ab0m,b2p,b2m,bdotvp,bdotvm + CCTK_REAL :: wp,wm,v2p,v2m,bxlowp,bxlowm,bylowp,bylowm,bzlowp,bzlowm,vA2m,vA2p + CCTK_REAL :: Bvecxlowp,Bvecxlowm,Bvecylowp,Bvecylowm,Bveczlowp,Bveczlowm + CCTK_REAL :: pressstarp,pressstarm,velxlowp,velxlowm,velylowp,velylowm,velzlowp,velzlowm + + CCTK_INT :: type_bits, trivial, not_trivial + + if (flux_direction == 1) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", & + &"trivial") + else if (flux_direction == 2) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", & + &"trivial") + else if (flux_direction == 3) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", & + &"trivial") + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + + f1 = 0.d0 + lamminus = 0.d0 + lamplus = 0.d0 + cons_p = 0.d0 + cons_m = 0.d0 + 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) = Bvecxplus(i,j,k) + cons_p(7) = Bvecyplus(i,j,k) + cons_p(8) = Bveczplus(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) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(7) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(8) = 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. +!!$ +!!$ In MHD, we need all three shift components regardless of the flux direction + + if (shift_state .ne. 0) then + avg_betax = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + & + betax(i,j,k)) + avg_betay = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + & + betay(i,j,k)) + avg_betaz = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + & + betaz(i,j,k)) + if (flux_direction == 1) then + avg_beta=avg_betax + else if (flux_direction == 2) then + avg_beta=avg_betay + else if (flux_direction == 3) then + avg_beta=avg_betaz + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + avg_beta = 0.d0 + avg_betax = 0.d0 + avg_betay = 0.d0 + avg_betaz = 0.d0 + end if + + avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset)) + + gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + gxx(i,j,k)) + gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + gxy(i,j,k)) + gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + gxz(i,j,k)) + gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + gyy(i,j,k)) + gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + gyz(i,j,k)) + gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + gzz(i,j,k)) + + avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh) + + vxtp = prim_p(2)-avg_betax/avg_alp + vytp = prim_p(3)-avg_betay/avg_alp + vztp = prim_p(4)-avg_betaz/avg_alp + vxtm = prim_m(2)-avg_betax/avg_alp + vytm = prim_m(3)-avg_betay/avg_alp + vztm = prim_m(4)-avg_betaz/avg_alp + + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_p(2),prim_p(3),prim_p(4),cons_p(6),cons_p(7),cons_p(8), & + velxlowp,velylowp,velzlowp,Bvecxlowp,Bvecylowp,Bveczlowp, & + bdotvp,b2p,v2p,wp,bxlowp,bylowp,bzlowp) + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_m(2),prim_m(3),prim_m(4),cons_m(6),cons_m(7),cons_m(8), & + velxlowm,velylowm,velzlowm,Bvecxlowm,Bvecylowm,Bveczlowm, & + bdotvm,b2m,v2m,wm,bxlowm,bylowm,bzlowm) + + ab0p = wp*bdotvp + ab0m = wm*bdotvm + + vA2p = b2p/(rhoenth_p+b2p) + vA2m = b2m/(rhoenth_m+b2m) + +!!$ p^* = p+b^2/2 in Anton et al. + pressstarp = prim_p(6)+0.5d0*b2p + pressstarm = prim_m(6)+0.5d0*b2m + + +!!$ If the Riemann problem is trivial, just calculate the fluxes from the +!!$ left state and skip to the next cell + + if (SpaceMask_CheckStateBitsF90(space_mask, i, j, k, type_bits, trivial)) then + +!!$ we now pass in the B-field as conserved and flux, the vtilde's instead of v's, +!!$ pressstar instead of P, b_i, alp b^0, w, metric determinant, +!!$ alp, and beta in the flux dir + + if (flux_direction == 1) then + call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),& + cons_p(6),cons_p(7),cons_p(8),& + f1(1),f1(2),f1(3),f1(4),f1(5),f1(6),f1(7),f1(8),& + vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 2) then + call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),& + cons_p(7),cons_p(8),cons_p(6),& + f1(1),f1(3),f1(4),f1(2),f1(5),f1(7),f1(8),f1(6),& + vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 3) then + call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),& + cons_p(8),cons_p(6),cons_p(7),& + f1(1),f1(4),f1(2),f1(3),f1(5),f1(8),f1(6),f1(7), & + vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + else !!! The end of this branch is right at the bottom of the routine + + call UpperMetric(uxxh, uxyh, uxzh, uyyh, uyzh, uzzh, & + avg_det,gxxh, gxyh, gxzh, & + gyyh, gyzh, gzzh) + + if (flux_direction == 1) then + usendh = uxxh + else if (flux_direction == 2) then + usendh = uyyh + else if (flux_direction == 3) then + usendh = uzzh + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + +!!$ Calculate the jumps in the conserved variables + + qdiff(1) = cons_m(1) - cons_p(1) + qdiff(2) = cons_m(2) - cons_p(2) + qdiff(3) = cons_m(3) - cons_p(3) + qdiff(4) = cons_m(4) - cons_p(4) + qdiff(5) = cons_m(5) - cons_p(5) + qdiff(6) = cons_m(6) - cons_p(6) + qdiff(7) = cons_m(7) - cons_p(7) + qdiff(8) = cons_m(8) - cons_p(8) + +!!$ Eigenvalues and fluxes either side of the cell interface + + if (flux_direction == 1) then + call eigenvaluesM(GRHydro_eos_handle,& + prim_m(1),prim_m(2),prim_m(3),prim_m(4),prim_m(5),prim_m(7), & + cons_m(6),cons_m(7),cons_m(8),& + 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(7), & + cons_p(6),cons_p(7),cons_p(8),& + lamplus,gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),& + cons_p(6),cons_p(7),cons_p(8),& + fplus(1),fplus(2),fplus(3),fplus(4),fplus(5),fplus(6),fplus(7),fplus(8),& + vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(2),cons_m(3),cons_m(4),cons_m(5),& + cons_m(6),cons_m(7),cons_m(8),& + fminus(1),fminus(2),fminus(3),fminus(4),fminus(5),& + fminus(6),fminus(7),fminus(8),& + vxtm,vytm,vztm,pressstarm,bxlowm,bylowm,bzlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 2) then + call eigenvaluesM(GRHydro_eos_handle,& + prim_m(1),prim_m(3),prim_m(4),prim_m(2),prim_m(5),prim_m(7), & + cons_m(7),cons_m(8),cons_m(6),& + 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(7), & + cons_p(7),cons_p(8),cons_p(6),& + lamplus,gyyh,gyzh,gxyh,gzzh,gxzh,gxxh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),& + cons_p(7),cons_p(8),cons_p(6),& + fplus(1),fplus(3),fplus(4),fplus(2),fplus(5),fplus(7),fplus(8),fplus(6),& + vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(3),cons_m(4),cons_m(2),cons_m(5),& + cons_m(7),cons_m(8),cons_m(6),& + fminus(1),fminus(3),fminus(4),fminus(2),fminus(5),& + fminus(7),fminus(8),fminus(6),& + vytm,vztm,vxtm,pressstarm,bylowm,bzlowm,bxlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else if (flux_direction == 3) then + call eigenvaluesM(GRHydro_eos_handle,& + prim_m(1),prim_m(4),prim_m(2),prim_m(3),prim_m(5),prim_m(7), & + cons_m(8),cons_m(6),cons_m(7),& + 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(7), & + cons_p(8),cons_p(6),cons_p(7),& + lamplus,gzzh,gxzh,gyzh,gxxh,gxyh,gyyh,& + usendh,avg_alp,avg_beta) + call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),& + cons_p(8),cons_p(6),cons_p(7),& + fplus(1),fplus(4),fplus(2),fplus(3),fplus(5),fplus(8),fplus(6),fplus(7), & + vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + call num_x_fluxM(cons_m(1),cons_m(4),cons_m(2),cons_m(3),cons_m(5),& + cons_m(8),cons_m(6),cons_m(7),& + fminus(1),fminus(4),fminus(2),fminus(3),fminus(5), & + fminus(8),fminus(6),fminus(7), & + vztm,vxtm,vytm,pressstarm,bzlowm,bxlowm,bylowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + +!!$ Find minimum and maximum wavespeeds + + charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), & + lamplus(4),lamplus(5), lamminus(1),lamminus(2),lamminus(3),& + lamminus(4),lamminus(5)) + + charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), & + lamplus(4),lamplus(5), lamminus(1),lamminus(2),lamminus(3),& + lamminus(4),lamminus(5)) + + charpm = charmax - charmin + +!!$ Calculate flux by standard formula + + do m = 1,8 + + qdiff(m) = cons_m(m) - cons_p(m) + + f1(m) = (charmax * fplus(m) - charmin * fminus(m) + & + charmax * charmin * qdiff(m)) / charpm + + end do + + end if !!! The end of the SpaceMask check for a trivial RP. + + densflux(i, j, k) = f1(1) + sxflux(i, j, k) = f1(2) + syflux(i, j, k) = f1(3) + szflux(i, j, k) = f1(4) + tauflux(i, j, k) = f1(5) + Bvecxflux(i, j, k) = f1(6) + Bvecyflux(i, j, k) = f1(7) + Bveczflux(i, j, k) = f1(8) + + end do + end do + end do + +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 + + 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, alp_l, alp_r, & + cs2_p, cs2_m, dpdeps_p, dpdeps_m + CCTK_REAL :: b2p,b2m,vA2m,vA2p + + CCTK_INT :: type_bits, trivial, not_trivial + + if (flux_direction == 1) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemX") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemX", & + &"trivial") + else if (flux_direction == 2) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemY") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemY", & + &"trivial") + else if (flux_direction == 3) then + call SpaceMask_GetTypeBits(type_bits, "Hydro_RiemannProblemZ") + call SpaceMask_GetStateBits(trivial, "Hydro_RiemannProblemZ", & + &"trivial") + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + + f1 = 0.d0 + lamminus = 0.d0 + lamplus = 0.d0 + cons_p = 0.d0 + cons_m = 0.d0 + mag_p = 0.d0 + mag_m = 0.d0 + fplus = 0.d0 + fminus = 0.d0 + qdiff = 0.d0 + +!!$ Set the left (p for plus) and right (m_i for minus, i+1) states + + cons_p(:) = cons_tracerplus(i,j,k,:) + cons_m(:) = cons_tracerminus(i+xoffset,j+yoffset,k+zoffset,:) + + mag_p(1) = Bvecxplus(i,j,k) + mag_p(2) = Bvecyplus(i,j,k) + mag_p(3) = Bveczplus(i,j,k) + + mag_m(1) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset) + mag_m(2) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset) + mag_m(3) = Bveczminus(i+xoffset,j+yoffset,k+zoffset) + + prim_p(1) = rhoplus(i,j,k) + prim_p(2) = velxplus(i,j,k) + prim_p(3) = velyplus(i,j,k) + prim_p(4) = velzplus(i,j,k) + prim_p(5) = epsplus(i,j,k) + prim_p(6) = pressplus(i,j,k) + prim_p(7) = w_lorentzplus(i,j,k) + + prim_m(1) = rhominus(i+xoffset,j+yoffset,k+zoffset) + prim_m(2) = velxminus(i+xoffset,j+yoffset,k+zoffset) + prim_m(3) = velyminus(i+xoffset,j+yoffset,k+zoffset) + prim_m(4) = velzminus(i+xoffset,j+yoffset,k+zoffset) + prim_m(5) = epsminus(i+xoffset,j+yoffset,k+zoffset) + prim_m(6) = pressminus(i+xoffset,j+yoffset,k+zoffset) + prim_m(7) = w_lorentzminus(i+xoffset,j+yoffset,k+zoffset) + +!!$ Calculate various metric terms here. +!!$ Note also need the average of the lapse at the +!!$ left and right points. + + if (shift_state .ne. 0) then + if (flux_direction == 1) then + avg_beta = 0.5d0 * (betax(i+xoffset,j+yoffset,k+zoffset) + & + betax(i,j,k)) + else if (flux_direction == 2) then + avg_beta = 0.5d0 * (betay(i+xoffset,j+yoffset,k+zoffset) + & + betay(i,j,k)) + else if (flux_direction == 3) then + avg_beta = 0.5d0 * (betaz(i+xoffset,j+yoffset,k+zoffset) + & + betaz(i,j,k)) + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + avg_beta = 0.d0 + end if + + avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset)) + + gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + gxx(i,j,k)) + gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + gxy(i,j,k)) + gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + gxz(i,j,k)) + gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + gyy(i,j,k)) + gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + gyz(i,j,k)) + gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + gzz(i,j,k)) + + avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh) + + 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_WARN(0, "Flux direction not x,y,z") + end if + +!!$ b^2 = (1-v^2)B^2+(B dot v)^2 + b2p=DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_p(1),mag_p(2),mag_p(3))/prim_p(7)**2 + & + (DOTP(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_p(2),prim_p(3),prim_p(4),mag_p(1),mag_p(2),mag_p(3)))**2 + b2m=DOTP2(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,mag_m(1),mag_m(2),mag_m(3))/prim_m(7)**2 + & + (DOTP(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh,prim_m(2),prim_m(3),prim_m(4),mag_m(1),mag_m(2),mag_m(3)))**2 + + vA2p = b2p/(prim_p(1)*(1.0d0+prim_p(5))+prim_p(6)+b2p) + vA2m = b2m/(prim_m(1)*(1.0d0+prim_m(5))+prim_m(6)+b2m) + +!!$ Calculate the jumps in the conserved variables + + qdiff = cons_m - cons_p + +!!$ Eigenvalues and fluxes either side of the cell interface + + if (flux_direction == 1) then + call eigenvaluesM(GRHydro_eos_handle,& + prim_m(1),prim_m(2),prim_m(3),prim_m(4),prim_m(5),prim_m(7), & + cons_m(6),cons_m(7),cons_m(8),& + 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(7), & + cons_p(6),cons_p(7),cons_p(8),& + 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(7), & + cons_m(7),cons_m(8),cons_m(6),& + 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(7), & + cons_p(7),cons_p(8),cons_p(6),& + 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(7), & + cons_m(8),cons_m(6),cons_m(7),& + 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(7), & + cons_p(8),cons_p(6),cons_p(7),& + 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_WARN(0, "Flux direction not x,y,z") + end if + +!!$ Find minimum and maximum wavespeeds + + charmin = min(0.d0, lamplus(1), lamplus(2), lamplus(3), & + lamplus(4),lamplus(5), lamminus(1),lamminus(2),lamminus(3),& + lamminus(4),lamminus(5)) + + charmax = max(0.d0, lamplus(1), lamplus(2), lamplus(3), & + lamplus(4),lamplus(5), lamminus(1),lamminus(2),lamminus(3),& + lamminus(4),lamminus(5)) + + charpm = charmax - charmin + +!!$ Calculate flux by standard formula + + do m = 1,number_of_tracers + + qdiff(m) = cons_m(m) - cons_p(m) + + f1(m) = (charmax * fplus(m) - charmin * fminus(m) + & + charmax * charmin * qdiff(m)) / charpm + + end do + + cons_tracerflux(i, j, k,:) = f1(:) +!!$ +!!$ if ( ((flux_direction.eq.3).and.(i.eq.4).and.(j.eq.4)).or.& +!!$ ((flux_direction.eq.2).and.(i.eq.4).and.(k.eq.4)).or.& +!!$ ((flux_direction.eq.1).and.(j.eq.4).and.(k.eq.4))& +!!$ ) then +!!$ write(*,*) flux_direction, i, j, k, f1(1), cons_m(1), cons_p(1) +!!$ end if + + end do + end do +end do + + +end subroutine GRHydro_HLLE_TracerM + diff --git a/src/GRHydro_InterfacesM.h b/src/GRHydro_InterfacesM.h new file mode 100644 index 0000000..7479278 --- /dev/null +++ b/src/GRHydro_InterfacesM.h @@ -0,0 +1,84 @@ +module Con2PrimM_fortran_interfaces + implicit none + + interface + + subroutine GRHydro_Con2PrimM_pt( handle, & + dens, & + sx, sy, sz, & + tau, & + rho, & + velx, vely, velz,& + epsilon, pressure,& + w_lorentz, & + gxx, gxy, gxz, & + gyy, gyz, gzz, & + uxx, uxy, uxz,& + uyy, uyz, uzz,& + det,& + Bx, By, Bz, & + bsq,& + epsnegative, & + retval) + + implicit none + CCTK_INT handle + CCTK_REAL dens + CCTK_REAL sx, sy, sz + CCTK_REAL tau + CCTK_REAL rho + CCTK_REAL velx, vely, velz + CCTK_REAL epsilon, pressure + 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_REAL Bx, By, Bz + CCTK_REAL bsq + CCTK_INT epsnegative + CCTK_REAL retval + end subroutine GRHydro_Con2PrimM_pt + + subroutine GRHydro_Con2PrimM_Polytype_pt( handle, & + dens, & + sx, sy, sz, & + tau, & + rho, & + velx, vely, velz,& + epsilon, pressure,& + w_lorentz, & + gxx, gxy, gxz, & + gyy, gyz, gzz, & + uxx, uxy, uxz,& + uyy, uyz, uzz,& + det,& + Bx, By, Bz, & + bsq,& + epsnegative, & + retval) + + implicit none + CCTK_INT handle + CCTK_REAL dens + CCTK_REAL sx, sy, sz + CCTK_REAL tau + CCTK_REAL rho + CCTK_REAL velx, vely, velz + CCTK_REAL epsilon, pressure + 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_REAL Bx, By, Bz + CCTK_REAL bsq + CCTK_INT epsnegative + CCTK_REAL retval + end subroutine GRHydro_Con2PrimM_Polytype_pt + + end interface + +end module Con2PrimM_fortran_interfaces diff --git a/src/GRHydro_Macros.h b/src/GRHydro_Macros.h index c3cdd69..7009b86 100644 --- a/src/GRHydro_Macros.h +++ b/src/GRHydro_Macros.h @@ -1,3 +1,12 @@ -#define SPATIAL_DETERMINANT(gxx,gxy,gxz,gyy,gyz,gzz) \ - (-(gxz)**2*(gyy) + 2*(gxy)*(gxz)*(gyz) - (gxx)*(gyz)**2 - (gxy)**2*(gzz) \ - + (gxx)*(gyy)*(gzz)) +#define SPATIAL_DETERMINANT(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_) \ + (-(gxz_)**2*(gyy_) + 2*(gxy_)*(gxz_)*(gyz_) - (gxx_)*(gyz_)**2 - (gxy_)**2*(gzz_) \ + + (gxx_)*(gyy_)*(gzz_)) + +#define DOTP(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_,x1_,y1_,z1_,x2_,y2_,z2_) \ + ( (gxx_)*(x1_)*(x2_)+(gyy_)*(y1_)*(y2_)+(gzz_)*(z1_)*(z2_)+ \ + (gxy_)*( (x1_)*(y2_)+(y1_)*(x2_) )+(gxz_)*( (x1_)*(z2_)+(z1_)*(x2_) )+\ + (gyz_)*( (y1_)*(z2_)+(z1_)*(y2_) ) ) + +#define DOTP2(gxx_,gxy_,gxz_,gyy_,gyz_,gzz_,x_,y_,z_) \ + ( (gxx_)*(x_)**2+(gyy_)*(y_)**2+(gzz_)*(z_)**2+ \ + 2.0*( (gxy_)*(x_)*(y_)+(gxz_)*(x_)*(z_)+(gyz_)*(y_)*(z_) ) ) diff --git a/src/GRHydro_PPMM.F90 b/src/GRHydro_PPMM.F90 new file mode 100644 index 0000000..0ff4d72 --- /dev/null +++ b/src/GRHydro_PPMM.F90 @@ -0,0 +1,820 @@ + /*@@ + @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 "GRHydro_Macros.h" + +!!subroutine PPM_TVD(origm, orig, origp, bextm, bextp) +!! CCTK_REAL :: origm, orig, origp, bextm, bextp +!! CCTK_REAL :: dloc, dupw, delta +!! +!! dupw = orig - origm +!! dloc = origp - orig +!! if (dupw*dloc < 0.d0) then +!! delta=0.d0 +!! else if (abs(dupw) < abs(dloc)) then +!! delta=dupw +!! else +!! delta=dloc +!! end if +!! bextm = orig - 0.5d0 * delta +!! bextp = orig + 0.5d0 * delta +!!end subroutine PPM_TVD + + /*@@ + @routine SimplePPM_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 + +@@*/ + +#define SpaceMask_CheckStateBitsF90_1D(mask,i,type_bits,state_bits) \ + (iand(mask((i)),(type_bits)).eq.(state_bits)) + + +subroutine SimplePPM_1dM(handle,poly,nx,dx,& + rho,velx,vely,velz,Bvcx,Bvcy,Bvcz,eps,press,& + rhominus,velxminus,velyminus,velzminus,Bvcxminus,Bvcyminus,Bvczminus,epsminus,& + rhoplus,velxplus,velyplus,velzplus,Bvcxplus,Bvcyplus,Bvczplus,epsplus,& + trivial_rp, hydro_excision_mask,& + gxx, gxy, gxz, gyy, gyz, gzz, psi4, 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 + + CCTK_INT :: handle,poly,nx + CCTK_REAL :: dx + CCTK_REAL, dimension(nx) :: rho,velx,vely,velz,eps + CCTK_REAL, dimension(nx) :: Bvcx,Bvcy,Bvcz + CCTK_REAL, dimension(nx) :: rhominus,velxminus,velyminus,velzminus,epsminus + CCTK_REAL, dimension(nx) :: Bvcxminus,Bvcyminus,Bvczminus + CCTK_REAL, dimension(nx) :: rhoplus,velxplus,velyplus,velzplus,epsplus + CCTK_REAL, dimension(nx) :: Bvcxplus,Bvcyplus,Bvczplus + CCTK_REAL, dimension(nx) :: rhominusl,velxminusl,velyminusl,velzminusl + CCTK_REAL, dimension(nx) :: Bvcxminusl,Bvcyminusl,Bvczminusl + CCTK_REAL, dimension(nx) :: epsminusl + CCTK_REAL, dimension(nx) :: rhoplusl,velxplusl,velyplusl,velzplusl,epsplusl + CCTK_REAL, dimension(nx) :: Bvcxplusl,Bvcyplusl,Bvczplusl + CCTK_REAL, dimension(nx) :: rhominusr,velxminusr,velyminusr,velzminusr + CCTK_REAL, dimension(nx) :: Bvcxminusr,Bvcyminusr,Bvczminusr + CCTK_REAL, dimension(nx) :: epsminusr + CCTK_REAL, dimension(nx) :: rhoplusr,velxplusr,velyplusr,velzplusr,epsplusr + CCTK_REAL, dimension(nx) :: Bvcxplusr,Bvcyplusr,Bvczplusr + + CCTK_INT :: i,s + CCTK_REAL, dimension(nx) :: drho,dvelx,dvely,dvelz,deps + CCTK_REAL, dimension(nx) :: dBvcx,dBvcy,dBvcz + CCTK_REAL, dimension(nx) :: dmrho,dmvelx,dmvely,dmvelz,dmeps + CCTK_REAL, dimension(nx) :: dmBvcx,dmBvcy,dmBvcz + 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, & + psi4, 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 :: dupw, dloc, delta + CCTK_REAL :: agxx, agxy, agxz, agyy, agyz, agzz + CCTK_REAL, dimension(nx) :: xwind, l_ev_l, l_ev_r + + logical :: cond + + +!!$ 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 * (velx(i+1) - velx(i-1)) + dvely(i) = 0.5d0 * (vely(i+1) - vely(i-1)) + dvelz(i) = 0.5d0 * (velz(i+1) - velz(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)) + 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(velx, dvelx, dmvelx) + STEEP(vely, dvely, dmvely) + STEEP(velz, dvelz, dmvelz) + STEEP(Bvcx, dBvcx, dmBvcx) + STEEP(Bvcy, dBvcy, dmBvcy) + STEEP(Bvcz, dBvcz, dmBvcz) + 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 * (velx(i) + velx(i+1)) + & + (dmvelx(i) - dmvelx(i+1)) / 6.d0 + velxminus(i+1) = velxplus(i) + velyplus(i) = 0.5d0 * (vely(i) + vely(i+1)) + & + (dmvely(i) - dmvely(i+1)) / 6.d0 + velyminus(i+1) = velyplus(i) + velzplus(i) = 0.5d0 * (velz(i) + velz(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) + 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*( psi4(i)*gxx(i) + psi4(i+1)*gxx(i+1) ) + agxy = 0.5d0*( psi4(i)*gxy(i) + psi4(i+1)*gxy(i+1) ) + agxz = 0.5d0*( psi4(i)*gxz(i) + psi4(i+1)*gxz(i+1) ) + agyy = 0.5d0*( psi4(i)*gyy(i) + psi4(i+1)*gyy(i+1) ) + agyz = 0.5d0*( psi4(i)*gyz(i) + psi4(i+1)*gyz(i+1) ) + agzz = 0.5d0*( psi4(i)*gzz(i) + psi4(i+1)*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(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 (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 (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 (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 = velx(i+1) - velx(i-1) + if ( (abs(dpress(i)) > ppm_epsilon * min(press(i-1),press(i+1))) .and. & + (dvel < 0.d0) ) then + w = 1.d0 + else + w = 0.d0 + end if + if (abs(dpress2) < ppm_small) then + tilde_flatten(i) = 1.d0 + else + tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * & + (dpress(i) / dpress2 - ppm_omega1))) + end if + end do + + + + if (PPM3) then !!$ 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) * velx(i) + velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * velx(i) + velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vely(i) + velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vely(i) + velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * velz(i) + velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * velz(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 (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=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) * velx(i) + velxminus(i) = flatten * velxminus(i) + (1.d0 - flatten) * velx(i) + velyplus(i) = flatten * velyplus(i) + (1.d0 - flatten) * vely(i) + velyminus(i) = flatten * velyminus(i) + (1.d0 - flatten) * vely(i) + velzplus(i) = flatten * velzplus(i) + (1.d0 - flatten) * velz(i) + velzminus(i) = flatten * velzminus(i) + (1.d0 - flatten) * velz(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 (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,velx,velxplus) + MON(velyminus,vely,velyplus) + MON(velzminus,velz,velzplus) + MON(Bvcxminus,Bvcx,Bvcxplus) + MON(Bvcyminus,Bvcy,Bvcyplus) + MON(Bvczminus,Bvcz,Bvczplus) + 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)=velx(i) + velxplus(i)=velx(i) + velyminus(i)=vely(i) + velyplus(i)=vely(i) + velzminus(i)=velz(i) + velzplus(i)=velz(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)=velx(i) + velxplus(i-1)=velx(i) + velyminus(i-1)=vely(i) + velyplus(i-1)=vely(i) + velzminus(i-1)=velz(i) + velzplus(i-1)=velz(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 (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(velx(i-1), velx(i), velx(i+1), velxminus(i), velxplus(i)) + call PPM_TVD(vely(i-1), vely(i), vely(i+1), velyminus(i), velyplus(i)) + call PPM_TVD(velz(i-1), velz(i), velz(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 (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)=velx(i) + velxplus(i)=velx(i) + velyminus(i)=vely(i) + velyplus(i)=vely(i) + velzminus(i)=velz(i) + velzplus(i)=velz(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)=velx(i) + velxplus(i+1)=velx(i) + velyminus(i+1)=vely(i) + velyplus(i+1)=vely(i) + velzminus(i+1)=velz(i) + velzplus(i+1)=velz(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 (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(velx(i-1), velx(i), velx(i+1), velxminus(i), velxplus(i)) + call PPM_TVD(vely(i-1), vely(i), vely(i+1), velyminus(i), velyplus(i)) + call PPM_TVD(velz(i-1), velz(i), velz(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 (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 +return + +end subroutine SimplePPM_1dM + + + +!!subroutine SimplePPM_tracer_1d(nx,dx,rho,velx,vely,velz, & +!! tracer,tracerminus,tracerplus,press) +!! +!! USE GRHydro_Scalars +!! +!! implicit none +!! +!! DECLARE_CCTK_PARAMETERS +!! +!! CCTK_INT :: nx +!! CCTK_REAL :: dx +!! CCTK_REAL, dimension(nx) :: rho,velx,vely,velz +!! CCTK_REAL, dimension(nx,number_of_tracers) :: tracer,tracerminus,tracerplus +!! CCTK_REAL :: tracerflatomega +!! +!! +!! CCTK_INT :: i,s,itracer +!! CCTK_REAL, dimension(nx) :: press,dpress,tilde_flatten +!! CCTK_REAL, dimension(nx,number_of_tracers) :: dmtracer, dtracer, tracerflat!, d2tracer +!! CCTK_REAL :: dpress2,w,flatten,dvel +!! CCTK_REAL :: eta, etatilde +!! +!!!!$ Average slopes delta_m(a). See (1.7) of Colella and Woodward, p.178 +!!!!$ This is the expression for an even grid. +!! +!! +!! do i = 2, nx - 1 +!! dpress(i) = press(i+1) - press(i-1) +!! end do +!! +!! do itracer=1,number_of_tracers +!! do i = 2, nx - 1 +!! dtracer(i,itracer) = 0.5d0 * (tracer(i+1,itracer) - tracer(i-1,itracer)) +!!! d2tracer(i,itracer) = (tracer(i+1) - 2.d0 * tracer(i) + tracer(i-1))! / 6.d0 / dx / dx +!!! ! since we use d2tracer only for the condition d2tracer(i+1)*d2tracer(i-1)<0 +!!! ! the denominator is not necessary +!! enddo +!! enddo +!! +!!!!$ Steepened slope. See (1.8) of Colella and Woodward, p.178 +!! +!! do itracer=1,number_of_tracers +!! do i = 2, nx - 1 +!! if( (tracer(i+1,itracer) - tracer(i,itracer)) * & +!! (tracer(i,itracer) - tracer(i-1,itracer)) > 0.0d0 ) then +!! dmtracer(i,itracer) = sign(1.0d0,dtracer(i,itracer)) * & +!! min(abs(dtracer(i,itracer)), 2.0d0 * & +!! abs(tracer(i,itracer) - tracer(i-1,itracer)), & +!! 2.0d0 * abs(tracer(i+1,itracer) - tracer(i,itracer))) +!! else +!! dmtracer(i,itracer) = 0.0d0 +!! endif +!! end do +!! enddo +!! +!!!!$ Initial boundary states. See (1.9) of Colella and Woodward, p.178 +!! +!! do itracer=1,number_of_tracers +!! do i = 2, nx - 2 +!! tracerplus(i,itracer) = 0.5d0 * (tracer(i,itracer) + tracer(i+1,itracer)) + & +!! (dmtracer(i,itracer) - dmtracer(i+1,itracer)) / 6.d0 +!! tracerminus(i+1,itracer) = tracerplus(i,itracer) +!! enddo +!! enddo +!! +!! +!!!!$Discontinuity steepening. See (1.14-17) of C&W. +!!!!$This is the detect routine which mat be activated with the ppm_detect parameter +!!!!$Note that this part really also depends on the grid being even. +!!!!$Note also that we do not have access to the gas constant gamma. +!!!!$So this is just dropped from eq. (3.2) of C&W. +!!!!$We can get around this by just rescaling the constant k0 (ppm_k0 here). +!! +!!!!! We might play around with this for the tracer. CURRENTLY TURNED OFF +!! +!!#if 0 +!! if (ppm_detect .eq. 1000) then +!! do itracer=1,number_of_tracers +!! +!! do i = 3, nx - 2 +!! if ( (dtracer(i+1,itracer)*dtracer(i-1,itracer) > 0.d0) & !make sure this is not an extremum +!! .and.(abs(tracer(i+1,itracer)-tracer(i-1,itracer)) - & !this is to prevent steepening +!! !of relatively small composition jumps +!! ppm_epsilon_shock * min(tracer(i+1,itracer), tracer(i-1,itracer)) > 0.d0 ) & +!! .and. & ! the actual criterion from Plewa & Mueller +!! ((tracer(i+1,itracer)-tracer(i-1,itracer)) / & +!! (tracer(i+2,itracer)-tracer(i-2,itracer)) > ppm_omega1 ) ) then +!! +!! etatilde = (tracer(i-2,itracer) - tracer(i+2,itracer) + & +!! 4.d0 * dtracer(i,itracer)) / (dtracer(i,itracer) * 12.d0) +!! +!! write(*,*) "Additional Steepening in Zone: ",i +!! +!! else +!! etatilde = 0.d0 +!! end if +!! eta = max(0.d0, min(1.d0, ppm_eta1 * (etatilde - ppm_eta2))) +!! if (ppm_k0 * abs(dtracer(i,itracer)) * min(press(i-1),press(i+1)) < & +!! abs(dpress(i)) * min(tracer(i-1,itracer), tracer(i+1,itracer))) then +!! eta = 0.d0 +!! end if +!! tracerminus(i,itracer) = tracerminus(i,itracer) * (1.d0 - eta) + & +!! (tracer(i-1,itracer) + 0.5d0 * dmtracer(i-1,itracer)) * eta +!! tracerplus(i,itracer) = tracerplus(i,itracer) * (1.d0 - eta) + & +!! (tracer(i+1,itracer) - 0.5d0 * dmtracer(i+1,itracer)) * eta +!! end do +!! +!! enddo +!! +!! end if +!!#endif +!! +!!!!$ Zone flattening. See appendix of C&W, p. 197-8. +!! +!! do i = 3, nx - 2 +!! dpress2 = press(i+2) - press(i-2) +!! dvel = velx(i+1) - velx(i-1) +!! if ( (abs(dpress(i)) > ppm_epsilon * min(press(i-1),press(i+1))) .and. & +!! (dvel < 0.d0) ) then +!! w = 1.d0 +!! else +!! w = 0.d0 +!! end if +!! if (abs(dpress2) < ppm_small) then +!! tilde_flatten(i) = 1.d0 +!! else +!! tilde_flatten(i) = max(0.d0, 1.d0 - w * max(0.d0, ppm_omega2 * & +!! (dpress(i) / dpress2 - ppm_omega1))) +!! end if +!! end do +!! +!! if (PPM3) then +!! do itracer=1,number_of_tracers +!! do i = 3, nx - 2 +!! flatten = tilde_flatten(i) +!! tracerplus(i,itracer) = flatten * tracerplus(i,itracer) & +!! + (1.d0 - flatten) * tracer(i,itracer) +!! tracerminus(i,itracer) = flatten * tracerminus(i,itracer) & +!! + (1.d0 - flatten) * tracer(i,itracer) +!! end do +!! enddo +!! else !!$ Really implement C&W, page 197; which requires stencil 4. +!! do itracer=1,number_of_tracers +!! do i = 4, nx - 3 +!! s=sign(1.d0, -dpress(i)) +!! flatten = max(tilde_flatten(i), tilde_flatten(i+s)) +!! tracerplus(i,itracer) = flatten * tracerplus(i,itracer) + & +!! (1.d0 - flatten) * tracer(i,itracer) +!! tracerminus(i,itracer) = flatten * tracerminus(i,itracer) & +!! + (1.d0 - flatten) * tracer(i,itracer) +!! end do +!! enddo +!! end if +!! +!! +!!!! Additional flattening a la Plewa & Mueller +!! +!!#if 1 +!! do itracer=1,number_of_tracers +!! do i = 2, nx - 1 +!! if ( ( tracer(i+1,itracer) - tracer(i,itracer) ) * & +!! ( tracer(i,itracer) - tracer(i-1,itracer) ) < 0.0d0 ) then +!! tracerflat(i,itracer) = 1.0d0 +!! else +!! tracerflat(i,itracer) = 0.0d0 +!! endif +!! enddo +!! enddo +!! +!! do itracer=1,number_of_tracers +!! do i = 3, nx -2 +!! +!! tracerflatomega = 0.5d0 * max(tracerflat(i-1,itracer),2.0d0*tracerflat(i,itracer), & +!! tracerflat(i+1,itracer)) * ppm_omega_tracer +!! +!! tracerplus(i,itracer) = tracerflatomega*tracer(i,itracer) + & +!! (1.0d0 - tracerflatomega)*tracerplus(i,itracer) +!! +!! tracerminus(i,itracer) = tracerflatomega*tracer(i,itracer) + & +!! (1.0d0 - tracerflatomega)*tracerminus(i,itracer) +!! +!! enddo +!! enddo +!! +!! +!!#endif +!! +!!!!$ Monotonicity. See (1.10) of C&W. +!! +!! +!! do itracer=1,number_of_tracers +!! do i = GRHydro_stencil, nx - GRHydro_stencil + 1 +!! if (((tracerplus(i,itracer)-tracer(i,itracer))* & +!! (tracer(i,itracer)-tracerminus(i,itracer)) .le. 0.d0)) then +!! tracerminus(i,itracer) = tracer(i,itracer) +!! tracerplus(i,itracer) = tracer(i,itracer) +!! else if ((tracerplus(i,itracer) - tracerminus(i,itracer)) * (tracer(i,itracer) - 0.5d0 * & +!! (tracerplus(i,itracer) + tracerminus(i,itracer))) > & +!! (tracerplus(i,itracer) - tracerminus(i,itracer))**2 / 6.d0) then +!! tracerminus(i,itracer) = 3.d0 * tracer(i,itracer) - 2.d0 * tracerplus(i,itracer) +!! else if ((tracerplus(i,itracer) - tracerminus(i,itracer)) * (tracer(i,itracer) - 0.5d0 * & +!! (tracerplus(i,itracer) + tracerminus(i,itracer))) < & +!! -(tracerplus(i,itracer) - tracerminus(i,itracer))**2 / 6.d0 ) then +!! tracerplus(i,itracer) = 3.d0 * tracer(i,itracer) - 2.d0 * tracerminus(i,itracer) +!! end if +!! end do +!! enddo +!! +!! +!! +!!end subroutine SimplePPM_tracer_1d +!! diff --git a/src/GRHydro_ParamCheck.F90 b/src/GRHydro_ParamCheck.F90 index f192071..132569c 100644 --- a/src/GRHydro_ParamCheck.F90 +++ b/src/GRHydro_ParamCheck.F90 @@ -86,13 +86,14 @@ subroutine GRHydro_ParamCheck(CCTK_ARGUMENTS) call CCTK_PARAMWARN("GRHydro::bound = 'static' is no longer supported, use 'none' instead"); end if - if (CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then - MHD = 1 - ! issue a fatal warning, since MHD is not implemented yet - call CCTK_PARAMWARN("MHD is not yet implemented. Please run with GRHydro::Bvec_evolution_method='none'."); - else - MHD = 0 - endif +!!$ AU CONTRAIRE, MON FRERE!!! WE DO MHD NOW!!!! +!!$ if (CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then +!!$ MHD = 1 +!!$ ! issue a fatal warning, since MHD is not implemented yet +!!$ call CCTK_PARAMWARN("MHD is not yet implemented. Please run with GRHydro::Bvec_evolution_method='none'."); +!!$ else +!!$ MHD = 0 +!!$ endif diff --git a/src/GRHydro_ParamCheckM.F90 b/src/GRHydro_ParamCheckM.F90 new file mode 100644 index 0000000..6043ae9 --- /dev/null +++ b/src/GRHydro_ParamCheckM.F90 @@ -0,0 +1,52 @@ + /*@@ + @file GRHydro_ParamCheckM.F90 + @date Sep 23, 2010 + @author + @desc + Parameter checking routine. + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_Parameters.h" +#include "cctk_Arguments.h" +#include "cctk_Functions.h" + + /*@@ + @routine GRHydro_ParamCheckM + @date Sep 23, 2010 + @author Joshua Faber, Scott Noble, Bruno Mundim + @desc + Checks the parameters. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + +subroutine GRHydro_ParamCheckM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + +!! if (CCTK_EQUALS(recon_method,"ppm").and.CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then +!! call CCTK_PARAMWARN("PPM is not implemented yet for MHD") +!! end if + + if (CCTK_EQUALS(riemann_solver,"Roe").and.CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then + call CCTK_PARAMWARN("Roe solver is not implemented yet for MHD") + end if + + if (CCTK_EQUALS(riemann_solver,"Marquina").and.CCTK_EQUALS(Bvec_evolution_method,"GRHydro")) then + call CCTK_PARAMWARN("Marquina solver is not implemented yet for MHD") + end if + + +end subroutine GRHydro_ParamCheckM + diff --git a/src/GRHydro_Prim2Con.F90 b/src/GRHydro_Prim2Con.F90 index 268e8e4..af0e661 100644 --- a/src/GRHydro_Prim2Con.F90 +++ b/src/GRHydro_Prim2Con.F90 @@ -45,7 +45,7 @@ subroutine primitive2conservative(CCTK_ARGUMENTS) integer :: i, j, k CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& - gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4l,psi4r + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr do k = GRHydro_stencil,cctk_lsh(3)-GRHydro_stencil+1 do j = GRHydro_stencil,cctk_lsh(2)-GRHydro_stencil+1 @@ -179,19 +179,18 @@ subroutine Primitive2ConservativeCells(CCTK_ARGUMENTS) DECLARE_CCTK_PARAMETERS CCTK_INT :: i, j, k - CCTK_REAL :: det,psi4pt + CCTK_REAL :: det 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 - psi4pt = 1.0d0 det = SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k), \ gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) - call prim2con(GRHydro_eos_handle,psi4pt*gxx(i,j,k),& - psi4pt*gxy(i,j,k),psi4pt*gxz(i,j,k),& - psi4pt*gyy(i,j,k),psi4pt*gyz(i,j,k),psi4pt*gzz(i,j,k),& + call prim2con(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),& det, 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)) @@ -228,11 +227,10 @@ subroutine Prim2ConservativePolytype(CCTK_ARGUMENTS) integer :: i, j, k CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& - gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4r,psi4l - character(len=200) warnline + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr !$OMP PARALLEL DO PRIVATE(i, j, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& - !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4r,psi4l) + !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr) 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 @@ -437,7 +435,7 @@ subroutine Prim2ConservativeTracer(CCTK_ARGUMENTS) integer :: i, j, k CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& - gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4r,psi4l + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr do k = GRHydro_stencil,cctk_lsh(3)-GRHydro_stencil+1 do j = GRHydro_stencil,cctk_lsh(2)-GRHydro_stencil+1 @@ -510,14 +508,14 @@ subroutine primitive2conservativegeneral(CCTK_ARGUMENTS) CCTK_INT :: i, j, k, ierr CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl, & - gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4l,psi4r, & + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr, & vlowx, vlowy, vlowz ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConBndCallPlus) ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConBndCallMinus) !$OMP PARALLEL DO PRIVATE(i, j, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& - !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr,psi4r,psi4l) + !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr) 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 @@ -585,7 +583,7 @@ subroutine Primitive2ConservativeCellsGeneral(CCTK_ARGUMENTS) DECLARE_CCTK_FUNCTIONS CCTK_INT :: i, j, k, ierr - CCTK_REAL :: det,psi4pt,gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt, & + CCTK_REAL :: det,gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt, & vlowx, vlowy, vlowz ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConCellsCall) diff --git a/src/GRHydro_Prim2ConM.F90 b/src/GRHydro_Prim2ConM.F90 new file mode 100644 index 0000000..162e66f --- /dev/null +++ b/src/GRHydro_Prim2ConM.F90 @@ -0,0 +1,637 @@ + /*@@ + @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 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) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + + integer :: i, j, k + CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr + + 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 + + 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_detl = SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl) + avg_detr = SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr) + + call prim2conM(GRHydro_eos_handle, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl, & + avg_detl,densminus(i,j,k),sxminus(i,j,k),& + syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),& + Bvecxminus(i,j,k),Bvecyminus(i,j,k),Bveczminus(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 prim2conM(GRHydro_eos_handle, gxxr,gxyr,gxzr,gyyr,gyzr,gzzr, & + avg_detr, densplus(i,j,k),sxplus(i,j,k),& + syplus(i,j,k),szplus(i,j ,k),tauplus(i,j,k),& + Bvecxplus(i,j,k),Bvecyplus(i,j,k),Bveczplus(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 + +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(handle, gxx, gxy, gxz, gyy, gyz, gzz, det, ddens, & + dsx, dsy, dsz, dtau , dBvcx, dBvcy, dBvcz, drho, dvelx, dvely, dvelz, deps, dpress, w) + + implicit none + + DECLARE_CCTK_PARAMETERS + + CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, det + CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, dBvcx, dBvcy, dBvcz, & + drho, dvelx, dvely, dvelz,& + deps, dpress, w, vlowx, vlowy, vlowz + CCTK_REAL :: Bdotv,ab0,b2,blowx,blowy,blowz + CCTK_INT :: handle + character(len=256) NaN_WarnLine + +#if !USE_EOS_OMNI +#include "EOS_Base.inc" +#endif + +#if USE_EOS_OMNI +! begin EOS Omni vars + integer :: n = 1 + integer :: keytemp = 0 + integer :: anyerr = 0 + integer :: keyerr(1) = 0 + real*8 :: xpress = 0.0d0 + real*8 :: xeps = 0.0d0 + real*8 :: xtemp = 0.0d0 + real*8 :: xye = 0.0d0 +! end EOS Omni vars +#endif + + w = 1.d0 / sqrt(1.d0 - DOT2(dvelx,dvely,dvelz)) + +!!$ BEGIN: Check for NaN value + if (w .ne. w) then + !$OMP CRITICAL + 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 + +#if USE_EOS_OMNI + call EOS_Omni_press(handle,keytemp,GRHydro_eos_rf_prec,n,& + drho,deps,xtemp,xye,dpress,keyerr,anyerr) +#else + dpress = EOS_Pressure(handle, drho, deps) +#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 = sqrt(det) * drho * w + dsx = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - & + ab0*blowx) + dsy = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - & + ab0*blowy) + dsz = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - & + ab0*blowz) + dtau = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens + +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 + + CCTK_INT :: i, j, k + CCTK_REAL :: det + + 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 + + det = SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k), \ + gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + + call prim2conM(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),& + det, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),& + tau(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(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 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 + + integer :: i, j, k + CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr + + !$OMP PARALLEL DO PRIVATE(i, j, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr) + 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 + + 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_detl = SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl) + avg_detr = SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr) + + call prim2conpolytypeM(GRHydro_eos_handle, gxxl,gxyl,gxzl,& + gyyl,gyzl,gzzl, & + avg_detl,densminus(i,j,k),sxminus(i,j,k),& + syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),& + Bvecxminus(i,j,k),Bvecyminus(i,j,k),Bveczminus(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 prim2conpolytypeM(GRHydro_eos_handle, gxxr,gxyr,gxzr,& + gyyr,gyzr,gzzr, & + avg_detr, densplus(i,j,k),sxplus(i,j,k),& + syplus(i,j,k),szplus(i,j ,k),tauplus(i,j,k),& + Bvecxplus(i,j,k),Bvecyplus(i,j,k),Bveczplus(i,j,k),& + rhoplus(i,j,k),epsplus(i,j,k),pressplus(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, det, ddens, dsx, dsy, dsz, dtau, dBvcx, dBvcy, dBvcz, & + drho, dvelx, dvely, dvelz, deps, dpress, w) + + implicit none + + DECLARE_CCTK_PARAMETERS + + CCTK_REAL :: gxx, gxy, gxz, gyy, gyz, gzz, det + CCTK_REAL :: ddens, dsx, dsy, dsz, dtau, dBvcx, dBvcy, dBvcz, & + drho, dvelx, dvely, dvelz,& + deps, dpress, w_tmp, w, vlowx, vlowy, vlowz, sqrtdet + CCTK_INT :: handle + CCTK_REAL :: Bdotv,ab0,b2,blowx,blowy,blowz + character(len=256) NaN_WarnLine + +#if !USE_EOS_OMNI +#ifdef _EOS_BASE_INC_ +#undef _EOS_BASE_INC_ +#endif +#include "EOS_Base.inc" +#endif + +#if USE_EOS_OMNI +! begin EOS Omni vars + integer :: n = 1 + integer :: keytemp = 0 + integer :: anyerr = 0 + integer :: keyerr(1) = 0 + real*8 :: xpress = 0.0d0 + real*8 :: xeps = 0.0d0 + real*8 :: xtemp = 0.0d0 + real*8 :: xye = 0.0d0 +! end EOS Omni vars +#endif + + 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 + +#if USE_EOS_OMNI + 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) +#else + if (handle .ge. 0) then + dpress = EOS_Pressure(handle, drho, deps) + deps = EOS_SpecificIntEnergy(handle, drho, dpress) + end if +#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 = sqrt(det) * drho * w + dsx = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowx - & + ab0*blowx) + dsy = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowy - & + ab0*blowy) + dsz = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w * vlowz - & + ab0*blowz) + dtau = sqrt(det) * ((drho*(1+deps)+dpress+b2)*w*w - dpress-b2/2.0-ab0**2) - ddens + +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 + + CCTK_INT :: i, j, k + CCTK_REAL :: det + + 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 + + det = SPATIAL_DETERMINANT(gxx(i,j,k),gxy(i,j,k),gxz(i,j,k),\ + gyy(i,j,k),gyz(i,j,k),gzz(i,j,k)) + + call prim2conpolytypeM(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),& + det, dens(i,j,k),sx(i,j,k),sy(i,j,k),sz(i,j,k),& + tau(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(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 Primitive2ConservativePolyCellsM + +!!$ +!!$ Prim2Con doesn't change for tracers with the addition of a B-field! +!!$ + + /*@@ + @routine primitive2conservativegeneralM + @date Aug 31, 2010 + @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 primitive2conservativegeneralM(CCTK_ARGUMENTS) + + USE GRHydro_Scalars + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i, j, k, ierr + CCTK_REAL :: gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl, & + gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr, & + vlowx, vlowy, vlowz + + ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConBndCallPlus) + ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConBndCallMinus) + + !$OMP PARALLEL DO PRIVATE(i, j, gxxl,gxyl,gxzl,gyyl,gyzl,gzzl,avg_detl,& + !$OMP gxxr,gxyr,gxzr,gyyr,gyzr,gzzr,avg_detr) + 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 + + 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_detl = SPATIAL_DETERMINANT(gxxl,gxyl,gxzl,gyyl, gyzl,gzzl) + avg_detr = SPATIAL_DETERMINANT(gxxr,gxyr,gxzr,gyyr, gyzr,gzzr) + + call prim2conpolytypeM(-1, gxxl,gxyl,gxzl,& + gyyl,gyzl,gzzl, & + avg_detl,densminus(i,j,k),sxminus(i,j,k),& + syminus(i,j,k),szminus(i,j,k),tauminus(i,j,k),& + Bvecxminus(i,j,k),Bvecyminus(i,j,k),Bveczminus(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 prim2conpolytypeM(-1, gxxr,gxyr,gxzr,& + gyyr,gyzr,gzzr, & + avg_detr, densplus(i,j,k),sxplus(i,j,k),& + syplus(i,j,k),szplus(i,j ,k),tauplus(i,j,k),& + Bvecxplus(i,j,k),Bvecyplus(i,j,k),Bveczplus(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)) + 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 primitive2conservativegeneralM + + /*@@ + @routine Primitive2ConservativeCellsGeneralM + @date Ag 31, 2010 + @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 Primitive2ConservativeCellsGeneralM(CCTK_ARGUMENTS) + + USE GRHydro_Scalars + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i, j, k, ierr + CCTK_REAL :: det,gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt, & + vlowx, vlowy, vlowz + CCTK_REAL Bdotv,ab0,b2,blowx,blowy,blowz + + ierr = EOS_SetGFs(cctkGH, EOS_Prim2ConCellsCall) + + 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 + + gxxpt = gxx(i,j,k) + gxypt = gxy(i,j,k) + gxzpt = gxz(i,j,k) + gyypt = gyy(i,j,k) + gyzpt = gyz(i,j,k) + gzzpt = gzz(i,j,k) + + det = SPATIAL_DETERMINANT(gxxpt,gxypt,gxzpt,gyypt,gyzpt,gzzpt) + + w_lorentz(i,j,k)=1.d0/sqrt(1.d0-DOTPT2(velx(i,j,k),vely(i,j,k),velz(i,j,k))) + + vlowx = gxxpt * velx(i,j,k) + & + gxypt * vely(i,j,k) + & + gxzpt * velz(i,j,k) + vlowy = gxypt * velx(i,j,k) + & + gyypt * vely(i,j,k) + & + gyzpt * velz(i,j,k) + vlowz = gxzpt * velx(i,j,k) + & + gyzpt * vely(i,j,k) + & + gzzpt * velz(i,j,k) + + Bdotv=DOTPT(velx(i,j,k),vely(i,j,k),velz(i,j,k),Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(i,j,k)) + ab0=w_lorentz(i,j,k)*Bdotv + b2 = DOTPT2(Bvecx(i,j,k),Bvecy(i,j,k),Bvecz(i,j,k))/w_lorentz(i,j,k)**2+Bdotv**2 + + blowx = (gxx(i,j,k)*Bvecx(i,j,k) + gxy(i,j,k)*Bvecy(i,j,k) + gxz(i,j,k)*Bvecz(i,j,k))/ & + w_lorentz(i,j,k) + w_lorentz(i,j,k)*Bdotv*vlowx + blowy = (gxy(i,j,k)*Bvecx(i,j,k) + gyy(i,j,k)*Bvecy(i,j,k) + gyz(i,j,k)*Bvecz(i,j,k))/ & + w_lorentz(i,j,k) + w_lorentz(i,j,k)*Bdotv*vlowy + blowz = (gxz(i,j,k)*Bvecx(i,j,k) + gyz(i,j,k)*Bvecy(i,j,k) + gzz(i,j,k)*Bvecz(i,j,k))/ & + w_lorentz(i,j,k) + w_lorentz(i,j,k)*Bdotv*vlowz + + dens(i,j,k) = sqrt(det) * rho(i,j,k) * w_lorentz(i,j,k) + sx(i,j,k) = sqrt(det) * ((rho(i,j,k)*(1+eps(i,j,k))+press(i,j,k)+b2)* & + w_lorentz(i,j,k)*w_lorentz(i,j,k) * vlowx - ab0*blowx) + sy(i,j,k) = sqrt(det) * ((rho(i,j,k)*(1+eps(i,j,k))+press(i,j,k)+b2)* & + w_lorentz(i,j,k)*w_lorentz(i,j,k) * vlowy - ab0*blowy) + sz(i,j,k) = sqrt(det) * ((rho(i,j,k)*(1+eps(i,j,k))+press(i,j,k)+b2)* & + w_lorentz(i,j,k)*w_lorentz(i,j,k) * vlowz - ab0*blowz) + tau(i,j,k) = sqrt(det) * ((rho(i,j,k)*(1+eps(i,j,k))+press(i,j,k)+b2)* & + w_lorentz(i,j,k)*w_lorentz(i,j,k) - press(i,j,k)-b2/2.0-ab0**2) - dens(i,j,k) + + end do + end do + end do + +end subroutine Primitive2ConservativeCellsGeneralM diff --git a/src/GRHydro_ReconstructM.F90 b/src/GRHydro_ReconstructM.F90 new file mode 100644 index 0000000..66e433b --- /dev/null +++ b/src/GRHydro_ReconstructM.F90 @@ -0,0 +1,621 @@ + /*@@ + @file GRHydro_ReconstructM.F90 + @date Sep 2, 2010 + @author + @desc + Wrapper routine to perform the 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) 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) + + + /*@@ + @routine ReconstructionM + @date Sep 2, 2010 + @author Joshua Faber, SCott Noble, Bruno Mundim, Luca Baiotti, Ian Hawke + @desc + A wrapper routine to do reconstruction. Currently just does + TVD on the primitive variables. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + +subroutine ReconstructionM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + integer :: nx, ny, nz, i, j, k, itracer + + logical, dimension(:,:,:), allocatable :: trivial_rp +!!$ logical, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: trivial_rp + + CCTK_INT :: type_bitsx, trivialx, not_trivialx, & + &type_bitsy, trivialy, not_trivialy, & + &type_bitsz, trivialz, not_trivialz + + CCTK_REAL, dimension(:,:,:),allocatable :: & + &psi4, lbetax, lbetay, lbetaz +!!$ CCTK_REAL, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: & +!!$ &psi4, lbetax, lbetay, lbetaz + + CCTK_INT :: ierr + + CCTK_REAL :: local_min_tracer + + allocate(trivial_rp(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),STAT=ierr) + if (ierr .ne. 0) then + call CCTK_WARN(0, "Allocation problems with trivial_rp") + end if + + allocate(psi4(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetax(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetay(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetaz(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),STAT=ierr) + if (ierr .ne. 0) then + call CCTK_WARN(0, "Allocation problems with lbeta") + 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) + + trivial_rp = .false. + +!!$ Currently only option is reconstruction on primitive variables. +!!$ Should change this. + + psi4 = 1.d0 + + if (shift_state .ne. 0) then + lbetax = betax + lbetay = betay + lbetaz = betaz + else + lbetax = 0.d0 + lbetay = 0.d0 + lbetaz = 0.d0 + end if + +!!$ Initialize variables that store reconstructed quantities + + rhoplus = 0.0d0 + rhominus = 0.0d0 + epsplus = 0.0d0 + epsminus = 0.0d0 + velxplus = 0.0d0 + velxminus = 0.0d0 + velyplus = 0.0d0 + velyminus = 0.0d0 + velzplus = 0.0d0 + velzminus = 0.0d0 + Bvecxplus = 0.0d0 + Bvecxminus = 0.0d0 + Bvecyplus = 0.0d0 + Bvecyminus = 0.0d0 + Bveczplus = 0.0d0 + Bveczminus = 0.0d0 + + if (evolve_tracer .ne. 0) then + tracerplus = 0.0d0 + tracerminus = 0.0d0 + endif + + if (CCTK_EQUALS(recon_method,"tvd")) then + + if (evolve_tracer .ne. 0) then + do itracer=1,number_of_tracers + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), & + tracerminus(:,:,:,itracer), & + trivial_rp, hydro_excision_mask) + enddo + end if + + if (CCTK_EQUALS(recon_vars,"primitive")) then + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + rho, rhoplus, rhominus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,1), velxplus, velxminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,2), velyplus, velyminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,3), velzplus, velzminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + eps, epsplus, epsminus, trivial_rp, hydro_excision_mask) + 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) + else + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + end if + +!!$ B-field is both prim and con + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,1), Bvecxplus, Bvecxminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,2), Bvecyplus, Bvecyminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,3), Bveczplus, Bveczminus, trivial_rp, hydro_excision_mask) + + + + !$OMP PARALLEL DO PRIVATE(i, j) + do k = 1, nz + do j = 1, ny + do i = 1, nx + if (trivial_rp(i,j,k)) then + if (flux_direction == 1) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) + else if (flux_direction == 2) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, trivialy) + else if (flux_direction == 3) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, trivialz) + end if + else + if (flux_direction == 1) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) + else if (flux_direction == 2) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, not_trivialy) + else if (flux_direction == 3) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, not_trivialz) + end if + end if + end do + end do + end do + !$OMP END PARALLEL DO + + else if (CCTK_EQUALS(recon_method,"ppm")) then + + if (flux_direction == 1) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + do j = GRHydro_stencil, ny - GRHydro_stencil + 1 + call SimplePPM_1dM(GRHydro_eos_handle,0,nx,CCTK_DELTA_SPACE(1),& + rho(:,j,k),velx(:,j,k),vely(:,j,k),velz(:,j,k),& + Bvecx(:,j,k),Bvecy(:,j,k),Bvecz(:,j,k),eps(:,j,k),press(:,j,k),& + rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),velzminus(:,j,k),& + Bvecxminus(:,j,k),Bvecyminus(:,j,k),Bveczminus(:,j,k),epsminus(:,j,k),& + rhoplus(:,j,k),velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),& + Bvecxplus(:,j,k),Bvecyplus(:,j,k),Bveczplus(:,j,k),epsplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k),& + gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), & + gzz(:,j,k), psi4(:,j,k), lbetax(:,j,k), alp(:,j,k),& + w_lorentz(:,j,k), & + 1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, & + GRHydro_mppm_eigenvalue_x_right, & + GRHydro_mppm_xwind) + do i = 1, nx + if (trivial_rp(i,j,k)) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) + else + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) + end if + end do + end do + end do + !$OMP END PARALLEL DO + if(evolve_tracer.ne.0) then + !$OMP PARALLEL DO PRIVATE(j) + do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + do j = GRHydro_stencil, ny - GRHydro_stencil + 1 + call SimplePPM_tracer_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), & + velx(:,j,k),vely(:,j,k),velz(:,j,k), & + tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), & + press(:,j,k)) + end do + end do + !$OMP END PARALLEL DO + end if + + else if (flux_direction == 2) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + call SimplePPM_1dM(GRHydro_eos_handle,0,ny,CCTK_DELTA_SPACE(2),& + rho(j,:,k),vely(j,:,k),velz(j,:,k),velx(j,:,k),& + Bvecy(j,:,k),Bvecz(j,:,k),Bvecx(j,:,k),eps(j,:,k),press(j,:,k),& + rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),velxminus(j,:,k),& + Bvecyminus(j,:,k),Bveczminus(j,:,k),Bvecxminus(j,:,k),epsminus(j,:,k),& + rhoplus(j,:,k),velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),& + Bvecyplus(j,:,k),Bveczplus(j,:,k),Bvecxplus(j,:,k),epsplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k),& + gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), & + gxx(j,:,k), psi4(j,:,k), lbetay(j,:,k), alp(j,:,k),& + w_lorentz(j,:,k), & + 2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, & + GRHydro_mppm_eigenvalue_y_right, & + GRHydro_mppm_xwind) + do i = 1, ny + if (trivial_rp(j,i,k)) then + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy) + else + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy) + end if + end do + end do + end do + !$OMP END PARALLEL DO + if(evolve_tracer.ne.0) then + !$OMP PARALLEL DO PRIVATE(j) + do k = GRHydro_stencil, nz - GRHydro_stencil + 1 + do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + call SimplePPM_tracer_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), & + vely(j,:,k),velz(j,:,k),velx(j,:,k), & + tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), & + press(j,:,k)) + end do + end do + !$OMP END PARALLEL DO + end if + + else if (flux_direction == 3) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, ny - GRHydro_stencil + 1 + do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + call SimplePPM_1dM(GRHydro_eos_handle,0,nz,CCTK_DELTA_SPACE(3),& + rho(j,k,:),velz(j,k,:),velx(j,k,:),vely(j,k,:),& + Bvecz(j,k,:),Bvecx(j,k,:),Bvecy(j,k,:),eps(j,k,:),press(j,k,:),& + rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),velyminus(j,k,:),& + Bveczminus(j,k,:),Bvecxminus(j,k,:),Bvecyminus(j,k,:),epsminus(j,k,:),& + rhoplus(j,k,:),velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),& + Bveczplus(j,k,:),Bvecxplus(j,k,:),Bvecyplus(j,k,:),epsplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:),& + gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), & + gyy(j,k,:), psi4(j,k,:), lbetaz(j,k,:), alp(j,k,:),& + w_lorentz(j,k,:), & + 3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, & + GRHydro_mppm_eigenvalue_z_right, & + GRHydro_mppm_xwind) + do i = 1, nz + if (trivial_rp(j,k,i)) then + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz) + else + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz) + end if + end do + end do + end do + !$OMP END PARALLEL DO + if(evolve_tracer.ne.0) then + !$OMP PARALLEL DO PRIVATE(j) + do k = GRHydro_stencil, ny - GRHydro_stencil + 1 + do j = GRHydro_stencil, nx - GRHydro_stencil + 1 + + call SimplePPM_tracer_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), & + velz(j,k,:),velx(j,k,:),vely(j,k,:), & + tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), & + press(j,k,:)) + end do + end do + !$OMP END PARALLEL DO + end if + + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + +!! call CCTK_WARN(0, "PPM not implemented in MHD yet!!!") + + else if (CCTK_EQUALS(recon_method,"eno")) then + + if (evolve_tracer .ne. 0) then + do itracer=1,number_of_tracers + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), & + tracerminus(:,:,:,itracer), trivial_rp, & + hydro_excision_mask) + enddo + end if + + if (flux_direction == 1) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + velx(:,j,k),velxminus(:,j,k),velxplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + vely(:,j,k),velyminus(:,j,k),velyplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + velz(:,j,k),velzminus(:,j,k),velzplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + 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)) + 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)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + +!!$ B-fields are both prim and con + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecx(:,j,k),Bvecxminus(:,j,k),Bvecxplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecy(:,j,k),Bvecyminus(:,j,k),Bvecyplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecz(:,j,k),Bveczminus(:,j,k),Bveczplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + + + do i = 1, cctk_lsh(1) + if (trivial_rp(i,j,k)) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) + else + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else if (flux_direction == 2) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + velx(j,:,k),velxminus(j,:,k),velxplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + vely(j,:,k),velyminus(j,:,k),velyplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + velz(j,:,k),velzminus(j,:,k),velzplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + 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)) + 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)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecx(j,:,k),Bvecxminus(j,:,k),Bvecxplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecy(j,:,k),Bvecyminus(j,:,k),Bvecyplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecz(j,:,k),Bveczminus(j,:,k),Bveczplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + + do i = 1, cctk_lsh(2) + if (trivial_rp(j,i,k)) then + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy) + else + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else if (flux_direction == 3) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + velx(j,k,:),velxminus(j,k,:),velxplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + vely(j,k,:),velyminus(j,k,:),velyplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + velz(j,k,:),velzminus(j,k,:),velzplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + 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,:)) + 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,:)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecx(j,k,:),Bvecxminus(j,k,:),Bvecxplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecy(j,k,:),Bvecyminus(j,k,:),Bvecyplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecz(j,k,:),Bveczminus(j,k,:),Bveczplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + + do i = 1, cctk_lsh(3) + if (trivial_rp(j,k,i)) then + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz) + else + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + call CCTK_WARN(0, "Reconstruction method not recognized!") + end if + + deallocate(trivial_rp) + deallocate(psi4, lbetax, lbetay, lbetaz) + + !$OMP WORKSHARE + where ( (rhoplus < GRHydro_rho_min).or.(rhominus < GRHydro_rho_min).or.& + (epsplus < 0.d0).or.(epsminus < 0.d0) ) + rhoplus = rho + rhominus = rho + velxplus = vel(:,:,:,1) + velxminus = vel(:,:,:,1) + velyplus = vel(:,:,:,2) + velyminus = vel(:,:,:,2) + velzplus = vel(:,:,:,3) + velzminus = vel(:,:,:,3) + epsplus = eps + epsminus = eps + Bvecxplus = Bvec(:,:,:,1) + Bvecxminus = Bvec(:,:,:,1) + Bvecyplus = Bvec(:,:,:,2) + Bvecyminus = Bvec(:,:,:,2) + Bveczplus = Bvec(:,:,:,3) + Bveczminus = Bvec(:,:,:,3) + + end where + !$OMP END WORKSHARE + + if (evolve_tracer .ne. 0) then + if (use_min_tracer .ne. 0) then + local_min_tracer = min_tracer + else + local_min_tracer = 0d0 + end if + + !$OMP WORKSHARE + where( (tracerplus .le. local_min_tracer).or.& + (tracerminus .le. local_min_tracer) ) + tracerplus = tracer + tracerminus = tracer + end where + !$OMP END WORKSHARE + ! Call the conserved tracer routine in any case because (accord. to + ! Christian Ott) this is the only way this works + +!!$ Tracer routines don't require changes for MHD! + + call Prim2ConservativeTracer(CCTK_PASS_FTOF) + endif + + if (CCTK_EQUALS(recon_vars,"primitive")& +!!$ PPM is not implemented yet in MHD! +!!$ .or.CCTK_EQUALS(recon_method,"ppm")& + ) then + if (use_eosgeneral == 0) then + call primitive2conservativeM(CCTK_PASS_FTOF) + else + call primitive2conservativegeneralM(CCTK_PASS_FTOF) + end if + else if (CCTK_EQUALS(recon_vars,"conservative")) then + call Conservative2PrimitiveBoundsM(CCTK_PASS_FTOF) + else + call CCTK_WARN(0,"Variable type to reconstruct not recognized.") + end if + + return + +end subroutine ReconstructionM + diff --git a/src/GRHydro_ReconstructPolyM.F90 b/src/GRHydro_ReconstructPolyM.F90 new file mode 100644 index 0000000..a5b3acd --- /dev/null +++ b/src/GRHydro_ReconstructPolyM.F90 @@ -0,0 +1,593 @@ + /*@@ + @file GRHydro_ReconstructPolyM.F90 + @date Sep 2, 2010 + @author + @desc + Wrapper routine to perform the reconstruction for polytropes. + @enddesc + @@*/ + +#include "cctk.h" +#include "cctk_Arguments.h" +#include "cctk_Parameters.h" +#include "cctk_Functions.h" + +#include "SpaceMask.h" + +#define velx(i,j,k) vel(i,j,k,1) +#define vely(i,j,k) vel(i,j,k,2) +#define velz(i,j,k) vel(i,j,k,3) +#define sx(i,j,k) scon(i,j,k,1) +#define sy(i,j,k) scon(i,j,k,2) +#define sz(i,j,k) scon(i,j,k,3) +#define Bvecx(i,j,k) Bvec(i,j,k,1) +#define Bvecy(i,j,k) Bvec(i,j,k,2) +#define Bvecz(i,j,k) Bvec(i,j,k,3) + + + /*@@ + @routine ReconstructionPolytypeM + @date Tue Mar 19 11:36:55 2002 + @author Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke + @desc + If using a polytropic type EOS, we do not have to reconstruct all the + variables. + @enddesc + @calls + @calledby + @history + + @endhistory + +@@*/ + +subroutine ReconstructionPolytypeM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + integer :: nx, ny, nz, i, j, k, itracer + + logical, dimension(:,:,:), allocatable :: trivial_rp +!!$ logical, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: trivial_rp + + CCTK_INT :: type_bitsx, trivialx, not_trivialx, & + &type_bitsy, trivialy, not_trivialy, & + &type_bitsz, trivialz, not_trivialz + + CCTK_REAL, dimension(:,:,:),allocatable :: & + &psi4, lbetax, lbetay, lbetaz +!!$ CCTK_REAL, dimension(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)) :: & +!!$ &psi4, lbetax, lbetay, lbetaz + + CCTK_INT :: ierr + + CCTK_REAL :: local_min_tracer + + allocate(trivial_rp(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),STAT=ierr) + if (ierr .ne. 0) then + call CCTK_WARN(0, "Allocation problems with trivial_rp") + end if + + allocate(psi4(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetax(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetay(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),& + lbetaz(cctk_lsh(1),cctk_lsh(2),cctk_lsh(3)),STAT=ierr) + if (ierr .ne. 0) then + call CCTK_WARN(0, "Allocation problems with lbeta") + 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) + + trivial_rp = .false. + +!!$ Currently only option is reconstruction on primitive variables. +!!$ Should change this. + + psi4 = 1.d0 + + if (shift_state .ne. 0) then + lbetax = betax + lbetay = betay + lbetaz = betaz + else + lbetax = 0.d0 + lbetay = 0.d0 + lbetaz = 0.d0 + end if + +!!$ Initialize variables that store reconstructed quantities + + rhoplus = 0.0d0 + rhominus = 0.0d0 + epsplus = 0.0d0 + epsminus = 0.0d0 + velxplus = 0.0d0 + velxminus = 0.0d0 + velyplus = 0.0d0 + velyminus = 0.0d0 + velzplus = 0.0d0 + velzminus = 0.0d0 + Bvecxplus = 0.0d0 + Bvecxminus = 0.0d0 + Bvecyplus = 0.0d0 + Bvecyminus = 0.0d0 + Bveczplus = 0.0d0 + Bveczminus = 0.0d0 + + if (evolve_tracer .ne. 0) then + tracerplus = 0.0d0 + tracerminus = 0.0d0 + endif + + if (CCTK_EQUALS(recon_method,"tvd")) then + + if (evolve_tracer .ne. 0) then + do itracer=1,number_of_tracers + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), & + tracerminus(:,:,:,itracer), & + trivial_rp, hydro_excision_mask) + enddo + end if + + + if (CCTK_EQUALS(recon_vars,"primitive")) then + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + rho, rhoplus, rhominus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,1), velxplus, velxminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,2), velyplus, velyminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + vel(:,:,:,3), velzplus, velzminus, trivial_rp, hydro_excision_mask) + + 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) + + else + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + end if + +!!$ B-field always needs reconstruction, as it is both prim and con + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,1), Bvecxplus, Bvecxminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,2), Bvecyplus, Bvecyminus, trivial_rp, hydro_excision_mask) + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + Bvec(:,:,:,3), Bveczplus, Bveczminus, trivial_rp, hydro_excision_mask) + + !$OMP PARALLEL DO PRIVATE(i, j) + do k = 1, nz + do j = 1, ny + do i = 1, nx + if (trivial_rp(i,j,k)) then + if (flux_direction == 1) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) + else if (flux_direction == 2) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, trivialy) + else if (flux_direction == 3) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, trivialz) + end if + else + if (flux_direction == 1) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) + else if (flux_direction == 2) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsy, not_trivialy) + else if (flux_direction == 3) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsz, not_trivialz) + end if + end if + end do + end do + end do + !$OMP END PARALLEL DO + + else if (CCTK_EQUALS(recon_method,"ppm")) then + +!!$ if (flux_direction == 1) then +!!$ !$OMP PARALLEL DO PRIVATE(i, j) +!!$ do k = GRHydro_stencil, nz - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, ny - GRHydro_stencil + 1 +!!$ call SimplePPM_1d(GRHydro_eos_handle,1,nx,CCTK_DELTA_SPACE(1),& +!!$ rho(:,j,k),velx(:,j,k),vely(:,j,k),velz(:,j,k),eps(:,j,k),& +!!$ press(:,j,k),rhominus(:,j,k),velxminus(:,j,k),velyminus(:,j,k),& +!!$ velzminus(:,j,k),epsminus(:,j,k),rhoplus(:,j,k),& +!!$ velxplus(:,j,k),velyplus(:,j,k),velzplus(:,j,k),epsplus(:,j,k),& +!!$ trivial_rp(:,j,k), hydro_excision_mask(:,j,k),& +!!$ gxx(:,j,k), gxy(:,j,k), gxz(:,j,k), gyy(:,j,k), gyz(:,j,k), & +!!$ gzz(:,j,k), psi4(:,j,k), lbetax(:,j,k), alp(:,j,k),& +!!$ w_lorentz(:,j,k), & +!!$ 1, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_x_left, & +!!$ GRHydro_mppm_eigenvalue_x_right, & +!!$ GRHydro_mppm_xwind) +!!$ do i = 1, nx +!!$ if (trivial_rp(i,j,k)) then +!!$ SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) +!!$ else +!!$ SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) +!!$ end if +!!$ end do +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ if(evolve_tracer.ne.0) then +!!$ !$OMP PARALLEL DO PRIVATE(j) +!!$ do k = GRHydro_stencil, nz - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, ny - GRHydro_stencil + 1 +!!$ call SimplePPM_tracer_1d(nx,CCTK_DELTA_SPACE(1),rho(:,j,k), & +!!$ velx(:,j,k),vely(:,j,k),velz(:,j,k), & +!!$ tracer(:,j,k,:),tracerminus(:,j,k,:),tracerplus(:,j,k,:), & +!!$ press(:,j,k)) +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ end if +!!$ +!!$ else if (flux_direction == 2) then +!!$ !$OMP PARALLEL DO PRIVATE(i, j) +!!$ do k = GRHydro_stencil, nz - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, nx - GRHydro_stencil + 1 +!!$ call SimplePPM_1d(GRHydro_eos_handle,1,ny,CCTK_DELTA_SPACE(2),& +!!$ rho(j,:,k),vely(j,:,k),velz(j,:,k),velx(j,:,k),eps(j,:,k),& +!!$ press(j,:,k),rhominus(j,:,k),velyminus(j,:,k),velzminus(j,:,k),& +!!$ velxminus(j,:,k),epsminus(j,:,k),rhoplus(j,:,k),& +!!$ velyplus(j,:,k),velzplus(j,:,k),velxplus(j,:,k),epsplus(j,:,k),& +!!$ trivial_rp(j,:,k), hydro_excision_mask(j,:,k),& +!!$ gyy(j,:,k), gyz(j,:,k), gxy(j,:,k), gzz(j,:,k), gxz(j,:,k), & +!!$ gxx(j,:,k), psi4(j,:,k), lbetay(j,:,k), alp(j,:,k),& +!!$ w_lorentz(j,:,k), & +!!$ 2, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_y_left, & +!!$ GRHydro_mppm_eigenvalue_y_right, & +!!$ GRHydro_mppm_xwind) +!!$ do i = 1, ny +!!$ if (trivial_rp(j,i,k)) then +!!$ SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy) +!!$ else +!!$ SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy) +!!$ end if +!!$ end do +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ if(evolve_tracer.ne.0) then +!!$ !$OMP PARALLEL DO PRIVATE(j) +!!$ do k = GRHydro_stencil, nz - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, nx - GRHydro_stencil + 1 +!!$ call SimplePPM_tracer_1d(ny,CCTK_DELTA_SPACE(2),rho(j,:,k), & +!!$ vely(j,:,k),velz(j,:,k),velx(j,:,k), & +!!$ tracer(j,:,k,:),tracerminus(j,:,k,:),tracerplus(j,:,k,:), & +!!$ press(j,:,k)) +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ end if +!!$ +!!$ else if (flux_direction == 3) then +!!$ !$OMP PARALLEL DO PRIVATE(i, j) +!!$ do k = GRHydro_stencil, ny - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, nx - GRHydro_stencil + 1 +!!$ call SimplePPM_1d(GRHydro_eos_handle,1,nz,CCTK_DELTA_SPACE(3),& +!!$ rho(j,k,:),velz(j,k,:),velx(j,k,:),vely(j,k,:),eps(j,k,:),& +!!$ press(j,k,:),rhominus(j,k,:),velzminus(j,k,:),velxminus(j,k,:),& +!!$ velyminus(j,k,:),epsminus(j,k,:),rhoplus(j,k,:),& +!!$ velzplus(j,k,:),velxplus(j,k,:),velyplus(j,k,:),epsplus(j,k,:),& +!!$ trivial_rp(j,k,:), hydro_excision_mask(j,k,:),& +!!$ gzz(j,k,:), gxz(j,k,:), gyz(j,k,:), gxx(j,k,:), gxy(j,k,:), & +!!$ gyy(j,k,:), psi4(j,k,:), lbetaz(j,k,:), alp(j,k,:),& +!!$ w_lorentz(j,k,:), & +!!$ 3, j, k, nx, ny, nz, GRHydro_mppm_eigenvalue_z_left, & +!!$ GRHydro_mppm_eigenvalue_z_right, & +!!$ GRHydro_mppm_xwind) +!!$ do i = 1, nz +!!$ if (trivial_rp(j,k,i)) then +!!$ SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz) +!!$ else +!!$ SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz) +!!$ end if +!!$ end do +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ if(evolve_tracer.ne.0) then +!!$ !$OMP PARALLEL DO PRIVATE(j) +!!$ do k = GRHydro_stencil, ny - GRHydro_stencil + 1 +!!$ do j = GRHydro_stencil, nx - GRHydro_stencil + 1 +!!$ +!!$ call SimplePPM_tracer_1d(nz,CCTK_DELTA_SPACE(3),rho(j,k,:), & +!!$ velz(j,k,:),velx(j,k,:),vely(j,k,:), & +!!$ tracer(j,k,:,:),tracerminus(j,k,:,:),tracerplus(j,k,:,:), & +!!$ press(j,k,:)) +!!$ end do +!!$ end do +!!$ !$OMP END PARALLEL DO +!!$ end if +!!$ +!!$ else +!!$ call CCTK_WARN(0, "Flux direction not x,y,z") +!!$ end if + + call CCTK_WARN(0, "PPM not implemented in MHD yet!!!") + + else if (CCTK_EQUALS(recon_method,"eno")) then + + if (evolve_tracer .ne. 0) then + do itracer=1,number_of_tracers + call tvdreconstruct(nx, ny, nz, xoffset, yoffset, zoffset, & + tracer(:,:,:,itracer), tracerplus(:,:,:,itracer), & + tracerminus(:,:,:,itracer), trivial_rp, & + hydro_excision_mask) + enddo + end if + + if (flux_direction == 1) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + rho(:,j,k),rhominus(:,j,k),rhoplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + velx(:,j,k),velxminus(:,j,k),velxplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + vely(:,j,k),velyminus(:,j,k),velyplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + velz(:,j,k),velzminus(:,j,k),velzplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + 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)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + +!!$ Always do B-field + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecx(:,j,k),Bvecxminus(:,j,k),Bvecxplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecy(:,j,k),Bvecyminus(:,j,k),Bvecyplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(1),& + Bvecz(:,j,k),Bveczminus(:,j,k),Bveczplus(:,j,k),& + trivial_rp(:,j,k), hydro_excision_mask(:,j,k)) + + do i = 1, cctk_lsh(1) + if (trivial_rp(i,j,k)) then + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, trivialx) + else + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bitsx, not_trivialx) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else if (flux_direction == 2) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + rho(j,:,k),rhominus(j,:,k),rhoplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + velx(j,:,k),velxminus(j,:,k),velxplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + vely(j,:,k),velyminus(j,:,k),velyplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + velz(j,:,k),velzminus(j,:,k),velzplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + 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)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecx(j,:,k),Bvecxminus(j,:,k),Bvecxplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecy(j,:,k),Bvecyminus(j,:,k),Bvecyplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(2),& + Bvecz(j,:,k),Bveczminus(j,:,k),Bveczplus(j,:,k),& + trivial_rp(j,:,k), hydro_excision_mask(j,:,k)) + + do i = 1, cctk_lsh(2) + if (trivial_rp(j,i,k)) then + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, trivialy) + else + SpaceMask_SetStateBitsF90(space_mask, j, i, k, type_bitsy, not_trivialy) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else if (flux_direction == 3) then + !$OMP PARALLEL DO PRIVATE(i, j) + do k = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + 1 + do j = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + 1 + if (CCTK_EQUALS(recon_vars,"primitive")) then + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + rho(j,k,:),rhominus(j,k,:),rhoplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + velx(j,k,:),velxminus(j,k,:),velxplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + vely(j,k,:),velyminus(j,k,:),velyplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + velz(j,k,:),velzminus(j,k,:),velzplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + 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,:)) + else + !$OMP CRITICAL + call CCTK_WARN(0, "Variable type to reconstruct not recognized.") + !$OMP END CRITICAL + end if + + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecx(j,k,:),Bvecxminus(j,k,:),Bvecxplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecy(j,k,:),Bvecyminus(j,k,:),Bvecyplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + call GRHydro_ENOReconstruct1d(eno_order,cctk_lsh(3),& + Bvecz(j,k,:),Bveczminus(j,k,:),Bveczplus(j,k,:),& + trivial_rp(j,k,:), hydro_excision_mask(j,k,:)) + + do i = 1, cctk_lsh(3) + if (trivial_rp(j,k,i)) then + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, trivialz) + else + SpaceMask_SetStateBitsF90(space_mask, j, k, i, type_bitsz, not_trivialz) + end if + end do + end do + end do + !$OMP END PARALLEL DO + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + call CCTK_WARN(0, "Reconstruction method not recognized!") + end if + + deallocate(trivial_rp) + deallocate(psi4, lbetax, lbetay, lbetaz) + + !$OMP WORKSHARE + where ( (rhoplus < GRHydro_rho_min).or.(rhominus < GRHydro_rho_min).or.& + (epsplus < 0.d0).or.(epsminus < 0.d0) ) + rhoplus = rho + rhominus = rho + velxplus = vel(:,:,:,1) + velxminus = vel(:,:,:,1) + velyplus = vel(:,:,:,2) + velyminus = vel(:,:,:,2) + velzplus = vel(:,:,:,3) + velzminus = vel(:,:,:,3) + epsplus = eps + epsminus = eps + Bvecxplus = Bvec(:,:,:,1) + Bvecxminus = Bvec(:,:,:,1) + Bvecyplus = Bvec(:,:,:,2) + Bvecyminus = Bvec(:,:,:,2) + Bveczplus = Bvec(:,:,:,3) + Bveczminus = Bvec(:,:,:,3) + + end where + !$OMP END WORKSHARE + + if (evolve_tracer .ne. 0) then + if (use_min_tracer .ne. 0) then + local_min_tracer = min_tracer + else + local_min_tracer = 0d0 + end if + + !$OMP WORKSHARE + where( (tracerplus .le. local_min_tracer).or.& + (tracerminus .le. local_min_tracer) ) + tracerplus = tracer + tracerminus = tracer + end where + !$OMP END WORKSHARE + ! Call the conserved tracer routine in any case because (accord. to + ! Christian Ott) this is the only way this works +!!$ No special call in MHD + + call Prim2ConservativeTracer(CCTK_PASS_FTOF) + endif + + if (CCTK_EQUALS(recon_vars,"primitive")& +!!$ PPM not implemented yet +!!$ .or.CCTK_EQUALS(recon_method,"ppm")& + ) then + + if (use_eosgeneral == 0) then + call Prim2ConservativePolytypeM(CCTK_PASS_FTOF) + else + call primitive2conservativegeneralM(CCTK_PASS_FTOF) + end if + else if (CCTK_EQUALS(recon_vars,"conservative")) then + call Con2PrimBoundsPolytypeM(CCTK_PASS_FTOF) + else + call CCTK_WARN(0,"Variable type to reconstruct not recognized.") + end if + + return + +end subroutine ReconstructionPolytypeM + diff --git a/src/GRHydro_RegisterGZM.cc b/src/GRHydro_RegisterGZM.cc new file mode 100644 index 0000000..9f4ff93 --- /dev/null +++ b/src/GRHydro_RegisterGZM.cc @@ -0,0 +1,92 @@ +// register.cc -- register variables with various thorns that need-to-know +// $Header$ +// +// GRHydro_register_GZPatchSystem - register with GZPatchSystem +// +// Cut 'n paste job from BackgroundWaveToy, author J Thornburg... + +#include <cstdio> +#include <string> + +#include "cctk.h" +#include "cctk_Arguments.h" + +using namespace std; + +//****************************************************************************** + +// +// This function is called by the Cactus scheduler to (maybe) register +// our to-be-interpatch-synchronized variables with GZPatchSystem. It +// checks if the GZPatchSystem registration function has been provided +// (which it should be if and only if GZPatchSystem is active), and if so, +// does the registration. +// +// If we're using Carpet, this function must be called in meta mode. +// +extern "C"void GRHydro_register_GZPatchSystemM(CCTK_ARGUMENTS) +{ + + if (CCTK_IsFunctionAliased("GZPatchSystem_register_sync")) + { + CCTK_VInfo(CCTK_THORNSTRING, + "registering to-be-interpatch-synchronized variables " + "with GZPatchSystem"); + + string var[9] = {"HydroBase::rho", "HydroBase::press", "HydroBase::eps", + "HydroBase::vel", + "GRHydro::dens", "GRHydro::tau", "GRHydro::w_lorentz", + "GRHydro::scon", "HydroBase::Bvec"}; + for (int i = 0; i < 9; i++) + { + int status = + GZPatchSystem_register_sync(var[i].c_str()); + if (status < 0) + { + CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING, + "***** GRHydro_register_GZPatchSystem():\n" + " error registering var group %s to be " + "interpatch-synchronized!\n" + " (GZPatchSystem_register_sync() error code %d)\n", + var[i].c_str(), status); + } + } + + } + else + { + CCTK_WARN(1, "Function GZPatchSystem_register_sync not registered!"); + } + + if (CCTK_IsFunctionAliased("GZPatchSystem_register_cxform")) + { + CCTK_VInfo(CCTK_THORNSTRING, + "registering to-be-cxformed variables with GZPatchSystem"); + + string var[12] = {"HydroBase::rho", "HydroBase::press", "HydroBase::eps", + "HydroBase::vel", + "GRHydro::dens", "GRHydro::tau", "GRHydro::w_lorentz", + "GRHydro::scon", "HydroBase::Bvec", + "ADMBase::metric", "ADMBase::curv", "ADMBase::shift"}; + for (int i = 0; i < 12; i++) + for (int j = 0; j < 3; j++) + { + int ps_status = + GZPatchSystem_register_cxform(j, var[i].c_str()); + if (ps_status < 0) + { + CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING, + "***** GRHydro_register_GZPatchSystem():\n" + " error registering var group %s to be " + "interpatch-cxformhronized!\n" + " (GZPatchSystem_register_cxform() error code %d)\n", + var[i].c_str(), ps_status); + } + } + } + else + { + CCTK_WARN(1, "Function GZPatchSystem_register_cxform not registered!"); + } + +} diff --git a/src/GRHydro_RegisterVarsM.cc b/src/GRHydro_RegisterVarsM.cc new file mode 100644 index 0000000..f17254e --- /dev/null +++ b/src/GRHydro_RegisterVarsM.cc @@ -0,0 +1,107 @@ +// GRHydro_RegisterVars.cc +// +// converted from F90 to improve readability and maintainability +// +// Frank Loeffler + +#include <cstdio> +#include <string> + +#include "cctk.h" +#include "cctk_Arguments.h" +#include "cctk_Parameters.h" + +using namespace std; + +// Utility functions to register variables with MoL +// Note: We could check for the return value here, but MoL issues a +// level 0 warning in that case anyway. If that changes in the +// future, a check can simply be inserted here. +static void register_evolved(string v1, string v2) +{ + MoLRegisterEvolvedGroup(CCTK_GroupIndex(v1.c_str()), CCTK_GroupIndex(v2.c_str())); +} +static void register_constrained(string v1) +{ + MoLRegisterConstrainedGroup(CCTK_GroupIndex(v1.c_str())); +} +static void register_saveandrestore(string v1) +{ + MoLRegisterSaveAndRestoreGroup(CCTK_GroupIndex(v1.c_str())); +} + +// Main function called by Cactus to register variables with MoL + +extern "C"void GRHydro_RegisterM(CCTK_ARGUMENTS) +{ + DECLARE_CCTK_ARGUMENTS; + DECLARE_CCTK_PARAMETERS; + + // We need some aliased functions, so we first check if they are available + string needed_funs[5] = {"MoLRegisterEvolvedGroup", + "MoLRegisterConstrainedGroup", + "MoLRegisterSaveAndRestoreGroup", + "MoLRegisterEvolved", + "MoLRegisterConstrained"}; + for (int i = 0; i < 5; i++) + if (!CCTK_IsFunctionAliased(needed_funs[i].c_str())) + CCTK_VWarn(0, __LINE__, __FILE__, CCTK_THORNSTRING, + "The function \"%s\" has not been aliased!", + needed_funs[i].c_str()); + + // Now we can set which variables have to be registered as which type with MoL + register_constrained("HydroBase::rho"); + register_constrained("HydroBase::press"); + register_constrained("HydroBase::eps"); + register_constrained("HydroBase::vel"); + register_constrained("GRHydro::w_lorentz"); + + if (CCTK_EQUALS(evolution_method, "GRHydro")) + { + // dens and scon + register_evolved("GRHydro::dens", "GRHydro::densrhs"); + register_evolved("GRHydro::scon", "GRHydro::srhs"); + register_evolved("HydroBase::Bvec", "GRHydro::Bvecrhs"); + + // tau + if (CCTK_EQUALS(GRHydro_eos_type, "General")) + register_evolved("GRHydro::tau" , "GRHydro::taurhs"); + else if (CCTK_EQUALS(GRHydro_eos_type, "Polytype")) + register_constrained("GRHydro::tau"); + else + CCTK_WARN(0, "Don't recognize the type of EOS!"); + + // lapse, metric, curv + register_saveandrestore("admbase::lapse"); + register_saveandrestore("admbase::metric"); + register_saveandrestore("admbase::curv"); + + // shift + if (!CCTK_EQUALS(initial_shift, "none")) + { + if (CCTK_EQUALS(shift_evolution_method, "Comoving")) + { + register_constrained("admbase::shift"); + register_evolved("GRHydro::GRHydro_coords", "GRHydro::GRHydro_coords_rhs"); + } + else + register_saveandrestore("admbase::shift"); + } + + // tracer + if (evolve_tracer != 0) + register_evolved("GRHydro::GRHydro_cons_tracers", "GRHydro::GRHydro_tracer_rhs"); + + // particles + if (number_of_particles > 0) + register_evolved("GRHydro::particles", "GRHydro::particle_rhs"); + } + else if (CCTK_EQUALS(evolution_method, "none")) + { + register_constrained("GRHydro::dens"); + register_constrained("GRHydro::scon"); + register_constrained("GRHydro::tau"); + register_constrained("HydroBase::Bvec"); + } +} + diff --git a/src/GRHydro_RiemannSolveM.F90 b/src/GRHydro_RiemannSolveM.F90 new file mode 100644 index 0000000..46ab310 --- /dev/null +++ b/src/GRHydro_RiemannSolveM.F90 @@ -0,0 +1,457 @@ + /*@@ + @file GRHydro_RiemannSolveM.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 RiemannSolveM + @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 RiemannSolveM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i,j,k + + if (CCTK_EQUALS(riemann_solver,"HLLE")) then + + call GRHydro_HLLEM(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_RoeSolveM(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_WARN(0, "Roe and Marquina not implemented in MHD yet!!!") + + end if + +end subroutine RiemannSolveM + + /*@@ + @routine RiemannSolvePolytypeM + @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 RiemannSolvePolytypeM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i,j,k + + if (CCTK_EQUALS(riemann_solver,"HLLE")) then + + call GRHydro_HLLEM(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_WARN(0, "Roe and Marquina not implemented in MHD yet!!!") + + end if + +end subroutine RiemannSolvePolytypeM + + + +/*@@ +@routine RiemannSolveGeneralM +@date Tue Mar 19 11:40:20 2002 +@author Joshua Faber, Scott Noble, Bruno Mundim, Ian Hawke +@desc +The Riemann solvers for the new general EOS routines. +This sets the fluxes from the left and right reconstructed +states, so that after this routine they are effectively +scratch space. +@enddesc +@calls +@calledby +@history + +@endhistory + +@@*/ + + +subroutine RiemannSolveGeneralM(CCTK_ARGUMENTS) + + USE GRHydro_Scalars + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_FUNCTIONS + + CCTK_INT :: i,j,k, ierr + CCTK_REAL, dimension(8) :: tmp_flux, cons_p, cons_m + CCTK_REAL, dimension(6) :: prim_p, prim_m + CCTK_REAL :: avg_det, avg_alp, avg_beta + CCTK_REAL :: gxxh, gyyh, gzzh, gxyh, gxzh, gyzh + CCTK_REAL :: avg_betax, avg_betay, avg_betaz + CCTK_REAL :: vxtp,vytp,vztp,vxtm,vytm,vztm,ab0p,ab0m,b2p,b2m,bdotvp,bdotvm + CCTK_REAL :: wp,wm,v2p,v2m,bxlowp,bxlowm,bylowp,bylowm,bzlowp,bzlowm,vA2m,vA2p + CCTK_REAL :: Bvecxlowp,Bvecxlowm,Bvecylowp,Bvecylowm,Bveczlowp,Bveczlowm + CCTK_REAL :: pressstarp,pressstarm,rhoenth_p,rhoenth_m + CCTK_REAL :: velxlowp,velxlowm,velylowp,velylowm,velzlowp,velzlowm + + densflux = 0.d0 + sxflux = 0.d0 + syflux = 0.d0 + szflux = 0.d0 + tauflux = 0.d0 + Bvecxflux = 0.d0 + Bvecyflux = 0.d0 + Bveczflux = 0.d0 + +!!$ Do the EOS call to set the pressure, derivative and cs2 + + ierr = EOS_SetGFs(cctkGH, EOS_RiemannCallPlus) + ierr = EOS_SetGFs(cctkGH, EOS_RiemannCallMinus) + + + if (CCTK_EQUALS(riemann_solver,"HLLE")) then + + call GRHydro_HLLEGeneralM(CCTK_PASS_FTOF) + + if (evolve_tracer .ne. 0) then + +!!$ No b-field component for tracers! + call GRHydro_HLLE_TracerGeneral(CCTK_PASS_FTOF) + + end if + + else + + do k = GRHydro_stencil, cctk_lsh(3) - GRHydro_stencil + do j = GRHydro_stencil, cctk_lsh(2) - GRHydro_stencil + do i = GRHydro_stencil, cctk_lsh(1) - GRHydro_stencil + +!!$ Set the left (p for plus) and right (m 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) = Bvecxplus(i,j,k) + cons_p(7) = Bvecyplus(i,j,k) + cons_p(8) = Bveczplus(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) = Bvecxminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(7) = Bvecyminus(i+xoffset,j+yoffset,k+zoffset) + cons_m(8) = 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) + rhoenth_p = prim_p(1)*(1.0d0+prim_p(5))+prim_p(6) + + 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) + rhoenth_m = prim_m(1)*(1.0d0+prim_m(5))+prim_m(6) + +!!$ Set metric terms at interface + + if (shift_state .ne. 0) then + avg_betax = 0.5d0*(betax(i+xoffset,j+yoffset,k+zoffset)+betax(i,j,k)) + avg_betay = 0.5d0*(betay(i+xoffset,j+yoffset,k+zoffset)+betay(i,j,k)) + avg_betaz = 0.5d0*(betaz(i+xoffset,j+yoffset,k+zoffset)+betaz(i,j,k)) + if (flux_direction == 1) then + avg_beta = avg_betax + else if (flux_direction == 2) then + avg_beta = avg_betay + else if (flux_direction == 3) then + avg_beta = avg_betaz + else + call CCTK_WARN(0, "Flux direction not x,y,z") + end if + else + avg_beta = 0.d0 + avg_betax = 0.d0 + avg_betay = 0.d0 + avg_betaz = 0.d0 + end if + + avg_alp = 0.5 * (alp(i,j,k) + alp(i+xoffset,j+yoffset,k+zoffset)) + + gxxh = 0.5d0 * (gxx(i+xoffset,j+yoffset,k+zoffset) + & + gxx(i,j,k)) + gxyh = 0.5d0 * (gxy(i+xoffset,j+yoffset,k+zoffset) + & + gxy(i,j,k)) + gxzh = 0.5d0 * (gxz(i+xoffset,j+yoffset,k+zoffset) + & + gxz(i,j,k)) + gyyh = 0.5d0 * (gyy(i+xoffset,j+yoffset,k+zoffset) + & + gyy(i,j,k)) + gyzh = 0.5d0 * (gyz(i+xoffset,j+yoffset,k+zoffset) + & + gyz(i,j,k)) + gzzh = 0.5d0 * (gzz(i+xoffset,j+yoffset,k+zoffset) + & + gzz(i,j,k)) + + avg_det = SPATIAL_DETERMINANT(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh) + + vxtp = prim_p(2)-avg_betax/avg_alp + vytp = prim_p(3)-avg_betay/avg_alp + vztp = prim_p(4)-avg_betaz/avg_alp + vxtm = prim_m(2)-avg_betax/avg_alp + vytm = prim_m(3)-avg_betay/avg_alp + vztm = prim_m(4)-avg_betaz/avg_alp + + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_p(2),prim_p(3),prim_p(4),cons_p(6),cons_p(7),cons_p(8), & + velxlowp,velylowp,velzlowp,Bvecxlowp,Bvecylowp,Bveczlowp, & + bdotvp,b2p,v2p,wp,bxlowp,bylowp,bzlowp) + call calc_vlow_blow(gxxh,gxyh,gxzh,gyyh,gyzh,gzzh, & + prim_m(2),prim_m(3),prim_m(4),cons_m(6),cons_m(7),cons_m(8), & + velxlowm,velylowm,velzlowm,Bvecxlowm,Bvecylowm,Bveczlowm, & + bdotvm,b2m,v2m,wm,bxlowm,bylowm,bzlowm) + + ab0p = wp*bdotvp + ab0m = wm*bdotvm + + vA2p = b2p/(rhoenth_p+b2p) + vA2m = b2m/(rhoenth_m+b2m) + +!!$ p^* = p+b^2/2 in Anton et al. + pressstarp = prim_p(6)+0.5d0*b2p + pressstarm = prim_m(6)+0.5d0*b2m + + if (flux_direction == 1) then + + call num_x_fluxM(cons_p(1),cons_p(2),cons_p(3),cons_p(4),cons_p(5),& + cons_p(6),cons_p(7),cons_p(8),& + tmp_flux(1),tmp_flux(2),tmp_flux(3),tmp_flux(4),tmp_flux(5), & + tmp_flux(6),tmp_flux(7),tmp_flux(8), & + vxtp,vytp,vztp,pressstarp,bxlowp,bylowp,bzlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = 0.5d0 * tmp_flux(2) + syflux(i,j,k) = 0.5d0 * tmp_flux(3) + szflux(i,j,k) = 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k) = 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k) = 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k) = 0.5d0 * tmp_flux(8) + + call num_x_fluxM(cons_m(1),cons_m(2),cons_m(3),cons_m(4),cons_m(5),& + cons_m(6),cons_m(7),cons_m(8),& + tmp_flux(1),tmp_flux(2),tmp_flux(3),tmp_flux(4),tmp_flux(5),& + tmp_flux(6),tmp_flux(7),tmp_flux(8),& + vxtm,vytm,vztm,pressstarm,bxlowm,bylowm,bzlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = densflux(i,j,k) + 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = sxflux(i,j,k) + 0.5d0 * tmp_flux(2) + syflux(i,j,k) = syflux(i,j,k) + 0.5d0 * tmp_flux(3) + szflux(i,j,k) = szflux(i,j,k) + 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = tauflux(i,j,k) + 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k)= Bvecxflux(i,j,k)+ 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k)= Bvecyflux(i,j,k)+ 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k)= Bveczflux(i,j,k)+ 0.5d0 * tmp_flux(8) + + else if (flux_direction == 2) then + + call num_x_fluxM(cons_p(1),cons_p(3),cons_p(4),cons_p(2),cons_p(5),& + cons_p(7),cons_p(8),cons_p(6),& + tmp_flux(1),tmp_flux(3),tmp_flux(4),tmp_flux(2),tmp_flux(5),& + tmp_flux(7),tmp_flux(8),tmp_flux(6),& + vytp,vztp,vxtp,pressstarp,bylowp,bzlowp,bxlowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = 0.5d0 * tmp_flux(2) + syflux(i,j,k) = 0.5d0 * tmp_flux(3) + szflux(i,j,k) = 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k)= Bvecxflux(i,j,k)+ 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k)= Bvecyflux(i,j,k)+ 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k)= Bveczflux(i,j,k)+ 0.5d0 * tmp_flux(8) + + call num_x_fluxM(cons_m(1),cons_m(3),cons_m(4),cons_m(2),cons_m(5),& + cons_m(7),cons_m(8),cons_m(6),& + tmp_flux(1),tmp_flux(3),tmp_flux(4),tmp_flux(2),tmp_flux(5),& + tmp_flux(7),tmp_flux(8),tmp_flux(6),& + vytm,vztm,vxtm,pressstarm,bylowm,bzlowm,bxlowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = densflux(i,j,k) + 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = sxflux(i,j,k) + 0.5d0 * tmp_flux(2) + syflux(i,j,k) = syflux(i,j,k) + 0.5d0 * tmp_flux(3) + szflux(i,j,k) = szflux(i,j,k) + 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = tauflux(i,j,k) + 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k)= Bvecxflux(i,j,k)+ 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k)= Bvecyflux(i,j,k)+ 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k)= Bveczflux(i,j,k)+ 0.5d0 * tmp_flux(8) + + else if (flux_direction == 3) then + + call num_x_fluxM(cons_p(1),cons_p(4),cons_p(2),cons_p(3),cons_p(5),& + cons_p(8),cons_p(6),cons_p(7),& + tmp_flux(1),tmp_flux(4),tmp_flux(2),tmp_flux(3),tmp_flux(5),& + tmp_flux(8),tmp_flux(6),tmp_flux(7), & + vztp,vxtp,vytp,pressstarp,bzlowp,bxlowp,bylowp,ab0p,wp, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = 0.5d0 * tmp_flux(2) + syflux(i,j,k) = 0.5d0 * tmp_flux(3) + szflux(i,j,k) = 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k)= Bvecxflux(i,j,k)+ 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k)= Bvecyflux(i,j,k)+ 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k)= Bveczflux(i,j,k)+ 0.5d0 * tmp_flux(8) + + call num_x_fluxM(cons_m(1),cons_m(4),cons_m(2),cons_m(3),cons_m(5),& + cons_m(8),cons_m(6),cons_m(7),& + tmp_flux(1),tmp_flux(4),tmp_flux(2),tmp_flux(3),tmp_flux(5), & + tmp_flux(8),tmp_flux(6),tmp_flux(7), & + vztm,vxtm,vytm,pressstarm,bzlowm,bxlowm,bylowm,ab0m,wm, & + avg_det,avg_alp,avg_beta) + + densflux(i,j,k) = densflux(i,j,k) + 0.5d0 * tmp_flux(1) + sxflux(i,j,k) = sxflux(i,j,k) + 0.5d0 * tmp_flux(2) + syflux(i,j,k) = syflux(i,j,k) + 0.5d0 * tmp_flux(3) + szflux(i,j,k) = szflux(i,j,k) + 0.5d0 * tmp_flux(4) + tauflux(i,j,k) = tauflux(i,j,k) + 0.5d0 * tmp_flux(5) + Bvecxflux(i,j,k)= Bvecxflux(i,j,k)+ 0.5d0 * tmp_flux(6) + Bvecyflux(i,j,k)= Bvecyflux(i,j,k)+ 0.5d0 * tmp_flux(7) + Bveczflux(i,j,k)= Bveczflux(i,j,k)+ 0.5d0 * tmp_flux(8) + + else + + call CCTK_WARN(0, "Flux direction not x,y,z") + + end if + + end do + end do + end do + + if (CCTK_EQUALS(riemann_solver,"Roe")) then + + call CCTK_WARN(0, "Roe and Marquina not implemented in MHD yet!!!") + +!!$ +!!$ call GRHydro_RoeSolveGeneral(CCTK_PASS_FTOF) +!!$ +!!$ if (evolve_tracer .ne. 0) then +!!$ +!!$ call GRHydro_HLLE_TracerGeneral(CCTK_PASS_FTOF) +!!$ +!!$ end if +!!$ + else if (CCTK_EQUALS(riemann_solver,"Marquina")) then + + call CCTK_WARN(0, "Roe and Marquina not implemented in MHD yet!!!") + +!!$ +!!$ call GRHydro_MarquinaGeneral(CCTK_PASS_FTOF) +!!$ +!!$ Tracers are built directly in to the Marquina solver + + end if + + end if + +end subroutine RiemannSolveGeneralM + + diff --git a/src/GRHydro_SourceM.F90 b/src/GRHydro_SourceM.F90 new file mode 100644 index 0000000..27f39e4 --- /dev/null +++ b/src/GRHydro_SourceM.F90 @@ -0,0 +1,436 @@ + /*@@ + @file GRHydro_SourceM.F90 + @date Aug 30, 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 "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 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) + + /*@@ + @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 + + 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, det, 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 :: Bvecxlow,Bvecylow,Bveczlow,bdotv,b2,dum,bxlow,bylow,bzlow + CCTK_REAL :: bt,bx,by,bz,rhohstarW2,pstar + + logical, allocatable, dimension (:,:,:) :: force_spatial_second_order + + 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 + + if (evolve_tracer .ne. 0) then + + cons_tracerrhs = 0.d0 + + end if + +!!$ 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 (spatial_order > 2) then + !$OMP PARALLEL DO PRIVATE(i, j) + 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, local_spatial_order,& + !$OMP localgxx,localgxy,localgxz,localgyy,localgyz,localgzz,& + !$OMP det,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,dum,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,tau_source,sx_source,sy_source,sz_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 = spatial_order + if (force_spatial_second_order(i,j,k)) then + local_spatial_order = 2 + end if + +!!$ Set the metric terms. + + localgxx = gxx(i,j,k) + localgxy = gxy(i,j,k) + localgxz = gxz(i,j,k) + localgyy = gyy(i,j,k) + localgyz = gyz(i,j,k) + localgzz = gzz(i,j,k) + + det = SPATIAL_DETERMINANT(localgxx, localgxy, localgxz,\ + localgyy, localgyz, localgzz) + sqrtdet = sqrt(det) + call UpperMetric(uxx, uxy, uxz, uyy, uyz, uzz, det, localgxx,& + localgxy, localgxz, localgyy, localgyz, localgzz) + + + if (shift_state .ne. 0) then + + shiftx = betax(i,j,k) + shifty = betay(i,j,k) + shiftz = betaz(i,j,k) + + if (local_spatial_order .eq. 2) then + + dx_betax = DIFF_X_2(betax) + dx_betay = DIFF_X_2(betay) + dx_betaz = DIFF_X_2(betaz) + + dy_betax = DIFF_Y_2(betax) + dy_betay = DIFF_Y_2(betay) + dy_betaz = DIFF_Y_2(betaz) + + dz_betax = DIFF_Z_2(betax) + dz_betay = DIFF_Z_2(betay) + dz_betaz = DIFF_Z_2(betaz) + + else + + dx_betax = DIFF_X_4(betax) + dx_betay = DIFF_X_4(betay) + dx_betaz = DIFF_X_4(betaz) + + dy_betax = DIFF_Y_4(betax) + dy_betay = DIFF_Y_4(betay) + dy_betaz = DIFF_Y_4(betaz) + + dz_betax = DIFF_Z_4(betax) + dz_betay = DIFF_Z_4(betay) + dz_betaz = DIFF_Z_4(betaz) + + end if + + else + + shiftx = 0.0d0 + shifty = 0.0d0 + shiftz = 0.0d0 + + dx_betax = 0.0d0 + dx_betay = 0.0d0 + dx_betaz = 0.0d0 + + dy_betax = 0.0d0 + dy_betay = 0.0d0 + dy_betaz = 0.0d0 + + dz_betax = 0.0d0 + dz_betay = 0.0d0 + dz_betaz = 0.0d0 + + endif + + 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,dum,dum,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)+b2/2.d0 + +!!$ 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(gxx) + dx_gxy = DIFF_X_2(gxy) + dx_gxz = DIFF_X_2(gxz) + dx_gyy = DIFF_X_2(gyy) + dx_gyz = DIFF_X_2(gyz) + dx_gzz = DIFF_X_2(gzz) + dy_gxx = DIFF_Y_2(gxx) + dy_gxy = DIFF_Y_2(gxy) + dy_gxz = DIFF_Y_2(gxz) + dy_gyy = DIFF_Y_2(gyy) + dy_gyz = DIFF_Y_2(gyz) + dy_gzz = DIFF_Y_2(gzz) + dz_gxx = DIFF_Z_2(gxx) + dz_gxy = DIFF_Z_2(gxy) + dz_gxz = DIFF_Z_2(gxz) + dz_gyy = DIFF_Z_2(gyy) + dz_gyz = DIFF_Z_2(gyz) + dz_gzz = DIFF_Z_2(gzz) + + else + + dx_gxx = DIFF_X_4(gxx) + dx_gxy = DIFF_X_4(gxy) + dx_gxz = DIFF_X_4(gxz) + dx_gyy = DIFF_X_4(gyy) + dx_gyz = DIFF_X_4(gyz) + dx_gzz = DIFF_X_4(gzz) + dy_gxx = DIFF_Y_4(gxx) + dy_gxy = DIFF_Y_4(gxy) + dy_gxz = DIFF_Y_4(gxz) + dy_gyy = DIFF_Y_4(gyy) + dy_gyz = DIFF_Y_4(gyz) + dy_gzz = DIFF_Y_4(gzz) + dz_gxx = DIFF_Z_4(gxx) + dz_gxy = DIFF_Z_4(gxy) + dz_gxz = DIFF_Z_4(gxz) + dz_gyy = DIFF_Z_4(gyy) + dz_gyz = DIFF_Z_4(gyz) + dz_gzz = DIFF_Z_4(gzz) + + end if + +!!$ Contract the shift with the extrinsic curvature + + shiftshiftk = shiftx*shiftx*kxx(i,j,k) + & + shifty*shifty*kyy(i,j,k) + & + shiftz*shiftz*kzz(i,j,k) + & + two*(shiftx*shifty*kxy(i,j,k) + & + shiftx*shiftz*kxz(i,j,k) + & + shifty*shiftz*kyz(i,j,k)) + + shiftkx = shiftx*kxx(i,j,k) + shifty*kxy(i,j,k) + shiftz*kxz(i,j,k) + shiftky = shiftx*kxy(i,j,k) + shifty*kyy(i,j,k) + shiftz*kyz(i,j,k) + shiftkz = shiftx*kxz(i,j,k) + shifty*kyz(i,j,k) + shiftz*kzz(i,j,k) + +!!$ Contract the matter terms with the extrinsic curvature + + sumTK = txx*kxx(i,j,k) + tyy*kyy(i,j,k) + tzz*kzz(i,j,k) & + + two*(txy*kxy(i,j,k) + txz*kxz(i,j,k) + tyz*kyz(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) + halfTdgy + & + 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 + Bvecrhs(i,j,k,1) = 0.d0 + Bvecrhs(i,j,k,2) = 0.d0 + Bvecrhs(i,j,k,3) = 0.d0 + + enddo + enddo + enddo + !$OMP END PARALLEL DO + + deallocate(force_spatial_second_order) + +end subroutine SourceTermsM + + + diff --git a/src/GRHydro_TmunuM.F90 b/src/GRHydro_TmunuM.F90 new file mode 100644 index 0000000..5464e45 --- /dev/null +++ b/src/GRHydro_TmunuM.F90 @@ -0,0 +1,166 @@ + /*@@ + @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 "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) + + subroutine GRHydro_TmunuM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + + CCTK_REAL velxlow, velylow, velzlow + CCTK_REAL betaxlow, betaylow, betazlow, beta2 + CCTK_REAL Bvecxlow,Bvecylow,Bveczlow + CCTK_REAL bdotv,b2,bxlow,bylow,bzlow,btlow,dum + CCTK_REAL utlow,rhohstarw2,pstar + CCTK_REAL bdotbeta,vdotbeta + CCTK_INT i,j,k + + + !$OMP PARALLEL DO PRIVATE(i,j,velxlow, velylow, velzlow,& + !$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) + + 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,dum,dum,b2,bxlow,bylow,bzlow) + +!!$ Calculate lower components and square of shift vector. + + if (shift_state .ne. 0) then + + 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 + + + else + + betaxlow = 0.0D0 + betaylow = 0.0D0 + betazlow = 0.0D0 + beta2 = 0.0D0 + +!!$ u0 low is missing the w_lorentz factor (see below)!! + utlow = -1.0*alp(i,j,k) + btlow = utlow*w_lorentz(i,j,k)*bdotv + + end if + +!!$ 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)+b2/2.d0 + +!!$ 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 + + end do + end do + end do + !$OMP END PARALLEL DO + + return + + end subroutine GRHydro_TmunuM diff --git a/src/GRHydro_UpdateMaskM.F90 b/src/GRHydro_UpdateMaskM.F90 new file mode 100644 index 0000000..5e46380 --- /dev/null +++ b/src/GRHydro_UpdateMaskM.F90 @@ -0,0 +1,227 @@ + /*@@ + @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 "GRHydro_Macros.h" +#include "SpaceMask.h" + +!!$ 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 + + CCTK_INT :: i, j, k + CCTK_REAL :: det, psi4pt + + CCTK_INT :: type_bits, atmosphere, not_atmosphere + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere",& + "in_atmosphere") + call SpaceMask_GetStateBits(not_atmosphere, "Hydro_Atmosphere",& + "not_in_atmosphere") + + do k = 1, cctk_lsh(3) + do j = 1, cctk_lsh(2) + do i = 1, cctk_lsh(1) + + if ( (atmosphere_mask(i, j, k) .eq. 1) & + &.or. (SpaceMask_CheckStateBitsF90(space_mask,i, j, k, type_bits,\ + atmosphere)) & + &) then + +!!$ write(*,*) 'Resetting at ',i,j,k, atmosphere_mask(i, j, k), & +!!$ & (SpaceMask_CheckStateBitsF90(space_mask,i, j, k, type_bits,\ +!!$ atmosphere)) + + rho(i,j,k) = GRHydro_rho_min + vel(i,j,k,1) = 0.0d0 + vel(i,j,k,2) = 0.0d0 + vel(i,j,k,3) = 0.0d0 + det = SPATIAL_DETERMINANT(gxx(i,j,k), gxy(i,j,k), gxz(i,j,k), \ + gyy(i,j,k), gyz(i,j,k), gzz(i,j,k)) + call prim2conpolytypeM(GRHydro_polytrope_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), det, & + dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), & + tau(i,j,k), Bvec(i,j,k,1),Bvec(i,j,k,2),Bvec(i,j,k,3),& + rho(i,j,k), vel(i,j,k,1), vel(i,j,k,2), & + vel(i,j,k,3), 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 + SpaceMask_SetStateBitsF90(space_mask, i, j, k, type_bits,\ + not_atmosphere) + end if + + end if + + end do + end do + end do + +!!$ call GRHydro_BoundariesM(CCTK_PASS_FTOF) + +end subroutine GRHydro_AtmosphereResetM + +subroutine GRHydro_InitialAtmosphereResetM(CCTK_ARGUMENTS) + + implicit none + + DECLARE_CCTK_ARGUMENTS + DECLARE_CCTK_PARAMETERS + + CCTK_INT :: i, j, k + CCTK_REAL :: det, psi4pt + + CCTK_INT :: type_bits, atmosphere, not_atmosphere + CCTK_INT :: eos_handle + +#if !USE_EOS_OMNI +#ifdef _EOS_BASE_INC_ +#undef _EOS_BASE_INC_ +#endif +#include "EOS_Base.inc" +#endif + +#if USE_EOS_OMNI +! begin EOS Omni vars + integer :: n = 1 + integer :: keytemp = 0 + integer :: anyerr = 0 + integer :: keyerr(1) = 0 + real*8 :: xpress = 0.0d0 + real*8 :: xeps = 0.0d0 + real*8 :: xtemp = 0.0d0 + real*8 :: xye = 0.0d0 +! end EOS Omni vars +#endif + + eos_handle = GRHydro_polytrope_handle + + call SpaceMask_GetTypeBits(type_bits, "Hydro_Atmosphere") + call SpaceMask_GetStateBits(atmosphere, "Hydro_Atmosphere",& + "in_atmosphere") + call SpaceMask_GetStateBits(not_atmosphere, "Hydro_Atmosphere",& + "not_in_atmosphere") + + 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 + rho(i,j,k) = GRHydro_rho_min + vel(i,j,k,1) = 0.0d0 + vel(i,j,k,2) = 0.0d0 + vel(i,j,k,3) = 0.0d0 +#if USE_EOS_OMNI + 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) +#else + press(i,j,k) = EOS_Pressure(eos_handle, GRHydro_rho_min, eps(i,j,k)) + eps(i,j,k) = EOS_SpecificIntEnergy(eos_handle, GRHydro_rho_min, press(i,j,k)) +#endif + det = SPATIAL_DETERMINANT(gxx(i,j,k), gxy(i,j,k), gxz(i,j,k), \ + gyy(i,j,k), gyz(i,j,k), gzz(i,j,k)) + call prim2conpolytypeM(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), det, & + dens(i,j,k), scon(i,j,k,1), scon(i,j,k,2), scon(i,j,k,3), & + tau(i,j,k), Bvec(i,j,k,1),Bvec(i,j,k,2),Bvec(i,j,k,3),& + rho(i,j,k), vel(i,j,k,1), vel(i,j,k,2), & + vel(i,j,k,3), eps(i,j,k), press(i,j,k), w_lorentz(i,j,k)) + end if + if (timelevels .gt. 1) then + if (rho_p(i,j,k) .le. GRHydro_rho_min) then + rho_p(i,j,k) = GRHydro_rho_min + vel_p(i,j,k,1) = 0.0d0 + vel_p(i,j,k,2) = 0.0d0 + vel_p(i,j,k,3) = 0.0d0 +#if USE_EOS_OMNI + 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) +#else + press_p(i,j,k) = EOS_Pressure(eos_handle, GRHydro_rho_min, eps_p(i,j,k)) + eps_p(i,j,k) = EOS_SpecificIntEnergy(eos_handle, GRHydro_rho_min, press_p(i,j,k)) +#endif + det = SPATIAL_DETERMINANT(gxx_p(i,j,k), gxy_p(i,j,k), gxz_p(i,j,k), \ + gyy_p(i,j,k), gyz_p(i,j,k), gzz_p(i,j,k)) + call prim2conpolytypeM(eos_handle, & + gxx_p(i,j,k), gxy_p(i,j,k), gxz_p(i,j,k), & + gyy_p(i,j,k), gyz_p(i,j,k), gzz_p(i,j,k), det, & + 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), Bvec_p(i,j,k,1),Bvec_p(i,j,k,2),Bvec_p(i,j,k,3),& + rho_p(i,j,k), vel_p(i,j,k,1), vel_p(i,j,k,2), & + vel_p(i,j,k,3), eps_p(i,j,k), press_p(i,j,k), w_lorentz_p(i,j,k)) + endif + end if + if (timelevels .gt. 2) then + if (rho_p_p(i,j,k) .le. GRHydro_rho_min) then + rho_p_p(i,j,k) = GRHydro_rho_min + vel_p_p(i,j,k,1) = 0.0d0 + vel_p_p(i,j,k,2) = 0.0d0 + vel_p_p(i,j,k,3) = 0.0d0 +#if USE_EOS_OMNI + 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) +#else + press_p_p(i,j,k) = EOS_Pressure(eos_handle, GRHydro_rho_min, eps_p_p(i,j,k)) + eps_p_p(i,j,k) = EOS_SpecificIntEnergy(eos_handle, GRHydro_rho_min, press_p_p(i,j,k)) +#endif + det = SPATIAL_DETERMINANT(gxx_p_p(i,j,k), gxy_p_p(i,j,k), gxz_p_p(i,j,k), \ + gyy_p_p(i,j,k), gyz_p_p(i,j,k), gzz_p_p(i,j,k)) + call prim2conpolytypeM(eos_handle, & + gxx_p_p(i,j,k), gxy_p_p(i,j,k), gxz_p_p(i,j,k), & + gyy_p_p(i,j,k), gyz_p_p(i,j,k), gzz_p_p(i,j,k), det, & + 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), Bvec_p_p(i,j,k,1),Bvec_p_p(i,j,k,2),Bvec_p_p(i,j,k,3),& + rho_p_p(i,j,k), vel_p_p(i,j,k,1), vel_p_p(i,j,k,2), & + vel_p_p(i,j,k,3), eps_p_p(i,j,k), press_p_p(i,j,k), w_lorentz_p_p(i,j,k)) + endif + endif + + end do + end do + end do + + write(*,*) " GRHydro_InitialAtmosphereReset" +!!$ call GRHydro_BoundariesM(CCTK_PASS_FTOF) + +end subroutine GRHydro_InitialAtmosphereResetM + diff --git a/src/GRHydro_UtilsM.F90 b/src/GRHydro_UtilsM.F90 new file mode 100644 index 0000000..d3239f8 --- /dev/null +++ b/src/GRHydro_UtilsM.F90 @@ -0,0 +1,58 @@ +/*@@ +@file UtilsM.F +@date Aug 30, 2010 +@author Joshua Faber, Scott Noble, Bruno Mundim +@desc +Utility functions for other thorns. +@enddesc +@@*/ + +#include "cctk.h" +#include "cctk_Parameters.h" +#include "cctk_Arguments.h" + + +subroutine calc_vlow_blow(gxx,gxy,gxz,gyy,gyz,gzz, & + velx,vely,velz,Bvecx,Bvecy,Bvecz, & + velxlow,velylow,velzlow,Bvecxlow,Bvecylow,Bveczlow, & + Bdotv,b2,v2,w,bxlow,bylow,bzlow) + +!!$ Calculates v_i (see Anton Eq. 5) and B_i (Bvecxlow)- undensitized! +!!$ calculates B^i v_i [Anton eq. 44] and b^2 [LHS of Anton eq. 46] +!!$ Calculates w (Lorentz factor) as (1-v^i v_i)^{-1/2} +!!$ Calculates b_i (bxlow) + + CCTK_REAL :: gxx,gxy,gxz,gyy,gyz,gzz + CCTK_REAL :: velx,vely,velz,Bvecx,Bvecy,Bvecz + CCTK_REAL :: velxlow,velylow,velzlow + CCTK_REAL :: Bvecxlow,Bvecylow,Bveczlow + CCTK_REAL :: Bdotv,v2,w,b2,bxlow,bylow,bzlow + +!!$ vel_i = g_ij v^j +!!$ B_i = g_ij B^i + + velxlow = gxx*velx + gxy*vely + gxz*velz + velylow = gxy*velx + gyy*vely + gyz*velz + velzlow = gxz*velx + gyz*vely + gzz*velz + Bvecxlow = gxx*Bvecx + gxy*Bvecy + gxz*Bvecz + Bvecylow = gxy*Bvecx + gyy*Bvecy + gyz*Bvecz + Bveczlow = gxz*Bvecx + gyz*Bvecy + gzz*Bvecz + +!!$ B^i v_i (= b^0/u^0) + Bdotv = velxlow*Bvecx+velylow*Bvecy+velzlow*Bvecz + +!!$v^2 = v_i v^i; w=(1-v^2)^{-1/2} + + v2 = velxlow*velx + velylow*vely + velzlow*velz + w = 1.d0/sqrt(1.d0-v2) + +!!$b^2 = B^i B_i / w^2 + (b^0/u^0)^2 + + b2=(Bvecx*Bvecxlow+Bvecy*Bvecylow+Bvecz*Bveczlow)/w**2+Bdotv**2 + +!!$ b_i = B_i/w +w*(B dot v)*v_i + bxlow = Bvecxlow/w+w*Bdotv*velxlow + bylow = Bvecylow/w+w*Bdotv*velylow + bzlow = Bveczlow/w+w*Bdotv*velzlow + +end subroutine calc_vlow_blow diff --git a/src/make.code.defn b/src/make.code.defn index c7dadf2..53fe17c 100644 --- a/src/make.code.defn +++ b/src/make.code.defn @@ -7,7 +7,6 @@ SRCS = Utils.F90 \ GRHydro_Boundaries.F90 \ GRHydro_CalcUpdate.F90 \ GRHydro_Con2Prim.F90 \ - GRHydro_Con2PrimM.F90 \ GRHydro_Eigenproblem.F90 \ GRHydro_Eigenproblem_Marquina.F90 \ GRHydro_ENOReconstruct.F90 \ @@ -44,7 +43,27 @@ SRCS = Utils.F90 \ GRHydro_Set_TP_GF.c \ GRHydro_Differences.F90 \ GRHydro_EoSChangeGamma.F90 \ - GRHydro_Tmunu.F90 + GRHydro_Tmunu.F90 \ + GRHydro_RegisterGZM.cc \ + GRHydro_RegisterVarsM.cc \ + GRHydro_BoundariesM.F90 \ + GRHydro_CalcUpdateM.F90 \ + GRHydro_Con2PrimM.F90 \ + GRHydro_Con2PrimM_pt.c \ + GRHydro_EigenproblemM.F90 \ + GRHydro_FluxM.F90 \ + GRHydro_HLLEM.F90 \ + GRHydro_HLLEPolyM.F90 \ + GRHydro_PPMM.F90 \ + GRHydro_ParamCheckM.F90 \ + GRHydro_Prim2ConM.F90 \ + GRHydro_RiemannSolveM.F90 \ + GRHydro_ReconstructM.F90 \ + GRHydro_ReconstructPolyM.F90 \ + GRHydro_SourceM.F90 \ + GRHydro_TmunuM.F90 \ + GRHydro_UpdateMaskM.F90 \ + GRHydro_UtilsM.F90 ### GRHydro_Weights.c \ |