368 lines
10 KiB
Fortran
368 lines
10 KiB
Fortran
!!******************************************************************************
|
|
!!
|
|
!! 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-2024 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
|
|
|
|
use helpers , only : print_welcome, print_section, print_parameter
|
|
use helpers , only : print_message
|
|
use io , only : initialize_io, finalize_io
|
|
use mpitools , only : initialize_mpitools, finalize_mpitools
|
|
use mpitools , only : verbose => master, nproc, check_status
|
|
#ifdef MPI
|
|
use mpitools , only : reduce_sum, nodes, nprocs
|
|
#endif /* MPI */
|
|
use parameters, only : read_parameters, finalize_parameters
|
|
use random , only : initialize_random, finalize_random
|
|
use system , only : initialize_system, finalize_system
|
|
use system , only : print_system_info, prepare_system, evolve_system
|
|
use system , only : nsteps, nwork
|
|
#ifdef SIGNALS
|
|
use system , only : quit
|
|
#endif /* SIGNALS */
|
|
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 workspace , only : initialize_workspace, finalize_workspace
|
|
|
|
implicit none
|
|
|
|
! the timings printing and execution status flags
|
|
!
|
|
logical :: timings = .false.
|
|
integer :: status = 0
|
|
|
|
! timer indices, iteration number and other time variables
|
|
!
|
|
integer :: iin, iev, itm
|
|
integer :: ed, eh, em, es
|
|
|
|
! OpenMP
|
|
!
|
|
integer :: nthreads = 1
|
|
!$ integer :: omp_get_num_threads
|
|
|
|
! the format string
|
|
!
|
|
character(len=80) :: sfmt
|
|
|
|
! an array pointer for timings
|
|
!
|
|
real(kind=8), dimension(:), allocatable :: tm
|
|
|
|
#ifndef __GFORTRAN__
|
|
! signal is a subroutine only for the GNU compiler, otherwise it is a function
|
|
!
|
|
integer(kind=4) :: signal
|
|
#endif /* __GFORTRAN__ */
|
|
|
|
#ifdef SIGNALS
|
|
#ifdef __GFORTRAN__
|
|
intrinsic signal
|
|
#endif /* __GFORTRAN__ */
|
|
|
|
integer, parameter :: SIGERR = -1
|
|
integer, parameter :: SIGINT = 2, SIGABRT = 6, SIGTERM = 15
|
|
#endif /* SIGNALS */
|
|
|
|
character(len=*), parameter :: loc = 'AMUN::amun()'
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
#ifdef SIGNALS
|
|
! signals handling
|
|
!
|
|
#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__ */
|
|
|
|
if (status /= 0) then
|
|
call print_message(loc, "Could not initialize the signal handling!")
|
|
call exit(status)
|
|
end if
|
|
#endif /* SIGNALS */
|
|
|
|
! timers
|
|
!
|
|
call initialize_timers()
|
|
|
|
call set_timer('INITIALIZATION', iin)
|
|
call set_timer('EVOLUTION' , iev)
|
|
call set_timer('TERMINATION' , itm)
|
|
|
|
! parallelization
|
|
!
|
|
call initialize_mpitools(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not initialize module MPITOOLS!")
|
|
if (check_status(status /= 0)) call exit(status)
|
|
|
|
call start_timer(iin)
|
|
|
|
call print_welcome(verbose)
|
|
#ifdef MPI
|
|
call print_section(verbose, "Parallelization")
|
|
call print_parameter(verbose, "MPI nodes" , nodes)
|
|
call print_parameter(verbose, "MPI processes per node" , nprocs / nodes)
|
|
#else /* MPI */
|
|
!$ call print_section(verbose, "Parallelization")
|
|
#endif /* MPI */
|
|
!$omp parallel
|
|
!$omp master
|
|
!$ nthreads = omp_get_num_threads()
|
|
#ifdef MPI
|
|
!$ call print_parameter(verbose, "OpenMP threads per process", nthreads)
|
|
#else /* MPI */
|
|
!$ call print_parameter(verbose, "OpenMP threads", nthreads)
|
|
#endif /* MPI */
|
|
!$omp end master
|
|
!$omp end parallel
|
|
|
|
! read parameters
|
|
!
|
|
call read_parameters(verbose, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not read parameters!")
|
|
if (check_status(status /= 0)) go to 6000
|
|
|
|
! initialize a few basic modules: IO, RANDOM, SYSTEM, and WORKSPACE
|
|
!
|
|
call initialize_io(verbose, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not initialize module IO!")
|
|
if (check_status(status /= 0)) go to 5000
|
|
|
|
call initialize_random("same", 1, 0, nproc, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not initialize module RANDOM!")
|
|
if (check_status(status /= 0)) go to 4000
|
|
|
|
call initialize_system(verbose, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not initialize module SYSTEM!")
|
|
if (check_status(status /= 0)) go to 3000
|
|
|
|
call initialize_workspace(nwork, nthreads, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not initialize module WORKSPACE!")
|
|
if (check_status(status /= 0)) go to 2000
|
|
|
|
! show some info before the simulation starts
|
|
!
|
|
call print_system_info(verbose)
|
|
|
|
! prepare the system
|
|
!
|
|
call prepare_system(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not prepare the system for integration!")
|
|
if (check_status(status /= 0)) go to 1000
|
|
|
|
call stop_timer(iin)
|
|
|
|
timings = .true.
|
|
|
|
! the system evolution
|
|
!
|
|
call start_timer(iev)
|
|
|
|
call evolve_system(verbose, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not integrate the system!")
|
|
if (check_status(status /= 0)) go to 1000
|
|
|
|
call stop_timer(iev)
|
|
|
|
1000 continue
|
|
call start_timer(itm)
|
|
|
|
! finalize all initialized modules
|
|
!
|
|
call finalize_workspace(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not finalize module WORKSPACE!")
|
|
2000 continue
|
|
|
|
call finalize_system(verbose, status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not finalize module SYSTEM!")
|
|
3000 continue
|
|
|
|
call finalize_random(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not finalize module RANDOM!")
|
|
4000 continue
|
|
|
|
call finalize_io(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not finalize module IO!")
|
|
5000 continue
|
|
|
|
call finalize_parameters()
|
|
|
|
call stop_timer(itm)
|
|
|
|
! print the execution summary (only if the initialization was successful)
|
|
!
|
|
if (timings) then
|
|
allocate(tm(ntimers), stat=status)
|
|
if (status /= 0) then
|
|
call print_message(loc, "Could not allocate memory for timings!")
|
|
go to 6000
|
|
end if
|
|
|
|
tm(1) = get_timer_total()
|
|
do es = 2, ntimers
|
|
tm(es) = get_timer(es)
|
|
end do
|
|
#ifdef MPI
|
|
call reduce_sum(tm(1:ntimers))
|
|
#endif /* MPI */
|
|
|
|
if (verbose) then
|
|
write(* ,'(a)') ''
|
|
write(*,'(1x,a)') 'EXECUTION TIMINGS'
|
|
sfmt = "(2x,a32,1x,':',3x,1f16.3,' secs = ',f6.2,' %')"
|
|
do es = 2, ntimers
|
|
if (timer_enabled(es) .and. get_count(es) > 0) then
|
|
write(*,sfmt) timer_description(es), tm(es), 1.0d+02 * tm(es) / tm(1)
|
|
end if
|
|
end do
|
|
|
|
sfmt = "(1x,a20,14x,':',3x,1f16.3,' secs = ',f6.2,' %')"
|
|
write(*,sfmt) 'TOTAL EXECUTION TIME', tm(1) , 1.0d+02
|
|
write(*,sfmt) 'TIME PER STEP ', tm(1) / nsteps, 1.0d+02 / nsteps
|
|
#ifdef MPI
|
|
write(*,sfmt) 'TIME PER MPI PROCESS', tm(1) / nprocs, 1.0d+02 / nprocs
|
|
#endif /* MPI */
|
|
|
|
es = int(get_timer_total())
|
|
ed = es / 86400
|
|
es = mod(es, 86400)
|
|
eh = es / 3600
|
|
es = mod(es, 3600)
|
|
em = es / 60
|
|
es = mod(es, 60)
|
|
|
|
sfmt = "(1x,'EXECUTION TIME',20x,':',3x,i14," // &
|
|
"'d',i3.2,'h',i3.2,'m',i3.2,'s')"
|
|
write(*,sfmt) ed, eh, em, es
|
|
|
|
end if
|
|
deallocate(tm, stat=status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not deallocate memory for timings!")
|
|
end if
|
|
6000 continue
|
|
|
|
call finalize_mpitools(status)
|
|
if (status /= 0) &
|
|
call print_message(loc, "Could not finalize module MPITOOLS!")
|
|
|
|
call finalize_timers()
|
|
|
|
#ifdef SIGNALS
|
|
contains
|
|
#ifdef __INTEL_COMPILER
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! function SIGNAL_HANDLER:
|
|
! -----------------------
|
|
!
|
|
! Function sets the variable quit 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
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
quit = sig_num
|
|
write(error_unit,*)
|
|
write(error_unit,*) "Received signal:", sig_num
|
|
write(error_unit,*) "Closing program..."
|
|
signal_handler = 1
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end function
|
|
#else /* __INTEL_COMPILER */
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! subroutine SIGNAL_HANDLER:
|
|
! -------------------------
|
|
!
|
|
! Subroutine sets the variable quit after receiving a signal.
|
|
!
|
|
!===============================================================================
|
|
!
|
|
subroutine signal_handler()
|
|
|
|
use iso_fortran_env, only : error_unit
|
|
|
|
implicit none
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
quit = 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 */
|
|
|
|
!===============================================================================
|
|
!
|
|
end program
|