amun-code/sources/amun.F90

!!******************************************************************************
!!
!!  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