MOM_error_handler.F90

Go to the documentation of this file.

module mom_error_handler
!********+*********+*********+*********+*********+*********+*********+**
!*                                                                     *
!*    This file is a part of MOM.  See MOM.F90 for licensing.          *
!*                                                                     *
!*  By R. Hallberg, 2005-2012.                                         *
!*                                                                     *
!*    This module wraps the mpp_mod error handling code and the        *
!*  mpp functions stdlog() and stdout() that return open unit numbers. *
!*                                                                     *
!********+*********+*********+*********+*********+*********+*********+**

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

! 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 #define DEBUG)
integer :: verbosity = 6
!   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

! The level of calling within the call tree
integer :: calltreeindentlevel = 0

contains

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

subroutine mom_mesg(message, verb, all_print)
  character(len=*), intent(in)  :: message
  integer, optional, intent(in) :: verb
  logical, optional, intent(in) :: all_print
  ! 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

subroutine mom_error(level, message, all_print)
  integer,           intent(in) :: level
  character(len=*),  intent(in) :: message
  logical, optional, intent(in) :: all_print
  ! 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

subroutine mom_set_verbosity(verb)
  integer, intent(in) :: verb
  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

function mom_get_verbosity()
  integer :: MOM_get_verbosity
  mom_get_verbosity = verbosity
end function mom_get_verbosity

function mom_verbose_enough(verb)
  integer, intent(in) :: verb
  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=*)  :: mesg !< Message to write
  integer, optional :: 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=*) :: mesg !< Message to write
  integer, optional :: 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