gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into reconnection

Browse Source
This commit is contained in:
Grzegorz Kowal 2019-01-30 15:41:54 -02:00
commit 6087e1b833
13 changed files with 997 additions and 630 deletions

18
sources/blocks.F90

@ -372,12 +372,13 @@ module blocks
!
! Arguments:
!
! bdims - block dimensions;
! verbose - flag determining if the subroutine should be verbose;
! iret - return flag of the procedure execution status;
!
!===============================================================================
!
subroutine initialize_blocks(verbose, iret)
subroutine initialize_blocks(bdims, verbose, iret)
! local variables are not implicit by default
!
@ -385,8 +386,9 @@ module blocks
! subroutine arguments
!
logical, intent(in) :: verbose
integer, intent(inout) :: iret
integer, dimension(5), intent(in) :: bdims
logical , intent(in) :: verbose
integer , intent(inout) :: iret
!
!-------------------------------------------------------------------------------
!
@ -421,14 +423,14 @@ module blocks
! set the initial number of variables and fluxes
!
nvars = 1
nflux = 1
nvars = bdims(1)
nflux = bdims(2)
! set the initial data block resolution
!
nx = 1
ny = 1
nz = 1
nx = bdims(3)
ny = bdims(4)
nz = bdims(5)
! nullify pointers defining the meta and data lists
!

83
sources/boundaries.F90

@ -76,7 +76,7 @@ module boundaries
! declare public subroutines
!
public :: initialize_boundaries, finalize_boundaries
public :: initialize_boundaries, finalize_boundaries, print_boundaries
public :: boundary_variables, boundary_fluxes
public :: bnd_type, bnd_periodic
@ -279,23 +279,6 @@ module boundaries
call prepare_exchange_array()
#endif /* MPI */
! print information about the boundary conditions
!
if (verbose) then
write (*,*)
write (*,"(1x,a)") "Boundaries:"
write (*,"(4x,a10,13x,'=',2(1x,a))") "x-boundary" &
, trim(xlbndry), trim(xubndry)
write (*,"(4x,a10,13x,'=',2(1x,a))") "y-boundary" &
, trim(ylbndry), trim(yubndry)
#if NDIMS == 3
write (*,"(4x,a10,13x,'=',2(1x,a))") "z-boundary" &
, trim(zlbndry), trim(zubndry)
#endif /* NDIMS == 3 */
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -359,6 +342,70 @@ module boundaries
!
!===============================================================================
!
! subroutine INITIALIZE_BOUNDARIES:
! --------------------------------
!
! Subroutine initializes the module BOUNDARIES by setting its parameters.
!
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
! iret - return flag of the procedure execution status;
!
!===============================================================================
!
subroutine print_boundaries(verbose)
! import external procedures and variables
!
use parameters, only : get_parameter
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
character(len=32) :: xlbndry = "periodic"
character(len=32) :: xubndry = "periodic"
character(len=32) :: ylbndry = "periodic"
character(len=32) :: yubndry = "periodic"
character(len=32) :: zlbndry = "periodic"
character(len=32) :: zubndry = "periodic"
!
!-------------------------------------------------------------------------------
!
if (verbose) then
call get_parameter("xlbndry", xlbndry)
call get_parameter("xubndry", xubndry)
call get_parameter("ylbndry", ylbndry)
call get_parameter("yubndry", yubndry)
call get_parameter("zlbndry", zlbndry)
call get_parameter("zubndry", zubndry)
write(*,*)
write(*,"(1x,a)") "Boundaries:"
sfmts = "(4x,a10,13x,'=',2(1x,a))"
write(*,sfmts) "X-boundary", trim(xlbndry), trim(xubndry)
write(*,sfmts) "Y-boundary", trim(ylbndry), trim(yubndry)
#if NDIMS == 3
write(*,sfmts) "Z-boundary", trim(zlbndry), trim(zubndry)
#endif /* NDIMS == 3 */
end if
!-------------------------------------------------------------------------------
!
end subroutine print_boundaries
!
!===============================================================================
!
! subroutine BOUNDARY_VARIABLES:
! -----------------------------
!

148
sources/coordinates.F90

@ -184,14 +184,11 @@ module coordinates
! local variables
!
integer :: i, j, k, l, p, q, r, ff
integer :: fi, fj, fk
integer :: ni, nj, nk, nm, np, nr, nq, ns, nt, nu
logical :: info
! local arrays
!
integer(kind=4), dimension(3) :: cm, rm, dm
character(len=32) :: lbndry, ubndry
integer :: i, j, k, l, p, q, r, ff
integer :: fi, fj, fk
integer :: ni, nj, nk, nm, np, nr, nq, ns, nt, nu
logical :: info
!
!-------------------------------------------------------------------------------
!
@ -256,6 +253,26 @@ module coordinates
keu = ke + 1
#endif /* NDIMS == 3 */
! determine domain periodicity
!
lbndry = "periodic"
ubndry = "periodic"
call get_parameter("xlbndry", lbndry)
call get_parameter("xubndry", ubndry)
periodic(1) = lbndry == "periodic" .and. ubndry == "periodic"
lbndry = "periodic"
ubndry = "periodic"
call get_parameter("ylbndry", lbndry)
call get_parameter("yubndry", ubndry)
periodic(2) = lbndry == "periodic" .and. ubndry == "periodic"
#if NDIMS == 3
lbndry = "periodic"
ubndry = "periodic"
call get_parameter("ylbndry", lbndry)
call get_parameter("yubndry", ubndry)
periodic(3) = lbndry == "periodic" .and. ubndry == "periodic"
#endif /* NDIMS == 3 */
! obtain the refinement level bounds
!
call get_parameter("minlev", minlev)
@ -726,46 +743,6 @@ module coordinates
end do ! k = 1, 2
#endif /* NDIMS == 3 */
! print general information about the level resolutions
!
if (verbose) then
! the base resolution
!
cm(1) = ir * in
cm(2) = jr * jn
cm(3) = kr * kn
! the effective resolution
!
ff = 2**(maxlev - 1)
rm(1) = cm(1) * ff
rm(2) = cm(2) * ff
rm(3) = cm(3) * ff
! the top level block division
!
dm(1) = rm(1) / in
dm(2) = rm(2) / jn
dm(3) = rm(3) / kn
! obtain the maximum number of block
!
ff = product(dm(1:NDIMS))
! print info
!
write(*,*)
write(*,"(1x,a)") "Geometry:"
write(*,"(4x,a, 1x,i6 )" ) "refinement to level =", toplev
write(*,"(4x,a,3(1x,i6 ))") "base configuration =", ir, jr, kr
write(*,"(4x,a,3(1x,i6 ))") "top level blocks =", dm(1:NDIMS)
write(*,"(4x,a, 3x,i18)" ) "maximum cover blocks =", ff
write(*,"(4x,a,3(1x,i6 ))") "base resolution =", cm(1:NDIMS)
write(*,"(4x,a,3(1x,i6 ))") "effective resolution =", rm(1:NDIMS)
end if ! verbose
!-------------------------------------------------------------------------------
!
end subroutine initialize_coordinates
@ -812,6 +789,81 @@ module coordinates
!-------------------------------------------------------------------------------
!
end subroutine finalize_coordinates
!
!===============================================================================
!
! subroutine PRINT_COORDINATES:
! ----------------------------
!
! Subroutine print module parameters.
!
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
!
!===============================================================================
!
subroutine print_coordinates(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=80) :: sfmts
integer :: p, q
! local arrays
!
integer(kind=4), dimension(3) :: bm, rm, cm, fm
!
!-------------------------------------------------------------------------------
!
if (verbose) then
! the base and top level block dimensions, and the base and effective resolution
!
bm(:) = (/ ir, jr, kr /)
rm(:) = bm(:) * 2**(maxlev - 1)
cm(:) = bm(:) * nc
fm(:) = rm(:) * nc
write(*,*)
write(*,"(1x,a)") "Geometry:"
sfmts = "(4x,a,1x,i0)"
write(*,sfmts) "refinement to level =", maxlev
write(*,sfmts) "number of block cells =", nc
write(*,sfmts) "number of ghost zones =", ng
write(sfmts,"(i0)") maxval(fm(1:NDIMS))
p = len(trim(adjustl(sfmts)))
write(sfmts,"(i0)") maxval(rm(1:NDIMS))
q = len(trim(adjustl(sfmts)))
#if NDIMS == 3
write(sfmts,'(6(a,i0),a)') "(4x,a,1x,i", p, ",' x ',i", p, ",' x ',i", p,&
",' (',i", q, ",' x ',i", q, ",' x ',i", q, ",' blocks)')"
#else /* NDIMS == 3 */
write(sfmts,'(4(a,i0),a)') "(4x,a,1x,i", p, ",' x ',i", p, &
",' (',i", q, ",' x ',i", q, ",' blocks)')"
#endif /* NDIMS == 3 */
write(*,sfmts) "base resolution =", cm(1:NDIMS), bm(1:NDIMS)
write(*,sfmts) "effective resolution =", fm(1:NDIMS), rm(1:NDIMS)
sfmts = "(4x,a,1x,1es12.5,1x,'...',1x,1es12.5)"
write(*,sfmts) "X-bounds =", xmin, xmax
write(*,sfmts) "Y-bounds =", ymin, ymax
#if NDIMS == 3
write(*,sfmts) "Z-bounds =", zmin, zmax
#endif /* NDIMS */
end if
!-------------------------------------------------------------------------------
!
end subroutine print_coordinates
!===============================================================================
!

