343 lines
9.3 KiB
Fortran
343 lines
9.3 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) 2019-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/>.
|
|
!!
|
|
!!******************************************************************************
|
|
!!
|
|
!! 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
|
|
end interface
|
|
|
|
private
|
|
|
|
public :: print_welcome, print_section, print_parameter
|
|
public :: 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-2021 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,'=',1x,a)") msg, trim(t)
|
|
else
|
|
write(*,"(4x,a26,1x,'=',1x,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))
|
|
write(*,"(4x,a26,1x,'=',1x,i0)") msg, val
|
|
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))
|
|
if (val >= 0.0d+00) then
|
|
write(*,"(4x,a26,1x,'=',1x,es12.5)") msg, val
|
|
else
|
|
write(*,"(4x,a26,1x,'=',2x,es12.5)") msg, val
|
|
end if
|
|
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,'=',1x,a)") msg, trim(adjustl(val))
|
|
end if
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
end subroutine print_parameter_string
|
|
!
|
|
!===============================================================================
|
|
!
|
|
! subroutine FLUSH_AND_SYNC:
|
|
! -----------------------
|
|
!
|
|
! Function flushes and fsyncs the I/O buffers.
|
|
!
|
|
! 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
|
|
|
|
!-------------------------------------------------------------------------------
|
|
!
|
|
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
|