gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
amun-code/sources/helpers.F90
Grzegorz Kowal 29f1e94e9c HELPERS: Add functions to enable/disable I/O flush and sync. 
This change introduces the logical flag 'noflush' to control the flushing
and synchronization of I/O buffers. Subsequently, subroutines
'enable_flush_and_sync' and 'disable_flush_and_sync' were added to enable
and disable the flushing and synchronization, respectively.

The 'flush_and_sync' subroutine was modified to respect the noflush flag.

Additionally, this change updates 'statistics.F90' to read
the 'enable_io_flush' parameter and call the appropriate subroutine
('enable_flush_and_sync' or 'disable_flush_and_sync') based on its value.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
2024-07-19 10:00:18 -03:00

650 lines
18 KiB
Fortran
Raw Permalink 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) 2019-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/>.
!!
!!******************************************************************************
!!
!! module: HELPERS
!!
!! This module provides miscellaneous support subroutines.
!!
!!
!!******************************************************************************
!
module helpers
implicit none
! MODULE INTERFACES:
! =================
!
interface print_parameter
module procedure print_parameter_logical
module procedure print_parameter_integer
module procedure print_parameter_double
module procedure print_parameter_string
module procedure print_parameter_integer_range
module procedure print_parameter_double_range
module procedure print_parameter_string_range
end interface
interface print_message
module procedure print_message_loc
module procedure print_message_msg
end interface
logical :: noflush = .true.
private
public :: print_welcome, print_section, print_parameter, print_message
public :: uppercase, lowercase
public :: enable_flush_and_sync, disable_flush_and_sync, flush_and_sync
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
contains
!
!===============================================================================
!!
!!*** PUBLIC SUBROUTINES *****************************************************
!!
!===============================================================================
!
!===============================================================================
!
! subroutine PRINT_WELCOME:
! ------------------------
!
! Subroutine prints welcome message.
!
! Arguments:
!
! verbose - the verbose flag;
!
!===============================================================================
!
subroutine print_welcome(verbose)
implicit none
logical, intent(in) :: verbose
!-------------------------------------------------------------------------------
!
if (.not. verbose) return
write(*,"(1x,78('-'))")
write(*,"(1x,18('='),17x,a,17x,19('='))") 'A M U N'
write(*,"(1x,16('='),4x,a,4x,16('='))") &
'Copyright (C) 2008-2024 Grzegorz Kowal'
write(*,"(1x,18('='),9x,a,9x,19('='))") &
'under GNU GPLv3 license'
write(*,"(1x,78('-'))")
!-------------------------------------------------------------------------------
!
end subroutine print_welcome
!
!===============================================================================
!
! subroutine PRINT_SECTION:
! ------------------------
!
! Subroutine prints section lines.
!
! Arguments:
!
! verbose - the verbose flag;
! title - the section title;
!
!===============================================================================
!
subroutine print_section(verbose, title)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: title
!-------------------------------------------------------------------------------
!
if (.not. verbose) return
write(*,*)
write(*,"(1x,a,':')") trim(adjustl(title))
!-------------------------------------------------------------------------------
!
end subroutine print_section
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_LOGICAL:
! ----------------------------------
!
! Subroutine prints the value of a boolean parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! val - the parameter value;
!
!===============================================================================
!
subroutine print_parameter_logical(verbose, dsc, val, str)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
logical , intent(in) :: val
character(len=*), intent(in) :: str
character(len=26) :: msg
character(len=8) :: t, f
!-------------------------------------------------------------------------------
!
if (verbose) then
select case(str)
case("yes","no")
t = "yes"
f = "no"
case("true","false")
t = "true"
f = "false"
case default
t = "on"
f = "off"
end select
msg = trim(adjustl(dsc))
if (val) then
write(*,"(4x,a26,1x,'=',2x,a)") msg, trim(t)
else
write(*,"(4x,a26,1x,'=',2x,a)") msg, trim(f)
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_logical
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_INTEGER:
! ----------------------------------
!
! Subroutine prints integer parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! val - the parameter value;
!
!===============================================================================
!
subroutine print_parameter_integer(verbose, dsc, val)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
integer , intent(in) :: val
character(len=26) :: msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
if (val >= 0) then
write(*,"(4x,a26,1x,'=',2x,i0)") msg, val
else
write(*,"(4x,a26,1x,'=',1x,i0)") msg, val
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_integer
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_DOUBLE:
! ----------------------------------
!
! Subroutine prints double precision parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! val - the parameter value;
!
!===============================================================================
!
subroutine print_parameter_double(verbose, dsc, val)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
real(kind=8) , intent(in) :: val
character(len=26) :: msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
write(*,"(4x,a26,1x,'=',1x,es12.5)") msg, val
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_double
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_STRING:
! ---------------------------------
!
! Subroutine prints string parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! val - the parameter value;
!
!===============================================================================
!
subroutine print_parameter_string(verbose, dsc, val)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
character(len=*), intent(in) :: val
character(len=26) :: msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
write(*,"(4x,a26,1x,'=',2x,a)") msg, trim(adjustl(val))
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_string
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_INTEGER_RANGE:
! ----------------------------------------
!
! Subroutine prints the range of integer parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! lo - the range lower value;
! hi - the range higher value;
!
!===============================================================================
!
subroutine print_parameter_integer_range(verbose, dsc, lo, hi)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
integer , intent(in) :: lo, hi
character(len=26) :: msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
if (lo >= 0) then
write(*,"(4x,a26,1x,'=',2x,i0,' ... ',i0)") msg, lo, hi
else
write(*,"(4x,a26,1x,'=',1x,i0,' ... ',i0)") msg, lo, hi
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_integer_range
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_DOUBLE_RANGE:
! ---------------------------------------
!
! Subroutine prints the range of double precision parameter.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! lo - the range lower value;
! hi - the range higher value;
!
!===============================================================================
!
subroutine print_parameter_double_range(verbose, dsc, lo, hi)
implicit none
logical , intent(in) :: verbose
character(len=*), intent(in) :: dsc
real(kind=8) , intent(in) :: lo, hi
character(len=26) :: msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
write(*,"(4x,a26,1x,'=',1x,es12.5,' ... ',es12.5)") msg, lo, hi
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_double_range
!
!===============================================================================
!
! subroutine PRINT_PARAMETER_STRING_RANGE:
! ---------------------------------------
!
! Subroutine prints two string parameters as a range.
!
! Arguments:
!
! verbose - the verbose flag;
! dsc - the parameter description;
! lo - the range lower value;
! hi - the range higher value;
!
!===============================================================================
!
subroutine print_parameter_string_range(verbose, dsc, lo, hi, width)
implicit none
logical , intent(in) :: verbose
character(len=*) , intent(in) :: dsc
character(len=*) , intent(in) :: lo, hi
integer, optional, intent(in) :: width
character(len=26) :: num, msg
!-------------------------------------------------------------------------------
!
if (verbose) then
msg = trim(adjustl(dsc))
if (present(width)) then
write(num,'(i0)') width
write(*,"(4x,a26,1x,'=',2x,a" // num // ",' ... ',a)") &
msg, trim(lo), trim(hi)
else
write(*,"(4x,a26,1x,'=',2x,a,' ... ',a)") msg, trim(lo), trim(hi)
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_parameter_string_range
!
!===============================================================================
!
! subroutine PRINT_MESSAGE_LOC:
! ----------------------------
!
! Subroutine prints a message for a given location.
!
! Arguments:
!
! loc - the warning location;
! msg - the warning message;
!
!===============================================================================
!
subroutine print_message_loc(loc, msg)
use iso_fortran_env, only : error_unit
implicit none
character(len=*), intent(in) :: loc, msg
!-------------------------------------------------------------------------------
!
write(error_unit,"('[',a,']:')") trim(loc)
write(error_unit,"(4x,a)" ) trim(msg)
!-------------------------------------------------------------------------------
!
end subroutine print_message_loc
!
!===============================================================================
!
! subroutine PRINT_MESSAGE_LOC:
! ----------------------------
!
! Subroutine prints just a message without the location.
!
! Arguments:
!
! msg - the warning message;
!
!===============================================================================
!
subroutine print_message_msg(msg)
use iso_fortran_env, only : error_unit
implicit none
character(len=*), intent(in) :: msg
!-------------------------------------------------------------------------------
!
write(error_unit,"(4x,a)" ) trim(msg)
!-------------------------------------------------------------------------------
!
end subroutine print_message_msg
!
!===============================================================================
!
! function UPPERCASE:
! ------------------
!
! Function converts string to the upper case.
!
! Arguments:
!
! str - the input string;
!
!===============================================================================
!
pure function uppercase(str) result(string)
implicit none
character(*), intent(in) :: str
character(len(str)) :: string
integer :: ic, i
character(26), parameter :: cap = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
character(26), parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
!-------------------------------------------------------------------------------
!
string = str
do i = 1, len_trim(str)
ic = index(low, str(i:i))
if (ic > 0) string(i:i) = cap(ic:ic)
end do
end function uppercase
!
!===============================================================================
!
! function LOWERCASE:
! ------------------
!
! Function converts string to the lower case.
!
! Arguments:
!
! str - the input string;
!
!===============================================================================
!
pure function lowercase(str) result(string)
implicit none
character(*), intent(in) :: str
character(len(str)) :: string
integer :: ic, i
character(26), parameter :: cap = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
character(26), parameter :: low = 'abcdefghijklmnopqrstuvwxyz'
!-------------------------------------------------------------------------------
!
string = str
do i = 1, len_trim(str)
ic = index(cap, str(i:i))
if (ic > 0) string(i:i) = low(ic:ic)
end do
end function lowercase
!
!===============================================================================
!
! subroutine ENABLE_FLUSH_AND_SYNC:
! --------------------------------
!
! This function enables flushing and synchronization of I/O buffers.
!
!===============================================================================
!
subroutine enable_flush_and_sync()
implicit none
!-------------------------------------------------------------------------------
!
noflush = .false.
!-------------------------------------------------------------------------------
!
end subroutine enable_flush_and_sync
!
!===============================================================================
!
! subroutine DISABLE_FLUSH_AND_SYNC:
! ---------------------------------
!
! This function disables flushing and synchronization of I/O buffers.
!
!===============================================================================
!
subroutine disable_flush_and_sync()
implicit none
!-------------------------------------------------------------------------------
!
noflush = .true.
!-------------------------------------------------------------------------------
!
end subroutine disable_flush_and_sync
!
!===============================================================================
!
! subroutine FLUSH_AND_SYNC:
! -------------------------
!
! This function performs a flush of the I/O buffers and ensures that all
! changes are synchronized to the storage device using fsync.
!
! Arguments:
!
! iounit - the I/O unit to flash;
!
!===============================================================================
!
subroutine flush_and_sync(iounit)
use iso_fortran_env, only : error_unit
implicit none
#ifdef __GFORTRAN__
interface
function fsync (fd) bind(c,name="fsync")
use iso_c_binding, only: c_int
integer(c_int), value :: fd
integer(c_int) :: fsync
end function fsync
end interface
#endif /* __GFORTRAN__ */
integer, intent(in) :: iounit
integer :: ret
!-------------------------------------------------------------------------------
!
if (noflush) return
call flush(iounit)
#ifdef __GFORTRAN__
ret = fsync(fnum(iounit))
if (ret /= 0) &
write(error_unit,"('Error calling FSYNC for unit:',1i4)") iounit
#endif /* __GFORTRAN__ */
!-------------------------------------------------------------------------------
!
end subroutine flush_and_sync
!===============================================================================
!
end module helpers
Reference in New Issue View Git Blame Copy Permalink