!!****************************************************************************** !! !! 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 !! !! 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 . !! !!****************************************************************************** !! !! 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, 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 processes" , nprocs) #else /* MPI */ !$ call print_section(verbose, "Parallelization") #endif /* MPI */ !$omp parallel !$omp master !$ nthreads = omp_get_num_threads() !$ call print_parameter(verbose, "OpenMP threads", nthreads) !$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