wrfv2_fire/phys/module_diagnostics.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3
   4 MODULE module_diagnostics
   5 CONTAINS
   6    SUBROUTINE diagnostic_output_calc(                                 &
   7                       ids,ide, jds,jde, kds,kde,                      &
   8                       ims,ime, jms,jme, kms,kme,                      &
   9                       ips,ipe, jps,jpe, kps,kpe,                      & ! patch  dims
  10                       i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
  11                      ,dpsdt,dmudt                                     &
  12                      ,p8w,pk1m,mu_2,mu_2m                             &
  13                      ,u,v                                             &
  14                      ,raincv,rainncv,rainc,rainnc                     &
  15                      ,hfx,sfcevp,lh                                   &
  16                      ,dt,xtime,sbw                                    &
  17                      ,diag_print                                      &
  18                                                                       )
  19 !----------------------------------------------------------------------
  20
  21   USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
  22
  23    IMPLICIT NONE
  24 !======================================================================
  25 ! Definitions
  26 !-----------
  27 !-- DIAG_PRINT    print control: 0 - no diagnostics; 1 - dmudt only; 2 - all
  28 !-- DT            time step (second)
  29 !-- XTIME         forecast time
  30 !-- SBW           specified boundary width - used later
  31 !
  32 !-- P8W           3D pressure array at full eta levels
  33 !-- MU            dry column hydrostatic pressure
  34 !-- RAINC         cumulus scheme precipitation since hour 0
  35 !-- RAINCV        cumulus scheme precipitation in one time step (mm)
  36 !-- RAINNC        explicit scheme precipitation since hour 0
  37 !-- RAINNCV       explicit scheme precipitation in one time step (mm)
  38 !-- HFX           surface sensible heat flux
  39 !-- LH            surface latent heat flux
  40 !-- SFCEVP        total surface evaporation
  41 !-- U             u component of wind - to be used later to compute k.e.
  42 !-- V             v component of wind - to be used later to compute k.e.
  43 !
  44 !-- ids           start index for i in domain
  45 !-- ide           end index for i in domain
  46 !-- jds           start index for j in domain
  47 !-- jde           end index for j in domain
  48 !-- kds           start index for k in domain
  49 !-- kde           end index for k in domain
  50 !-- ims           start index for i in memory
  51 !-- ime           end index for i in memory
  52 !-- jms           start index for j in memory
  53 !-- jme           end index for j in memory
  54 !-- ips           start index for i in patch
  55 !-- ipe           end index for i in patch
  56 !-- jps           start index for j in patch
  57 !-- jpe           end index for j in patch
  58 !-- kms           start index for k in memory
  59 !-- kme           end index for k in memory
  60 !-- i_start       start indices for i in tile
  61 !-- i_end         end indices for i in tile
  62 !-- j_start       start indices for j in tile
  63 !-- j_end         end indices for j in tile
  64 !-- kts           start index for k in tile
  65 !-- kte           end index for k in tile
  66 !-- num_tiles     number of tiles
  67 !
  68 !======================================================================
  69
  70    INTEGER,      INTENT(IN   )    ::                             &
  71                                       ids,ide, jds,jde, kds,kde, &
  72                                       ims,ime, jms,jme, kms,kme, &
  73                                       ips,ipe, jps,jpe, kps,kpe, &
  74                                                         kts,kte, &
  75                                                       num_tiles
  76
  77    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                  &
  78      &           i_start,i_end,j_start,j_end
  79
  80    INTEGER,      INTENT(IN   )    ::   diag_print
  81
  82    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
  83          INTENT(IN ) ::                                       u  &
  84                                                     ,         v  &
  85                                                     ,       p8w
  86
  87    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
  88                                                            MU_2  &
  89                                                     ,     RAINC  &
  90                                                     ,    RAINNC  &
  91                                                     ,    RAINCV  &
  92                                                     ,   RAINNCV  &
  93                                                     ,       HFX  &
  94                                                     ,    SFCEVP  &
  95                                                     ,        LH
  96
  97    REAL, DIMENSION( ims:ime , jms:jme ),                         &
  98           INTENT(INOUT) ::                                DPSDT  &
  99                                                     ,     DMUDT  &
 100                                                     ,     MU_2M  &
 101                                                     ,      PK1M
 102
 103    REAL,  INTENT(IN   ) :: DT, XTIME
 104    INTEGER,  INTENT(IN   ) :: SBW
 105
 106 ! LOCAL  VAR
 107
 108    INTEGER :: i,j,k,its,ite,jts,jte,ij
 109    INTEGER :: idp,jdp,irc,jrc,irnc,jrnc,isnh,jsnh
 110    INTEGER :: prfreq
 111
 112    REAL              :: no_points
 113    REAL              :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
 114    REAL              :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
 115    REAL              :: dmumax, raincmax, rainncmax, snowhmax
 116    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
 117    CHARACTER*256     :: outstring
 118    CHARACTER*6       :: grid_str
 119
 120 !-----------------------------------------------------------------
 121
 122    if (diag_print .eq. 0 ) return
 123
 124    IF ( xtime .ne. 0. ) THEN
 125
 126     if(diag_print.eq.1) then
 127        prfreq = dt
 128 !      prfreq = max(2,int(dt/60.))   ! in min
 129     else
 130        prfreq=10                   ! in min
 131     endif
 132
 133     IF (MOD(nint(dt),prfreq) == 0) THEN
 134
 135 ! COMPUTE THE NUMBER OF MASS GRID POINTS
 136    no_points = float((ide-ids)*(jde-jds))
 137
 138 ! SET START AND END POINTS FOR TILES
 139 !  !$OMP PARALLEL DO   &
 140 !  !$OMP PRIVATE ( ij )
 141
 142    dmumax = 0.
 143    DO ij = 1 , num_tiles
 144
 145 !     print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
 146       DO j=j_start(ij),j_end(ij)
 147       DO i=i_start(ij),i_end(ij)
 148          dpsdt(i,j)=(p8w(i,kms,j)-pk1m(i,j))/dt
 149          dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
 150          if(abs(dmudt(i,j)*dt).gt.dmumax)then
 151            dmumax=abs(dmudt(i,j)*dt)
 152            idp=i
 153            jdp=j
 154          endif
 155       ENDDO
 156       ENDDO
 157
 158    ENDDO
 159 !  !$OMP END PARALLEL DO
 160
 161 ! convert DMUMAX from (PA) to (bars) per time step
 162    dmumax = dmumax*1.e-5
 163 ! compute global MAX
 164    CALL wrf_dm_maxval ( dmumax,  idp, jdp )
 165
 166 !  print *, 'p8w(30,1,30),pk1m(30,30) : ', p8w(30,1,30),pk1m(30,30)
 167 !  print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
 168    dpsdt_sum = 0.
 169    dmudt_sum = 0.
 170
 171    DO j = jps, min(jpe,jde-1)
 172      DO i = ips, min(ipe,ide-1)
 173        dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
 174        dmudt_sum = dmudt_sum + abs(dmudt(i,j))
 175      ENDDO
 176    ENDDO
 177
 178 ! compute global sum
 179    dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
 180    dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
 181
 182 !  print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
 183
 184    IF ( diag_print .eq. 2 ) THEN
 185    dardt_sum = 0.
 186    drcdt_sum = 0.
 187    drndt_sum = 0.
 188    rainc_sum = 0.
 189    raint_sum = 0.
 190    rainnc_sum = 0.
 191    sfcevp_sum = 0.
 192    hfx_sum = 0.
 193    lh_sum = 0.
 194
 195    DO j = jps, min(jpe,jde-1)
 196      DO i = ips, min(ipe,ide-1)
 197        drcdt_sum = drcdt_sum + abs(raincv(i,j))
 198        drndt_sum = drndt_sum + abs(rainncv(i,j))
 199        dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
 200        rainc_sum = rainc_sum + abs(rainc(i,j))
 201 ! MAX for accumulated conv precip
 202        IF(rainc(i,j).gt.raincmax)then
 203           raincmax=rainc(i,j)
 204           irc=i
 205           jrc=j
 206        ENDIF
 207        rainnc_sum = rainnc_sum + abs(rainnc(i,j))
 208 ! MAX for accumulated resolved precip
 209        IF(rainnc(i,j).gt.rainncmax)then
 210           rainncmax=rainnc(i,j)
 211           irnc=i
 212           jrnc=j
 213        ENDIF
 214        raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
 215        sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
 216        hfx_sum = hfx_sum + abs(hfx(i,j))
 217        lh_sum = lh_sum + abs(lh(i,j))
 218      ENDDO
 219    ENDDO
 220
 221 ! compute global MAX
 222    CALL wrf_dm_maxval ( raincmax, irc, jrc )
 223    CALL wrf_dm_maxval ( rainncmax, irnc, jrnc )
 224
 225 ! compute global sum
 226    drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
 227    drndt_sum = wrf_dm_sum_real ( drndt_sum )
 228    dardt_sum = wrf_dm_sum_real ( dardt_sum )
 229    rainc_sum = wrf_dm_sum_real ( rainc_sum )
 230    rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
 231    raint_sum = wrf_dm_sum_real ( raint_sum )
 232    sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
 233    hfx_sum = wrf_dm_sum_real ( hfx_sum )
 234    lh_sum = wrf_dm_sum_real ( lh_sum )
 235
 236    ENDIF
 237
 238 ! print out the average values
 239
 240    CALL get_current_grid_name( grid_str )
 241
 242 #ifdef DM_PARALLEL
 243    IF ( wrf_dm_on_monitor() ) THEN
 244 #endif
 245      WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (mb/3h): ', xtime, &
 246            dpsdt_sum/no_points*108., &
 247            dmudt_sum/no_points*108.
 248      CALL wrf_message ( TRIM(outstring) )
 249
 250      WRITE(outstring,*) grid_str,'Max mu change time step: ', idp,jdp,dmumax
 251      CALL wrf_message ( TRIM(outstring) )
 252
 253      IF ( diag_print .eq. 2) THEN
 254      WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
 255            dardt_sum/dt/no_points, &
 256            drcdt_sum/dt/no_points, &
 257            drndt_sum/dt/no_points
 258      CALL wrf_message ( TRIM(outstring) )
 259      WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm): ', xtime, &
 260            raint_sum/no_points, &
 261            rainc_sum/no_points, &
 262            rainnc_sum/no_points
 263      CALL wrf_message ( TRIM(outstring) )
 264      WRITE(outstring,*) grid_str,'Max Accum Resolved Precip,   I,J  (mm): '               ,&
 265            rainncmax,irnc,jrnc
 266      CALL wrf_message ( TRIM(outstring) )
 267      WRITE(outstring,*) grid_str,'Max Accum Convective Precip,   I,J  (mm): '             ,&
 268            raincmax,irc,jrc
 269      CALL wrf_message ( TRIM(outstring) )
 270      WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
 271            sfcevp_sum/no_points, &
 272            hfx_sum/no_points, &
 273            lh_sum/no_points
 274      CALL wrf_message ( TRIM(outstring) )
 275      ENDIF
 276 #ifdef DM_PARALLEL
 277    ENDIF
 278 #endif
 279
 280     ENDIF        ! print frequency
 281    ENDIF
 282
 283 ! save values at this time step
 284    !$OMP PARALLEL DO   &
 285    !$OMP PRIVATE ( ij,i,j )
 286    DO ij = 1 , num_tiles
 287
 288       DO j=j_start(ij),j_end(ij)
 289       DO i=i_start(ij),i_end(ij)
 290          pk1m(i,j)=p8w(i,kms,j)
 291          mu_2m(i,j)=mu_2(i,j)
 292       ENDDO
 293       ENDDO
 294
 295       IF ( xtime .lt. 0.0001 ) THEN
 296       DO j=j_start(ij),j_end(ij)
 297       DO i=i_start(ij),i_end(ij)
 298          dpsdt(i,j)=0.
 299          dmudt(i,j)=0.
 300       ENDDO
 301       ENDDO
 302       ENDIF
 303
 304    ENDDO
 305    !$OMP END PARALLEL DO
 306
 307    END SUBROUTINE diagnostic_output_calc
 308
 309 END MODULE module_diagnostics