frame/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   if(silence/=0) return
  27   CALL get_wrf_debug_level( debug_level )
  28   IF ( level .LE. debug_level ) THEN
  29 #ifdef _OPENMP
  30   ! old behavior
  31   CALL wrf_message( str )
  32 #else
  33   ! TBH: This fails on pgf90 6.1-4 when built with OpenMP and using more
  34   ! TBH: than one thread. It works fine multi-threaded on AIX with xlf
  35   ! TBH: 10.1.0.0 . Hence the cpp nastiness.
  36   ! new behavior: include domain name and time-stamp
  37   CALL get_current_time_string( time_str )
  38   CALL get_current_grid_name( grid_str )
  39   out_str = TRIM(grid_str)//' '//TRIM(time_str)//' '//TRIM(str)
  40   CALL wrf_message( TRIM(out_str) )
  41 #endif
  42   ENDIF
  43   RETURN
  44 END SUBROUTINE wrf_debug