61
sources/domains.F90

@ -34,9 +34,16 @@ module domains
!
implicit none
! module variable to store the problem name
! interfaces for procedure pointers
!
character(len=32), save :: problem = "blast"
abstract interface
subroutine setup_domain_iface()
end subroutine
end interface
! pointer to the problem setup subroutine
!
procedure(setup_domain_iface), pointer, save :: setup_domain => null()
! by default everything is private
!
@ -44,7 +51,8 @@ module domains
! declare public subroutines
!
public :: initialize_domains, setup_domain
public :: initialize_domains, finalize_domains
public :: setup_domain
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@ -63,10 +71,15 @@ module domains
!
! Subroutine prepares module DOMAINS.
!
! Arguments:
!
! problem - the problem name
! verbose - a logical flag turning the information printing;
! iret - an integer flag for error return value;
!
!===============================================================================
!
subroutine initialize_domains()
subroutine initialize_domains(problem, verbose, iret)
! include external procedures and variables
!
@ -75,12 +88,24 @@ module domains
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
character(len=64), intent(in) :: problem
logical , intent(in) :: verbose
integer , intent(inout) :: iret
!
!-------------------------------------------------------------------------------
!
! get the problem name
! associate the setup_domain pointer with the respective problem setup
! subroutine
!
call get_parameter("problem", problem)
select case(trim(problem))
case default
setup_domain => setup_domain_default
end select
!-------------------------------------------------------------------------------
!
@ -88,33 +113,33 @@ module domains
!
!===============================================================================
!
! subroutine SETUP_DOMAIN:
! -----------------------
! subroutine FINALIZE_DOMAINS:
! ---------------------------
!
! Subroutine sets up the domain for selected problem. If there is no special
! domain required, sets up the default domain.
! Subroutine releases memory used by the module.
!
! Arguments:
!
! iret - an integer flag for error return value;
!
!===============================================================================
!
subroutine setup_domain()
subroutine finalize_domains(iret)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
integer, intent(inout) :: iret
!
!-------------------------------------------------------------------------------
!
! select the domain setup depending on the problem name
!
select case(problem)
case default
call setup_domain_default()
end select
!-------------------------------------------------------------------------------
!
end subroutine setup_domain
end subroutine finalize_domains
!
!===============================================================================
!!

345
sources/driver.F90

