scrip_errormod.f90

Go to the documentation of this file.

!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 
module scrip_errormod
 
  !BOP
  ! !MODULE: SCRIP_ErrorMod
  ! !DESCRIPTION:
  ! This module contains SCRIP error flags and facilities for logging and
  ! printing error messages. Note that error flags are local to a
  ! process and there is no synchronization of error flags across
  ! processes. As routines trap error flags, they may add a message
  ! to the error log to aid in tracking the call sequence.
  !
  ! Users should not need to change any values in this module.
  !
  ! All routines in SCRIP which encounter an error should return to
  ! the calling routine with the SCRIP\_Fail error code set and a message
  ! added to the error log using the SCRIP\_ErrorCheck or
  ! SCRIP\_ErrorSet function. Routines in SCRIP should also check
  ! error codes returned by called routines and add a message to the
  ! error log to help users track the calling sequence that generated
  ! the error. This process enables the error code to be propagated
  ! to the highest level or calling routine to enable a graceful
  ! exit. At that level, the SCRIP_ErrorPrint call can be used to
  ! print the entire error trace or error log.
  !
  ! !REVISION HISTORY:
  ! SVN:$Id: SCRIP_ErrorMod.F90 14 2006-08-17 17:07:05Z $
  !
  ! !USES:
 
  use scrip_kindsmod
  !use SCRIP_CommMod
  use scrip_iounitsmod
 
  implicit none
  private
  save
 
  ! !DEFINED PARAMETERS:
 
  integer (SCRIP_i4), parameter, public :: &
       scrip_success = 0, & ! standard SCRIP error flags
       scrip_fail = -1
 
  ! !PUBLIC MEMBER FUNCTIONS:
 
  public :: scrip_errorset, &
       scrip_errorcheck, &
       scrip_errorprint
 
  !EOP
  !BOC
  !-----------------------------------------------------------------------
  !
  ! module variables
  !
  !-----------------------------------------------------------------------
 
  integer (SCRIP_i4), parameter :: &
       scrip_errorlogdepth = 20 ! Max depth of call tree to properly
  ! size the error log array
 
  integer (SCRIP_i4) :: &
       scrip_errormsgcount = 0 ! tracks current number of log messages
 
  character (SCRIP_CharLength), dimension(SCRIP_ErrorLogDepth) :: &
       scrip_errorlog ! list of error messages to be output
 
  !EOC
  !***********************************************************************
 
