phys/module_diag_cl.F

   1 #if (NMM_CORE == 1)
   2 MODULE module_diag_cl
   3 CONTAINS
   4    SUBROUTINE diag_cl_stub
   5    END SUBROUTINE diag_cl_stub
   6 END MODULE module_diag_cl
   7 #else
   8 !WRF:MEDIATION_LAYER:PHYSICS
   9 !
  10
  11 MODULE module_diag_cl
  12 CONTAINS
  13
  14    SUBROUTINE clwrf_output_calc(                                      &
  15                       ids,ide, jds,jde, kds,kde,                      &
  16                       ims,ime, jms,jme, kms,kme,                      &
  17                       ips,ipe, jps,jpe, kps,kpe,                      & ! patch  dims
  18                       i_start,i_end,j_start,j_end,kts,kte,num_tiles   &
  19                      ,is_restart                                      & ! CLWRF
  20                      ,clwrfH,t2,q2,u10,v10, skintemp                  & ! CLWRF
  21                      ,t2clmin,t2clmax,tt2clmin,tt2clmax               & ! CLWRF
  22                      ,t2clmean,t2clstd                                & ! CLWRF
  23                      ,q2clmin,q2clmax,tq2clmin,tq2clmax               & ! CLWRF
  24                      ,q2clmean,q2clstd                                & ! CLWRF
  25                      ,u10clmax,v10clmax,spduv10clmax,tspduv10clmax    & ! CLWRF
  26                      ,u10clmean,v10clmean,spduv10clmean               & ! CLWRF
  27                      ,u10clstd,v10clstd,spduv10clstd                  & ! CLWRF
  28                      ,raincclmax,rainncclmax,traincclmax,trainncclmax & ! CLWRF
  29                      ,raincclmean,rainncclmean,raincclstd,rainncclstd & ! CLWRF
  30                      ,skintempclmin,skintempclmax                     & ! CLWRF
  31                      ,tskintempclmin,tskintempclmax                   & ! CLWRF
  32                      ,skintempclmean,skintempclstd                    & ! CLWRF
  33                      ,raincv,rainncv                                  &
  34                      ,dt,xtime,curr_secs2                             &
  35                      ,nsteps                                          &
  36                                                                       )
  37 !----------------------------------------------------------------------
  38
  39   USE module_dm, ONLY: wrf_dm_sum_real, wrf_dm_maxval
  40   USE module_configure
  41
  42    IMPLICIT NONE
  43 !======================================================================
  44 ! Definitions
  45 !-----------
  46 !-- DT            time step (second)
  47 !-- XTIME         forecast time
  48 !-- curr_secs2    current time in seconds since simulation restart
  49 !
  50 !-- RAINCV        cumulus scheme precipitation in one time step (mm)
  51 !-- RAINNCV       explicit scheme precipitation in one time step (mm)
  52 !
  53 !-- ids           start index for i in domain
  54 !-- ide           end index for i in domain
  55 !-- jds           start index for j in domain
  56 !-- jde           end index for j in domain
  57 !-- kds           start index for k in domain
  58 !-- kde           end index for k in domain
  59 !-- ims           start index for i in memory
  60 !-- ime           end index for i in memory
  61 !-- jms           start index for j in memory
  62 !-- jme           end index for j in memory
  63 !-- ips           start index for i in patch
  64 !-- ipe           end index for i in patch
  65 !-- jps           start index for j in patch
  66 !-- jpe           end index for j in patch
  67 !-- kms           start index for k in memory
  68 !-- kme           end index for k in memory
  69 !-- i_start       start indices for i in tile
  70 !-- i_end         end indices for i in tile
  71 !-- j_start       start indices for j in tile
  72 !-- j_end         end indices for j in tile
  73 !-- kts           start index for k in tile
  74 !-- kte           end index for k in tile
  75 !-- num_tiles     number of tiles
  76 !
  77 ! CLWRF-UC May.09 definitions
  78 !-----------
  79 ! is_restart: whether if simulation is a restart
  80 ! clwrfH: Interval (hour) of accumulation for computations
  81 ! [var]cl[min/max]: [minimum/maximum] of variable [var] during interval
  82 ! t[var]cl[min/max]: Time (minutes) of [minimum/maximum] of variable
  83 !    [var] during interval
  84 ! [var]clmean: mean of variable [var] during interval
  85 ! [var]clstd: standard dev. of variable [var] during interval
  86 !    Variables are written on aux_hist_out7 (established
  87 !    in Registry)
  88 !
  89 !======================================================================
  90
  91    INTEGER,      INTENT(IN   )                     ::            &
  92                                       ids,ide, jds,jde, kds,kde, &
  93                                       ims,ime, jms,jme, kms,kme, &
  94                                       ips,ipe, jps,jpe, kps,kpe, &
  95                                                         kts,kte, &
  96                                                       num_tiles
  97
  98    INTEGER, DIMENSION(num_tiles), INTENT(IN)       :: i_start,   &
  99                                       i_end,j_start,j_end
 100
 101    REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) ::           &
 102                                       RAINNCV, RAINCV, SKINTEMP
 103
 104    REAL,  INTENT(IN   )                            :: DT, XTIME
 105    REAL,  INTENT(IN   )                            :: curr_secs2
 106
 107 ! LOCAL  VAR
 108
 109    INTEGER                                   :: i,j,k,its,ite,jts,jte,ij
 110    INTEGER                                   :: idp,jdp
 111
 112    REAL                                      :: xtimep
 113    LOGICAL, EXTERNAL                         :: wrf_dm_on_monitor
 114
 115 !!-------------------
 116 !! CLWRF-UC Nov.09
 117
 118    CHARACTER (LEN=80)                        :: timestr
 119
 120    REAL, DIMENSION( ims:ime , jms:jme ),                                          &
 121                           INTENT(IN)         :: t2, q2, u10, v10
 122    REAL, DIMENSION( ims:ime , jms:jme ),                                          &
 123                           INTENT(OUT)        :: t2clmin, t2clmax, tt2clmin,       &
 124                           tt2clmax, t2clmean, t2clstd,                            &
 125                           q2clmin, q2clmax, tq2clmin, tq2clmax, q2clmean, q2clstd,&
 126                           u10clmax, v10clmax, spduv10clmax, tspduv10clmax,        &
 127                           u10clmean, v10clmean, spduv10clmean,                    &
 128                           u10clstd, v10clstd, spduv10clstd, skintempclmin,        &
 129                           skintempclmax, tskintempclmin, tskintempclmax,          &
 130                           skintempclmean, skintempclstd
 131    REAL, DIMENSION( ims:ime , jms:jme ),                                          &
 132                           INTENT(OUT)        :: raincclmax, rainncclmax,          &
 133                           traincclmax, trainncclmax, raincclmean, rainncclmean,   &
 134                           raincclstd, rainncclstd
 135    REAL, PARAMETER                           :: minimum0= 1000000.,               &
 136                           maximum0= -1000000.
 137    REAL                                      :: value
 138    INTEGER, INTENT(IN)                       :: clwrfH
 139    CHARACTER (LEN=1024)                      :: message
 140    INTEGER, INTENT(INOUT)                    :: nsteps
 141    LOGICAL                                   :: is_restart
 142 ! local vars
 143    REAL                                      :: t273
 144
 145 !-----------------------------------------------------------------
 146
 147    t273  = 273.
 148
 149 ! Initialize [var] values
 150 ! SET START AND END POINTS FOR TILES
 151 !  !$OMP PARALLEL DO   &
 152 !  !$OMP PRIVATE ( ij )
 153 !  IF ( MOD(NINT(XTIME), clwrfH) == 0 ) THEN
 154 ! IF (( MOD(NINT(curr_secs2/dt),NINT(clwrfH*60./dt)) == 0) .AND. (.NOT.is_restart)) THEN
 155   IF (( MOD(NINT(curr_secs2/dt),NINT(clwrfH*60./dt)) == 0) ) THEN
 156     DO ij = 1 , num_tiles
 157       IF  ( wrf_dm_on_monitor() ) THEN
 158           CALL wrf_debug(0, 'Re-initializing accumulation arrays')
 159       ENDIF
 160       nsteps = 1
 161       DO j = j_start(ij), j_end(ij)
 162         DO i = i_start(ij), i_end(ij)
 163           t2clmin(i,j)=t2(i,j)-t273
 164           t2clmax(i,j)=t2(i,j)-t273
 165           t2clmean(i,j)=t2(i,j)-t273
 166           t2clstd(i,j)=(t2(i,j)-t273)*(t2(i,j)-t273)
 167           q2clmin(i,j)=q2(i,j)
 168           q2clmax(i,j)=q2(i,j)
 169           q2clmean(i,j)=q2(i,j)
 170           q2clstd(i,j)=q2(i,j)*q2(i,j)
 171           spduv10clmax(i,j)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
 172           u10clmean(i,j)=u10(i,j)
 173           v10clmean(i,j)=v10(i,j)
 174           spduv10clmean(i,j)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
 175           u10clstd(i,j)=u10(i,j)*u10(i,j)
 176           v10clstd(i,j)=v10(i,j)*v10(i,j)
 177           spduv10clstd(i,j)=u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j)
 178           raincclmax(i,j)=raincv(i,j)/dt
 179           rainncclmax(i,j)=rainncv(i,j)/dt
 180           raincclmean(i,j)=raincv(i,j)/dt
 181           rainncclmean(i,j)=rainncv(i,j)/dt
 182           raincclstd(i,j)=(raincv(i,j)/dt)*(raincv(i,j)/dt)
 183           rainncclstd(i,j)=(rainncv(i,j)/dt)*(rainncv(i,j)/dt)
 184           skintempclmin(i,j)=skintemp(i,j)-t273
 185           skintempclmax(i,j)=skintemp(i,j)-t273
 186           skintempclmean(i,j)=skintemp(i,j)-t273
 187           skintempclstd(i,j)=(skintemp(i,j)-t273)*(skintemp(i,j)-t273)
 188           ! reinitialize times
 189           tt2clmin(i,j)       = xtime + dt/60.  ! value at end of timestep
 190           tt2clmax(i,j)       = xtime + dt/60.
 191           tq2clmin(i,j)       = xtime + dt/60.
 192           tq2clmax(i,j)       = xtime + dt/60.
 193           tspduv10clmax(i,j)  = xtime + dt/60.
 194           traincclmax(i,j)    = xtime + dt/60.
 195           trainncclmax(i,j)   = xtime + dt/60.
 196           tskintempclmin(i,j) = xtime + dt/60.
 197           tskintempclmax(i,j) = xtime + dt/60.
 198         ENDDO
 199       ENDDO
 200     ENDDO
 201 !    nsteps=clwrfH*60./dt
 202   ELSE
 203     xtimep = xtime + dt/60.   ! value at end of timestep for time info
 204     nsteps=nsteps+1
 205 ! Temperature
 206           CALL varstatistics(t2-t273,xtimep,ime-ims+1,jme-jms+1,t2clmin,t2clmax,   &
 207             tt2clmin,tt2clmax,t2clmean,t2clstd)
 208 ! Water vapor mixing ratio
 209           CALL varstatistics(q2,xtimep,ime-ims+1,jme-jms+1,q2clmin,q2clmax,   &
 210             tq2clmin,tq2clmax,q2clmean,q2clstd)
 211 ! Wind speed
 212           CALL varstatisticsWIND(u10,v10,xtimep,ime-ims+1,jme-jms+1,u10clmax, &
 213             v10clmax,spduv10clmax,tspduv10clmax,u10clmean,v10clmean,         &
 214             spduv10clmean,u10clstd,v10clstd,spduv10clstd)
 215 ! Precipitation flux
 216           CALL varstatisticsMAX(raincv/dt,xtimep,ime-ims+1,jme-jms+1,         &
 217             raincclmax,traincclmax,raincclmean,raincclstd)
 218           CALL varstatisticsMAX(rainncv/dt,xtimep,ime-ims+1,jme-jms+1,        &
 219             rainncclmax,trainncclmax,rainncclmean,rainncclstd)
 220 ! Skin Temperature
 221           CALL varstatistics(skintemp-t273,xtimep,ime-ims+1,jme-jms+1,skintempclmin,&
 222             skintempclmax,tskintempclmin,tskintempclmax,skintempclmean,       &
 223             skintempclstd)
 224
 225 !          IF (MOD(NINT(XTIME),clwrfH) == 0) THEN
 226 !          IF (MOD(NINT(XTIME+dt/60.),clwrfH) == 0) THEN
 227            IF (MOD(NINT((curr_secs2+dt)/dt),NINT(clwrfH*60./dt)) == 0) THEN
 228              IF  ( wrf_dm_on_monitor() ) &
 229                PRINT *,'nsteps=',nsteps,' xtime:', xtime,' clwrfH:',clwrfH
 230                t2clmean=t2clmean/nsteps
 231                t2clstd=SQRT(MAX(t2clstd/nsteps-t2clmean**2.,0.))
 232                t2clmean=t2clmean+t273
 233                t2clmin=t2clmin+t273
 234                t2clmax=t2clmax+t273
 235                q2clmean=q2clmean/nsteps
 236                q2clstd=q2clstd/nsteps-q2clmean*q2clmean
 237                q2clstd=MAX(q2clstd,0.)
 238                q2clstd=SQRT(q2clstd)
 239                u10clmean=u10clmean/nsteps
 240                v10clmean=v10clmean/nsteps
 241                spduv10clmean=spduv10clmean/nsteps
 242                u10clstd=SQRT(MAX(u10clstd/nsteps-u10clmean**2., 0.))
 243                v10clstd=SQRT(MAX(v10clstd/nsteps-v10clmean**2., 0.))
 244                spduv10clstd=SQRT(MAX(spduv10clstd/nsteps-                        &
 245                  spduv10clmean**2, 0.))
 246                raincclmean=raincclmean/nsteps
 247                rainncclmean=rainncclmean/nsteps
 248                raincclstd=SQRT(MAX(raincclstd/nsteps-raincclmean**2., 0.))
 249                rainncclstd=SQRT(MAX(rainncclstd/nsteps-rainncclmean**2., 0.))
 250                skintempclmean=skintempclmean/nsteps
 251                skintempclstd=skintempclstd/nsteps-skintempclmean*skintempclmean
 252                skintempclstd=MAX(skintempclstd,0.)
 253                skintempclstd=SQRT(skintempclstd)
 254                skintempclmean=skintempclmean+t273
 255                skintempclmin=skintempclmin+t273
 256                skintempclmax=skintempclmax+t273
 257              IF  ( wrf_dm_on_monitor() ) THEN
 258                DO ij = 1 , num_tiles
 259                idp = i_start(ij)+(i_end(ij)-i_start(ij))/2
 260                jdp = j_start(ij)+(j_end(ij)-j_start(ij))/2
 261                WRITE(message, *)'CLWRFdiag - T2; tile: ',ij,          &
 262                  ' T2clmin:', t2clmin(idp,jdp),                       &
 263                  ' T2clmax:', t2clmax(idp,jdp),                       &
 264                  ' TT2clmin:', tt2clmin(idp,jdp),                     &
 265                  ' TT2clmax:', tt2clmax(idp,jdp),                     &
 266                  ' T2clmean:', t2clmean(idp,jdp),                     &
 267                  ' T2clstd:', t2clstd(idp,jdp)
 268                CALL wrf_debug(0, message)
 269                WRITE(message, *)'CLWRFdiag - Q2; tile: ',ij,          &
 270                  ' Q2clmin:', q2clmin(idp,jdp),                       &
 271                  ' Q2clmax:', q2clmax(idp,jdp),                       &
 272                  ' TQ2clmin:', tq2clmin(idp,jdp),                     &
 273                  ' TQ2clmax:', tq2clmax(idp,jdp),                     &
 274                  ' Q2clmean:', q2clmean(idp,jdp),                     &
 275                  ' Q2clstd:', q2clstd(idp,jdp)
 276                CALL wrf_debug(75, message)
 277                WRITE(message, *)'CLWRFdiag - WINDSPEED; tile: ',ij,   &
 278                  ' U10clmax:', u10clmax(idp,jdp),                     &
 279                  ' V10clmax:', v10clmax(idp,jdp),                     &
 280                  ' SPDUV10clmax:', spduv10clmax(idp,jdp),             &
 281                  ' TSPDUV10clmax:', tspduv10clmax(idp,jdp),           &
 282                  ' U10clmean:', u10clmean(idp,jdp),                   &
 283                  ' V10clmean:', v10clmean(idp,jdp),                   &
 284                  ' SPDUV10clmean:', spduv10clmean(idp,jdp),           &
 285                  ' U10clstd:', u10clstd(idp,jdp),                     &
 286                  ' V10clstd:', v10clstd(idp,jdp),                     &
 287                  ' SPDUV10clstd:', spduv10clstd(idp,jdp)
 288                CALL wrf_debug(75, message)
 289                WRITE(message, *)'CLWRFdiag - RAIN; tile: ',ij,        &
 290                  ' RAINCclmax:',raincclmax(idp,jdp),                  &
 291                  ' RAINNCclmax:',rainncclmax(idp,jdp),                &
 292                  ' TRAINCclmax:',traincclmax(idp,jdp),                &
 293                  ' TRAINNCclmax:',trainncclmax(idp,jdp),              &
 294                  ' RAINCclmean:',raincclmean(idp,jdp),                &
 295                  ' RAINNCclmean:',rainncclmean(idp,jdp),              &
 296                  ' RAINCclstd:',raincclstd(idp,jdp),                  &
 297                  ' RAINNCclstd:',rainncclstd(idp,jdp)
 298                CALL wrf_debug(75, message)
 299                WRITE(message,*)'CLWRFdiag - SKINTEMP; tile: ',ij,     &
 300                  ' SKINTEMPclmin:',skintempclmin(idp,jdp),            &
 301                  ' SKINTEMPclmax:',skintempclmax(idp,jdp),            &
 302                  ' TSKINTEMPclmin:',tskintempclmin(idp,jdp),          &
 303                  ' TSKINTEMPclmax:',tskintempclmax(idp,jdp),          &
 304                  ' SKINTEMPclmean:',skintempclmean(idp,jdp),          &
 305                  ' SKINTEMPclstd:',skintempclstd(idp,jdp)
 306                CALL wrf_debug(75, message)
 307                ENDDO
 308              ENDIF
 309            END IF
 310 !        ENDDO
 311 !      ENDDO
 312   ENDIF
 313 !  !$OMP END PARALLEL DO
 314
 315    END SUBROUTINE clwrf_output_calc
 316
 317 ! UC.CLWRF Nov.09
 318 SUBROUTINE varstatisticsWIND(varu, varv, tt, dx, dy, varumax, varvmax,       &
 319   varuvmax, tvaruvmax, varumean, varvmean, varuvmean, varustd, varvstd,     &
 320   varuvstd)
 321 ! Subroutine to compute variable statistics for a wind somponents
 322
 323 IMPLICIT NONE
 324
 325 INTEGER                                                        :: i, j
 326 INTEGER, INTENT(IN)                                            :: dx, dy
 327 REAL, DIMENSION(dx,dy), INTENT(IN)                             :: varu, varv
 328 REAL, INTENT(IN)                                               :: tt
 329 REAL, DIMENSION(dx,dy), INTENT(INOUT)                          :: varumax,   &
 330   varvmax, varuvmax, tvaruvmax, varumean, varvmean, varuvmean, varustd,      &
 331   varvstd, varuvstd
 332 REAL                                                           :: varuv
 333
 334 DO i=1,dx
 335   DO j=1,dy
 336     varuv=sqrt(varu(i,j)*varu(i,j)+varv(i,j)*varv(i,j))
 337       IF (varuv > varuvmax(i,j)) THEN
 338         varumax(i,j)=varu(i,j)
 339         varvmax(i,j)=varv(i,j)
 340         varuvmax(i,j)=varuv
 341         tvaruvmax(i,j)=tt
 342       END IF
 343     varuvmean(i,j)=varuvmean(i,j)+varuv
 344     varuvstd(i,j)=varuvstd(i,j)+varuv**2
 345   END DO
 346 END DO
 347 varumean=varumean+varu
 348 varvmean=varvmean+varv
 349 varustd=varustd+varu*varu
 350 varvstd=varvstd+varv*varv
 351
 352 END SUBROUTINE varstatisticsWIND
 353
 354 SUBROUTINE varstatisticsMAX(var, tt, dx, dy, varmax, tvarmax, varmean,       &
 355    varstd)
 356 ! Subroutine to compute variable statistics for a max only variable values
 357
 358 IMPLICIT NONE
 359
 360 INTEGER                                                        :: i,j
 361 INTEGER, INTENT(IN)                                            :: dx, dy
 362 REAL, DIMENSION(dx,dy), INTENT(IN)                             :: var
 363 REAL, INTENT(IN)                                               :: tt
 364 REAL, DIMENSION(dx,dy), INTENT(INOUT)                          :: varmax,    &
 365   tvarmax, varmean, varstd
 366
 367 DO i=1,dx
 368   DO j=1,dy
 369     IF (var(i,j) > varmax(i,j)) THEN
 370       varmax(i,j)=var(i,j)
 371       tvarmax(i,j)=tt
 372     END IF
 373   END DO
 374 END DO
 375 varmean=varmean+var
 376 varstd=varstd+var*var
 377
 378 END SUBROUTINE varstatisticsMAX
 379
 380 SUBROUTINE varstatistics(var, tt, dx, dy, varmin, varmax, tvarmin, tvarmax,  &
 381   varmean, varstd)
 382 ! Subroutine to compute variable statistics
 383
 384 IMPLICIT NONE
 385
 386 INTEGER                                                        :: i,j
 387 INTEGER, INTENT(IN)                                            :: dx, dy
 388 REAL, DIMENSION(dx,dy), INTENT(IN)                             :: var
 389 REAL, INTENT(IN)                                               :: tt
 390 REAL, DIMENSION(dx,dy), INTENT(INOUT)                          :: varmin,    &
 391   varmax, tvarmin, tvarmax, varmean, varstd
 392
 393 DO i=1,dx
 394   DO j=1,dy
 395     IF (var(i,j) < varmin(i,j)) THEN
 396       varmin(i,j)=var(i,j)
 397       tvarmin(i,j)=tt
 398     END IF
 399     IF (var(i,j) > varmax(i,j)) THEN
 400       varmax(i,j)=var(i,j)
 401       tvarmax(i,j)=tt
 402     END IF
 403   END DO
 404 END DO
 405 varmean=varmean+var
 406 varstd=varstd+var*var
 407
 408 END SUBROUTINE varstatistics
 409
 410 END MODULE module_diag_cl
 411 #endif