@ -38,20 +38,28 @@ program amun
use blocks , only : initialize_blocks, finalize_blocks, get_nleafs
use blocks , only : build_leaf_list
use boundaries , only : initialize_boundaries, finalize_boundaries
use boundaries , only : boundary_variables
use boundaries , only : print_boundaries, boundary_variables
use coordinates , only : initialize_coordinates, finalize_coordinates
use coordinates , only : print_coordinates
use coordinates , only : im, jm, km
use domains , only : initialize_domains, finalize_domains
use equations , only : initialize_equations, finalize_equations
use equations , only : print_equations
use equations , only : nv
use evolution , only : initialize_evolution, finalize_evolution
use evolution , only : print_evolution
use evolution , only : advance, new_time_step
use evolution , only : step, time, dt
use gravity , only : initialize_gravity, finalize_gravity
use integrals , only : initialize_integrals, finalize_integrals
use integrals , only : store_integrals
use interpolations , only : initialize_interpolations, finalize_interpolations
use io , only : initialize_io, finalize_io
use io , only : restart_from_snapshot, read_snapshot_parameter
use interpolations , only : print_interpolations
use io , only : initialize_io, finalize_io, print_io
use io , only : restart_snapshot_number, restart_from_snapshot
use io , only : read_snapshot_parameter
use io , only : read_restart_snapshot, write_restart_snapshot
use io , only : write_snapshot, next_tout
use io , only : write_snapshot, next_tout, precise_snapshots
use mesh , only : initialize_mesh, finalize_mesh
use mesh , only : generate_mesh, store_mesh_stats
use mpitools , only : initialize_mpitools, finalize_mpitools
@ -69,9 +77,12 @@ program amun
use problems , only : initialize_problems, finalize_problems
use random , only : initialize_random, finalize_random
use refinement , only : initialize_refinement, finalize_refinement
use refinement , only : print_refinement
use schemes , only : initialize_schemes, finalize_schemes
use shapes , only : initialize_shapes, finalize_shapes
use schemes , only : print_schemes
use shapes , only : initialize_shapes, finalize_shapes, print_shapes
use sources , only : initialize_sources, finalize_sources
use sources , only : print_sources
use timers , only : initialize_timers, finalize_timers
use timers , only : start_timer, stop_timer, set_timer, get_timer
use timers , only : get_timer_total, timer_enabled, timer_description
@ -82,10 +93,9 @@ program amun
!
implicit none
! flat to identify if the problem is run from scratch or restarted
! the number of restarted runs
!
logical :: job_restart = .false.
integer :: nres = 0
integer :: nrun = 0
! default parameters
!
@ -103,11 +113,6 @@ program amun
real(kind=8) :: tmax = 0.0d+00, trun = 9.999d+03, tsav = 3.0d+01
real(kind=8) :: dtnext = 0.0d+00
! flag to adjust time precisely to the snapshots
!
logical , save :: precise_snapshots = .false.
character(len=255) :: prec_snap = "off"
! the termination and status flags
!
integer :: iterm, iret
@ -119,10 +124,6 @@ program amun
integer :: ipr, ipi
#endif /* PROFILE */
! local snapshot file counters
!
integer :: nrun = 1
! iteration and time variables
!
integer :: i, ed, eh, em, es, ec
@ -214,27 +215,27 @@ program amun
!
if (iret > 0) then
call stop_timer(iin)
go to 500
go to 400
end if
! print the welcome message
!
if (master) then
write (*,"(1x,78('-'))")
write (*,"(1x,18('='),17x,a,17x,19('='))") 'A M U N'
write (*,"(1x,16('='),4x,a,4x,16('='))") &
'Copyright (C) 2008-2019 Grzegorz Kowal'
write (*,"(1x,18('='),9x,a,9x,19('='))") &
write(*,"(1x,78('-'))")
write(*,"(1x,18('='),17x,a,17x,19('='))") 'A M U N'
write(*,"(1x,16('='),4x,a,4x,16('='))") &
'Copyright (C) 2008-2019 Grzegorz Kowal'
write(*,"(1x,18('='),9x,a,9x,19('='))") &
'under GNU GPLv3 license'
write (*,"(1x,78('-'))")
write(*,"(1x,78('-'))")
#ifdef MPI
! print the parallelization type and the number of parallel processes
!
write (*,*)
write (*,"(1x,a)" ) "Parallelization:"
write (*,"(4x,a,1x,i6 )" ) "MPI processes =", nprocs
write(*,*)
write(*,"(1x,a)") "Parallelization:"
write(*,"(4x,a,1x,i0)") "MPI processes =", nprocs
#endif /* MPI */
end if
@ -255,7 +256,7 @@ program amun
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") "Problem reading parameters!"
end if
go to 400
go to 300
end if
#ifdef MPI
@ -274,19 +275,23 @@ program amun
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem broadcasting parameters!"
end if
go to 400
go to 300
end if
#endif /* MPI */
! check if the job is restarted
! initialize IO to handle restart snapshots if necessary
!
call get_parameter("restart_number", nres)
job_restart = nres > 0
call initialize_io(master, iret)
if (iret > 0) go to 200
! get the run number
!
nrun = max(1, restart_snapshot_number() + 1)
! if the run is from a restarted job, read the fixed parameters from
! the restart snapshot, otherwise, read them from the parameter file
!
if (job_restart) then
if (restart_from_snapshot()) then
call read_snapshot_parameter("problem", problem, iret)
call read_snapshot_parameter("eqsys" , eqsys , iret)
call read_snapshot_parameter("eos" , eos , iret)
@ -339,125 +344,67 @@ program amun
!
dtnext = 2.0d+00 * tmax
! get the precise snapshot flag
!
call get_parameter("precise_snapshots", prec_snap)
! set the precise snapshot flag
!
if (prec_snap == "on" ) precise_snapshots = .true.
if (prec_snap == "ON" ) precise_snapshots = .true.
if (prec_snap == "true") precise_snapshots = .true.
if (prec_snap == "TRUE") precise_snapshots = .true.
if (prec_snap == "yes" ) precise_snapshots = .true.
if (prec_snap == "YES" ) precise_snapshots = .true.
! get integral calculation interval
!
call get_parameter("ndat" , ndat)
! initialize the random number generator (passes the number of OpenMP threads
! and the current thread number)
! initialize the remaining modules
!
call initialize_random(1, 0)
! initialize module USER_PROBLEM
!
call initialize_user_problem(problem, master, iret)
if (iret > 0) go to 340
! initialize module PROBLEMS
!
call initialize_problems(problem, master, iret)
if (iret > 0) go to 320
! initialize module EQUATIONS
!
if (iret > 0) go to 190
call initialize_equations(eqsys, eos, master, iret)
if (iret > 0) go to 300
! initialize module SOURCES
!
call initialize_sources(master, iret)
if (iret > 0) go to 280
! initialize module GRAVITY
!
call initialize_gravity(master, iret)
if (iret > 0) go to 260
! initialize module COORDINATES
!
if (iret > 0) go to 180
call initialize_coordinates(ncells, nghosts, toplev, bdims, xmin, xmax, &
ymin, ymax, zmin, zmax, master, iret)
if (iret > 0) go to 240
! initialize block module
!
call initialize_blocks(master, iret)
if (iret > 0) go to 220
! initialize boundaries
!
call initialize_boundaries(master, iret)
if (iret > 0) go to 200
! initialize module REFINEMENT
!
call initialize_refinement(master, iret)
if (iret > 0) go to 180
! initialize module SHAPES
!
call initialize_shapes(master, iret)
if (iret > 0) go to 170
call initialize_blocks((/ nv, nv, im, jm, km /), master, iret)
if (iret > 0) go to 160
! initialize evolution
!
call initialize_evolution(master, iret)
if (iret > 0) go to 140
! initialize module SCHEMES
!
call initialize_schemes(master, iret)
if (iret > 0) go to 120
! initialize module INTERPOLATIONS
!
call initialize_interpolations(master, iret)
if (iret > 0) go to 100
! initialize module OPERATORS
!
call initialize_operators(master, iret)
if (iret > 0) go to 150
call initialize_sources(master, iret)
if (iret > 0) go to 140
call initialize_user_problem(problem, master, iret)
if (iret > 0) go to 130
call initialize_problems(problem, master, iret)
if (iret > 0) go to 120
call initialize_domains(problem, master, iret)
if (iret > 0) go to 110
call initialize_boundaries(master, iret)
if (iret > 0) go to 100
call initialize_refinement(master, iret)
if (iret > 0) go to 90
call initialize_mesh(nrun, master, iret)
if (iret > 0) go to 80
! initialize boundaries module and print info
!
if (master) then
write (*,*)
write (*,"(1x,a)" ) "Snapshots:"
write (*,"(4x,a22,1x,'=',1x,a)") "precise snapshot times", trim(prec_snap)
end if
! initialize module IO
!
call initialize_io(master, nrun, iret)
call initialize_shapes(master, iret)
if (iret > 0) go to 70
call initialize_gravity(master, iret)
if (iret > 0) go to 60
call initialize_interpolations(master, iret)
if (iret > 0) go to 50
call initialize_schemes(master, iret)
if (iret > 0) go to 40
call initialize_evolution(master, iret)
if (iret > 0) go to 30
call initialize_integrals(master, nrun, iret)
if (iret > 0) go to 20
! print module information
!
call print_equations(master)
call print_sources(master)
call print_coordinates(master)
call print_boundaries(master)
call print_shapes(master)
call print_refinement(master)
call print_evolution(master)
call print_schemes(master)
call print_interpolations(master)
call print_io(master)
! check if we initiate new problem or restart previous job
!
if (restart_from_snapshot()) then
! increase the run number
!
nrun = nrun + 1
! initialize the mesh module
!
call initialize_mesh(nrun, master, iret)
if (iret > 0) go to 40
! reconstruct the meta and data block structures from a given restart file
!
call read_restart_snapshot(iterm)
@ -470,7 +417,7 @@ program amun
! quit if there was a problem with reading restart snapshots
!
if (iterm > 0) go to 40
if (iterm > 0) go to 10
! update the list of leafs
!
@ -478,11 +425,6 @@ program amun
else
! initialize the mesh module
!
call initialize_mesh(nrun, master, iret)
if (iret > 0) go to 40
! generate the initial mesh, refine that mesh to the desired level according to
! the initialized problem
!
@ -498,11 +440,6 @@ program amun
end if
! initialize the integrals module
!
call initialize_integrals(master, nrun, iret)
if (iret > 0) go to 20
! store mesh statistics
!
call store_mesh_stats(step, time)
@ -688,100 +625,52 @@ program amun
! a label to go to if there are any problems, but since all modules have been
! initialized, we have to finalize them first
!
10 continue
10 continue
! start time accounting for the termination
!
call start_timer(itm)
! finalize integrals module
! finalize modules
!
20 continue
call finalize_integrals()
! finalize the mesh module
!
40 continue
call finalize_mesh(iret)
! finalize I/O module
!
60 continue
call finalize_io(iret)
! finalize module OPERATORS
!
80 continue
call finalize_operators(iret)
! finalize module INTERPOLATIONS
!
100 continue
call finalize_interpolations(iret)
! finalize module SCHEMES
!
120 continue
call finalize_schemes(iret)
! finalize module EVOLUTION
!
140 continue
30 continue
call finalize_evolution(iret)
! finalize module SHAPES
!
160 continue
call finalize_shapes(iret)
! finalize module REFINEMENT
!
180 continue
call finalize_refinement(iret)
! finalize module BOUNDARIES
!
200 continue
call finalize_boundaries(iret)
! deallocate block structure
!
220 continue
call finalize_blocks(iret)
! finalize module COORDINATES
!
240 continue
call finalize_coordinates(iret)
! finalize module GRAVITY
!
260 continue
40 continue
call finalize_schemes(iret)
50 continue
call finalize_interpolations(iret)
60 continue
call finalize_gravity(iret)
! finalize module SOURCES
!
280 continue
call finalize_sources(iret)
! finalize module EQUATIONS
!
300 continue
call finalize_equations(iret)
! finalize module PROBLEMS
!
320 continue
70 continue
call finalize_shapes(iret)
80 continue
call finalize_mesh(iret)
90 continue
call finalize_refinement(iret)
100 continue
call finalize_boundaries(iret)
110 continue
call finalize_domains(iret)
120 continue
call finalize_problems(iret)
! finalize module USER_PROBLEMS
!
340 continue
130 continue
call finalize_user_problem(iret)
! finalize the random number generator
!
140 continue
call finalize_sources(iret)
150 continue
call finalize_operators(iret)
160 continue
call finalize_blocks(iret)
170 continue
call finalize_coordinates(iret)
180 continue
call finalize_equations(iret)
190 continue
call finalize_random()
200 continue
call finalize_io(iret)
! stop time accounting for the termination
!
@ -856,12 +745,12 @@ program amun
! finalize modules PARAMETERS
!
400 continue
300 continue
call finalize_parameters()
! finalize module MPITOOLS
!
500 continue
400 continue
call finalize_mpitools()
! finalize module TIMERS

