Line data    Source code

       1             : module error_messages
       2             : 
       3             :    !----------------------------------------------------------------------- 
       4             :    ! 
       5             :    ! Purpose: 
       6             :    ! General purpose routines for issuing error messages.
       7             :    ! 
       8             :    ! Author: B. Eaton
       9             :    ! 
      10             :    !----------------------------------------------------------------------- 
      11             :    use cam_abortutils, only: endrun
      12             :    use cam_logfile,    only: iulog
      13             : 
      14             :    implicit none
      15             :    save
      16             :    private
      17             :    public :: &
      18             :       alloc_err,      &! Issue error message after non-zero return from an allocate statement.
      19             :       handle_err,     &! Issue error message after non-zero return from anything
      20             :       handle_ncerr     ! Handle error returns from netCDF library procedures.
      21             : 
      22             :    ! If an error message string is not empty, abort with that string as the
      23             :    ! error message.
      24             :    public :: handle_errmsg
      25             : 
      26             : !##############################################################################
      27             : contains
      28             : !##############################################################################
      29             : 
      30    36428831 :    subroutine alloc_err( istat, routine, name, nelem )
      31             : 
      32             :       !----------------------------------------------------------------------- 
      33             :       ! Purpose: 
      34             :       ! Issue error message after non-zero return from an allocate statement.
      35             :       !
      36             :       ! Author: B. Eaton
      37             :       !----------------------------------------------------------------------- 
      38             : 
      39             :       integer, intent(in) ::&
      40             :          istat           ! status from allocate statement
      41             :       character(len=*), intent(in) ::&
      42             :          routine,       &! routine that called allocate
      43             :          name            ! name of array
      44             :       integer, intent(in) ::&
      45             :          nelem           ! number of elements attempted to allocate
      46             :       !-----------------------------------------------------------------------
      47             : 
      48    36428831 :       if ( istat .ne. 0 ) then
      49             :          write(iulog,*)'ERROR trying to allocate memory in routine: ' &
      50           0 :                    //trim(routine)
      51           0 :          write(iulog,*)'  Variable name: '//trim(name)
      52           0 :          write(iulog,*)'  Number of elements: ',nelem
      53           0 :          call endrun ('ALLOC_ERR')
      54             :       end if
      55             : 
      56    36428831 :       return
      57             : 
      58             :    end subroutine alloc_err
      59             : 
      60             : !##############################################################################
      61             : 
      62           0 :    subroutine handle_err( istat, msg )
      63             : 
      64             :       !----------------------------------------------------------------------- 
      65             :       ! Purpose: 
      66             :       ! Issue error message after non-zero return from anything.
      67             :       !
      68             :       ! Author: T. Henderson
      69             :       !----------------------------------------------------------------------- 
      70             : 
      71             :       integer,          intent(in) :: istat  ! status, zero = "no error"
      72             :       character(len=*), intent(in) :: msg    ! error message to print
      73             :       !-----------------------------------------------------------------------
      74             : 
      75           0 :       if ( istat .ne. 0 ) then
      76           0 :          call endrun (trim(msg))
      77             :       end if
      78             : 
      79           0 :       return
      80             : 
      81             :    end subroutine handle_err
      82             : 
      83             : !##############################################################################
      84             : 
      85          86 :    subroutine handle_ncerr( ret, mes, line )
      86             :       
      87             :       !----------------------------------------------------------------------- 
      88             :       ! Purpose: 
      89             :       ! Check netCDF library function return code.  If error detected 
      90             :       ! issue error message then abort.
      91             :       !
      92             :       ! Author: B. Eaton
      93             :       !----------------------------------------------------------------------- 
      94             : 
      95             : !-----------------------------------------------------------------------
      96             :      use netcdf
      97             : !-----------------------------------------------------------------------
      98             : 
      99             :       integer, intent(in) ::&
     100             :          ret                 ! return code from netCDF library routine
     101             :       character(len=*), intent(in) ::&
     102             :          mes                 ! message to be printed if error detected
     103             :       integer, intent(in), optional :: line
     104             :       !-----------------------------------------------------------------------
     105             : 
     106          86 :       if ( ret .ne. NF90_NOERR ) then
     107           0 :          if(present(line)) then
     108           0 :             write(iulog,*) mes, line
     109             :          else   
     110           0 :             write(iulog,*) mes
     111             :          end if
     112           0 :          write(iulog,*) nf90_strerror( ret )
     113           0 :          call endrun ('HANDLE_NCERR')
     114             :       endif
     115             : 
     116          86 :       return
     117             : 
     118             :    end subroutine handle_ncerr
     119             : 
     120             : !##############################################################################
     121             : 
     122    10430376 :    subroutine handle_errmsg(errmsg, subname, extra_msg)
     123             : 
     124             :      ! String that is asserted to be null.
     125             :      character(len=*), intent(in)           :: errmsg
     126             :      ! Name of procedure generating the message.
     127             :      character(len=*), intent(in), optional :: subname
     128             :      ! Additional message from the procedure calling this one.
     129             :      character(len=*), intent(in), optional :: extra_msg
     130             : 
     131    10430376 :      if (trim(errmsg) /= "") then
     132             : 
     133           0 :         if (present(extra_msg)) &
     134             :              write(iulog,*) "handle_errmsg: &
     135           0 :              &Message from caller: ",trim(extra_msg)
     136             : 
     137           0 :         if (present(subname)) then
     138             :            call endrun("ERROR: handle_errmsg: "// &
     139           0 :                 trim(subname)//": "//trim(errmsg))
     140             :         else
     141             :            call endrun("ERROR: handle_errmsg: "// &
     142           0 :                 "Error message received from routine: "//trim(errmsg))
     143             :         end if
     144             : 
     145             :      end if
     146             : 
     147    10430376 :    end subroutine handle_errmsg
     148             : 
     149             : !##############################################################################
     150             : 
     151             : end module error_messages