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   IMPLICIT NONE
40   CHARACTER*(*) file_str
41   INTEGER , INTENT (IN) :: line  ! only print file and line if line > 0
42   CHARACTER*(*) str
43   CHARACTER*256 :: line_str
44 
45   write(line_str,'(i6)') line
46 #if defined( DM_PARALLEL ) && ! defined( STUBMPI )
47   CALL wrf_message( '-------------- FATAL CALLED ---------------' )
48   ! only print file and line if line is positive
49   IF ( line > 0 ) THEN
50     CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
51   ENDIF
52   CALL wrf_message( str )
53   CALL wrf_message( '-------------------------------------------' )
54 #else
55   CALL wrf_message2( '-------------- FATAL CALLED ---------------' )
56   ! only print file and line if line is positive
57   IF ( line > 0 ) THEN
58     CALL wrf_message( 'FATAL CALLED FROM FILE:  '//file_str//'  LINE:  '//TRIM(line_str) )
59   ENDIF
60   CALL wrf_message2( str )
61   CALL wrf_message2( '-------------------------------------------' )
62 #endif
63   CALL wrf_abort
64 END SUBROUTINE wrf_error_fatal3
65 
66 SUBROUTINE wrf_error_fatal( str )
67   USE module_wrf_error
68   IMPLICIT NONE
69   CHARACTER*(*) str
70   CALL wrf_error_fatal3 ( ' ', 0, str )
71 END SUBROUTINE wrf_error_fatal
72 
73 ! Check to see if expected value == actual value
74 ! If not, print message and exit.  
75 SUBROUTINE wrf_check_error( expected, actual, str, file_str, line )
76   USE module_wrf_error
77   IMPLICIT NONE
78   INTEGER , INTENT (IN) :: expected
79   INTEGER , INTENT (IN) :: actual
80   CHARACTER*(*) str
81   CHARACTER*(*) file_str
82   INTEGER , INTENT (IN) :: line
83   CHARACTER (LEN=512)   :: rc_str
84   CHARACTER (LEN=512)   :: str_with_rc
85 
86   IF ( expected .ne. actual ) THEN
87     WRITE (rc_str,*) '  Routine returned error code = ',actual
88     str_with_rc = TRIM(str // rc_str)
89     CALL wrf_error_fatal3 ( file_str, line, str_with_rc )
90   ENDIF
91 END SUBROUTINE wrf_check_error
92 
93