129
sources/equations.F90

@ -133,9 +133,20 @@ module equations
character(len=32), save :: eqsys = "hydrodynamic"
character(len=32), save :: eos = "adiabatic"
! the flag indicating if the set of equations is relativistic or magnetized
!
logical , save :: relativistic = .false.
logical , save :: magnetized = .false.
! the variable conversion method
!
character(len=32), save :: c2p = "1Dw"
character(len=32), save :: c2p = "1Dw"
! the names of equations and methods
!
character(len=80), save :: name_eqsys = ""
character(len=80), save :: name_eos = ""
character(len=80), save :: name_c2p = ""
! direction indices
!
@ -213,14 +224,14 @@ module equations
! declare public variables and subroutines
!
public :: initialize_equations, finalize_equations
public :: initialize_equations, finalize_equations, print_equations
public :: prim2cons, cons2prim
public :: fluxspeed
public :: maxspeed, reset_maxspeed, get_maxspeed
public :: eigensystem_roe
public :: update_primitive_variables
public :: fix_unphysical_cells, correct_unphysical_states
public :: gamma
public :: gamma, magnetized
public :: csnd, csnd2
public :: cmax, cmax2
public :: nv
@ -249,12 +260,14 @@ module equations
!
! Arguments:
!
! system - the equation system
! state - the equation of state
! verbose - a logical flag turning the information printing;
! iret - an integer flag for error return value;
!
!===============================================================================
!
subroutine initialize_equations(teqs, teos, verbose, iret)
subroutine initialize_equations(system, state, verbose, iret)
! include external procedures and variables
!
@ -266,18 +279,14 @@ module equations
! subroutine arguments
!
character(len=32), intent(in) :: teqs, teos
character(len=32), intent(in) :: system, state
logical , intent(in) :: verbose
integer , intent(inout) :: iret
! local variables
!
logical :: relativistic = .false.
integer :: p
character(len=255) :: name_eqsys = ""
character(len=255) :: name_eos = ""
character(len=255) :: name_c2p = ""
character(len=255) :: unphysical_fix = "off"
integer :: p
character(len=32) :: unphysical_fix = "off"
!
!-------------------------------------------------------------------------------
!
@ -298,11 +307,11 @@ module equations
! set the system of equations
!
eqsys = teqs
eqsys = system
! set the equation of state
!
eos = teos
eos = state
! get the primitive variable solver
!
@ -430,6 +439,10 @@ module equations
name_eqsys = "MHD"
eqsys = "mhd"
! set magnetized flag
!
magnetized = .true.
! initialize the number of variables (density + 3 components of velocity
! + 3 components of magnetic field)
!
@ -681,6 +694,10 @@ module equations
!
relativistic = .true.
! set magnetized flag
!
magnetized = .true.
! initialize the number of variables (density + 3 components of velocity
! + 3 components of magnetic field
! + magnetic divergence potential)
@ -923,26 +940,6 @@ module equations
ngavg = max(1, ngavg)
npavg = max(2, npavg)
! print information about the equation module
!
if (verbose) then
write (*,*)
write (*,"(1x,a)") "Physics:"
write (*,"(4x,a,1x,a)") "equation system =", trim(name_eqsys)
write (*,"(4x,a,1x,a)") "equation of state =", trim(name_eos)
if (relativistic) then
write (*,"(4x,a,1x,a)") "variable conversion =", trim(name_c2p)
end if
write (*,"(4x,a20, 3x,'=',1x,a)") "fix unphysical cells" &
, trim(unphysical_fix)
if (fix_unphysical_cells) then
write (*,"(4x,a20, 3x,'=',1x,i4)") "ngavg ", ngavg
write (*,"(4x,a20, 3x,'=',1x,i4)") "npavg ", npavg
end if
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -1017,6 +1014,72 @@ module equations
!
!===============================================================================
!
! subroutine PRINT_EQUATIONS:
! --------------------------
!
! Subroutine prints module parameters.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_equations(verbose)
! include external procedures and variables
!
use parameters, only : get_parameter
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts, sfmti
!
!-------------------------------------------------------------------------------
!
! print information about the equation module
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Physics:"
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "equation system =", trim(name_eqsys)
write(*,sfmts) "equation of state =", trim(name_eos)
sfmti = "(4x,a,1x,i0)"
write(*,sfmti) "number of variables =", nv
write(sfmti,"(a,i0,a)") "(4x,a,", nv, "(1x,a))"
write(*,sfmti) "conservative variables =", cvars
write(*,sfmti) "primitive variables =", pvars
if (relativistic) then
write(*,sfmts) "variable conversion =", trim(name_c2p)
end if
sfmts = "(4x,a20,3x,'=',1x,a)"
if (fix_unphysical_cells) then
write(*,sfmts) "fix unphysical cells", "on"
sfmti = "(4x,a20,3x,'=',1x,i0)"
write(*,sfmti) "ngavg ", ngavg
write(*,sfmti) "npavg ", npavg
else
write(*,sfmts) "fix unphysical cells", "off"
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_equations
!
!===============================================================================
!
! subroutine RESET_MAXSPEED:
! -------------------------
!

