From db1d3c6d4fe95f16a252fd160a3b74b9ee99e43c Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Mon, 11 Feb 2019 09:51:02 -0200 Subject: [PATCH] SCHEMES: Make initialize_schemes() resistant to wrong parameters. Signed-off-by: Grzegorz Kowal --- sources/schemes.F90 | 194 +++++++++++++++++++++++++++++--------------- 1 file changed, 129 insertions(+), 65 deletions(-) diff --git a/sources/schemes.F90 b/sources/schemes.F90 index 8d749f3..dd283cb 100644 --- a/sources/schemes.F90 +++ b/sources/schemes.F90 @@ -108,16 +108,16 @@ module schemes ! Arguments: ! ! verbose - a logical flag turning the information printing; -! iret - an integer flag for error return value; +! status - an integer flag for error return value; ! !=============================================================================== ! - subroutine initialize_schemes(verbose, iret) + subroutine initialize_schemes(verbose, status) ! include external procedures and variables ! - use equations , only : eqsys, eos - use parameters , only : get_parameter + use equations , only : eqsys, eos + use parameters, only : get_parameter ! local variables are not implicit by default ! @@ -125,13 +125,13 @@ module schemes ! subroutine arguments ! - logical, intent(in) :: verbose - integer, intent(inout) :: iret + logical, intent(in) :: verbose + integer, intent(out) :: status ! local variables ! - character(len=64) :: solver = "HLL" - character(len=64) :: statev = "primitive" + character(len=64) :: solver = "HLL" + character(len=64) :: statev = "primitive" ! !------------------------------------------------------------------------------- ! @@ -148,6 +148,10 @@ module schemes call start_timer(imi) #endif /* PROFILE */ +! reset the status flag +! + status = 0 + ! get the Riemann solver ! call get_parameter("riemann_solver" , solver) @@ -175,6 +179,16 @@ module schemes ! select case(trim(solver)) + case("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_hd_iso_hll + case("roe", "ROE") ! set the solver name @@ -185,17 +199,16 @@ module schemes ! riemann => riemann_hd_iso_roe -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_hd_iso_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for isothermal HD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'roe'." + end if + status = 1 end select @@ -209,6 +222,16 @@ module schemes ! select case(trim(solver)) + case("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_hd_adi_hll + case("hllc", "HLLC") ! set the solver name @@ -229,17 +252,16 @@ module schemes ! riemann => riemann_hd_adi_roe -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_hd_adi_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for adiabatic HD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'hllc', 'roe'." + end if + status = 1 end select @@ -263,6 +285,16 @@ module schemes ! select case(trim(solver)) + case("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_mhd_iso_hll + case ("hlld", "HLLD") ! set the solver name @@ -293,17 +325,17 @@ module schemes ! riemann => riemann_mhd_iso_roe -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_mhd_iso_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for isothermal MHD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'hlld'" // & + ", 'hlld-m', 'roe'." + end if + status = 1 end select @@ -317,6 +349,16 @@ module schemes ! select case(trim(solver)) + case ("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_mhd_adi_hll + case ("hllc", "HLLC") ! set the solver name @@ -347,17 +389,17 @@ module schemes ! riemann => riemann_mhd_adi_roe -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_mhd_adi_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for adiabatic MHD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'hllc'" // & + ", 'hlld', 'roe'." + end if + status = 1 end select @@ -405,6 +447,16 @@ module schemes ! select case(trim(solver)) + case ("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_srhd_adi_hll + case("hllc", "HLLC", "hllcm", "HLLCM", "hllc-m", "HLLC-M") ! set the solver name @@ -415,17 +467,16 @@ module schemes ! riemann => riemann_srhd_adi_hllc -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_srhd_adi_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for adiabatic SR-HD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'hllc'." + end if + status = 1 end select @@ -473,6 +524,16 @@ module schemes ! select case(trim(solver)) + case ("hll", "HLL") + +! set the solver name +! + name_sol = "HLL" + +! set pointers to subroutines +! + riemann => riemann_srmhd_adi_hll + case("hllc", "HLLC", "hllcm", "HLLCM", "hllc-m", "HLLC-M") ! set the solver name @@ -483,17 +544,16 @@ module schemes ! riemann => riemann_srmhd_adi_hllc -! in the case of unknown Riemann solver, revert to HLL -! case default -! set the solver name -! - name_sol = "HLL" - -! set pointers to subroutines -! - riemann => riemann_srmhd_adi_hll + if (verbose) then + write(*,*) + write(*,"(1x,a)") "ERROR!" + write(*,"(1x,a)") "The selected Riemann solver implemented " // & + "for adiabatic SR-MHD: '" // trim(solver) // "'." + write(*,"(1x,a)") "Available Riemann solvers: 'hll', 'hllc'." + end if + status = 1 end select @@ -520,11 +580,11 @@ module schemes ! ! Arguments: ! -! iret - an integer flag for error return value; +! status - an integer flag for error return value; ! !=============================================================================== ! - subroutine finalize_schemes(iret) + subroutine finalize_schemes(status) ! local variables are not implicit by default ! @@ -532,7 +592,7 @@ module schemes ! subroutine arguments ! - integer, intent(inout) :: iret + integer, intent(out) :: status ! !------------------------------------------------------------------------------- ! @@ -542,6 +602,10 @@ module schemes call start_timer(imi) #endif /* PROFILE */ +! reset the status flag +! + status = 0 + ! nullify procedure pointers ! nullify(update_flux)