contains
 
  !***********************************************************************
  !BOP
  ! !IROUTINE: SCRIP_ErrorSet -- sets error code and logs error message
  ! !INTERFACE:
 
  subroutine scrip_errorset(errorCode, rtnName, errorMsg)
 
    ! !DESCRIPTION:
    ! This routine sets an error code to SCRIP\_Fail and adds a message to
    ! the error log for later printing.
    !
    ! !REVISION HISTORY:
    ! same as module
 
    ! !OUTPUT PARAMETERS:
 
    integer (SCRIP_i4), intent(out) :: &
         errorcode ! Error code to set to fail
 
    ! !INPUT PARAMETERS:
 
    character (*), intent(in) :: &
         rtnname, &! name of calling routine
         errormsg ! message to add to error log for printing
 
    !EOP
    !BOC
    !-----------------------------------------------------------------------
    !
    ! Local variables
    !
    !-----------------------------------------------------------------------
 
    character(SCRIP_charLength) :: &
         logerrormsg ! constructed error message with routine name
 
    !-----------------------------------------------------------------------
    !
    ! Set error code to fail
    !
    !-----------------------------------------------------------------------
 
    errorcode = scrip_fail
 
    !-----------------------------------------------------------------------
    !
    ! Add error message to error log
    !
    !-----------------------------------------------------------------------
 
    scrip_errormsgcount = scrip_errormsgcount + 1
 
    if (scrip_errormsgcount <= scrip_errorlogdepth) then
      write(logerrormsg,'(a,a2,a)') rtnname,': ',errormsg
      scrip_errorlog(scrip_errormsgcount) = logerrormsg
    endif
 
    !-----------------------------------------------------------------------
    !EOC
 
  end subroutine scrip_errorset
 
  !***********************************************************************
  !BOP
  ! !IROUTINE: SCRIP_ErrorCheck -- checks error code and logs error message
  ! !INTERFACE:
 
  function scrip_errorcheck(errorCode, rtnName, errorMsg)
 
    ! !DESCRIPTION:
    ! This function checks an error code and adds a message to the error
    ! log for later printing. It is a more compact form of the ErrorSet
    ! routine that is especially useful for checking an error code after
    ! returning from a routine or function. If the errorCode is the
    ! failure code SCRIP\_Fail, it returns a logical true value so that
    ! it can be used in a typical call like:
    ! \begin{verbatim}
    ! if (SCRIP_ErrorCheck(errorCode, rtnName, errorMsg)) return
    ! \end{verbatim}
    !
    ! !REVISION HISTORY:
    ! same as module
 
    ! !OUTPUT PARAMETERS:
 
    logical (SCRIP_logical) :: &
         scrip_errorcheck
 
    ! !INPUT PARAMETERS:
 
    integer (SCRIP_i4), intent(in) :: &
         errorcode ! Error code to check
 
    character (*), intent(in) :: &
         rtnname, &! name of calling routine
         errormsg ! message to add to error log for printing
 
    !EOP
    !BOC
    !-----------------------------------------------------------------------
    !
    ! local variables
    !
    !-----------------------------------------------------------------------
 
    character (SCRIP_charLength) :: &
         logerrormsg ! constructed error message with routine name
 
    !-----------------------------------------------------------------------
    !
    ! If the error code is success, set the return value to false.
    !
    !-----------------------------------------------------------------------
 
    if (errorcode == scrip_success) then
      scrip_errorcheck = .false.
 
      !-----------------------------------------------------------------------
      !
      ! If the error code is a fail, set the return value to true and
      ! add the error message to the log.
      !
      !-----------------------------------------------------------------------
 
    else
      scrip_errorcheck = .true.
 
      scrip_errormsgcount = scrip_errormsgcount + 1
 
      if (scrip_errormsgcount <= scrip_errorlogdepth) then
        write(logerrormsg,'(a,a2,a)') rtnname,': ',errormsg
        scrip_errorlog(scrip_errormsgcount) = logerrormsg
      endif
    endif
 
    !-----------------------------------------------------------------------
    !EOC
 
  end function scrip_errorcheck
 
  !***********************************************************************
  !BOP
  ! !IROUTINE: SCRIP_ErrorPrint -- prints the error log
  ! !INTERFACE:
 
  subroutine scrip_errorprint(printTask)
 
    ! !DESCRIPTION:
    ! This routine prints all messages in the error log. If a printTask
    ! is specified, only the message log on that task will be printed.
    !
    ! !REVISION HISTORY:
    ! same as module
 
    ! !INPUT PARAMETERS:
 
    !   integer (SCRIP_i4), intent(in) :: &
    !      errorCode ! input error code to check success/fail
 
    !*** currently this has no meaning, but will be used in parallel
    !*** SCRIP version
    integer (SCRIP_i4), intent(in), optional :: &
         printtask ! Task from which to print error log
 
    !EOP
    !BOC
    !-----------------------------------------------------------------------
    !
    ! local variables
    !
    !-----------------------------------------------------------------------
 
    integer (SCRIP_i4) :: n
 
    !-----------------------------------------------------------------------
    !
    ! Print all error messages to stdout
    !
    !-----------------------------------------------------------------------
 
    if (present(printtask)) then
 
      !*** parallel SCRIP not yet supported
      !if (SCRIP_myTask == printTask) then
 
      write(scrip_stdout,scrip_blankformat)
      write(scrip_stdout,scrip_delimformat)
      write(scrip_stdout,scrip_blankformat)
 
      if (scrip_errormsgcount == 0) then ! no errors
 
        write(scrip_stdout,'(a34)') &
             'Successful completion of SCRIP model'
 
      else
 
        write(scrip_stdout,'(a14)') 'SCRIP Exiting...'
 
        do n=1,min(scrip_errormsgcount,scrip_errorlogdepth)
          write(scrip_stderr,'(a)') trim(scrip_errorlog(n))
          if (scrip_stdout /= scrip_stderr) then
            write(scrip_stdout,'(a)') trim(scrip_errorlog(n))
          endif
        end do
 
        if (scrip_errormsgcount > scrip_errorlogdepth) then
          write(scrip_stderr,'(a23)') 'Too many error messages'
          if (scrip_stdout /= scrip_stderr) then
            write(scrip_stdout,'(a23)') 'Too many error messages'
          endif
        endif
 
      endif
 
      write(scrip_stdout,scrip_blankformat)
      write(scrip_stdout,scrip_delimformat)
      write(scrip_stdout,scrip_blankformat)
 
      !endif
 
    else
 
      write(scrip_stdout,scrip_blankformat)
      write(scrip_stdout,scrip_delimformat)
      write(scrip_stdout,scrip_blankformat)
 
      if (scrip_errormsgcount == 0) then ! no errors
 
        write(scrip_stdout,'(a34)') 'Successful completion of SCRIP'
 
      else
 
        write(scrip_stdout,'(a14)') 'SCRIP Exiting...'
 
        do n=1,min(scrip_errormsgcount,scrip_errorlogdepth)
          write(scrip_stderr,'(a)') trim(scrip_errorlog(n))
          if (scrip_stdout /= scrip_stderr) then
            write(scrip_stdout,'(a)') trim(scrip_errorlog(n))
          endif
        end do
 
        if (scrip_errormsgcount > scrip_errorlogdepth) then
          write(scrip_stderr,'(a23)') 'Too many error messages'
          if (scrip_stdout /= scrip_stderr) then
            write(scrip_stdout,'(a23)') 'Too many error messages'
          endif
        endif
 
      endif
 
      write(scrip_stdout,scrip_blankformat)
      write(scrip_stdout,scrip_delimformat)
      write(scrip_stdout,scrip_blankformat)
 
    endif
 
    !-----------------------------------------------------------------------
    !EOC
 
  end subroutine scrip_errorprint
 
  !***********************************************************************
 
end module scrip_errormod
 
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||