wrf_debug.F

1 SUBROUTINE set_wrf_debug_level ( level ) 
2   USE module_wrf_error 
3   IMPLICIT NONE 
4   INTEGER , INTENT(IN) :: level 
5   wrf_debug_level = level 
6   RETURN 
7 END SUBROUTINE set_wrf_debug_level 
8  
9 SUBROUTINE get_wrf_debug_level ( level ) 
10   USE module_wrf_error 
11   IMPLICIT NONE 
12   INTEGER , INTENT(OUT) :: level 
13   level = wrf_debug_level 
14   RETURN 
15 END SUBROUTINE get_wrf_debug_level 
16  
17 SUBROUTINE wrf_debug( level , str ) 
18   USE module_wrf_error 
19   IMPLICIT NONE 
20   CHARACTER*(*) str 
21   INTEGER , INTENT (IN) :: level 
22   INTEGER :: debug_level 
23   CHARACTER (LEN=256) :: time_str 
24   CHARACTER (LEN=256) :: grid_str 
25   CHARACTER (LEN=512) :: out_str 
26   CALL get_wrf_debug_level( debug_level ) 
27   IF ( level .LE. debug_level ) THEN 
28 #ifdef _OPENMP 
29   ! old behavior 
30   CALL wrf_message( str ) 
31 #else 
32   ! TBH: This fails on pgf90 6.1-4 when built with OpenMP and using more 
33   ! TBH: than one thread. It works fine multi-threaded on AIX with xlf 
34   ! TBH: 10.1.0.0 . Hence the cpp nastiness. 
35   ! new behavior: include domain name and time-stamp 
36   CALL get_current_time_string( time_str ) 
37   CALL get_current_grid_name( grid_str ) 
38   out_str = TRIM(grid_str)//' '//TRIM(time_str)//' '//TRIM(str) 
39   CALL wrf_message( TRIM(out_str) ) 
40 #endif 
41   ENDIF 
42   RETURN 
43 END SUBROUTINE wrf_debug