Line data    Source code

       1             : !------------------------------------------------------------------------------
       2             : !       NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group        !
       3             : !                      and NASA/GSFC, SIVO, Code 610.3                        !
       4             : !------------------------------------------------------------------------------
       5             : !BOP
       6             : !
       7             : ! !MODULE: m_do_err_out.F90
       8             : !
       9             : ! !INTERFACE:
      10             : !
      11             : module m_Do_Err_Out
      12             : !
      13             :   implicit none
      14             : !
      15             : ! !PUBLIC MEMBER FUNCTIONS:
      16             : !
      17             :   public  Do_Err_Out
      18             : !
      19             : ! !DESCRIPTION: Provides a routine to print an error message and exit the code.
      20             : !\\
      21             : !\\
      22             : ! !AUTHOR:
      23             : !  Jules Kouatchou
      24             : !
      25             : ! !REVISION HISTORY:
      26             : !  See https://github.com/geoschem/ncdfutil for complete history
      27             : !EOP
      28             : !------------------------------------------------------------------------------
      29             : !BOC
      30             : CONTAINS
      31             : !EOC
      32             : !------------------------------------------------------------------------------
      33             : !       NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group        !
      34             : !                      and NASA/GSFC, SIVO, Code 610.3                        !
      35             : !------------------------------------------------------------------------------
      36             : !BOP
      37             : !
      38             : ! !IROUTINE: Do_Err_Out
      39             : !
      40             : ! !INTERFACE:
      41             : !
      42           0 :   subroutine Do_Err_Out  &
      43             :        (err_msg, err_do_stop, err_num_ints, err_int1, err_int2,  &
      44             :        err_num_reals, err_real1, err_real2)
      45             : !
      46             :     implicit none
      47             : !
      48             : ! !INPUT PARAMETERS:
      49             : !!     err_msg       : error message to be printed out
      50             : !!     err_do_stop   : do stop on error?
      51             : !!     err_num_ints  : number of integers to be printed out (0, 1, or 2)
      52             : !!     err_int1      : integer 1 to print out
      53             : !!     err_int2      : integer 2 to print out
      54             : !!     err_num_reals : number of reals to be printed out (0, 1, or 2)
      55             : !!     err_real1     : real 1 to print out
      56             : !!     err_real2     : real 2 to print out
      57             :     character (len=*), intent(in) :: err_msg
      58             :     logical          , intent(in) :: err_do_stop
      59             :     integer          , intent(in) :: err_num_ints
      60             :     integer          , intent(in) :: err_int1
      61             :     integer          , intent(in) :: err_int2
      62             :     integer          , intent(in) :: err_num_reals
      63             :     real*8           , intent(in) :: err_real1
      64             :     real*8           , intent(in) :: err_real2
      65             : !
      66             : ! !DESCRIPTION: Outputs error messages, and exits if requested.
      67             : !\\
      68             : !\\
      69             : ! !AUTHOR:
      70             : !  John Tannahill (LLNL) and Jules Kouatchou
      71             : !
      72             : ! !REMARKS:
      73             : !  NOTE: SHOULD PROPAGATE ERROR CODE TO MAIN PROGRAM LEVEL!
      74             : !
      75             : ! !REVISION HISTORY:
      76             : !  See https://github.com/geoschem/ncdfutil for complete history
      77             : !EOP
      78             : !-------------------------------------------------------------------------
      79             : !BOC
      80             : 
      81             :     ! Write separator
      82           0 :     WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 )
      83             : 
      84             :     ! Write error message
      85           0 :     WRITE( 6,'(a)' ) TRIM( err_msg )
      86             : 
      87             :     ! Write error codes
      88           0 :     IF ( err_num_ints == 1 ) THEN
      89           0 :        WRITE( 6,'(i10)'   ) err_int1
      90           0 :     ELSE IF ( err_num_ints == 2 ) then
      91           0 :        WRITE( 6, '(2i10)' ) err_int1, err_int2
      92             :     ENDIF
      93             : 
      94           0 :     IF ( err_num_reals == 1 ) THEN
      95           0 :        WRITE( 6, '(f13.6  )' ) err_real1
      96           0 :     ELSE IF ( err_num_reals == 2 ) THEN
      97           0 :        WRITE( 6, '(2f13.6 )' ) err_real1, err_real2
      98             :     ENDIF
      99             : 
     100             :     ! Write separator
     101           0 :     WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 )
     102             : 
     103             :     ! Flush the buffer
     104             :     ! Flush is unavailable on the NAG compiler (for CESM) and CPRNAG is defined if using it.
     105             : #ifndef CPRNAG
     106           0 :     CALL Flush( 6 )
     107             : #endif
     108             : 
     109             :     ! Stop with error (if requested)
     110             :     ! NOTE: We should pass back the error code to the main routine
     111           0 :     IF ( err_do_stop ) THEN
     112             :         WRITE( 6, '(a,/)' ) 'Code stopped from DO_ERR_OUT '               // &
     113           0 :                             '(in module NcdfUtil/m_do_err_out.F90) '
     114             :         WRITE( 6, '(a)'   ) 'This is an error that was encountered '      // &
     115           0 :                             'in one of the netCDF I/O modules,'
     116             :         WRITE( 6, '(a)'   ) 'which indicates an error in writing to '     // &
     117           0 :                             'or reading from a netCDF file!'
     118             : 
     119             :         ! Write separator
     120           0 :         WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 )
     121             : 
     122             :         ! Flush stdout buffer
     123             :         ! Flush is unavailable on the NAG compiler (for CESM) and CPRNAG is defined if using it.
     124             : #ifndef CPRNAG
     125           0 :         CALL Flush( 6 )
     126             : #endif
     127             : 
     128             :         ! NOTE: Should not exit but pass error code up
     129             :         ! work on this for a future version
     130           0 :         stop 999
     131             :     ENDIF
     132             : 
     133           0 :     RETURN
     134             : 
     135             :   end subroutine Do_Err_Out
     136             : !EOC
     137             : end module m_Do_Err_Out