phys/module_diag_misc.F

   1 #if ( NMM_CORE == 1)
   2 MODULE module_diag_misc
   3 CONTAINS
   4    SUBROUTINE diag_misc_stub
   5    END SUBROUTINE diag_misc_stub
   6 END MODULE module_diag_misc
   7 #else
   8 !WRF:MEDIATION_LAYER:PHYSICS
   9 !
  10
  11 MODULE module_diag_misc
  12 CONTAINS
  13    SUBROUTINE diagnostic_output_calc(                                 &
  14                       ids,ide, jds,jde, kds,kde,                      &
  15                       ims,ime, jms,jme, kms,kme,                      &
  16                       ips,ipe, jps,jpe, kps,kpe,                      & ! patch  dims
  17                       i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
  18                      ,dpsdt,dmudt                                     &
  19                      ,p8w,pk1m,mu_2,mu_2m                             &
  20                      ,raincv,rainncv,rainc,rainnc                     &
  21                      ,i_rainc,i_rainnc                                &
  22                      ,hfx,sfcevp,lh,t2                                &
  23                      ,ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC               & ! Optional
  24                      ,ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC               & ! Optional
  25                      ,ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC               & ! Optional
  26                      ,ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC               & ! Optional
  27                      ,I_ACSWUPT,I_ACSWUPTC,I_ACSWDNT,I_ACSWDNTC       & ! Optional
  28                      ,I_ACSWUPB,I_ACSWUPBC,I_ACSWDNB,I_ACSWDNBC       & ! Optional
  29                      ,I_ACLWUPT,I_ACLWUPTC,I_ACLWDNT,I_ACLWDNTC       & ! Optional
  30                      ,I_ACLWUPB,I_ACLWUPBC,I_ACLWDNB,I_ACLWDNBC       & ! Optional
  31                      ,athmp, aqvmp                                    &
  32                      ,athcu, aqvcu, aucu, avcu                        &
  33                      ,athsh, aqvsh, aush, avsh                        &
  34                      ,athbl, aqvbl, aubl, avbl                        &
  35                      ,athralw, athrasw                                &
  36                      ,h_diabatic, qv_diabatic                         &
  37                      ,rthcuten, rqvcuten, rucuten, rvcuten            &
  38                      ,rthshten, rqvshten, rushten, rvshten            &
  39                      ,rthblten, rqvblten, rublten, rvblten            &
  40                      ,rthratenlw, rthratensw                          &
  41                      ,dt,xtime                                        &
  42                      ,diag_print                                      &
  43                      ,bucket_mm, bucket_J                             &
  44                      ,prec_acc_c, prec_acc_nc, snow_acc_nc            &
  45                      ,snowncv, prec_acc_dt, curr_secs2                &
  46                      ,history_interval                                &
  47                      ,itimestep                                       &
  48                      ,cu_used, shcu_used, acc_phy_tend                &
  49                                                                       )
  50 !----------------------------------------------------------------------
  51
  52   USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
  53
  54   IMPLICIT NONE
  55 !======================================================================
  56 ! Definitions
  57 !-----------
  58 !-- DIAG_PRINT    print control: 0 - no diagnostics; 1 - dmudt only; 2 - all
  59 !-- DT            time step (second)
  60 !-- XTIME         forecast time
  61 !-- ACSWUPT
  62 !-- ACSWUPTC
  63 !-- ACSWDNT
  64 !-- ACSWDNTC
  65 !-- ACSWUPB
  66 !-- ACSWUPBC
  67 !-- ACSWDNB
  68 !-- ACSWDNBC
  69 !-- ACLWUPT
  70 !-- ACLWUPTC
  71 !-- ACLWDNT
  72 !-- ACLWDNTC
  73 !-- ACLWUPB
  74 !-- ACLWUPBC
  75 !-- ACLWDNB
  76 !-- ACLWDNBC
  77 !-- ATHMPTEN      Accumulated theta tendency from microphysics
  78 !-- AQVMPTEN      Accumulated qv tendency from microphysics
  79 !-- ATHCUTEN      Accumulated theta tendency from cumulus physics
  80 !-- AQVCUTEN      Accumulated qv tendency from cumulus physics
  81 !-- AUCUTEN       Accumulated u-wind tendency from cumulus physics
  82 !-- AVCUTEN       Accumulated v-wind tendency from cumulus physics
  83 !-- ATHSHTEN      Accumulated theta tendency from shallow cumulus
  84 !-- AQVSHTEN      Accumulated qv tendency from shallow cumulus
  85 !-- AUSHTEN       Accumulated u-wind tendency from shallow cumulus
  86 !-- AVSHTEN       Accumulated v-wind tendency from shallow cumulus
  87 !-- ATHBLTEN      Accumulated theta tendency from pbl physics
  88 !-- AQVBLTEN      Accumulated qv tendency from pbl physics
  89 !-- AUBLTEN       Accumulated u-wind tendency from pbl physics
  90 !-- AVBLTEN       Accumulated v-wind tendency from pbl physics
  91 !-- ATHRATENLW    Accumulated theta tendency from longwave radiation
  92 !-- ATHRATENSW    Accumulated theta tendency from shortwave radiation
  93 !-- P8W           3D pressure array at full eta levels
  94 !-- MU            dry column hydrostatic pressure
  95 !-- RAINC         cumulus scheme precipitation since hour 0
  96 !-- RAINCV        cumulus scheme precipitation in one time step (mm)
  97 !-- RAINNC        explicit scheme precipitation since hour 0
  98 !-- RAINNCV       explicit scheme precipitation in one time step (mm)
  99 !-- SNOWNCV       explicit scheme snow in one time step (mm)
 100 !-- HFX           surface sensible heat flux
 101 !-- LH            surface latent heat flux
 102 !-- SFCEVP        total surface evaporation
 103 !-- PREC_ACC_C    accumulated convective precip over accumulation time prec_acc_dt
 104 !-- PREC_ACC_NC   accumulated explicit precip over accumulation time prec_acc_dt
 105 !-- SNOW_ACC_NC   accumulated explicit snow precip over accumulation time prec_acc_dt
 106 !-- PREC_ACC_DT   precip accumulation time, default is 60 min
 107 !-- CURR_SECS2    Time (s) since the beginning of the restart
 108 !
 109 !-- ids           start index for i in domain
 110 !-- ide           end index for i in domain
 111 !-- jds           start index for j in domain
 112 !-- jde           end index for j in domain
 113 !-- kds           start index for k in domain
 114 !-- kde           end index for k in domain
 115 !-- ims           start index for i in memory
 116 !-- ime           end index for i in memory
 117 !-- jms           start index for j in memory
 118 !-- jme           end index for j in memory
 119 !-- ips           start index for i in patch
 120 !-- ipe           end index for i in patch
 121 !-- jps           start index for j in patch
 122 !-- jpe           end index for j in patch
 123 !-- kms           start index for k in memory
 124 !-- kme           end index for k in memory
 125 !-- i_start       start indices for i in tile
 126 !-- i_end         end indices for i in tile
 127 !-- j_start       start indices for j in tile
 128 !-- j_end         end indices for j in tile
 129 !-- kts           start index for k in tile
 130 !-- kte           end index for k in tile
 131 !-- num_tiles     number of tiles
 132 !
 133 !======================================================================
 134
 135    INTEGER,      INTENT(IN   )    ::                             &
 136                                       ids,ide, jds,jde, kds,kde, &
 137                                       ims,ime, jms,jme, kms,kme, &
 138                                       ips,ipe, jps,jpe, kps,kpe, &
 139                                                         kts,kte, &
 140                                                       num_tiles
 141
 142    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                  &
 143      &           i_start,i_end,j_start,j_end
 144
 145    INTEGER,   INTENT(IN   )    ::   diag_print
 146    REAL,      INTENT(IN   )    ::   bucket_mm, bucket_J
 147
 148    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 149          INTENT(IN ) ::                                     p8w
 150
 151    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
 152                                                            MU_2  &
 153                                                     ,   RAINNCV  &
 154                                                     ,    RAINCV  &
 155                                                     ,   SNOWNCV  &
 156                                                     ,       HFX  &
 157                                                     ,        LH  &
 158                                                     ,    SFCEVP  &
 159                                                     ,        T2
 160
 161    REAL, DIMENSION( ims:ime , jms:jme ),                         &
 162           INTENT(INOUT) ::                                DPSDT  &
 163                                                     ,     DMUDT  &
 164                                                     ,    RAINNC  &
 165                                                     ,     RAINC  &
 166                                                     ,     MU_2M  &
 167                                                     ,      PK1M
 168
 169    REAL,  INTENT(IN   ) :: DT, XTIME
 170    INTEGER,  INTENT(IN   )  ::  cu_used, shcu_used, acc_phy_tend
 171    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) ::&
 172                                                     athmp,aqvmp  &
 173                                          ,athcu,aqvcu,aucu,avcu  &
 174                                          ,athsh,aqvsh,aush,avsh  &
 175                                          ,athbl,aqvbl,aubl,avbl  &
 176                                                ,athralw,athrasw
 177
 178    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) ::   &
 179                                          h_diabatic,qv_diabatic  &
 180                              ,rthcuten,rqvcuten,rucuten,rvcuten  &
 181                              ,rthshten,rqvshten,rushten,rvshten  &
 182                              ,rthblten,rqvblten,rublten,rvblten  &
 183                                          ,rthratenlw,rthratensw
 184
 185    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) ::     &
 186                                                        I_RAINC,  &
 187                                                        I_RAINNC
 188    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
 189                       ACSWUPT,ACSWUPTC,ACSWDNT,ACSWDNTC,          &
 190                       ACSWUPB,ACSWUPBC,ACSWDNB,ACSWDNBC,          &
 191                       ACLWUPT,ACLWUPTC,ACLWDNT,ACLWDNTC,          &
 192                       ACLWUPB,ACLWUPBC,ACLWDNB,ACLWDNBC
 193    INTEGER, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
 194                       I_ACSWUPT,I_ACSWUPTC,I_ACSWDNT,I_ACSWDNTC,  &
 195                       I_ACSWUPB,I_ACSWUPBC,I_ACSWDNB,I_ACSWDNBC,  &
 196                       I_ACLWUPT,I_ACLWUPTC,I_ACLWDNT,I_ACLWDNTC,  &
 197                       I_ACLWUPB,I_ACLWUPBC,I_ACLWDNB,I_ACLWDNBC
 198
 199    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::&
 200                       PREC_ACC_C, PREC_ACC_NC, SNOW_ACC_NC
 201
 202    REAL, OPTIONAL, INTENT(IN)::  PREC_ACC_DT, CURR_SECS2
 203
 204    INTEGER :: i,j,k,its,ite,jts,jte,ij
 205    INTEGER :: idp,jdp,irc,jrc,irnc,jrnc,isnh,jsnh
 206
 207    REAL              :: no_points
 208    REAL              :: dpsdt_sum, dmudt_sum, dardt_sum, drcdt_sum, drndt_sum
 209    REAL              :: hfx_sum, lh_sum, sfcevp_sum, rainc_sum, rainnc_sum, raint_sum
 210    REAL              :: dmumax, raincmax, rainncmax, snowhmax
 211    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
 212    CHARACTER*256     :: outstring
 213    CHARACTER*6       :: grid_str
 214
 215    INTEGER, INTENT(IN) ::                                        &
 216                                      history_interval,itimestep
 217
 218    INTEGER :: idump
 219
 220 !-----------------------------------------------------------------
 221 ! Compute physics tendency accumulations in a given time window
 222
 223    IF ( acc_phy_tend .gt. 0 ) THEN
 224
 225 !  !$OMP PARALLEL DO   &
 226 !  !$OMP PRIVATE ( ij )
 227    DO ij = 1 , num_tiles
 228
 229       IF (mod(curr_secs2, history_interval*60.) == 0.) THEN
 230          WRITE(outstring,*) 'Reseting accumulation to 0'
 231          CALL wrf_debug ( 10, TRIM(outstring) )
 232          DO j=j_start(ij),j_end(ij)
 233          DO k=kps,kpe
 234          DO i=i_start(ij),i_end(ij)
 235             athmp(i,k,j) = 0.
 236             aqvmp(i,k,j) = 0.
 237             IF ( cu_used == 1 ) THEN
 238             athcu(i,k,j) = 0.
 239             aqvcu(i,k,j) = 0.
 240              aucu(i,k,j) = 0.
 241              avcu(i,k,j) = 0.
 242             END IF
 243             IF ( shcu_used == 1 ) THEN
 244             athsh(i,k,j) = 0.
 245             aqvsh(i,k,j) = 0.
 246              aush(i,k,j) = 0.
 247              avsh(i,k,j) = 0.
 248             END IF
 249             athbl(i,k,j) = 0.
 250             aqvbl(i,k,j) = 0.
 251              aubl(i,k,j) = 0.
 252              avbl(i,k,j) = 0.
 253           athralw(i,k,j) = 0.
 254           athrasw(i,k,j) = 0.
 255          ENDDO
 256          ENDDO
 257          ENDDO
 258       ENDIF
 259       DO j=j_start(ij),j_end(ij)
 260       DO k=kps,kpe
 261       DO i=i_start(ij),i_end(ij)
 262          athmp(i,k,j)  = athmp(i,k,j)  +  h_diabatic(i,k,j)*dt
 263          aqvmp(i,k,j)  = aqvmp(i,k,j)  +  qv_diabatic(i,k,j)*dt
 264          IF ( cu_used == 1 ) THEN
 265          athcu(i,k,j)  = athcu(i,k,j)  +  rthcuten(i,k,j)*dt
 266          aqvcu(i,k,j)  = aqvcu(i,k,j)  +  rqvcuten(i,k,j)*dt
 267           aucu(i,k,j)  =  aucu(i,k,j)  +  rucuten(i,k,j)*dt
 268           avcu(i,k,j)  =  avcu(i,k,j)  +  rvcuten(i,k,j)*dt
 269          END IF
 270          IF ( shcu_used == 1 ) THEN
 271          athsh(i,k,j)  = athsh(i,k,j)  +  rthshten(i,k,j)*dt
 272          aqvsh(i,k,j)  = aqvsh(i,k,j)  +  rqvshten(i,k,j)*dt
 273           aush(i,k,j)  =  aush(i,k,j)  +  rushten(i,k,j)*dt
 274           avsh(i,k,j)  =  avsh(i,k,j)  +  rvshten(i,k,j)*dt
 275          END IF
 276          athbl(i,k,j)  = athbl(i,k,j)  +  rthblten(i,k,j)*dt
 277          aqvbl(i,k,j)  = aqvbl(i,k,j)  +  rqvblten(i,k,j)*dt
 278           aubl(i,k,j)  =  aubl(i,k,j)  +  rublten(i,k,j)*dt
 279           avbl(i,k,j)  =  avbl(i,k,j)  +  rvblten(i,k,j)*dt
 280        athralw(i,k,j)  =  athralw(i,k,j)  +  rthratenlw(i,k,j)*dt
 281        athrasw(i,k,j)  =  athrasw(i,k,j)  +  rthratensw(i,k,j)*dt
 282       ENDDO
 283       ENDDO
 284       ENDDO
 285     ENDDO
 286    ENDIF
 287
 288 !-----------------------------------------------------------------
 289 ! Handle accumulations with buckets to prevent round-off truncation in long runs
 290 ! This is done every 360 minutes assuming time step fits exactly into 360 minutes
 291    IF(bucket_mm .gt. 0. .AND. MOD(NINT(XTIME),360) .EQ. 0)THEN
 292 ! SET START AND END POINTS FOR TILES
 293 !  !$OMP PARALLEL DO   &
 294 !  !$OMP PRIVATE ( ij )
 295
 296    DO ij = 1 , num_tiles
 297
 298       IF (xtime .eq. 0.0)THEN
 299         DO j=j_start(ij),j_end(ij)
 300         DO i=i_start(ij),i_end(ij)
 301           i_rainnc(i,j) = 0
 302           i_rainc(i,j) = 0
 303         ENDDO
 304         ENDDO
 305       ENDIF
 306       DO j=j_start(ij),j_end(ij)
 307       DO i=i_start(ij),i_end(ij)
 308         IF(rainnc(i,j) .gt. bucket_mm)THEN
 309           rainnc(i,j) = rainnc(i,j) - bucket_mm
 310           i_rainnc(i,j) =  i_rainnc(i,j) + 1
 311         ENDIF
 312         IF(rainc(i,j) .gt. bucket_mm)THEN
 313           rainc(i,j) = rainc(i,j) - bucket_mm
 314           i_rainc(i,j) =  i_rainc(i,j) + 1
 315         ENDIF
 316       ENDDO
 317       ENDDO
 318
 319       IF (xtime .eq. 0.0 .and. bucket_J .gt. 0.0 .and. PRESENT(ACSWUPT))THEN
 320         DO j=j_start(ij),j_end(ij)
 321         DO i=i_start(ij),i_end(ij)
 322           i_acswupt(i,j) = 0
 323           i_acswuptc(i,j) = 0
 324           i_acswdnt(i,j) = 0
 325           i_acswdntc(i,j) = 0
 326           i_acswupb(i,j) = 0
 327           i_acswupbc(i,j) = 0
 328           i_acswdnb(i,j) = 0
 329           i_acswdnbc(i,j) = 0
 330         ENDDO
 331         ENDDO
 332       ENDIF
 333       IF (xtime .eq. 0.0  .and. bucket_J .gt. 0.0 .and. PRESENT(ACLWUPT))THEN
 334         DO j=j_start(ij),j_end(ij)
 335         DO i=i_start(ij),i_end(ij)
 336           i_aclwupt(i,j) = 0
 337           i_aclwuptc(i,j) = 0
 338           i_aclwdnt(i,j) = 0
 339           i_aclwdntc(i,j) = 0
 340           i_aclwupb(i,j) = 0
 341           i_aclwupbc(i,j) = 0
 342           i_aclwdnb(i,j) = 0
 343           i_aclwdnbc(i,j) = 0
 344         ENDDO
 345         ENDDO
 346       ENDIF
 347       IF (PRESENT(ACSWUPT) .and. bucket_J .gt. 0.0)THEN
 348       DO j=j_start(ij),j_end(ij)
 349       DO i=i_start(ij),i_end(ij)
 350         IF(acswupt(i,j) .gt. bucket_J)THEN
 351           acswupt(i,j) = acswupt(i,j) - bucket_J
 352           i_acswupt(i,j) =  i_acswupt(i,j) + 1
 353         ENDIF
 354         IF(acswuptc(i,j) .gt. bucket_J)THEN
 355           acswuptc(i,j) = acswuptc(i,j) - bucket_J
 356           i_acswuptc(i,j) =  i_acswuptc(i,j) + 1
 357         ENDIF
 358         IF(acswdnt(i,j) .gt. bucket_J)THEN
 359           acswdnt(i,j) = acswdnt(i,j) - bucket_J
 360           i_acswdnt(i,j) =  i_acswdnt(i,j) + 1
 361         ENDIF
 362         IF(acswdntc(i,j) .gt. bucket_J)THEN
 363           acswdntc(i,j) = acswdntc(i,j) - bucket_J
 364           i_acswdntc(i,j) =  i_acswdntc(i,j) + 1
 365         ENDIF
 366         IF(acswupb(i,j) .gt. bucket_J)THEN
 367           acswupb(i,j) = acswupb(i,j) - bucket_J
 368           i_acswupb(i,j) =  i_acswupb(i,j) + 1
 369         ENDIF
 370         IF(acswupbc(i,j) .gt. bucket_J)THEN
 371           acswupbc(i,j) = acswupbc(i,j) - bucket_J
 372           i_acswupbc(i,j) =  i_acswupbc(i,j) + 1
 373         ENDIF
 374         IF(acswdnb(i,j) .gt. bucket_J)THEN
 375           acswdnb(i,j) = acswdnb(i,j) - bucket_J
 376           i_acswdnb(i,j) =  i_acswdnb(i,j) + 1
 377         ENDIF
 378         IF(acswdnbc(i,j) .gt. bucket_J)THEN
 379           acswdnbc(i,j) = acswdnbc(i,j) - bucket_J
 380           i_acswdnbc(i,j) =  i_acswdnbc(i,j) + 1
 381         ENDIF
 382       ENDDO
 383       ENDDO
 384       ENDIF
 385       IF (PRESENT(ACLWUPT) .and. bucket_J .gt. 0.0)THEN
 386       DO j=j_start(ij),j_end(ij)
 387       DO i=i_start(ij),i_end(ij)
 388         IF(aclwupt(i,j) .gt. bucket_J)THEN
 389           aclwupt(i,j) = aclwupt(i,j) - bucket_J
 390           i_aclwupt(i,j) =  i_aclwupt(i,j) + 1
 391         ENDIF
 392         IF(aclwuptc(i,j) .gt. bucket_J)THEN
 393           aclwuptc(i,j) = aclwuptc(i,j) - bucket_J
 394           i_aclwuptc(i,j) =  i_aclwuptc(i,j) + 1
 395         ENDIF
 396         IF(aclwdnt(i,j) .gt. bucket_J)THEN
 397           aclwdnt(i,j) = aclwdnt(i,j) - bucket_J
 398           i_aclwdnt(i,j) =  i_aclwdnt(i,j) + 1
 399         ENDIF
 400         IF(aclwdntc(i,j) .gt. bucket_J)THEN
 401           aclwdntc(i,j) = aclwdntc(i,j) - bucket_J
 402           i_aclwdntc(i,j) =  i_aclwdntc(i,j) + 1
 403         ENDIF
 404         IF(aclwupb(i,j) .gt. bucket_J)THEN
 405           aclwupb(i,j) = aclwupb(i,j) - bucket_J
 406           i_aclwupb(i,j) =  i_aclwupb(i,j) + 1
 407         ENDIF
 408         IF(aclwupbc(i,j) .gt. bucket_J)THEN
 409           aclwupbc(i,j) = aclwupbc(i,j) - bucket_J
 410           i_aclwupbc(i,j) =  i_aclwupbc(i,j) + 1
 411         ENDIF
 412         IF(aclwdnb(i,j) .gt. bucket_J)THEN
 413           aclwdnb(i,j) = aclwdnb(i,j) - bucket_J
 414           i_aclwdnb(i,j) =  i_aclwdnb(i,j) + 1
 415         ENDIF
 416         IF(aclwdnbc(i,j) .gt. bucket_J)THEN
 417           aclwdnbc(i,j) = aclwdnbc(i,j) - bucket_J
 418           i_aclwdnbc(i,j) =  i_aclwdnbc(i,j) + 1
 419         ENDIF
 420       ENDDO
 421       ENDDO
 422       ENDIF
 423    ENDDO
 424 !  !$OMP END PARALLEL DO
 425    ENDIF
 426
 427 ! Compute precipitation accumulation in a given time window: prec_acc_dt
 428    IF (prec_acc_dt .gt. 0.) THEN
 429
 430 !  !$OMP PARALLEL DO   &
 431 !  !$OMP PRIVATE ( ij )
 432
 433    DO ij = 1 , num_tiles
 434
 435       DO j=j_start(ij),j_end(ij)
 436       DO i=i_start(ij),i_end(ij)
 437          IF (mod(curr_secs2, 60.* prec_acc_dt) == 0.) THEN
 438             prec_acc_c(i,j)  = 0.
 439             prec_acc_nc(i,j) = 0.
 440             snow_acc_nc(i,j)  = 0.
 441          ENDIF
 442          prec_acc_c(i,j)  = prec_acc_c(i,j)  +  RAINCV(i,j)
 443          prec_acc_nc(i,j) = prec_acc_nc(i,j) + RAINNCV(i,j)
 444          prec_acc_c(i,j)  = MAX (prec_acc_c(i,j), 0.0)
 445          prec_acc_nc(i,j) = MAX (prec_acc_nc(i,j), 0.0)
 446          snow_acc_nc(i,j)   = snow_acc_nc(i,j) + SNOWNCV(I,J)
 447 ! add convective precip to snow bucket if t2 < 273.15
 448          IF ( t2(i,j) .lt. 273.15 ) THEN
 449          snow_acc_nc(i,j)   = snow_acc_nc(i,j) +  RAINCV(i,j)
 450          snow_acc_nc(i,j)   = MAX (snow_acc_nc(i,j), 0.0)
 451          ENDIF
 452       ENDDO
 453       ENDDO
 454
 455    ENDDO
 456
 457 !  !$OMP END PARALLEL DO
 458    ENDIF
 459
 460    if (diag_print .eq. 0 ) return
 461
 462    IF ( xtime .ne. 0. ) THEN
 463
 464 ! COMPUTE THE NUMBER OF MASS GRID POINTS
 465    no_points = float((ide-ids)*(jde-jds))
 466
 467 ! SET START AND END POINTS FOR TILES
 468 !  !$OMP PARALLEL DO   &
 469 !  !$OMP PRIVATE ( ij )
 470
 471    dmumax = 0.
 472    DO ij = 1 , num_tiles
 473
 474 !     print *, i_start(ij),i_end(ij),j_start(ij),j_end(ij)
 475       DO j=j_start(ij),j_end(ij)
 476       DO i=i_start(ij),i_end(ij)
 477          dpsdt(i,j)=(p8w(i,kms,j)-pk1m(i,j))/dt
 478          dmudt(i,j)=(mu_2(i,j)-mu_2m(i,j))/dt
 479          if(abs(dmudt(i,j)*dt).gt.dmumax)then
 480            dmumax=abs(dmudt(i,j)*dt)
 481            idp=i
 482            jdp=j
 483          endif
 484       ENDDO
 485       ENDDO
 486
 487    ENDDO
 488 !  !$OMP END PARALLEL DO
 489
 490 ! convert DMUMAX from (PA) to (bars) per time step
 491    dmumax = dmumax*1.e-5
 492 ! compute global MAX
 493    CALL wrf_dm_maxval ( dmumax,  idp, jdp )
 494
 495 !  print *, 'p8w(30,1,30),pk1m(30,30) : ', p8w(30,1,30),pk1m(30,30)
 496 !  print *, 'mu_2(30,30),mu_2m(30,30) : ', mu_2(30,30),mu_2m(30,30)
 497    dpsdt_sum = 0.
 498    dmudt_sum = 0.
 499
 500    DO j = jps, min(jpe,jde-1)
 501      DO i = ips, min(ipe,ide-1)
 502        dpsdt_sum = dpsdt_sum + abs(dpsdt(i,j))
 503        dmudt_sum = dmudt_sum + abs(dmudt(i,j))
 504      ENDDO
 505    ENDDO
 506
 507 ! compute global sum
 508    dpsdt_sum = wrf_dm_sum_real ( dpsdt_sum )
 509    dmudt_sum = wrf_dm_sum_real ( dmudt_sum )
 510
 511 !  print *, 'dpsdt, dmudt : ', dpsdt_sum, dmudt_sum
 512
 513    IF ( diag_print .eq. 2 ) THEN
 514    dardt_sum = 0.
 515    drcdt_sum = 0.
 516    drndt_sum = 0.
 517    rainc_sum = 0.
 518    raint_sum = 0.
 519    rainnc_sum = 0.
 520    sfcevp_sum = 0.
 521    hfx_sum = 0.
 522    lh_sum = 0.
 523    raincmax = 0.
 524    rainncmax = 0.
 525
 526    DO j = jps, min(jpe,jde-1)
 527      DO i = ips, min(ipe,ide-1)
 528        drcdt_sum = drcdt_sum + abs(raincv(i,j))
 529        drndt_sum = drndt_sum + abs(rainncv(i,j))
 530        dardt_sum = dardt_sum + abs(raincv(i,j)) + abs(rainncv(i,j))
 531        rainc_sum = rainc_sum + abs(rainc(i,j))
 532 ! MAX for accumulated conv precip
 533        IF(rainc(i,j).gt.raincmax)then
 534           raincmax=rainc(i,j)
 535           irc=i
 536           jrc=j
 537        ENDIF
 538        rainnc_sum = rainnc_sum + abs(rainnc(i,j))
 539 ! MAX for accumulated resolved precip
 540        IF(rainnc(i,j).gt.rainncmax)then
 541           rainncmax=rainnc(i,j)
 542           irnc=i
 543           jrnc=j
 544        ENDIF
 545        raint_sum = raint_sum + abs(rainc(i,j)) + abs(rainnc(i,j))
 546        sfcevp_sum = sfcevp_sum + abs(sfcevp(i,j))
 547        hfx_sum = hfx_sum + abs(hfx(i,j))
 548        lh_sum = lh_sum + abs(lh(i,j))
 549      ENDDO
 550    ENDDO
 551
 552 ! compute global MAX
 553    CALL wrf_dm_maxval ( raincmax, irc, jrc )
 554    CALL wrf_dm_maxval ( rainncmax, irnc, jrnc )
 555
 556 ! compute global sum
 557    drcdt_sum = wrf_dm_sum_real ( drcdt_sum )
 558    drndt_sum = wrf_dm_sum_real ( drndt_sum )
 559    dardt_sum = wrf_dm_sum_real ( dardt_sum )
 560    rainc_sum = wrf_dm_sum_real ( rainc_sum )
 561    rainnc_sum = wrf_dm_sum_real ( rainnc_sum )
 562    raint_sum = wrf_dm_sum_real ( raint_sum )
 563    sfcevp_sum = wrf_dm_sum_real ( sfcevp_sum )
 564    hfx_sum = wrf_dm_sum_real ( hfx_sum )
 565    lh_sum = wrf_dm_sum_real ( lh_sum )
 566
 567    ENDIF
 568
 569 ! print out the average values
 570
 571    CALL get_current_grid_name( grid_str )
 572
 573 #ifdef DM_PARALLEL
 574    IF ( wrf_dm_on_monitor() ) THEN
 575 #endif
 576      WRITE(outstring,*) grid_str,'Domain average of dpsdt, dmudt (mb/3h): ', xtime, &
 577            dpsdt_sum/no_points*108., &
 578            dmudt_sum/no_points*108.
 579      CALL wrf_message ( TRIM(outstring) )
 580
 581      WRITE(outstring,*) grid_str,'Max mu change time step: ', idp,jdp,dmumax
 582      CALL wrf_message ( TRIM(outstring) )
 583
 584      IF ( diag_print .eq. 2) THEN
 585      WRITE(outstring,*) grid_str,'Domain average of dardt, drcdt, drndt (mm/sec): ', xtime, &
 586            dardt_sum/dt/no_points, &
 587            drcdt_sum/dt/no_points, &
 588            drndt_sum/dt/no_points
 589      CALL wrf_message ( TRIM(outstring) )
 590      WRITE(outstring,*) grid_str,'Domain average of rt_sum, rc_sum, rnc_sum (mm): ', xtime, &
 591            raint_sum/no_points, &
 592            rainc_sum/no_points, &
 593            rainnc_sum/no_points
 594      CALL wrf_message ( TRIM(outstring) )
 595      WRITE(outstring,*) grid_str,'Max Accum Resolved Precip,   I,J  (mm): '               ,&
 596            rainncmax,irnc,jrnc
 597      CALL wrf_message ( TRIM(outstring) )
 598      WRITE(outstring,*) grid_str,'Max Accum Convective Precip,   I,J  (mm): '             ,&
 599            raincmax,irc,jrc
 600      CALL wrf_message ( TRIM(outstring) )
 601      WRITE(outstring,*) grid_str,'Domain average of sfcevp, hfx, lh: ', xtime, &
 602            sfcevp_sum/no_points, &
 603            hfx_sum/no_points, &
 604            lh_sum/no_points
 605      CALL wrf_message ( TRIM(outstring) )
 606      ENDIF
 607 #ifdef DM_PARALLEL
 608    ENDIF
 609 #endif
 610
 611    ENDIF
 612
 613 ! save values at this time step
 614    !$OMP PARALLEL DO   &
 615    !$OMP PRIVATE ( ij,i,j )
 616    DO ij = 1 , num_tiles
 617
 618       DO j=j_start(ij),j_end(ij)
 619       DO i=i_start(ij),i_end(ij)
 620          pk1m(i,j)=p8w(i,kms,j)
 621          mu_2m(i,j)=mu_2(i,j)
 622       ENDDO
 623       ENDDO
 624
 625       IF ( xtime .lt. 0.0001 ) THEN
 626       DO j=j_start(ij),j_end(ij)
 627       DO i=i_start(ij),i_end(ij)
 628          dpsdt(i,j)=0.
 629          dmudt(i,j)=0.
 630       ENDDO
 631       ENDDO
 632       ENDIF
 633
 634    ENDDO
 635    !$OMP END PARALLEL DO
 636
 637    END SUBROUTINE diagnostic_output_calc
 638
 639
 640 !-------------------------- NOAHMP model diagnostic output
 641    subroutine noahmp_output_calc(  ims,ime, jms,jme                                  ,&
 642       i_start  ,i_end    ,j_start  ,j_end    ,num_tiles                              ,&
 643       dt       ,noahmp_acc_dt      ,curr_secs2,opt_run  ,stepwtd ,itimestep          ,&
 644       acsagv   ,acsagb   ,acirg    ,acshg    ,acevg     ,acghv   ,acpahg   ,acirb    ,&
 645       acshb    ,acevb    ,acghb    ,acpahb   ,acsav     ,acirc   ,acshc    ,acevc    ,&
 646       actr     ,acpahv   ,acswdnlsm,acswuplsm,                                        &
 647       aclwdnlsm,aclwuplsm,acshflsm ,aclhflsm ,acghflsm  ,acpahlsm,acints   ,acintr   ,&
 648       acdrips  ,acdripr  ,acthros  ,acthror  ,acetlsm   ,acsnmelt,                    &
 649       acsnsub  ,acsnfro  ,acsubc   ,acfroc   ,acevac    ,acdewc  ,acfrzc   ,acmeltc  ,&
 650       acsnbot  ,acponding,acrainlsm,acsnowlsm,acrainsnow,acrunsb ,acrunsf  ,isnow    ,&
 651       acqlat   ,acqrf  ,acrech ,acqspring ,acecan ,acetran ,acedir ,aceflxb ,accanhs ,&
 652       sag      ,irg      ,shg      ,evg      ,ghv       ,pahg    ,irb      ,shb      ,&
 653       evb      ,ghb      ,pahb     ,sav      ,ircmp     ,shc     ,evc      ,tr       ,&
 654       pahv     ,swdown   ,albedo   ,emiss    ,                                        &
 655       glw      ,trad     ,qints    ,qintr    ,qdrips    ,qdripr  ,qthros   ,qthror   ,&
 656       qsnsub   ,qsnfro   ,qsubc    ,qfroc    ,qevac     ,qdewc   ,qfrzc    ,qmeltc   ,&
 657       qsnbot   ,ponding  ,rainlsm  ,snowlsm  ,runsb     ,runsf   ,fpice    ,fveg     ,&
 658       qlat     ,qrf      ,deeprech ,qspring  ,ecan      ,etran   ,edir     ,eflxb    ,&
 659       canhs    ,qmelt    )
 660
 661 !----------------------------------------------------------------------
 662
 663    implicit none
 664
 665 !======================================================================
 666
 667    integer,      intent(in   )    ::  ims,ime, jms,jme, num_tiles
 668
 669    integer, dimension(num_tiles), intent(in) :: i_start,i_end,j_start,j_end
 670
 671    real   ,           intent(in) :: dt
 672    real   , optional, intent(in) :: noahmp_acc_dt, curr_secs2
 673    integer, optional, intent(in) :: opt_run, stepwtd, itimestep
 674
 675    real, dimension( ims:ime, jms:jme ), optional, intent(inout) ::                    &
 676       acsagv   ,acsagb   ,acirg    ,acshg    ,acevg     ,acghv   ,acpahg   ,acirb    ,&
 677       acshb    ,acevb    ,acghb    ,acpahb   ,acsav     ,acirc   ,acshc    ,acevc    ,&
 678       actr     ,acpahv   ,acswdnlsm,acswuplsm,                                        &
 679       aclwdnlsm,aclwuplsm,acshflsm ,aclhflsm ,acghflsm  ,acpahlsm,acints   ,acintr   ,&
 680       acdrips   ,acdripr ,acthros  ,acthror  ,acetlsm   ,acsnmelt,                    &
 681       acsnsub  ,acsnfro  ,acsubc   ,acfroc   ,acevac    ,acdewc  ,acfrzc   ,acmeltc  ,&
 682       acsnbot  ,acponding,acrainlsm,acsnowlsm,acrainsnow,acrunsb ,acrunsf  ,          &
 683       acqlat   ,acqrf    ,acrech   ,acqspring,acecan    ,acetran ,acedir   ,aceflxb  ,&
 684       accanhs
 685
 686    real, dimension( ims:ime, jms:jme ), optional, intent(in) ::                       &
 687       sag      ,irg      ,shg      ,evg      ,ghv       ,pahg    ,irb      ,shb      ,&
 688       evb      ,ghb      ,pahb     ,sav      ,ircmp     ,shc     ,evc      ,tr       ,&
 689       pahv     ,swdown   ,albedo   ,emiss    ,                                        &
 690       glw      ,trad     ,qints    ,qintr    ,qdrips    ,qdripr  ,qthros   ,qthror   ,&
 691       qsnsub   ,qsnfro   ,qsubc    ,qfroc    ,qevac     ,qdewc   ,qfrzc    ,qmeltc   ,&
 692       qsnbot   ,ponding  ,rainlsm  ,snowlsm  ,runsb     ,runsf   ,fpice    ,fveg     ,&
 693       qlat     ,qrf      ,deeprech ,qspring  ,ecan      ,etran   ,edir     ,eflxb    ,&
 694       canhs    ,qmelt
 695
 696    integer, dimension( ims:ime, jms:jme ), optional, intent(in) ::   isnow
 697
 698    integer :: i,j,ij
 699    real :: kjconvert
 700
 701 ! compute noah-mp accumulation in a given time window: noahmp_acc_dt
 702
 703    if (noahmp_acc_dt .gt. 0.) then
 704
 705 !  !$omp parallel do   &
 706 !  !$omp private ( ij )
 707
 708    do ij = 1 , num_tiles
 709
 710       do j=j_start(ij),j_end(ij)
 711       do i=i_start(ij),i_end(ij)
 712          if (mod(curr_secs2, 60.* noahmp_acc_dt) == 0.) then
 713             acsagb(i,j) = 0.
 714             acsagv(i,j) = 0.
 715             acirg(i,j)  = 0.
 716             acshg(i,j)  = 0.
 717             acevg(i,j)  = 0.
 718             acghv(i,j)  = 0.
 719             acpahg(i,j) = 0.
 720             acirb(i,j)  = 0.
 721             acshb(i,j)  = 0.
 722             acevb(i,j)  = 0.
 723             acghb(i,j)  = 0.
 724             acpahb(i,j) = 0.
 725             acsav(i,j)  = 0.
 726             acirc(i,j)  = 0.
 727             acshc(i,j)  = 0.
 728             acevc(i,j)  = 0.
 729             actr (i,j)  = 0.
 730             acpahv(i,j) = 0.
 731             accanhs(i,j)= 0.
 732             acswdnlsm(i,j)  = 0.
 733             acswuplsm(i,j)  = 0.
 734             aclwdnlsm(i,j)  = 0.
 735             aclwuplsm(i,j)  = 0.
 736             acshflsm(i,j)   = 0.
 737             aclhflsm(i,j)   = 0.
 738             acghflsm(i,j)   = 0.
 739             acpahlsm(i,j)   = 0.
 740             acints(i,j)     = 0.
 741             acintr(i,j)     = 0.
 742             acdrips(i,j)    = 0.
 743             acdripr(i,j)    = 0.
 744             acthros(i,j)    = 0.
 745             acthror(i,j)    = 0.
 746             acsnsub(i,j)    = 0.
 747             acsnfro(i,j)    = 0.
 748             acsubc(i,j)     = 0.
 749             acfroc(i,j)     = 0.
 750             acevac(i,j)     = 0.
 751             acdewc(i,j)     = 0.
 752             acfrzc(i,j)     = 0.
 753             acmeltc(i,j)    = 0.
 754             acsnbot(i,j)    = 0.
 755             acsnmelt(i,j)   = 0.
 756             acrunsf(i,j)    = 0.
 757             acrunsb(i,j)    = 0.
 758             acecan(i,j)     = 0.
 759             acetran(i,j)    = 0.
 760             acedir(i,j)     = 0.
 761             acetlsm(i,j)    = 0.
 762             aceflxb(i,j)    = 0.
 763             acponding(i,j)  = 0.
 764             acrainsnow(i,j) = 0.
 765             acrainlsm(i,j)  = 0.
 766             acsnowlsm(i,j)  = 0.
 767             acqlat(i,j)     = 0.
 768             acqrf(i,j)      = 0.
 769             acrech(i,j)     = 0.
 770             acqspring(i,j)  = 0.
 771          endif
 772
 773          kjconvert = dt / 1000.0
 774          acsagb(i,j) = acsagb(i,j) +  kjconvert * (1.0 - fveg(i,j)) * sag(i,j)
 775          acsagv(i,j) = acsagv(i,j) +  kjconvert * fveg(i,j) * sag(i,j)
 776          acirg(i,j)  = acirg(i,j)  +  kjconvert * fveg(i,j) * irg(i,j)
 777          acshg(i,j)  = acshg(i,j)  +  kjconvert * fveg(i,j) * shg(i,j)
 778          acevg(i,j)  = acevg(i,j)  +  kjconvert * fveg(i,j) * evg(i,j)
 779          acghv(i,j)  = acghv(i,j)  +  kjconvert * fveg(i,j) * ghv(i,j)
 780          acpahg(i,j) = acpahg(i,j) +  kjconvert * fveg(i,j) * pahg(i,j)
 781          acirb(i,j)  = acirb(i,j)  +  kjconvert * (1.0 - fveg(i,j)) * irb(i,j)
 782          acshb(i,j)  = acshb(i,j)  +  kjconvert * (1.0 - fveg(i,j)) * shb(i,j)
 783          acevb(i,j)  = acevb(i,j)  +  kjconvert * (1.0 - fveg(i,j)) * evb(i,j)
 784          acghb(i,j)  = acghb(i,j)  +  kjconvert * (1.0 - fveg(i,j)) * ghb(i,j)
 785          acpahb(i,j) = acpahb(i,j) +  kjconvert * (1.0 - fveg(i,j)) * pahb(i,j)
 786          acsav(i,j)  = acsav(i,j)  +  kjconvert * sav(i,j)
 787          acirc(i,j)  = acirc(i,j)  +  kjconvert * ircmp(i,j)
 788          acshc(i,j)  = acshc(i,j)  +  kjconvert * shc(i,j)
 789          acevc(i,j)  = acevc(i,j)  +  kjconvert * evc(i,j)
 790          actr(i,j)   = actr(i,j)   +  kjconvert * tr(i,j)
 791          aceflxb(i,j)= aceflxb(i,j)+  eflxb(i,j) / 1000.0   ! multiplied by dt_soil in ENERGY
 792          accanhs(i,j)= accanhs(i,j)+  kjconvert * canhs(i,j)
 793          acpahv(i,j) = acpahv(i,j) +  kjconvert * pahv(i,j)
 794          acswdnlsm(i,j)  = acswdnlsm(i,j)  +  kjconvert * swdown(i,j)
 795          acswuplsm(i,j)  = acswuplsm(i,j)  +  kjconvert * swdown(i,j)*albedo(i,j)
 796          aclwdnlsm(i,j)  = aclwdnlsm(i,j)  +  kjconvert * glw(i,j)*emiss(i,j)
 797          aclwuplsm(i,j)  = aclwuplsm(i,j)  +  kjconvert * 5.67e-08*emiss(i,j)*trad(i,j)*trad(i,j)*trad(i,j)*trad(i,j)
 798          acshflsm(i,j)   = acshg(i,j) + acshc(i,j) + acshb(i,j)
 799          aclhflsm(i,j)   = acevg(i,j) + acevc(i,j) + actr(i,j) + acevb(i,j)
 800          acghflsm(i,j)   = acghv(i,j) + acghb(i,j)
 801          acpahlsm(i,j)   = acpahv(i,j) + acpahg(i,j) + acpahb(i,j)
 802          acints(i,j)     = acints(i,j)     +  dt *   qints(i,j)
 803          acintr(i,j)     = acintr(i,j)     +  dt *   qintr(i,j)
 804          acdrips(i,j)    = acdrips(i,j)    +  dt *  qdrips(i,j)
 805          acdripr(i,j)    = acdripr(i,j)    +  dt *  qdripr(i,j)
 806          acthros(i,j)    = acthros(i,j)    +  dt *  qthros(i,j)
 807          acthror(i,j)    = acthror(i,j)    +  dt *  qthror(i,j)
 808          acsnsub(i,j)    = acsnsub(i,j)    +  dt *  qsnsub(i,j)
 809          acsnfro(i,j)    = acsnfro(i,j)    +  dt *  qsnfro(i,j)
 810          acsubc(i,j)     = acsubc(i,j)     +  dt *   qsubc(i,j)
 811          acfroc(i,j)     = acfroc(i,j)     +  dt *   qfroc(i,j)
 812          acevac(i,j)     = acevac(i,j)     +  dt *   qevac(i,j)
 813          acdewc(i,j)     = acdewc(i,j)     +  dt *   qdewc(i,j)
 814          acfrzc(i,j)     = acfrzc(i,j)     +  dt *   qfrzc(i,j)
 815          acmeltc(i,j)    = acmeltc(i,j)    +  dt *  qmeltc(i,j)
 816          acsnbot(i,j)    = acsnbot(i,j)    +  dt *  qsnbot(i,j)
 817          acsnmelt(i,j)   = acsnmelt(i,j)   +  dt *   qmelt(i,j)
 818          acrunsf(i,j)    = acrunsf(i,j)    +  runsf(i,j)  ! multiplied by dt_soil in WATER
 819          acrunsb(i,j)    = acrunsb(i,j)    +  runsb(i,j)  ! multiplied by dt_soil in WATER
 820          acecan(i,j)     = acecan(i,j)     +  dt *    ecan(i,j)
 821          acetran(i,j)    = acetran(i,j)    +  dt *   etran(i,j)
 822          acedir(i,j)     = acedir(i,j)     +  dt *    edir(i,j)
 823          acetlsm(i,j)    = acetlsm(i,j)    +  dt *   (etran(i,j) + edir(i,j) + ecan(i,j))
 824          acponding(i,j)  = acponding(i,j)  +       ponding(i,j)
 825          acrainlsm(i,j)  = acrainlsm(i,j)  +  dt *  rainlsm(i,j)
 826          acsnowlsm(i,j)  = acsnowlsm(i,j)  +  dt *  snowlsm(i,j)
 827          if(opt_run == 5) then
 828            if(mod(itimestep,stepwtd) == 0) then
 829              acqlat(i,j)     = acqlat(i,j)     +          qlat(i,j) * 1000.0
 830              acqrf(i,j)      = acqrf(i,j)      +           qrf(i,j) * 1000.0
 831              acrech(i,j)     = acrech(i,j)     +      deeprech(i,j)
 832              acqspring(i,j)  = acqspring(i,j)  +       qspring(i,j)
 833            endif
 834          endif
 835          if(isnow(i,j) < 0 .and. isnow(i,j) > -5) then
 836             acrainsnow(i,j) =  acrainsnow(i,j) + dt * (qdripr(i,j) + qthror(i,j))
 837          endif
 838       enddo
 839       enddo
 840
 841    enddo
 842
 843 !  !$omp end parallel do
 844    endif
 845
 846    end subroutine noahmp_output_calc
 847
 848
 849 END MODULE module_diag_misc
 850 #endif