wrfv2_fire/frame/module_wrf_error.F

   1 !WRF:DRIVER_LAYER:UTIL
   2 !
   3
   4 MODULE module_wrf_error
   5   INTEGER           :: wrf_debug_level = 0
   6   CHARACTER*256     :: wrf_err_message
   7 CONTAINS
   8
   9   LOGICAL FUNCTION wrf_at_debug_level ( level )
  10     IMPLICIT NONE
  11     INTEGER , INTENT(IN) :: level
  12     wrf_at_debug_level = ( level .LE. wrf_debug_level )
  13     RETURN
  14   END FUNCTION wrf_at_debug_level
  15
  16   SUBROUTINE init_module_wrf_error
  17   END SUBROUTINE init_module_wrf_error
  18
  19 END MODULE module_wrf_error
  20
  21 SUBROUTINE wrf_message( str )
  22   IMPLICIT NONE
  23   CHARACTER*(*) str
  24 #if defined( DM_PARALLEL ) && ! defined( STUBMPI)
  25   write(0,*) TRIM(str)
  26 #endif
  27   print*, TRIM(str)
  28 END SUBROUTINE wrf_message
  29
  30 ! intentionally write to stderr only
  31 SUBROUTINE wrf_message2( str )
  32   IMPLICIT NONE
  33   CHARACTER*(*) str
  34   write(0,*) str
  35 END SUBROUTINE wrf_message2
  36
  37 SUBROUTINE wrf_error_fatal3( file_str, line, str )
  38   USE module_wrf_error
  39 #ifdef ESMFIO
  40   USE ESMF_Mod
  41 #endif
  42   IMPLICIT NONE
  43   CHARACTER*(*) file_str
  44   INTEGER , INTENT (IN) :: line  ! only print file and line if line > 0
  45   CHARACTER*(*) str
  46   CHARACTER*256 :: line_str
  47
  48   write(line_str,'(i6)') line
  49 #if defined( DM_PARALLEL ) && ! defined( STUBMPI )
  50   CALL wrf_message( '-------------- FATAL CALLED ---------------' )
  51   ! only print file and line if line is positive
  52   IF ( line > 0 ) THEN
  53     CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
  54   ENDIF
  55   CALL wrf_message( str )
  56   CALL wrf_message( '-------------------------------------------' )
  57 #else
  58   CALL wrf_message2( '-------------- FATAL CALLED ---------------' )
  59   ! only print file and line if line is positive
  60   IF ( line > 0 ) THEN
  61     CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
  62   ENDIF
  63   CALL wrf_message2( str )
  64   CALL wrf_message2( '-------------------------------------------' )
  65 #endif
  66 #ifdef ESMFIO
  67   CALL esmf_finalize(terminationflag=ESMF_ABORT)
  68 #endif
  69   CALL wrf_abort
  70 END SUBROUTINE wrf_error_fatal3
  71
  72 SUBROUTINE wrf_error_fatal( str )
  73   USE module_wrf_error
  74   IMPLICIT NONE
  75   CHARACTER*(*) str
  76   CALL wrf_error_fatal3 ( ' ', 0, str )
  77 END SUBROUTINE wrf_error_fatal
  78
  79 ! Check to see if expected value == actual value
  80 ! If not, print message and exit.
  81 SUBROUTINE wrf_check_error( expected, actual, str, file_str, line )
  82   USE module_wrf_error
  83   IMPLICIT NONE
  84   INTEGER , INTENT (IN) :: expected
  85   INTEGER , INTENT (IN) :: actual
  86   CHARACTER*(*) str
  87   CHARACTER*(*) file_str
  88   INTEGER , INTENT (IN) :: line
  89   CHARACTER (LEN=512)   :: rc_str
  90   CHARACTER (LEN=512)   :: str_with_rc
  91
  92   IF ( expected .ne. actual ) THEN
  93     WRITE (rc_str,*) '  Routine returned error code = ',actual
  94     str_with_rc = TRIM(str // rc_str)
  95     CALL wrf_error_fatal3 ( file_str, line, str_with_rc )
  96   ENDIF
  97 END SUBROUTINE wrf_check_error
  98
  99