SCHEMES: Make initialize_schemes() resistant to wrong parameters.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
5e7b0962bc
commit
db1d3c6d4f
@ -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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user