81
sources/evolution.F90

@ -60,20 +60,21 @@ module evolution
! evolution parameters
!
real(kind=8), save :: cfl = 5.0d-01
integer , save :: stages = 2
character(len=255), save :: name_int = ""
integer , save :: stages = 2
real(kind=8) , save :: cfl = 5.0d-01
! coefficient controlling the decay of scalar potential ѱ
!
real(kind=8), save :: alpha = 2.0d+00
real(kind=8), save :: decay = 1.0d+00
real(kind=8) , save :: alpha = 2.0d+00
real(kind=8) , save :: decay = 1.0d+00
! time variables
!
integer , save :: step = 0
real(kind=8), save :: time = 0.0d+00
real(kind=8), save :: dt = 1.0d+00
real(kind=8), save :: dtn = 1.0d+00
integer , save :: step = 0
real(kind=8) , save :: time = 0.0d+00
real(kind=8) , save :: dt = 1.0d+00
real(kind=8) , save :: dtn = 1.0d+00
! by default everything is private
!
@ -81,7 +82,7 @@ module evolution
! declare public subroutines
!
public :: initialize_evolution, finalize_evolution
public :: initialize_evolution, finalize_evolution, print_evolution
public :: advance, new_time_step
! declare public variables
@ -130,7 +131,6 @@ module evolution
! local variables
!
character(len=255) :: integration = "rk2"
character(len=255) :: name_int = ""
!
!-------------------------------------------------------------------------------
!
@ -211,16 +211,6 @@ module evolution
!
decay = exp(- alpha * cfl)
! print information about the Riemann solver
!
if (verbose) then
write (*,*)
write (*,"(1x,a)") "Methods:"
write (*,"(4x,a,1x,a)") "time advance =", trim(name_int)
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -278,6 +268,57 @@ module evolution
!
!===============================================================================
!
! subroutine PRINT_EVOLUTION:
! --------------------------
!
! Subroutine prints module parameters.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_evolution(verbose)
! import external procedures and variables
!
use equations, only : magnetized
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
!
!-------------------------------------------------------------------------------
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Evolution:"
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "time advance =", trim(name_int)
sfmts = "(4x,a,es9.2)"
write(*,sfmts) "CFL coefficient =", cfl
if (magnetized) then
write(*,sfmts) "GLM alpha coefficient =", alpha
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_evolution
!
!===============================================================================
!
! subroutine ADVANCE:
! ------------------
!

88
sources/interpolations.F90

