gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
amun-code/sources/driver.F90
Grzegorz Kowal 22455676f4 USER_PROBLEM: Add user_time_statistics() to module USER_PROBLEM. 
This file can we use to calculate and store the user defined time
statistics.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
2021-10-26 09:00:03 -03:00

1034 lines
32 KiB
Fortran
Raw Blame History

!!******************************************************************************
!!
!! This file is part of the AMUN source code, a program to perform
!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or
!! adaptive mesh.
!!
!! Copyright (C) 2008-2021 Grzegorz Kowal <grzegorz@amuncode.org>
!!
!! This program 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 3 of the License, or
!! (at your option) any later version.
!!
!! This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
!!
!!******************************************************************************
!!
!! program: AMUN
!!
!! AMUN is a code to perform numerical simulations in a fluid approximation on
!! adaptive mesh for Newtonian and relativistic environments with or without
!! magnetic field.
!!
!!
!!******************************************************************************
!
program amun
! include external subroutines used in this module
!
use iso_fortran_env, only : error_unit
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 : print_boundaries, boundary_variables
use coordinates , only : initialize_coordinates, finalize_coordinates
use coordinates , only : print_coordinates
use coordinates , only : nn => bcells
use domains , only : initialize_domains, finalize_domains
use equations , only : initialize_equations, finalize_equations
use equations , only : print_equations
use equations , only : nv, nf
use evolution , only : initialize_evolution, finalize_evolution
use evolution , only : print_evolution
use evolution , only : advance, initialize_time_step, new_time_step
use evolution , only : registers, step, time, dt, dtp, errtol
use forcing , only : initialize_forcing, finalize_forcing
use forcing , only : print_forcing
use gravity , only : initialize_gravity, finalize_gravity
use helpers , only : print_welcome, print_section, print_parameter
use integrals , only : initialize_integrals, finalize_integrals
use integrals , only : store_integrals
use interpolations , only : initialize_interpolations, finalize_interpolations
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, update_dtp
use mesh , only : initialize_mesh, finalize_mesh
use mesh , only : generate_mesh, store_mesh_stats
use mpitools , only : initialize_mpitools, finalize_mpitools
#ifdef MPI
use mpitools , only : reduce_sum
#endif /* MPI */
use mpitools , only : master, nprocs, nproc, check_status
use operators , only : initialize_operators, finalize_operators
use parameters , only : read_parameters, finalize_parameters
use parameters , only : get_parameter
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 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
use timers , only : get_count, ntimers
use user_problem , only : user_time_statistics
! module variables are not implicit by default
!
implicit none
! the initialization success and status flags
!
logical :: initialization_succeeded
logical :: proceed = .true.
integer :: status = 0
integer :: quit
! the run number (for restarted runs)
!
integer :: nrun = 0
! default parameters
!
character(len=64) :: problem = "none"
character(len=32) :: eqsys = "hydrodynamic"
character(len=32) :: eos = "adiabatic"
integer :: ncells = 8
integer :: nghosts = 2
integer :: toplev = 1
integer, dimension(3) :: bdims = 1
integer :: nmax = huge(1), ndat = 1
real(kind=8) :: xmin = 0.0d+00, xmax = 1.0d+00
real(kind=8) :: ymin = 0.0d+00, ymax = 1.0d+00
real(kind=8) :: zmin = 0.0d+00, zmax = 1.0d+00
real(kind=8) :: tmax = 0.0d+00, trun = 9.999d+03, tsav = 3.0d+01
! timer indices
!
integer :: iin, iev, itm
#ifdef PROFILE
integer :: ipr, ipi
#endif /* PROFILE */
! iteration and time variables
!
integer :: i, ed, eh, em, es, ec
integer :: nsteps = 1
character(len=80) :: tmp
real(kind=8) :: tbeg = 0.0d+00, thrs
real(kind=8) :: tm_curr, tm_exec, tm_conv, tm_last = 0.0d+00
#ifndef __GFORTRAN__
! the type of the function SIGNAL should be defined for Intel compiler
!
integer(kind=4) :: signal
#endif /* __GFORTRAN__ */
#ifdef SIGNALS
! references to functions handling signals
!
#ifdef __GFORTRAN__
intrinsic signal
#endif /* __GFORTRAN__ */
external signal_handler
! signal definitions
!
integer, parameter :: SIGERR = -1
integer, parameter :: SIGINT = 2, SIGABRT = 6, SIGTERM = 15
#endif /* SIGNALS */
! an array to store execution times
!
real(kind=8), dimension(ntimers) :: tm
! common block
!
common /termination/ quit
!
!-------------------------------------------------------------------------------
!
! initialize local flags
!
quit = 0
! initialize module TIMERS
!
call initialize_timers()
! set timer descriptions
!
call set_timer('INITIALIZATION', iin)
call set_timer('EVOLUTION' , iev)
call set_timer('TERMINATION' , itm)
#ifdef SIGNALS
! assign function signal_handler() to handle signals
!
#ifdef __GFORTRAN__
if (signal(SIGINT , signal_handler) == SIGERR) status = 1
if (signal(SIGABRT, signal_handler) == SIGERR) status = 2
if (signal(SIGTERM, signal_handler) == SIGERR) status = 3
#else /* __GFORTRAN__ */
if (signal(SIGINT , signal_handler, -1) == SIGERR) status = 1
if (signal(SIGABRT, signal_handler, -1) == SIGERR) status = 2
if (signal(SIGTERM, signal_handler, -1) == SIGERR) status = 3
#endif /* __GFORTRAN__ */
! in the case of problems with signal handler assignment, quit the program
!
if (status /= 0) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing the signal handler!"
call finalize_timers()
call exit(1)
end if
#endif /* SIGNALS */
! initialize module MPITOOLS
!
call initialize_mpitools(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing MPITOOLS module!"
end if
go to 4000
end if
! set the initiallization success flag
!
initialization_succeeded = .false.
! start time accounting for the initialization
!
call start_timer(iin)
! print welcome messages
!
call print_welcome(master)
call print_section(master, "Parallelization")
#ifdef MPI
call print_parameter(master, "MPI processes", nprocs)
#endif /* MPI */
! initialize and read parameters from the parameter file
!
call read_parameters(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem reading parameters!"
end if
go to 3900
end if
! initialize IO early to handle restart snapshots if necessary
!
call initialize_io(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing IO module!"
end if
go to 3800
end if
! 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 (restart_from_snapshot()) then
call read_snapshot_parameter("problem", problem , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("eqsys" , eqsys , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("eos" , eos , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("ncells" , ncells , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("maxlev" , toplev , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("xblocks", bdims(1), status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("yblocks", bdims(2), status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("zblocks", bdims(3), status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("xmin" , xmin , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("xmax" , xmax , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("ymin" , ymin , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("ymax" , ymax , status)
if (check_status(status /= 0)) go to 3800
#if NDIMS == 3
call read_snapshot_parameter("zmin" , zmin , status)
if (check_status(status /= 0)) go to 3800
call read_snapshot_parameter("zmax" , zmax , status)
if (check_status(status /= 0)) go to 3800
#endif /* NDIMS == 3 */
else
call get_parameter("problem" , problem )
call get_parameter("equation_system" , eqsys )
call get_parameter("equation_of_state", eos )
call get_parameter("ncells" , ncells )
call get_parameter("maxlev" , toplev )
call get_parameter("xblocks" , bdims(1))
call get_parameter("yblocks" , bdims(2))
#if NDIMS == 3
call get_parameter("zblocks" , bdims(3))
#endif /* NDIMS == 3 */
call get_parameter("xmin" , xmin )
call get_parameter("xmax" , xmax )
call get_parameter("ymin" , ymin )
call get_parameter("ymax" , ymax )
#if NDIMS == 3
call get_parameter("zmin" , zmin )
call get_parameter("zmax" , zmax )
#endif /* NDIMS == 3 */
end if
! get the number of ghost zones
!
call get_parameter("nghosts", nghosts)
! get the execution termination parameters
!
call get_parameter("nmax", nmax)
call get_parameter("tmax", tmax)
call get_parameter("trun", trun)
call get_parameter("tsav", tsav)
! correct the run time by the save time
!
trun = trun - tsav / 6.0d+01
! get integral calculation interval
!
call get_parameter("ndat", ndat)
! print the problem name here, so in initialize_user_problem() we can print
! parameters
!
call print_section(master, "Problem")
call print_parameter(master, "problem name", trim(problem))
! initialize the remaining modules
!
call initialize_random(1, 0, nproc, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing RANDOM module!"
end if
go to 3700
end if
call initialize_equations(eqsys, eos, master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing EQUATIONS module!"
end if
go to 3600
end if
call initialize_interpolations(nghosts, master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing INTERPOLATIONS module!"
end if
go to 3500
end if
call initialize_coordinates(ncells, nghosts, toplev, bdims, xmin, xmax, &
ymin, ymax, zmin, zmax, master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing COORDINATES module!"
end if
go to 3400
end if
call initialize_evolution(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing EVOLUTION module!"
end if
go to 3300
end if
call initialize_blocks(nv, nf, nn, registers, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing BLOCKS module!"
end if
go to 3200
end if
call initialize_operators(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing OPERATORS module!"
end if
go to 3100
end if
call initialize_sources(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing SOURCES module!"
end if
go to 3000
end if
call initialize_problems(problem, master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing PROBLEMS module!"
end if
go to 2900
end if
call initialize_domains(problem, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing DOMAINS module!"
end if
go to 2800
end if
call initialize_boundaries(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing BOUNDARIES module!"
end if
go to 2700
end if
call initialize_refinement(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing REFINEMENT module!"
end if
go to 2600
end if
call initialize_mesh(nrun, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing MESH module!"
end if
go to 2500
end if
call initialize_shapes(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing SHAPES module!"
end if
go to 2400
end if
call initialize_gravity(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing GRAVITY module!"
end if
go to 2300
end if
call initialize_schemes(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing SCHEMES module!"
end if
go to 2200
end if
call initialize_forcing(master, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing FORCING module!"
end if
go to 2100
end if
call initialize_integrals(master, nrun, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem initializing INTEGRALS module!"
end if
go to 2000
end if
! print module information
!
call print_equations(master)
call print_sources(master)
call print_forcing(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
! reconstruct the meta and data block structures from a given restart file
!
call read_restart_snapshot(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem reading restart snapshot!"
end if
go to 1000
end if
! update the list of leafs
!
call build_leaf_list(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem building the list of leafs!"
end if
go to 1000
end if
! update boundaries
!
call boundary_variables(time, 0.0d+00)
else
! generate the initial mesh, refine that mesh to the desired level according to
! the initialized problem
!
call generate_mesh(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem generating the initial mesh!"
end if
go to 1000
end if
! update boundaries
!
call boundary_variables(0.0d+00, 0.0d+00)
! estimate the initial timestep
!
call initialize_time_step()
end if
! store mesh statistics
!
call store_mesh_stats(step, time)
! store integrals and data to a file
!
if (.not. restart_from_snapshot()) then
call store_integrals()
call user_time_statistics()
call write_snapshot()
end if
! stop time accounting for the initialization
!
call stop_timer(iin)
! set the initiallization success flag
!
initialization_succeeded = .true.
! start time accounting for the evolution
!
call start_timer(iev)
! print progress info on master processor
!
if (master) then
! get current time in seconds
!
tbeg = time
! initialize estimated remaining time of calculations
!
ed = 9999
eh = 23
em = 59
es = 59
! print progress info
!
write(*,*)
write(*,"(1x,a)" ) "Evolving the system:"
write(*,"(4x,'step',5x,'time',11x,'timestep',6x,'err/tol',4x," // &
"'blocks',7x,'ETA')")
#ifdef __INTEL_COMPILER
write(*,"(i8,2(1x,1es14.6),1x,1es10.2,2x,i8,2x," // &
"1i4.1,'d',1i2.2,'h',1i2.2,'m',1i2.2,'s',15x,a1,$)") &
step, time, dt, errtol, get_nleafs(), ed, eh, em, es, char(13)
#else /* __INTEL_COMPILER */
write(*,"(i8,2(1x,1es14.6),1x,1es10.2,2x,i8,2x," // &
"1i4.1,'d',1i2.2,'h',1i2.2,'m',1i2.2,'s',15x,a1)",advance="no") &
step, time, dt, errtol, get_nleafs(), ed, eh, em, es, char(13)
#endif /* __INTEL_COMPILER */
end if
! main loop
!
do while((nsteps <= nmax) .and. (time < tmax) .and. proceed)
! performe one step evolution
!
call advance(status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Advancing to next step failed!"
end if
go to 1000
end if
! advance the iteration number and time
!
time = time + dt
step = step + 1
nsteps = nsteps + 1
! update time step for precise snapshots
!
call update_dtp()
! estimate the next time step
!
call new_time_step()
! get current time in seconds
!
tm_curr = get_timer_total()
! compute elapsed time
!
thrs = tm_curr / 3.6d+03
! store mesh statistics
!
call store_mesh_stats(step, time)
! store time statistics
!
call store_integrals()
call user_time_statistics()
! write down the restart snapshot
!
call write_restart_snapshot(thrs, nrun, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Writing restart snapshot failed!"
end if
go to 1000
end if
! store data
!
call write_snapshot()
! check if the time exceeds execution time limit
!
if (thrs > trun) quit = 100
! print progress info to console, but not too often
!
if (master) then
if (time >= tmax .or. (tm_curr - tm_last) >= 1.0d+00) then
! calculate days, hours, seconds
!
ec = int(tm_curr * (tmax - time) / max(1.0d-03, time - tbeg), kind = 4)
es = max(0, min(863999999, ec))
ed = es / 86400
es = es - 86400 * ed
eh = es / 3600
es = es - 3600 * eh
em = es / 60
es = es - 60 * em
#ifdef __INTEL_COMPILER
write(*,"(i8,2(1x,1es14.6),1x,1es10.2,2x,i8,2x," // &
"1i4.1,'d',1i2.2,'h',1i2.2,'m',1i2.2,'s',15x,a1,$)") &
step, time, dt, errtol, get_nleafs(), ed, eh, em, es, char(13)
#else /* __INTEL_COMPILER */
write(*,"(i8,2(1x,1es14.6),1x,1es10.2,2x,i8,2x," // &
"1i4.1,'d',1i2.2,'h',1i2.2,'m',1i2.2,'s',15x,a1)",advance="no")&
step, time, dt, errtol, get_nleafs(), ed, eh, em, es, char(13)
#endif /* __INTEL_COMPILER */
! update the timestamp
!
tm_last = tm_curr
end if
end if
! check if the loop should be kept going
!
proceed = .not. check_status(quit /= 0)
end do ! main loop
! add one empty line
!
if (master) write(*,*)
! stop time accounting for the evolution
!
call stop_timer(iev)
! write down the restart snapshot
!
call write_restart_snapshot(1.0d+16, nrun, status)
if (check_status(status /= 0)) then
if (master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Writing restart snapshot failed!"
end if
end if
! a label to go to if there are any problems, but since all modules have been
! initialized, we have to finalize them first
!
1000 continue
! start time accounting for the termination
!
call start_timer(itm)
! finalize modules
!
2000 continue
call finalize_integrals(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing INTEGRALS module!"
end if
2100 continue
call finalize_forcing(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing FORCING module!"
end if
2200 continue
call finalize_schemes(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing SCHEMES module!"
end if
2300 continue
call finalize_gravity(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing GRAVITY module!"
end if
2400 continue
call finalize_shapes(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing SHAPES module!"
end if
2500 continue
call finalize_mesh(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing MESH module!"
end if
2600 continue
call finalize_refinement(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing REFINEMENT module!"
end if
2700 continue
call finalize_boundaries(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing BOUNDARIES module!"
end if
2800 continue
call finalize_domains(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing DOMAINS module!"
end if
2900 continue
call finalize_problems(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing PROBLEMS module!"
end if
3000 continue
call finalize_sources(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing SOURCES module!"
end if
3100 continue
call finalize_operators(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing OPERATORS module!"
end if
3200 continue
call finalize_blocks(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing BLOCKS module!"
end if
3300 continue
call finalize_evolution(master, status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing EVOLUTION module!"
end if
3400 continue
call finalize_coordinates(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing COORDINATES module!"
end if
3500 continue
call finalize_interpolations(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing INTERPOLATIONS module!"
end if
3600 continue
call finalize_equations(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing EQUATIONS module!"
end if
3700 continue
call finalize_random()
3800 continue
call finalize_io(status)
if (check_status(status /= 0) .and. master) then
write(error_unit,"('[AMUN::program]: ', a)") &
"Problem finalizing IO module!"
end if
3900 continue
call finalize_parameters()
! print execution times only if the initialization was fine
!
if (initialization_succeeded) then
! stop time accounting for the termination
!
call stop_timer(itm)
! get total time
!
tm(1) = get_timer_total()
! get subtasks timers
!
do i = 2, ntimers
tm(i) = get_timer(i)
end do
#ifdef MPI
! sum up timers from all processes
!
call reduce_sum(tm(1:ntimers))
#endif /* MPI */
! print timings only on master processor
!
if (master) then
! calculate the conversion factor
!
tm_conv = 1.0d+02 / tm(1)
! print one empty line
!
write (*,'(a)') ''
! print the execution times
!
write (tmp,"(a)") "(2x,a32,1x,':',3x,1f16.3,' secs = ',f6.2,' %')"
write (*,'(1x,a)') 'EXECUTION TIMINGS'
do i = 2, ntimers
if (timer_enabled(i)) then
if (get_count(i) > 0) then
write (*,tmp) timer_description(i), tm(i), tm_conv * tm(i)
end if ! timer counter > 0
end if ! enabled
end do
! print the execution times
!
write (tmp,"(a)") "(1x,a14,20x,':',3x,1f16.3,' secs = ',f6.2,' %')"
write (*,tmp) 'TOTAL CPU TIME', tm(1) , 1.0d+02
write (*,tmp) 'TIME PER STEP ', tm(1) / nsteps, 1.0d+02 / nsteps
#ifdef MPI
write (*,tmp) 'TIME PER CPU ', tm(1) / nprocs, 1.0d+02 / nprocs
#endif /* MPI */
! get the execution time
!
tm_exec = get_timer_total()
! convert the execution time to days, hours, minutes, and seconds and print it
!
es = int(tm_exec)
ec = int(1000 * (tm_exec - es))
ed = es / 86400
es = es - 86400 * ed
eh = es / 3600
es = es - 3600 * eh
em = es / 60
es = es - 60 * em
write (tmp,"(a)") "(1x,a14,20x,':',3x,i14,'d'" // &
",i3.2,'h',i3.2,'m',i3.2,'.',i3.3,'s')"
write (*,tmp) 'EXECUTION TIME', ed, eh, em, es, ec
end if
end if
! finalize module MPITOOLS
!
4000 continue
call finalize_mpitools(status)
! finalize module TIMERS
!
call finalize_timers()
!-------------------------------------------------------------------------------
!
end program
#ifdef SIGNALS
#ifdef __INTEL_COMPILER
!
!===============================================================================
!
! function SIGNAL_HANDLER:
! -----------------------
!
! Function sets variable iterm after receiving a signal.
!
! Arguments:
!
! sig_num - the number of the signal to be handled;
!
!===============================================================================
!
integer(kind=4) function signal_handler(sig_num)
use iso_fortran_env, only : error_unit
implicit none
integer(kind=4), intent(in) :: sig_num
integer :: iterm
common /termination/ iterm
!-------------------------------------------------------------------------------
!
iterm = sig_num
write(error_unit,*)
write(error_unit,*) "Received signal:", iterm
write(error_unit,*) "Closing program..."
signal_handler = 1
!-------------------------------------------------------------------------------
!
end function
#else /* __INTEL_COMPILER */
!
!===============================================================================
!
! subroutine SIGNAL_HANDLER:
! -------------------------
!
! Subroutine sets variable iterm after receiving a signal.
!
!===============================================================================
!
subroutine signal_handler()
use iso_fortran_env, only : error_unit
implicit none
integer :: iterm
common /termination/ iterm
!-------------------------------------------------------------------------------
!
iterm = 15
write(error_unit,*)
write(error_unit,*) "Received signal: 2, 9, or 15"
write(error_unit,*) "Closing program..."
return
!-------------------------------------------------------------------------------
!
end subroutine
#endif /* __INTEL_COMPILER */
#endif /* SIGNALS */
!===============================================================================
!
Reference in New Issue View Git Blame Copy Permalink