MOM_error_handler.F90

!> Routines for error handling and I/O management
module mom_error_handler
 
! This file is part of MOM6. See LICENSE.md for the license.
 
use mpp_mod, only : mpp_error, note, warning, fatal
use mpp_mod, only : mpp_pe, mpp_root_pe, stdlog, stdout
 
implicit none ; private
 
public mom_error, mom_mesg, note, warning, fatal, is_root_pe, stdlog, stdout
public mom_set_verbosity, mom_get_verbosity, mom_verbose_enough
public calltree_showquery, calltree_enter, calltree_leave, calltree_waypoint
public assert
 
integer :: verbosity = 6
!< Verbosity level:
!!  0 - FATAL messages only
!!  1 - FATAL + WARNING messages only
!!  2 - FATAL + WARNING + NOTE messages only [default]
!!  3 - above + informational
!!  4 -
!!  5 -
!!  6 - above + call tree
!!  7 -
!!  8 -
!!  9 - anything and everything (also set with DEBUG=True)
 
!   Note that this module default will only hold until the
! VERBOSITY parameter is parsed and the given default imposed.
! We set it to 6 here so that the call tree will print before
! the parser has been initialized
!   Also note that this is a module variable rather than contained in
! a type passed by argument (preferred for most data) for convenience
! and to reduce obfuscation of code
 
integer :: calltreeindentlevel = 0
!< The level of calling within the call tree
 
contains
 
!> This returns .true. if the current PE is the root PE.
function is_root_pe()
  ! This returns .true. if the current PE is the root PE.
  logical :: is_root_pe
  is_root_pe = .false.
  if (mpp_pe() == mpp_root_pe()) is_root_pe = .true.
  return
end function is_root_pe
 
!> This provides a convenient interface for writing an informative comment.
subroutine mom_mesg(message, verb, all_print)
  character(len=*), intent(in)  :: message !< A message to write out
  integer, optional, intent(in) :: verb !< A level of verbosity for this message
  logical, optional, intent(in) :: all_print !< If present and true, any PEs are
                                             !! able to write this message.
  ! This provides a convenient interface for writing an informative comment.
  integer :: verb_msg
  logical :: write_msg
 
  write_msg = is_root_pe()
  if (present(all_print)) write_msg = write_msg .or. all_print
 
  verb_msg = 2 ; if (present(verb)) verb_msg = verb
  if (write_msg .and. (verbosity >= verb_msg)) call mpp_error(note, message)
 
end subroutine mom_mesg
 
!> This provides a convenient interface for writing an mpp_error message
!! with run-time filter based on a verbosity.
subroutine mom_error(level, message, all_print)
  integer,           intent(in) :: level !< The verbosity level of this message
  character(len=*),  intent(in) :: message !< A message to write out
  logical, optional, intent(in) :: all_print !< If present and true, any PEs are
                                             !! able to write this message.
  ! This provides a convenient interface for writing an mpp_error message
  ! with run-time filter based on a verbosity.
  logical :: write_msg
 
  write_msg = is_root_pe()
  if (present(all_print)) write_msg = write_msg .or. all_print
 
  select case (level)
    case (note)
      if (write_msg.and.verbosity>=2) call mpp_error(note, message)
    case (warning)
      if (write_msg.and.verbosity>=1) call mpp_error(warning, message)
    case (fatal)
      if (verbosity>=0) call mpp_error(fatal, message)
    case default
      call mpp_error(level, message)
  end select
end subroutine mom_error
 
!> This subroutine sets the level of verbosity filtering MOM error messages
subroutine mom_set_verbosity(verb)
  integer, intent(in) :: verb !< A level of verbosity to set
  character(len=80) :: msg
  if (verb>0 .and. verb<10) then
    verbosity=verb
  else
    write(msg(1:80),'("Attempt to set verbosity outside of range (0-9). verb=",I0)') verb
    call mom_error(fatal,msg)
  endif
end subroutine mom_set_verbosity
 
!> This subroutine gets the level of verbosity filtering MOM error messages
function mom_get_verbosity()
  integer :: mom_get_verbosity
  mom_get_verbosity = verbosity
end function mom_get_verbosity
 
!> This tests whether the level of verbosity filtering MOM error messages is
!! sufficient to write a message of verbosity level verb
function mom_verbose_enough(verb)
  integer, intent(in) :: verb !< A level of verbosity to test
  logical :: mom_verbose_enough
  mom_verbose_enough = (verbosity >= verb)
end function mom_verbose_enough
 
!> Returns True, if the verbosity>=6 indicating to show the call tree
function calltree_showquery()
  ! Local variables
  logical :: calltree_showquery
  calltree_showquery = (verbosity >= 6)
end function calltree_showquery
 
!> Writes a message about entering a subroutine if call tree reporting is active
subroutine calltree_enter(mesg,n)
  character(len=*),  intent(in) :: mesg !< Message to write
  integer, optional, intent(in) :: n !< An optional integer to write at end of message
  ! Local variables
  character(len=8) :: nasstring
  calltreeindentlevel = calltreeindentlevel + 1
  if (verbosity<6) return
  if (is_root_pe()) then
    nasstring = ''
    if (present(n)) then
      write(nasstring(1:8),'(i8)') n
      call mpp_error(note, 'callTree: '// &
        repeat('   ',calltreeindentlevel-1)//'loop '//trim(mesg)//trim(nasstring))
    else
      call mpp_error(note, 'callTree: '// &
        repeat('   ',calltreeindentlevel-1)//'---> '//trim(mesg))
    endif
  endif
end subroutine calltree_enter
 
!> Writes a message about leaving a subroutine if call tree reporting is active
subroutine calltree_leave(mesg)
  character(len=*) :: mesg !< Message to write
  if (calltreeindentlevel<1) write(0,*) 'callTree_leave: error callTreeIndentLevel=',calltreeindentlevel,trim(mesg)
  calltreeindentlevel = calltreeindentlevel - 1
  if (verbosity<6) return
  if (is_root_pe()) call mpp_error(note, 'callTree: '// &
        repeat('   ',calltreeindentlevel)//'<--- '//trim(mesg))
end subroutine calltree_leave
 
!> Writes a message about reaching a milestone if call tree reporting is active
subroutine calltree_waypoint(mesg,n)
  character(len=*),  intent(in) :: mesg !< Message to write
  integer, optional, intent(in) :: n !< An optional integer to write at end of message
  ! Local variables
  character(len=8) :: nasstring
  if (calltreeindentlevel<0) write(0,*) 'callTree_waypoint: error callTreeIndentLevel=',calltreeindentlevel,trim(mesg)
  if (verbosity<6) return
  if (is_root_pe()) then
    nasstring = ''
    if (present(n)) then
      write(nasstring(1:8),'(i8)') n
      call mpp_error(note, 'callTree: '// &
        repeat('   ',calltreeindentlevel)//'loop '//trim(mesg)//trim(nasstring))
    else
      call mpp_error(note, 'callTree: '// &
        repeat('   ',calltreeindentlevel)//'o '//trim(mesg))
    endif
  endif
end subroutine calltree_waypoint
 
!> Issues a FATAL error if the assertion fails, i.e. the first argument is false.
subroutine assert(logical_arg, msg)
  logical, intent(in) :: logical_arg !< If false causes a FATAL error
  character(len=*), intent(in) :: msg !< Message to issue in case of failed assertion
 
  if (.not. logical_arg) then
    call mom_error(fatal, msg)
  endif
 
end subroutine assert
 
end module mom_error_handler