!!****************************************************************************** !! !! 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 !! !! 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 . !! !!****************************************************************************** !! !! 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 private public :: print_welcome, print_section, print_parameter, print_message 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,'=',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: ! ------------------------ ! ! Subroutine prints a message for a given location. ! ! Arguments: ! ! loc - the warning location; ! msg - the warning message; ! !=============================================================================== ! subroutine print_message(loc, msg) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: loc, msg !------------------------------------------------------------------------------- ! write(error_unit,"('[',a,']: ',a)") trim(loc), trim(msg) !------------------------------------------------------------------------------- ! end subroutine print_message ! !=============================================================================== ! ! 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