@ -77,6 +77,13 @@ module interpolations
procedure(limiter_iface) , pointer, save :: limiter_prol => null()
procedure(limiter_iface) , pointer, save :: limiter_clip => null()
! method names
!
character(len=255), save :: name_rec = ""
character(len=255), save :: name_tlim = ""
character(len=255), save :: name_plim = ""
character(len=255), save :: name_clim = ""
! module parameters
!
real(kind=8), save :: eps = epsilon(1.0d+00)
@ -123,6 +130,7 @@ module interpolations
! declare public subroutines
!
public :: initialize_interpolations, finalize_interpolations
public :: print_interpolations
public :: interfaces, reconstruct, limiter_prol
public :: fix_positivity
@ -166,10 +174,6 @@ module interpolations
character(len=255) :: mlp_limiting = "off"
character(len=255) :: positivity_fix = "off"
character(len=255) :: clip_extrema = "off"
character(len=255) :: name_rec = ""
character(len=255) :: name_tlim = ""
character(len=255) :: name_plim = ""
character(len=255) :: name_clim = ""
character(len= 16) :: stmp
real(kind=8) :: cfl = 0.5d+00
@ -467,22 +471,6 @@ module interpolations
clip = .false.
end select
! print informations about the reconstruction methods and parameters
!
if (verbose) then
write (*,"(4x,a14, 9x,'=',1x,a)") "reconstruction" , trim(name_rec)
write (*,"(4x,a11,12x,'=',1x,a)") "TVD limiter" , trim(name_tlim)
write (*,"(4x,a20, 3x,'=',1x,a)") "prolongation limiter", trim(name_plim)
write (*,"(4x,a12,11x,'=',1x,a)") "MLP limiting" , trim(mlp_limiting)
write (*,"(4x,a14, 9x,'=',1x,a)") "fix positivity" , trim(positivity_fix)
write (*,"(4x,a12,11x,'=',1x,a)") "clip extrema" , trim(clip_extrema)
if (clip) then
write (*,"(4x,a15,8x,'=',1x,a)") "extrema limiter", trim(name_clim)
end if
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -546,6 +534,66 @@ module interpolations
!
!===============================================================================
!
! subroutine PRINT_INTERPOLATIONS:
! -------------------------------
!
! Subroutine prints module parameters and settings.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_interpolations(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
!
!-------------------------------------------------------------------------------
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Interpolations:"
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "reconstruction =", trim(name_rec)
write(*,sfmts) "TVD limiter =", trim(name_tlim)
write(*,sfmts) "prolongation limiter =", trim(name_plim)
if (mlp) then
write(*,sfmts) "MLP limiting =", "on"
else
write(*,sfmts) "MLP limiting =", "off"
end if
if (positivity) then
write(*,sfmts) "fix positivity =", "on"
else
write(*,sfmts) "fix positivity =", "off"
end if
if (clip) then
write(*,sfmts) "clip extrema =", "on"
write(*,sfmts) "extrema limiter =", trim(name_clim)
else
write(*,sfmts) "clip extrema =", "off"
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_interpolations
!
!===============================================================================
!
! subroutine PREPARE_MGP:
! ---------------------
!

383
sources/io.F90

@ -124,6 +124,7 @@ module io
!
character(len=255), save :: respath = "./"
character , save :: ftype = "p"
character(len=64) , save :: ftype_name = "primitive"
integer , save :: nrest = -1
integer(kind=4) , save :: irest = 1
integer(kind=4) , save :: isnap = 0
@ -132,6 +133,10 @@ module io
real(kind=8) , save :: hsnap = 1.0d+00
real(kind=8) , save :: tsnap = 0.0d+00
! flag indicating to store snapshots at exact intervals
!
logical , save :: precise_snapshots = .false.
! flags to determine the way of data writing
!
logical , save :: with_ghosts = .true.
@ -141,10 +146,18 @@ module io
logical , save :: with_xdmf = .false.
#ifdef HDF5
! compression type
!
integer , parameter :: H5Z_DEFLATE = 1, H5Z_ZSTANDARD = 32015
! compression type (0 for no compressions, 1 for deflate, 32015 for zstandard)
!
integer , save :: compression = 0
! compression level
!
integer , save :: clevel = 0
! HDF5 property object identifier
!
integer(hid_t) , save :: pid
@ -164,11 +177,11 @@ module io
! declare public subroutines
!
public :: initialize_io, finalize_io
public :: initialize_io, finalize_io, print_io
public :: restart_snapshot_number, restart_from_snapshot
public :: read_snapshot_parameter
public :: read_restart_snapshot, write_restart_snapshot, write_snapshot
public :: restart_from_snapshot
public :: next_tout
public :: next_tout, precise_snapshots
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
@ -190,12 +203,11 @@ module io
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
! irun - job execution counter;
! iret - return flag of the procedure execution status;
!
!===============================================================================
!
subroutine initialize_io(verbose, irun, iret)
subroutine initialize_io(verbose, iret)
! import external procedures
!
@ -215,26 +227,17 @@ module io
! subroutine arguments
!
logical, intent(in) :: verbose
integer, intent(inout) :: irun, iret
integer, intent(inout) :: iret
! local variables
!
character(len=255) :: ghosts = "on"
character(len=255) :: xdmf = "off"
integer :: dd, hh, mm, ss
character(len=255) :: precise = "off"
character(len=255) :: ghosts = "on"
character(len=255) :: xdmf = "off"
#ifdef HDF5
logical :: status = .false.
integer :: err
integer(hsize_t) :: cd_nelmts = 1
integer, dimension(1) :: cd_values = 3
! compression level
!
integer :: clevel = 0
! local parameters
!
integer, parameter :: H5Z_DEFLATE = 1, H5Z_ZSTANDARD = 32015
#endif /* HDF5 */
! local parameters
@ -256,25 +259,39 @@ module io
call start_timer(ioi)
#endif /* PROFILE */
! get restart parameters
! get module parameters
!
call get_parameter("restart_path" , respath)
call get_parameter("restart_number" , nrest )
call get_parameter("restart_interval" , hrest )
! get the interval between snapshots
!
call get_parameter("snapshot_type" , ftype )
call get_parameter("snapshot_interval", hsnap )
! get the flag determining if the ghost cells are stored
!
call get_parameter("precise_snapshots", precise)
call get_parameter("include_ghosts" , ghosts )
! get the flag determining if the XDMF files should be generated
!
call get_parameter("generate_xdmf" , xdmf )
! check the snapshot type
!
select case(ftype)
case('c')
ftype_name = 'conservative variables'
case('p')
ftype_name = 'primitive variables'
case default
write(error_unit,"('[',a,']: ',a)") trim(loc) &
, "Snapshot type " // trim(ftype) // " is not suppoerted!"
iret = 1
end select
! check ghost cell storing flag
!
select case(trim(precise))
case ("off", "OFF", "n", "N", "false", "FALSE", "no", "NO")
precise_snapshots = .false.
case default
precise_snapshots = .true.
end select
! check ghost cell storing flag
!
select case(trim(ghosts))
@ -322,11 +339,11 @@ module io
!
status = .false.
if (.not. status) then
call h5zfilter_avail_f(H5Z_ZSTANDARD, status, err)
call h5zfilter_avail_f(H5Z_ZSTANDARD, status, iret)
if (status) compression = H5Z_ZSTANDARD
end if
if (.not. status) then
call h5zfilter_avail_f(H5Z_DEFLATE, status, err)
call h5zfilter_avail_f(H5Z_DEFLATE, status, iret)
if (status) compression = H5Z_DEFLATE
end if
@ -349,54 +366,6 @@ module io
end select
#endif /* HDF5 */
! return the run number
!
irun = max(1, nrest)
! print info about snapshot parameters
!
if (verbose) then
if (ftype == 'p') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "primitive variables"
if (ftype == 'c') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "conservative variables"
if (with_ghosts) then
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "off"
end if
#ifdef HDF5
select case(compression)
case(H5Z_ZSTANDARD)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "zstd"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case(H5Z_DEFLATE)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "deflate"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case default
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "none"
end select
#endif /* HDF5 */
if (with_xdmf) then
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "off"
end if
write (*,"(4x,a21,2x,'=',1x,es9.2)") "snapshot interval ", hsnap
if (hrest > 0.0d+00) then
dd = int(hrest / 2.4d+01)
hh = int(mod(hrest, 2.4d+01))
mm = int(mod(6.0d+01 * hrest, 6.0d+01))
ss = int(mod(3.6d+03 * hrest, 6.0d+01))
write (*,"(4x,a16,7x,'=',1x,i2.2,'d',i2.2,'h',i2.2,'m',i2.2,'s')") &
"restart interval", dd, hh, mm, ss
end if
if (restart_from_snapshot()) then
write (*,"(4x,a18,5x,'=',1x,'[',a,']')") "restart from path ", trim(respath)
write (*,"(4x,a21,2x,'=',1x,i4)") "restart from snapshot", nrest
end if
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -487,11 +456,121 @@ module io
!
!===============================================================================
!
! subroutine PRINT_IO:
! -------------------
!
! Subroutine prints IO parameters.
!
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
!
!===============================================================================
!
subroutine print_io(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts, sfmtc, sfmti
integer :: dd, hh, mm, ss
!
!-------------------------------------------------------------------------------
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Snapshots:"
sfmts = "(4x,a22,1x,'=',1x,a)"
if (precise_snapshots) then
write(*,sfmts) "precise snapshot times", "on"
else
write(*,sfmts) "precise snapshot times", "off"
end if
write(*,sfmts) "snapshot type ", ftype_name
if (with_ghosts) then
write(*,sfmts) "with ghosts cells ", "on"
else
write(*,sfmts) "with ghosts cells ", "off"
end if
sfmti = "(4x,a21,2x,'=',1x,i0)"
#ifdef HDF5
sfmtc = "(4x,a21,2x,'=',1x,a)"
select case(compression)
case(H5Z_ZSTANDARD)
write(*,sfmtc) "HDF5 compression ", "zstd"
write(*,sfmti) "compression level ", clevel
case(H5Z_DEFLATE)
write(*,sfmtc) "HDF5 compression ", "deflate"
write(*,sfmti) "compression level ", clevel
case default
write(*,sfmtc) "HDF5 compression ", "none"
end select
#endif /* HDF5 */
if (with_xdmf) then
write(*,sfmts) "generate XDMF files ", "on"
else
write(*,sfmts) "generate XDMF files ", "off"
end if
sfmtc = "(4x,a22,1x,'=',es9.2)"
write(*,sfmtc) "snapshot interval ", hsnap
if (hrest > 0.0d+00) then
dd = int(hrest / 2.4d+01)
hh = int(mod(hrest, 2.4d+01))
mm = int(mod(6.0d+01 * hrest, 6.0d+01))
ss = int(mod(3.6d+03 * hrest, 6.0d+01))
sfmtc = "(4x,a16,7x,'=',1x,i2.2,'d',i2.2,'h',i2.2,'m',i2.2,'s')"
write(*,sfmtc) "restart interval", dd, hh, mm, ss
end if
if (restart_from_snapshot()) then
sfmtc = "(4x,a18,5x,'=',1x,'[',a,']')"
write(*,sfmtc) "restart from path ", trim(respath)
write(*,sfmti) "restart from snapshot", nrest
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_io
!
!===============================================================================
!
! function RESTART_SNAPSHOT_NUMBER:
! --------------------------------
!
! Subroutine returns the number of restart snapshot.
!
!
!===============================================================================
!
integer function restart_snapshot_number()
! local variables are not implicit by default
!
implicit none
!
!-------------------------------------------------------------------------------
!
restart_snapshot_number = nrest
!-------------------------------------------------------------------------------
!
end function restart_snapshot_number
!
!===============================================================================
!
! function RESTART_FROM_SNAPSHOT:
! ------------------------------
!
! Subroutine returns true if the job was selected to be restarted from
! a snapshot.
! Subroutine returns true if the current job is the restarted one.
!
!
!===============================================================================
@ -778,7 +857,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_CHARACTER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -801,9 +879,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, tid, aid
integer(size_t) :: aln
@ -820,46 +896,37 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
aln = len(pvalue)
call h5tcopy_f(H5T_NATIVE_CHARACTER, tid, iret)
call h5tset_size_f(tid, aln, iret)
call h5aread_f(aid, tid, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
aln = len(pvalue)
call h5tcopy_f(H5T_NATIVE_CHARACTER, tid, iret)
call h5tset_size_f(tid, aln, iret)
call h5aread_f(aid, tid, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -894,7 +961,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_INTEGER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -916,9 +982,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -935,43 +999,34 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -1006,7 +1061,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_INTEGER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -1028,9 +1082,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -1047,44 +1099,35 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
am(1) = size(pvalue)
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
am(1) = size(pvalue)
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -1120,7 +1163,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_DOUBLE
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -1142,9 +1184,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -1161,43 +1201,34 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_DOUBLE, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_DOUBLE, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &

92
sources/refinement.F90

@ -69,7 +69,7 @@ module refinement
! declare public subroutines
!
public :: initialize_refinement, finalize_refinement
public :: initialize_refinement, finalize_refinement, print_refinement
public :: check_refinement_criterion
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -100,7 +100,7 @@ module refinement
! import external procedures and variables
!
use equations , only : nv, pvars, ibx
use equations , only : magnetized, nv, pvars
use parameters , only : get_parameter
! local variables are not implicit by default
@ -116,7 +116,6 @@ module refinement
!
integer :: p
character(len=255) :: variables = "dens pres"
character(len=255) :: rvars = ""
!
!-------------------------------------------------------------------------------
!
@ -154,34 +153,16 @@ module refinement
!
do p = 1, nv
qvar_ref(p) = index(variables, trim(pvars(p))) > 0
if (qvar_ref(p)) rvars = adjustl(trim(rvars) // ' ' // trim(pvars(p)))
end do ! p = 1, nv
! turn on refinement based on vorticity if specified
!
vort_ref = index(variables, 'vort') > 0
if (vort_ref) rvars = adjustl(trim(rvars) // ' vort')
! turn on refinement based on current density if specified
!
if (ibx > 0) then
if (magnetized) then
jabs_ref = index(variables, 'jabs') > 0
if (jabs_ref) rvars = adjustl(trim(rvars) // ' jabs')
end if
! print information about the refinement criterion
!
if (verbose) then
write (*,*)
write (*,"(1x,a)") "Refinement:"
write (*,"(4x,a,1x,a)" ) "refined variables =", trim(rvars)
write (*,"(4x,a,1x,2es9.2)") "2nd order error limits =", crefmin, crefmax
if (vort_ref) &
write (*,"(4x,a,1x,2es9.2)") "vorticity limits =", vortmin, vortmax
if (jabs_ref) &
write (*,"(4x,a,1x,2es9.2)") "current density limits =", jabsmin, jabsmax
end if
#ifdef PROFILE
@ -241,6 +222,73 @@ module refinement
!
!===============================================================================
!
! subroutine PRINT_REFINEMENT:
! ---------------------------
!
! Subroutine prints module parameters.
!
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
!
!===============================================================================
!
subroutine print_refinement(verbose)
! import external procedures and variables
!
use equations, only : magnetized, pvars, nv
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
character(len=255) :: rvars = ""
integer :: p
!
!-------------------------------------------------------------------------------
!
if (verbose) then
rvars = ""
do p = 1, nv
if (qvar_ref(p)) rvars = adjustl(trim(rvars) // ' ' // trim(pvars(p)))
end do
if (vort_ref) then
rvars = adjustl(trim(rvars) // ' vort')
end if
if (magnetized .and. jabs_ref) then
rvars = adjustl(trim(rvars) // ' jabs')
end if
write(*,*)
write(*,"(1x,a)") "Refinement:"
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "refined variables =", trim(rvars)
sfmts = "(4x,a,2es9.2)"
write(*,sfmts) "2nd order error limits =", crefmin, crefmax
if (vort_ref) then
write(*,sfmts) "vorticity limits =", vortmin, vortmax
end if
if (magnetized .and. jabs_ref) then
write(*,sfmts) "current density limits =", jabsmin, jabsmax
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_refinement
!
!===============================================================================
!
! function CHECK_REFINEMENT_CRITERION:
! -----------------------------------
!

61
sources/schemes.F90

@ -49,6 +49,11 @@ module schemes
integer , save :: imi, imf, ims, imr
#endif /* PROFILE */
! Rieman solver and state vectors names
!
character(len=255) , save :: name_sol = ""
character(len=255) , save :: name_sts = "primitive"
! 4-vector reconstruction flag
!
logical , save :: states_4vec = .false.
@ -85,7 +90,7 @@ module schemes
! declare public subroutines
!
public :: initialize_schemes, finalize_schemes
public :: initialize_schemes, finalize_schemes, print_schemes
public :: update_flux
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -131,8 +136,6 @@ module schemes
!
character(len=64) :: solver = "HLL"
character(len=64) :: statev = "primitive"
character(len=255) :: name_sol = ""
character(len=255) :: name_sts = "primitive"
!
!-------------------------------------------------------------------------------
!
@ -502,15 +505,6 @@ module schemes
end select
! print information about the Riemann solver
!
if (verbose) then
write (*,"(4x,a,1x,a)" ) "Riemann solver =", trim(name_sol)
write (*,"(4x,a,1x,a)" ) "state variables =", trim(name_sts)
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -568,6 +562,49 @@ module schemes
end subroutine finalize_schemes
!
!===============================================================================
!
! subroutine PRINT_SCHEMES:
! ------------------------
!
! Subroutine prints module parameters and settings.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_schemes(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
!
!-------------------------------------------------------------------------------
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Schemes:"
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "Riemann solver =", trim(name_sol)
write(*,sfmts) "state variables =", trim(name_sts)
end if
!-------------------------------------------------------------------------------
!
end subroutine print_schemes
!
!===============================================================================
!!
!!*** PRIVATE SUBROUTINES ****************************************************
!!

57
sources/shapes.F90

@ -61,13 +61,17 @@ module shapes
!
procedure(update_shapes_iface), pointer, save :: update_shapes => null()
! a flag to indicate if shapes are on
!
logical, save :: enabled = .false.
! by default everything is private
!
private
! declare public subroutines
!
public :: initialize_shapes, finalize_shapes
public :: initialize_shapes, finalize_shapes, print_shapes
public :: update_shapes
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -138,6 +142,10 @@ module shapes
select case(trim(enable_shapes))
case ("on", "ON", "t", "T", "y", "Y", "true", "TRUE", "yes", "YES")
! turn on the enable shape flag
!
enabled = .true.
! select the shape update subroutine depending on the problem
!
select case(trim(problem_name))
@ -162,14 +170,6 @@ module shapes
end select
! print information about the Riemann solver
!
if (verbose) then
write (*,"(4x,a,1x,a)") "embedded shapes =", trim(enable_shapes)
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -226,6 +226,45 @@ module shapes
end subroutine finalize_shapes
!
!===============================================================================
!
! subroutine PRINT_SHAPES:
! -----------------------
!
! Subroutine prints module parameters and settings.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_shapes(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
!
!-------------------------------------------------------------------------------
!
if (verbose) then
if (enabled) then
write (*,"(4x,a,1x,a)") "embedded shapes =", "on"
else
write (*,"(4x,a,1x,a)") "embedded shapes =", "off"
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_shapes
!
!===============================================================================
!!
!!*** PRIVATE SUBROUTINES ****************************************************
!!

81
sources/sources.F90

@ -47,15 +47,16 @@ module sources
! GLM-MHD source terms type (1 - EGLM, 2 - HEGLM)
!
integer , save :: glm_type = 0
integer , save :: glm_type = 0
character(len=32), save :: glm_name = "none"
! viscosity coefficient
!
real(kind=8), save :: viscosity = 0.0d+00
real(kind=8) , save :: viscosity = 0.0d+00
! resistivity coefficient
!
real(kind=8), save :: resistivity = 0.0d+00
real(kind=8) , save :: resistivity = 0.0d+00
! by default everything is private
!
@ -63,7 +64,7 @@ module sources
! declare public subroutines
!
public :: initialize_sources, finalize_sources
public :: initialize_sources, finalize_sources, print_sources
public :: update_sources
public :: viscosity, resistivity
@ -132,33 +133,24 @@ module sources
select case(trim(tglm))
case("eglm", "EGLM")
glm_type = 1
glm_name = "EGLM"
case("heglm", "HEGLM")
glm_type = 2
glm_name = "HEGLM"
case default
glm_type = 0
glm_name = "none"
end select
! get viscosity coefficient
!
call get_parameter("viscosity" , viscosity)
viscosity = max(0.0d+00, viscosity)
! get resistivity coefficient
!
call get_parameter("resistivity", resistivity)
! print information about the Riemann solver
!
if (verbose) then
write (*,*)
write (*,"(1x,a)") "Source terms:"
write (*,"(4x,a,1x,a) ") "glm source terms =", trim(tglm)
write (*,"(4x,a,1x,1es9.2)") "viscosity =", viscosity
write (*,"(4x,a,1x,1es9.2)") "resistivity =", resistivity
end if
resistivity = max(0.0d+00, resistivity)
#ifdef PROFILE
! stop accounting time for module initialization/finalization
@ -213,6 +205,59 @@ module sources
!
!===============================================================================
!
! subroutine PRINT_SOURCES:
! ------------------------
!
! Subroutine prints module parameters.
!
! Arguments:
!
! verbose - a logical flag turning the information printing;
!
!===============================================================================
!
subroutine print_sources(verbose)
! include external procedures
!
use equations, only : magnetized
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
character(len=64) :: sfmts
!
!-------------------------------------------------------------------------------
!
if (verbose) then
write(*,*)
write(*,"(1x,a)") "Source terms:"
if (magnetized) then
sfmts = "(4x,a,1x,a)"
write(*,sfmts) "glm source terms =", trim(glm_name)
end if
sfmts = "(4x,a,1es9.2)"
write(*,sfmts) "viscosity =", viscosity
if (magnetized) then
write(*,sfmts) "resistivity =", resistivity
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_sources
!
!===============================================================================
!
! subroutine UPDATE_SOURCES:
! -------------------------
!