phys/module_diag_rasm.F

   1 #if (NMM_CORE == 1)
   2 MODULE module_diag_rasm
   3 CONTAINS
   4    SUBROUTINE diag_rasm_stub
   5    END SUBROUTINE diag_rasm_stub
   6 END MODULE module_diag_rasm
   7 #else
   8
   9 !WRF:MEDIATION_LAYER:PHYSICS
  10
  11 MODULE module_diag_rasm
  12 !----------------------------------------------------------------------
  13 ! RASM Climate Diagnostics - Jose Renteria, Amy Solomon, Mark Seefeldt
  14 ! -October 2016
  15 ! -handling of diagnostics controlled through namelist parameters
  16 !----------------------------------------------------------------------
  17
  18 CONTAINS
  19
  20   SUBROUTINE mean_output_calc(                    &
  21         is_restart, currentTime                   &
  22        ,stats_interval, output_freq, run_days     &
  23        ,dt, xtime                                 &
  24        ,psfc, psfc_mean, tsk, tsk_mean            &
  25        ,pmsl_mean, t2, t2_mean                    &
  26        ,t, p, pb, moist, ht                       & ! vars for pmsl calc
  27        ,th2, th2_mean, q2, q2_mean                &
  28        ,u10, u10_mean, v10, v10_mean              &
  29        ,hfx, hfx_mean, lh, lh_mean                &
  30        ,swdnb, swdnb_mean, glw, glw_mean          &
  31        ,lwupb, lwupb_mean, swupb, swupb_mean      &
  32        ,swupt, swupt_mean, swdnt, swdnt_mean      &
  33        ,lwupt, lwupt_mean, lwdnt, lwdnt_mean      &
  34        ,avgoutalarm, avgOutDateStr   &
  35        ,nsteps                                    &
  36        ,ids, ide, jds, jde, kds, kde              &
  37        ,ims, ime, jms, jme, kms, kme              &
  38        ,ips, ipe, jps, jpe, kps, kpe              & ! patch  dims
  39        ,i_start, i_end, j_start, j_end            &
  40        ,num_tiles                                 &
  41        )
  42     !----------------------------------------------------------------------
  43
  44     ! USES:
  45     USE module_utility
  46     USE module_streams
  47     USE module_domain, ONLY : domain_clock_get
  48
  49     IMPLICIT NONE
  50     !======================================================================
  51     ! Definitions
  52     !-----------
  53     !-- DT            time step (second)
  54     !-- XTIME         forecast time
  55     !-- ims           start index for i in memory
  56     !-- ime           end index for i in memory
  57     !-- jms           start index for j in memory
  58     !-- jme           end index for j in memory
  59     !-- i_start       start indices for i in tile
  60     !-- i_end         end indices for i in tile
  61     !-- j_start       start indices for j in tile
  62     !-- j_end         end indices for j in tile
  63     !-- num_tiles     number of tiles
  64     !
  65     !======================================================================
  66
  67     INTEGER, INTENT(IN)                       :: ims, ime, jms, jme, kms, kme
  68     INTEGER, INTENT(IN)                       :: ids, ide, jds, jde, kds, kde
  69     INTEGER, INTENT(IN)                       :: ips, ipe, jps, jpe, kps, kpe
  70     INTEGER, INTENT(IN)                       :: num_tiles
  71     INTEGER, INTENT(IN)                       :: stats_interval
  72     INTEGER, INTENT(IN)                       :: output_freq            ! interval type
  73     INTEGER, INTENT(IN)                       :: run_days
  74     INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, j_end
  75     TYPE(WRFU_Time), INTENT(IN)               :: currentTime
  76     TYPE(WRFU_Alarm), INTENT(INOUT)           :: avgOutAlarm
  77     INTEGER, INTENT(INOUT)                    :: nsteps                 ! number of step accumulated
  78     CHARACTER(*), INTENT(INOUT)               :: avgOutDateStr
  79
  80     INTEGER, PARAMETER :: NONE = 0
  81     INTEGER, PARAMETER :: SECS = 1
  82     INTEGER, PARAMETER :: MINS = 2
  83     INTEGER, PARAMETER :: HRS  = 3
  84     INTEGER, PARAMETER :: DAYS = 4
  85     INTEGER, PARAMETER :: MONTHLY = 5
  86
  87     REAL, INTENT(IN)                                  :: dt, xtime
  88     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: ht
  89     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: psfc, tsk, t2, th2, q2
  90     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: u10, v10
  91     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: hfx, lh
  92     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: swdnb, glw, lwupb, swupb
  93     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: swupt, swdnt, lwupt, lwdnt
  94     REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: t, p, pb, moist
  95
  96     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: psfc_mean, tsk_mean
  97     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: pmsl_mean, t2_mean
  98     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: th2_mean, q2_mean
  99     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: u10_mean, v10_mean
 100     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: hfx_mean, lh_mean
 101     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swdnb_mean, glw_mean
 102     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupb_mean, swupb_mean
 103     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swupt_mean, swdnt_mean
 104     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupt_mean, lwdnt_mean
 105
 106     ! LOCAL  VAR
 107     INTEGER     :: i, j, ij
 108     REAL        :: value
 109     LOGICAL     :: is_restart
 110     INTEGER     :: rc
 111
 112     LOGICAL     :: is_reset               ! reset averages
 113     LOGICAL     :: compute_avg            ! compute averages
 114
 115     INTEGER            :: mean_interval   ! interval (s) of mean calculations
 116
 117     ! DEBUG LOCAL  VAR
 118     CHARACTER (LEN=1024)  :: message
 119
 120     IF ( output_freq .eq. MONTHLY) THEN
 121       mean_interval = (run_days + 1) * 24 * 60 * 60
 122       WRITE(message, *) "RASM Diagnostics: Set average output to MONTHLY_INTERVAL ... "
 123       CALL wrf_debug(200, message)
 124     ELSE IF (output_freq .eq. DAYS ) THEN
 125       mean_interval = stats_interval  * 24 * 60 * 60
 126       WRITE(message, *) "RASM Diagnostics: Set average output to DAYS  ... mean_interval (secs) =", mean_interval
 127       CALL wrf_debug(200, message)
 128     ELSE IF (output_freq .eq. HRS ) THEN
 129       mean_interval =  stats_interval * 60 * 60
 130       WRITE(message, *) "RASM Diagnostics: Set average output to HRS  ... mean_interval (secs) =", mean_interval
 131       CALL wrf_debug(200, message)
 132     ELSE IF (output_freq .eq. MINS ) THEN
 133       mean_interval = stats_interval * 60
 134       WRITE(message, *) "RASM Diagnostics: Set average output to MINS  ... mean_interval (secs) =", mean_interval
 135       CALL wrf_debug(200, message)
 136     ELSE IF (output_freq .eq. SECS ) THEN
 137       mean_interval = stats_interval
 138       WRITE(message, *) "RASM Diagnostics: Set average output to SECS  ... mean_interval (secs) =", mean_interval
 139       CALL wrf_debug(200, message)
 140     ELSE
 141       !WRITE (wrf_err_message , * )"RASM Diagnostics:: ERROR -- error -- ERROR -- error : NO valid interval provided in namelist.input, please provided"
 142       !CALL wrf_error_fatal ( TRIM(wrf_err_message) )
 143     END IF
 144
 145     CALL getResetState(currentTime, xtime, dt, mean_interval, output_freq, is_reset)
 146
 147     IF (is_reset) THEN
 148        DO ij = 1 , num_tiles
 149           DO j = j_start(ij), j_end(ij)
 150              DO i = i_start(ij), i_end(ij)
 151                 psfc_mean(i,j)=0.0
 152                 tsk_mean(i,j)=0.0
 153                 pmsl_mean(i,j)=0.0
 154                 t2_mean(i,j)=0.0
 155                 th2_mean(i,j)=0.0
 156                 q2_mean(i,j)=0.0
 157                 u10_mean(i,j)=0.0
 158                 v10_mean(i,j)=0.0
 159                 hfx_mean(i,j)=0.0
 160                 lh_mean(i,j)=0.0
 161                 swdnb_mean(i,j)=0.0
 162                 glw_mean(i,j)=0.0
 163                 lwupb_mean(i,j)=0.0
 164                 swupb_mean(i,j)=0.0
 165                 swupt_mean(i,j)=0.0
 166                 swdnt_mean(i,j)=0.0
 167                 lwupt_mean(i,j)=0.0
 168                 lwdnt_mean(i,j)=0.0
 169              ENDDO
 170           ENDDO
 171        ENDDO
 172
 173        ! restart step count
 174        nsteps = 0.0
 175
 176        WRITE(message, *) "RASM Statistics: RESET accumaltions and means ..................... nsteps=", nsteps
 177        CALL wrf_debug(200, message)
 178
 179     ENDIF
 180
 181     nsteps = nsteps+1.0
 182
 183     WRITE(message, *) "RASM Statistics: Start accumulate .........................................................."
 184     CALL wrf_debug(200, message)
 185     WRITE(message, *) "RASM Statistics: nsteps=",nsteps, "time_step=", (xtime+dt/60.)*60./dt, "xtime=", xtime
 186     CALL wrf_debug(200, message)
 187
 188     ! Surface Pressure
 189     CALL var_accum_2d(psfc,ime-ims+1,jme-jms+1,psfc_mean)
 190
 191     ! Surface Skin Temperature
 192     CALL var_accum_2d(tsk,ime-ims+1,jme-jms+1,tsk_mean)
 193
 194     ! PMSL
 195     CALL PMSL_accum_01(ims, ime, jms, jme, kms, kme,    &
 196                        ide, jde, ips, ipe, jps, jpe,    &
 197                        t, p, pb, moist, ht, psfc, pmsl_mean)
 198
 199     ! Temperature at 2M
 200     CALL var_accum_2d(t2,ime-ims+1,jme-jms+1,t2_mean)
 201
 202     ! Potential Temperature at 2M
 203     CALL var_accum_2d(th2,ime-ims+1,jme-jms+1,th2_mean)
 204
 205     ! Water Vapor Mixing Ratio at 2M
 206     CALL var_accum_2d(q2,ime-ims+1,jme-jms+1,q2_mean)
 207
 208     ! U-component of Wind at 10M
 209     CALL var_accum_2d(u10,ime-ims+1,jme-jms+1,u10_mean)
 210
 211     ! V-component of Wind at 10M
 212     CALL var_accum_2d(v10,ime-ims+1,jme-jms+1,v10_mean)
 213
 214     ! SENSIBLE HEAT FLUX AT THE SURFACE
 215     CALL var_accum_2d(hfx,ime-ims+1,jme-jms+1,hfx_mean)
 216
 217     ! LATENT HEAT FLUX AT THE SURFACE
 218     CALL var_accum_2d(lh,ime-ims+1,jme-jms+1,lh_mean)
 219
 220     ! INCOMING SOLAR AT SURFACE (SHORTWAVE DOWN)
 221     CALL var_accum_2d(swdnb,ime-ims+1,jme-jms+1,swdnb_mean)
 222
 223     ! INCOMING LONGWAVE AT SURFACE (LONGWAVE DOWN)
 224     CALL var_accum_2d(glw,ime-ims+1,jme-jms+1,glw_mean)
 225
 226     ! OUTGOING LONGWAVE AT SURFACE (LONGWAVE FLUX UP)
 227     CALL var_accum_2d(lwupb,ime-ims+1,jme-jms+1,lwupb_mean)
 228
 229     ! REFLECTIVE SHORTWAVE AT SURFACE
 230     CALL var_accum_2d(swupb,ime-ims+1,jme-jms+1,swupb_mean)
 231
 232     ! SWUPT - UPWELLING SHORTWAVE FLUX AT TOP
 233     CALL var_accum_2d(swupt,ime-ims+1,jme-jms+1,swupt_mean)
 234
 235     ! SWDNT - DOWNWELLING SHORTWAVE FLUX AT TOP
 236     CALL var_accum_2d(swdnt,ime-ims+1,jme-jms+1,swdnt_mean)
 237
 238     ! LWUPT - UPWELLING LONGWAVE FLUX AT TOP
 239     CALL var_accum_2d(lwupt,ime-ims+1,jme-jms+1,lwupt_mean)
 240
 241     ! LWDNT - DOWNWELLING LONGWAVE FLUX AT TOP
 242     CALL var_accum_2d(lwdnt,ime-ims+1,jme-jms+1,lwdnt_mean)
 243
 244     CALL getAvgState(currentTime, xtime, dt, mean_interval, output_freq, compute_avg, avgOutDateStr)
 245     IF (compute_avg) THEN
 246        psfc_mean=psfc_mean/nsteps
 247        tsk_mean=tsk_mean/nsteps
 248        pmsl_mean=pmsl_mean/nsteps
 249        t2_mean=t2_mean/nsteps
 250        th2_mean=th2_mean/nsteps
 251        q2_mean=q2_mean/nsteps
 252        u10_mean=u10_mean/nsteps
 253        v10_mean=v10_mean/nsteps
 254        hfx_mean=hfx_mean/nsteps
 255        lh_mean=lh_mean/nsteps
 256        swdnb_mean=swdnb_mean/nsteps
 257        glw_mean=glw_mean/nsteps
 258        lwupb_mean=lwupb_mean/nsteps
 259        swupb_mean=swupb_mean/nsteps
 260        swupt_mean=swupt_mean/nsteps
 261        swdnt_mean=swdnt_mean/nsteps
 262        lwupt_mean=lwupt_mean/nsteps
 263        lwdnt_mean=lwdnt_mean/nsteps
 264
 265        if ( output_freq .EQ. MONTHLY) then
 266              WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL turn ON ALARM to generate output ........................"
 267              CALL wrf_debug(200, message)
 268        endif
 269
 270        CALL WRFU_AlarmRingerOn (avgOutAlarm, rc=rc)
 271
 272        WRITE(message, *) "RASM Statistics: Mean computed .........................................................."
 273        CALL wrf_debug(200, message)
 274
 275     END IF
 276
 277   END SUBROUTINE mean_output_calc
 278
 279   ! RASM: Diurnal
 280   SUBROUTINE diurnalcycle_output_calc(            &
 281         is_restart, currentTime                   &
 282        ,dt, xtime                                 &
 283        ,psfc, psfc_dtmp, tsk, tsk_dtmp            &
 284        ,t2, t2_dtmp                               &
 285        ,t, p, pb, moist                           & ! vars for pmsl calc
 286        ,th2, th2_dtmp, q2, q2_dtmp                &
 287        ,u10, u10_dtmp, v10, v10_dtmp              &
 288        ,hfx, hfx_dtmp, lh, lh_dtmp                &
 289        ,swdnb, swdnb_dtmp, glw, glw_dtmp          &
 290        ,lwupb, lwupb_dtmp, swupb, swupb_dtmp      &
 291        ,swupt, swupt_dtmp, swdnt, swdnt_dtmp      &
 292        ,lwupt, lwupt_dtmp, lwdnt, lwdnt_dtmp      &
 293        ,avgoutalarm                  &
 294        ,diurnOutDateStr, avg_nsteps               &
 295        ,diurnal_nsteps                            &
 296        ,psfc_diurn, tsk_diurn, t2_diurn           &
 297        ,th2_diurn, q2_diurn, u10_diurn, v10_diurn &
 298        ,hfx_diurn, lh_diurn                       &
 299        ,swdnb_diurn, glw_diurn                    &
 300        ,lwupb_diurn, swupb_diurn                  &
 301        ,swupt_diurn, swdnt_diurn                  &
 302        ,lwupt_diurn, lwdnt_diurn                  &
 303        ,ids, ide, jds, jde, kds, kde              &
 304        ,ims, ime, jms, jme, kms, kme              &
 305        ,ips, ipe, jps, jpe, kps, kpe              & ! patch  dims
 306        ,i_start, i_end, j_start, j_end            &
 307        ,num_tiles         )
 308
 309     !----------------------------------------------------------------------
 310     ! USES:
 311     USE module_utility
 312     USE module_domain, ONLY : domain_clock_get
 313
 314     IMPLICIT NONE
 315     !======================================================================
 316     ! Definitions
 317     !-----------
 318     !-- DT            time step (second)
 319     !-- XTIME         forecast time
 320     !-- ims           start index for i in memory
 321     !-- ime           end index for i in memory
 322     !-- jms           start index for j in memory
 323     !-- jme           end index for j in memory
 324     !-- i_start       start indices for i in tile
 325     !-- i_end         end indices for i in tile
 326     !-- j_start       start indices for j in tile
 327     !-- j_end         end indices for j in tile
 328     !-- num_tiles     number of tiles
 329     !
 330     !======================================================================
 331
 332     INTEGER, INTENT(IN)                       :: ims, ime, jms, jme, kms, kme
 333     INTEGER, INTENT(IN)                       :: ids, ide, jds, jde, kds, kde
 334     INTEGER, INTENT(IN)                       :: ips, ipe, jps, jpe, kps, kpe
 335
 336     INTEGER, INTENT(IN)                       :: num_tiles
 337     INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, j_end
 338     TYPE(WRFU_Time), INTENT(IN)               :: currentTime
 339     TYPE(WRFU_Alarm), INTENT(INOUT)           :: avgOutAlarm
 340     INTEGER, INTENT(INOUT)                    :: avg_nsteps             ! number of avg steps accumulated
 341     INTEGER, INTENT(INOUT)                    :: diurnal_nsteps         ! number of diurnal steps accumulated
 342     CHARACTER(*), INTENT(INOUT)               :: diurnOutDateStr
 343
 344     INTEGER, PARAMETER :: NONE = 0
 345     INTEGER, PARAMETER :: SECS = 1
 346     INTEGER, PARAMETER :: MINS = 2
 347     INTEGER, PARAMETER :: HRS  = 3
 348     INTEGER, PARAMETER :: DAYS = 4
 349     INTEGER, PARAMETER :: MONTHLY = 5
 350     INTEGER, PARAMETER :: NUM_DIURN_CYCLES = 8
 351     INTEGER, PARAMETER :: DIURNAL_3HR      = 10800   ! three hour period in seconds
 352
 353     REAL, INTENT(IN)                                  :: dt, xtime
 354     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: psfc, tsk, t2, th2, q2
 355     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: u10, v10
 356     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: hfx, lh
 357     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: swdnb, glw, lwupb, swupb
 358     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN)  :: swupt, swdnt, lwupt, lwdnt
 359     REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: t, p, pb, moist
 360     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: psfc_dtmp, tsk_dtmp
 361     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: t2_dtmp
 362     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: th2_dtmp, q2_dtmp
 363     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: u10_dtmp, v10_dtmp
 364     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: hfx_dtmp, lh_dtmp
 365     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swdnb_dtmp, glw_dtmp
 366     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupb_dtmp, swupb_dtmp
 367     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swupt_dtmp, swdnt_dtmp
 368     REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupt_dtmp, lwdnt_dtmp
 369
 370     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: psfc_diurn, tsk_diurn
 371     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: t2_diurn
 372     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: th2_diurn, q2_diurn
 373     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: u10_diurn, v10_diurn
 374     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: hfx_diurn, lh_diurn
 375     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: swdnb_diurn, glw_diurn
 376     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: lwupb_diurn, swupb_diurn
 377     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: swupt_diurn, swdnt_diurn
 378     REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: lwupt_diurn, lwdnt_diurn
 379
 380     ! LOCAL  VAR
 381     INTEGER     :: i, j, k, ij
 382     REAL        :: value
 383     LOGICAL     :: is_restart
 384     INTEGER     :: rc
 385     INTEGER     :: current_diurn_cycle
 386     INTEGER     :: diurnal_output_freq    ! diurnal interval type
 387     INTEGER     :: mean_output_freq       ! mean interval type
 388     INTEGER     :: mean_interval          ! mean interval
 389     LOGICAL     :: is_avg_reset           ! reset averages
 390     LOGICAL     :: is_diurnal_reset       ! reset dirurnal cycle
 391     LOGICAL     :: compute_avg            ! compute averages
 392     LOGICAL     :: compute_diurnalcycle   ! compute dirurnal cycle
 393
 394     ! DEBUG LOCAL  VAR
 395     CHARACTER (LEN=1024)  :: message
 396     CHARACTER (LEN=1024)  :: EmptyStr
 397     LOGICAL               :: diurn_test
 398     INTEGER               :: diurn_interval
 399
 400     ! initialize frequencies and intervals
 401     mean_interval = DIURNAL_3HR
 402     mean_output_freq = HRS
 403     diurn_interval = 2 * 24 * 60 * 60 ! dummy variable only used when testing
 404     diurnal_output_freq = MONTHLY
 405     EmptyStr =""                      ! empty string used for processing
 406
 407     ! intitialize 2 day test
 408     diurn_test = .false.
 409     ! if testing generate daily instead of monthy
 410     if (diurn_test) then
 411        diurnal_output_freq = DAYS
 412     else
 413        diurnal_output_freq = MONTHLY
 414     endif
 415
 416     ! get the average state
 417     CALL getResetState(currentTime, xtime, dt, mean_interval, mean_output_freq, is_avg_reset)
 418     IF (is_avg_reset) THEN
 419        DO ij = 1 , num_tiles
 420           DO j = j_start(ij), j_end(ij)
 421              DO i = i_start(ij), i_end(ij)
 422                 psfc_dtmp(i,j)=0.0
 423                 tsk_dtmp(i,j)=0.0
 424                 t2_dtmp(i,j)=0.0
 425                 th2_dtmp(i,j)=0.0
 426                 q2_dtmp(i,j)=0.0
 427                 u10_dtmp(i,j)=0.0
 428                 v10_dtmp(i,j)=0.0
 429                 hfx_dtmp(i,j)=0.0
 430                 lh_dtmp(i,j)=0.0
 431                 swdnb_dtmp(i,j)=0.0
 432                 glw_dtmp(i,j)=0.0
 433                 lwupb_dtmp(i,j)=0.0
 434                 swupb_dtmp(i,j)=0.0
 435                 swupt_dtmp(i,j)=0.0
 436                 swdnt_dtmp(i,j)=0.0
 437                 lwupt_dtmp(i,j)=0.0
 438                 lwdnt_dtmp(i,j)=0.0
 439              ENDDO
 440           ENDDO
 441        ENDDO
 442
 443        ! restart step count
 444        avg_nsteps = 0.0
 445
 446        WRITE(message, *) "RASM Statistics: RESET accumaltions and means ..................... avg_nsteps=", avg_nsteps
 447        CALL wrf_debug(200, message)
 448
 449     ENDIF
 450
 451     ! get the diurnal state
 452     CALL getResetState(currentTime, xtime, dt, diurn_interval, diurnal_output_freq, is_diurnal_reset)
 453     IF (is_diurnal_reset) THEN
 454        DO ij = 1 , num_tiles
 455           DO k = 1 , NUM_DIURN_CYCLES
 456              DO j = j_start(ij), j_end(ij)
 457                 DO i = i_start(ij), i_end(ij)
 458                    psfc_diurn(i,k,j)=0.0
 459                    tsk_diurn(i,k,j)=0.0
 460                    t2_diurn(i,k,j)=0.0
 461                    th2_diurn(i,k,j)=0.0
 462                    q2_diurn(i,k,j)=0.0
 463                    u10_diurn(i,k,j)=0.0
 464                    v10_diurn(i,k,j)=0.0
 465                    hfx_diurn(i,k,j)=0.0
 466                    lh_diurn(i,k,j)=0.0
 467                    swdnb_diurn(i,k,j)=0.0
 468                    glw_diurn(i,k,j)=0.0
 469                    lwupb_diurn(i,k,j)=0.0
 470                    swupb_diurn(i,k,j)=0.0
 471                    swupt_diurn(i,k,j)=0.0
 472                    swdnt_diurn(i,k,j)=0.0
 473                    lwupt_diurn(i,k,j)=0.0
 474                    lwdnt_diurn(i,k,j)=0.0
 475                 ENDDO
 476              ENDDO
 477           ENDDO
 478        ENDDO
 479
 480        ! restart step count
 481        diurnal_nsteps = 0.0
 482
 483        WRITE(message, *) "RASM Statistics: RESET Diurnal means ..................... diurnal_nsteps=", diurnal_nsteps
 484        CALL wrf_debug(200, message)
 485
 486     ENDIF
 487
 488     avg_nsteps = avg_nsteps+1.0
 489
 490     ! Surface Pressure
 491     CALL var_accum_2d(psfc,ime-ims+1,jme-jms+1,psfc_dtmp)
 492
 493     ! Surface Skin Temperature
 494     CALL var_accum_2d(tsk,ime-ims+1,jme-jms+1,tsk_dtmp)
 495
 496     ! Temperature at 2M
 497     CALL var_accum_2d(t2,ime-ims+1,jme-jms+1,t2_dtmp)
 498
 499     ! Potential Temperature at 2M
 500     CALL var_accum_2d(th2,ime-ims+1,jme-jms+1,th2_dtmp)
 501
 502     ! WATER VAPOR MIXING RATIO AT 2M
 503     CALL var_accum_2d(q2,ime-ims+1,jme-jms+1,q2_dtmp)
 504
 505     ! U-COMPONENT OF WIND AT 10M
 506     CALL var_accum_2d(u10,ime-ims+1,jme-jms+1,u10_dtmp)
 507
 508     ! V-COMPONENT OF WIND AT 10M
 509     CALL var_accum_2d(v10,ime-ims+1,jme-jms+1,v10_dtmp)
 510
 511     ! SENSIBLE HEAT FLUX AT THE SURFACE
 512     CALL var_accum_2d(hfx,ime-ims+1,jme-jms+1,hfx_dtmp)
 513
 514     ! LATENT HEAT FLUX AT THE SURFACE
 515     CALL var_accum_2d(lh,ime-ims+1,jme-jms+1,lh_dtmp)
 516
 517     ! DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE
 518     CALL var_accum_2d(swdnb,ime-ims+1,jme-jms+1,swdnb_dtmp)
 519
 520     ! DOWNWARD LONG WAVE FLUX AT GROUND SURFACE
 521     CALL var_accum_2d(glw,ime-ims+1,jme-jms+1,glw_dtmp)
 522
 523     ! UPWELLING LONGWAVE FLUX AT BOTTOM
 524     CALL var_accum_2d(lwupb,ime-ims+1,jme-jms+1,lwupb_dtmp)
 525
 526     ! UPWELLING SHORTWAVE FLUX AT BOTTOM
 527     CALL var_accum_2d(swupb,ime-ims+1,jme-jms+1,swupb_dtmp)
 528
 529     ! UPWELLING SHORTWAVE FLUX AT TOP
 530     CALL var_accum_2d(swupt,ime-ims+1,jme-jms+1,swupt_dtmp)
 531
 532     ! DOWNWELLING SHORTWAVE FLUX AT TOP
 533     CALL var_accum_2d(swdnt,ime-ims+1,jme-jms+1,swdnt_dtmp)
 534
 535     ! UPWELLING LONGWAVE FLUX AT TOP
 536     CALL var_accum_2d(lwupt,ime-ims+1,jme-jms+1,lwupt_dtmp)
 537
 538     ! DOWNWELLING LONGWAVE FLUX AT TOP
 539     CALL var_accum_2d(lwdnt,ime-ims+1,jme-jms+1,lwdnt_dtmp)
 540
 541     ! get average state
 542     CALL getAvgState(currentTime, xtime, dt, mean_interval, mean_output_freq, compute_avg, EmptyStr)
 543     IF (compute_avg) THEN
 544        psfc_dtmp=psfc_dtmp/avg_nsteps
 545        tsk_dtmp=tsk_dtmp/avg_nsteps
 546        t2_dtmp=t2_dtmp/avg_nsteps
 547        th2_dtmp=th2_dtmp/avg_nsteps
 548        q2_dtmp=q2_dtmp/avg_nsteps
 549        u10_dtmp=u10_dtmp/avg_nsteps
 550        v10_dtmp=v10_dtmp/avg_nsteps
 551        hfx_dtmp=hfx_dtmp/avg_nsteps
 552        lh_dtmp=lh_dtmp/avg_nsteps
 553        swdnb_dtmp=swdnb_dtmp/avg_nsteps
 554        glw_dtmp=glw_dtmp/avg_nsteps
 555        lwupb_dtmp=lwupb_dtmp/avg_nsteps
 556        swupb_dtmp=swupb_dtmp/avg_nsteps
 557        swupt_dtmp=swupt_dtmp/avg_nsteps
 558        swdnt_dtmp=swdnt_dtmp/avg_nsteps
 559        lwupt_dtmp=lwupt_dtmp/avg_nsteps
 560        lwdnt_dtmp=lwdnt_dtmp/avg_nsteps
 561
 562        CALL get_diurn_cycle(currentTime, xtime, dt, current_diurn_cycle)
 563        ! accummulate averages, increment counter by one
 564        CALL var_accum_diurnal(psfc_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, psfc_diurn)
 565        CALL var_accum_diurnal(tsk_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, tsk_diurn)
 566        CALL var_accum_diurnal(t2_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, t2_diurn)
 567        CALL var_accum_diurnal(th2_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, th2_diurn)
 568        CALL var_accum_diurnal(q2_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, q2_diurn)
 569        CALL var_accum_diurnal(u10_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, u10_diurn)
 570        CALL var_accum_diurnal(v10_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, v10_diurn)
 571        CALL var_accum_diurnal(hfx_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, hfx_diurn)
 572        CALL var_accum_diurnal(lh_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lh_diurn)
 573        CALL var_accum_diurnal(swdnb_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swdnb_diurn)
 574        CALL var_accum_diurnal(glw_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, glw_diurn)
 575        CALL var_accum_diurnal(lwupb_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwupb_diurn)
 576        CALL var_accum_diurnal(swupb_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swupb_diurn)
 577        CALL var_accum_diurnal(swupt_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swupt_diurn)
 578        CALL var_accum_diurnal(swdnt_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swdnt_diurn)
 579        CALL var_accum_diurnal(lwupt_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwupt_diurn)
 580        CALL var_accum_diurnal(lwdnt_dtmp, ime-ims+1,  NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwdnt_diurn)
 581
 582        ! increment diurnal count once a day, assuming 3hr cycles
 583        if (current_diurn_cycle .eq. 8) then
 584           diurnal_nsteps = diurnal_nsteps + 1.0
 585        endif
 586
 587     END IF
 588
 589     ! get Diurnal average state
 590     CALL getDiurnalState(currentTime, xtime, dt, diurn_interval, diurnal_output_freq, compute_diurnalcycle, diurnOutDateStr)
 591     IF (compute_diurnalcycle) THEN
 592        psfc_diurn=psfc_diurn/diurnal_nsteps
 593        tsk_diurn=tsk_diurn/diurnal_nsteps
 594        t2_diurn=t2_diurn/diurnal_nsteps
 595        th2_diurn=th2_diurn/diurnal_nsteps
 596        q2_diurn=q2_diurn/diurnal_nsteps
 597        u10_diurn=u10_diurn/diurnal_nsteps
 598        v10_diurn=v10_diurn/diurnal_nsteps
 599        hfx_diurn=hfx_diurn/diurnal_nsteps
 600        lh_diurn=lh_diurn/diurnal_nsteps
 601        swdnb_diurn=swdnb_diurn/diurnal_nsteps
 602        glw_diurn=glw_diurn/diurnal_nsteps
 603        lwupb_diurn=lwupb_diurn/diurnal_nsteps
 604        swupb_diurn=swupb_diurn/diurnal_nsteps
 605        swupt_diurn=swupt_diurn/diurnal_nsteps
 606        swdnt_diurn=swdnt_diurn/diurnal_nsteps
 607        lwupt_diurn=lwupt_diurn/diurnal_nsteps
 608        lwdnt_diurn=lwdnt_diurn/diurnal_nsteps
 609
 610        CALL WRFU_AlarmRingerOn (avgOutAlarm, rc=rc)
 611
 612        WRITE(message, *) "RASM Statistics: Diurnal Mean Cycle computed .........................................................."
 613        CALL wrf_debug(200, message)
 614
 615     END IF
 616
 617   END SUBROUTINE diurnalcycle_output_calc
 618
 619   SUBROUTINE var_accum_diurnal(var, dx, dz, dy, current_cycle, var_accum)
 620     ! Subroutine accumulates diurnal variable
 621
 622     IMPLICIT NONE
 623
 624     INTEGER, INTENT(IN)                   :: dx, dz, dy, current_cycle
 625     REAL, DIMENSION(dx,dy), INTENT(IN)         :: var
 626     REAL, DIMENSION(dx, dz, dy), INTENT(INOUT) :: var_accum
 627
 628     !local
 629     INTEGER :: k, i, j
 630
 631     k = current_cycle ! current cycle
 632     DO j=1,dy
 633        DO i=1,dx
 634           var_accum(i, k, j) = var_accum(i, k, j) + var(i,j)
 635        ENDDO
 636     ENDDO
 637
 638   END SUBROUTINE var_accum_diurnal
 639
 640   SUBROUTINE var_accum_2d(var, dx, dy, var_accum)
 641     ! Subroutine accumulates 2D variable
 642
 643     IMPLICIT NONE
 644
 645     INTEGER, INTENT(IN)                   :: dx, dy
 646     REAL, DIMENSION(dx,dy), INTENT(IN)    :: var
 647     REAL, DIMENSION(dx,dy), INTENT(INOUT) :: var_accum
 648
 649     var_accum = var_accum + var
 650
 651   END SUBROUTINE var_accum_2d
 652
 653   SUBROUTINE var_accum_3d_01(ims, ime, jms, jme, kms, kme,    &
 654                              ide, jde, ips, ipe, jps, jpe,    &
 655                              var, var_accum)
 656     ! Subroutine accumulates 3D variable at lowest level resulting in 2D output
 657
 658     IMPLICIT NONE
 659
 660     INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
 661     INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe
 662
 663     REAL, DIMENSION(  ims:ime , kms:kme, jms:jme ), INTENT(IN):: var
 664     REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: var_accum
 665
 666     !local
 667     INTEGER              :: k, i, j, j_end, i_end
 668     CHARACTER (LEN=1024) :: message
 669
 670     j_end = jpe
 671     i_end = ipe
 672     if(j_end.eq.jde) j_end=j_end-1
 673     if(i_end.eq.ide) i_end=i_end-1
 674
 675     k=1 ! lowest level
 676     DO j=jps, j_end
 677        DO i=ips, i_end
 678           var_accum(i,j) = var_accum(i,j) + var(i,k,j)
 679        ENDDO
 680     ENDDO
 681
 682   END SUBROUTINE var_accum_3d_01
 683
 684   SUBROUTINE shum_accum_01(ims, ime, jms, jme, kms, kme,    &
 685                            ide, jde, ips, ipe, jps, jpe,    &
 686                            moist, var_accum)
 687     ! Subroutine accumulates specific humidity at lowest level resulting in 2D output
 688
 689     IMPLICIT NONE
 690
 691     INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
 692     INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe
 693
 694     REAL, DIMENSION(  ims:ime , kms:kme, jms:jme ), INTENT(IN):: moist
 695     REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: var_accum
 696
 697     !local
 698     REAL :: tmp_shum
 699     INTEGER              :: k, i, j, j_end, i_end
 700     CHARACTER (LEN=1024) :: message
 701
 702     j_end = jpe
 703     i_end = ipe
 704     if(j_end.eq.jde) j_end=j_end-1
 705     if(i_end.eq.ide) i_end=i_end-1
 706
 707     k=1 ! lowest level
 708     DO j=jps, j_end
 709        DO i=ips, i_end
 710           if( moist(i,k,j) .gt. 0 ) then
 711              tmp_shum = moist(i,k,j) / (1+moist(i,k,j))
 712           else
 713              tmp_shum = 0.0
 714           endif
 715           var_accum(i,j) = var_accum(i,j) + tmp_shum
 716        ENDDO
 717     ENDDO
 718
 719   END SUBROUTINE shum_accum_01
 720
 721   SUBROUTINE T_accum_01( ims, ime, jms, jme, kms, kme,    &
 722                          ide, jde, ips, ipe, jps, jpe,    &
 723                          t, p, pb, t_accum)
 724     ! Subroutine accumulates Temperature at lowest level resulting in 2D output
 725
 726     USE module_model_constants, only: t0,p0
 727     USE shr_const_mod
 728
 729     IMPLICIT NONE
 730
 731     INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
 732     INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe
 733
 734     REAL, DIMENSION(  ims:ime , kms:kme, jms:jme ), INTENT(IN):: t, p, pb
 735     REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: t_accum
 736
 737     ! local
 738     REAL     :: t_tmp, cp, rd
 739     INTEGER              :: k, i, j, j_end, i_end
 740     CHARACTER (LEN=1024) :: message
 741
 742     rd=SHR_CONST_RDAIR
 743     cp=SHR_CONST_CPDAIR
 744
 745     j_end = jpe
 746     i_end = ipe
 747     if(j_end.eq.jde) j_end=j_end-1
 748     if(i_end.eq.ide) i_end=i_end-1
 749
 750     k=1 ! lowest level
 751     DO j=jps, j_end
 752        DO i=ips, i_end
 753           ! calulate surface tempature at lowest level
 754           t_tmp = (t(i,k,j) + t0) * (((p(i,k,j) + pb(i,k,j))/p0) ** (rd/cp))
 755           ! accumulate surface tempature at lowest level
 756           t_accum(i,j) = t_accum(i,j) + t_tmp
 757        ENDDO
 758     ENDDO
 759
 760   END SUBROUTINE T_accum_01
 761
 762
 763   SUBROUTINE PMSL_accum_01( ims, ime, jms, jme, kms, kme,    &
 764                             ide, jde, ips, ipe, jps, jpe,    &
 765                             t, p, pb, moist, ht, psfc, pmsl_accum)
 766     ! Subroutine calculates and accumulates PMSL resulting in 2D output
 767
 768     USE module_model_constants, only: t0,p0
 769     USE shr_const_mod
 770
 771     IMPLICIT NONE
 772
 773     INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme
 774     INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe
 775
 776     REAL, DIMENSION(  ims:ime , kms:kme, jms:jme ), INTENT(IN):: t, p, pb, moist
 777     REAL, DIMENSION(  ims:ime , jms:jme ), INTENT(IN):: ht, psfc
 778     REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: pmsl_accum
 779
 780     ! local
 781     REAL     :: t_tmp, tmp_pmsl, z, tv, g, cp, rd, xlapse
 782     REAL     :: alpha, tstar, tt0, alph, beta, psfc_tmp, p_tmp
 783     INTEGER              :: k, i, j, j_end, i_end
 784     CHARACTER (LEN=1024) :: message
 785
 786     xlapse = 6.5D-3
 787     rd=SHR_CONST_RDAIR
 788     g=SHR_CONST_G
 789     cp=SHR_CONST_CPDAIR
 790
 791     j_end = jpe
 792     i_end = ipe
 793     if(j_end.eq.jde) j_end=j_end-1
 794     if(i_end.eq.ide) i_end=i_end-1
 795
 796     k=1 ! lowest level
 797     do j=jps, j_end
 798        do i=ips, i_end
 799
 800              ! calulate surface tempature at lowest level
 801              t_tmp = (t(i,k,j) + t0) * (((p(i,k,j) + pb(i,k,j))/p0) ** (rd/cp))
 802
 803              ! calculate virtual temperature at lowest model level
 804              tv = t_tmp * (1 + moist(i,k,j) * 0.61)
 805
 806              ! Calculate geopotential at surface in m2 s-2
 807              z = ht(i,j) * g ! terrain height in m
 808
 809              alpha = rd * xlapse/g ! 0.1903, no units
 810
 811              ! Get surface pressure in Pa
 812              psfc_tmp = psfc(i,j)
 813
 814              ! Calculate pressure in WRF at lowest model level in Pa
 815              p_tmp = (p(i,k,j) + pb(i,k,j))
 816
 817              ! Use surface pressure for PMSL if we are at sea level.
 818              if ( abs(z/g) < 1.0E-4 )then
 819                 tmp_pmsl = psfc_tmp
 820                 ! Othewise, calculate based on ECMWF method
 821              else
 822                 tstar = tv * (1.0 + alpha * (psfc_tmp/p_tmp-1.0))
 823                 tt0 = tstar + xlapse*z/g
 824
 825                 if ( tstar <= 290.5 .and. tt0 > 290.5 ) then
 826                    alph = rd/z * (290.5 - tstar)
 827                 else if (tstar > 290.5  .and. tt0 > 290.5) then
 828                    alph = 0.0
 829                    tstar = 0.5 * (290.5 + tstar)
 830                 else
 831                    alph=alpha
 832                    if (tstar < 255.0) then
 833                       tstar = 0.5 * (255.0 + tstar)
 834                    endif
 835                 endif
 836                 beta = z/(rd*tstar)
 837                 tmp_pmsl = psfc_tmp * exp( beta*(1.0 - alph * beta/2.0 + ((alph*beta)**2)/3.0))
 838              end if
 839
 840              ! accumulate pmsl at lowest level
 841              pmsl_accum(i,j) = pmsl_accum(i,j) +  tmp_pmsl
 842
 843           ENDDO
 844        ENDDO
 845
 846   END SUBROUTINE PMSL_accum_01
 847
 848
 849   SUBROUTINE getResetState(currentTime, xtime, dt, mean_interval, output_freq, is_reset)
 850     ! Subroutine DESCRIPTION:
 851     ! Determine if data stats are to be reset at the current time step
 852     ! True implies that stats are reinitialized
 853
 854     ! USES:
 855     USE module_utility
 856     !USE ESMF_Mod
 857
 858     IMPLICIT NONE
 859
 860     TYPE(WRFU_Time), INTENT(IN)   :: currentTime
 861     INTEGER, INTENT(IN)           :: mean_interval
 862     REAL, INTENT(IN)              :: dt, xtime
 863     INTEGER, INTENT(IN)           :: output_freq
 864     LOGICAL, INTENT(INOUT)        :: is_reset
 865
 866     INTEGER, PARAMETER :: NONE = 0
 867     INTEGER, PARAMETER :: SECS = 1
 868     INTEGER, PARAMETER :: MINS = 2
 869     INTEGER, PARAMETER :: HRS  = 3
 870     INTEGER, PARAMETER :: DAYS = 4
 871     INTEGER, PARAMETER :: MONTHLY = 5
 872
 873     ! LOCAL VARIABLES:
 874     TYPE(WRFU_TimeInterval) :: off
 875     TYPE(WRFU_Time)         :: prevTime
 876
 877     integer :: yr         !nstep year
 878     integer :: mon        !nstep months (1 -> 12)
 879     integer :: prevMon    !nstep-1 months (1 -> 12)
 880     integer :: day        !nstep days (1 -> 31)
 881     integer :: dtime
 882
 883     CHARACTER (LEN=10) ::str_yr
 884     CHARACTER (LEN=10) ::str_mon
 885     CHARACTER (LEN=10) ::str_day
 886     CHARACTER (LEN=80) ::filedate
 887
 888     CHARACTER (LEN=1024) :: message
 889
 890     dtime = INT (dt)
 891
 892     ! Determine if time to reset data stats
 893     is_reset = .false.
 894
 895     if (output_freq .eq. MONTHLY) then
 896        ! get date for current time_step
 897        call WRFU_TimeGet( currentTime, mm=mon)
 898
 899        ! get date for previous time_step
 900        call WRFU_TimeIntervalSet( off, s=dtime)
 901        prevTime = currentTime - off
 902        call WRFU_TimeGet( prevTime, mm=prevMon)
 903
 904        if ( (mon-prevMon) /= 0) then
 905           is_reset = .true.
 906
 907           WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL RESET condition met (return TRUE) "
 908           CALL wrf_debug(200, message)
 909        endif
 910     else
 911        if ( MOD(NINT(xtime*60./dt),NINT(mean_interval/dt)) == 0 ) then
 912           is_reset = .true.
 913
 914           WRITE(message, *) "RASM Statistics: STATIC_INTERVAL RESET condition met (return TRUE) "
 915           CALL wrf_debug(200, message)
 916        endif
 917     endif
 918
 919   END SUBROUTINE getResetState
 920
 921   SUBROUTINE getAvgState(currentTime, xtime, dt, mean_interval, output_freq, compute_avg, OutDateStr)
 922     ! Subroutine DESCRIPTION:
 923     ! Determine if data averages are to be calculated at the current time step
 924     ! True implies calculate avergaes
 925
 926    ! USES:
 927     USE module_utility
 928     !USE ESMF_Mod
 929
 930     IMPLICIT NONE
 931
 932     TYPE(WRFU_Time), INTENT(IN)   :: currentTime
 933     INTEGER, INTENT(IN)           :: mean_interval
 934     REAL, INTENT(IN)              :: dt, xtime
 935     INTEGER, INTENT(IN)           :: output_freq
 936     LOGICAL, INTENT(INOUT)        :: compute_avg
 937     CHARACTER(*), INTENT(INOUT)   :: OutDateStr
 938
 939     ! LOCAL VARIABLES:
 940     TYPE(WRFU_TimeInterval) :: off
 941     TYPE(WRFU_Time)         :: nextTime
 942     TYPE(WRFU_Time)         :: prevTime
 943
 944     INTEGER, PARAMETER :: NONE = 0
 945     INTEGER, PARAMETER :: SECS = 1
 946     INTEGER, PARAMETER :: MINS = 2
 947     INTEGER, PARAMETER :: HRS  = 3
 948     INTEGER, PARAMETER :: DAYS = 4
 949     INTEGER, PARAMETER :: MONTHLY = 5
 950
 951     integer :: yr         !nstep year
 952     integer :: mon        !nstep months (1 -> 12)
 953     integer :: nextMon    !nstep+1 months (1 -> 12)
 954     integer :: prevMon    !nstep-1 months (1 -> 12)
 955     integer :: day        !nstep days (1 -> 31)
 956     integer :: hr         !nstep hrs
 957     integer :: min        !nstep mins
 958     integer :: sec        !nstep secs
 959     integer :: totalsec   !nstep total secs
 960     integer :: dtime
 961
 962     CHARACTER (LEN=10) ::str_yr
 963     CHARACTER (LEN=10) ::str_mon
 964     CHARACTER (LEN=10) ::str_day
 965     CHARACTER (LEN=10) ::str_sec
 966     CHARACTER (LEN=80) ::filedate
 967
 968     CHARACTER (LEN=1024) :: message
 969
 970     dtime = INT (dt)
 971
 972     ! Determine if time to average data
 973     compute_avg = .false.
 974     if ( output_freq .EQ. MONTHLY) then
 975
 976        ! get date for current time_step
 977        call WRFU_TimeGet( currentTime, mm=mon)
 978
 979        ! get date for next time_step
 980        call WRFU_TimeIntervalSet( off, s=dtime)
 981        nextTime = currentTime + off
 982        call WRFU_TimeGet( nextTime, mm=nextMon)
 983
 984        if ( (nextMon-mon) /= 0)  then
 985           compute_avg = .true.
 986
 987           WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL AVG condition met (return TRUE) "
 988           CALL wrf_debug(200, message)
 989        endif
 990
 991     else
 992        if ((MOD(NINT((xtime+dt/60.)*60./dt),NINT(mean_interval/dt)) == 0)) then
 993           compute_avg = .true.
 994
 995           WRITE(message, *) "RASM Statistics: STATIC_INTERVAL AVG condition met (return TRUE) "
 996           CALL wrf_debug(200, message)
 997        endif
 998     endif
 999
1000     ! generate date used for hourly, min and sec averages
1001     if (compute_avg) then
1002        IF ( (output_freq .ne. MONTHLY)  .and. (output_freq .ne. DAYS)) THEN
1003
1004           ! get date for next time_step
1005           call WRFU_TimeIntervalSet( off, s=dtime)
1006           nextTime = currentTime + off
1007           call WRFU_TimeGet( nextTime, yy=yr, mm=mon, dd=day, h=hr, m=min, s=sec)
1008
1009           WRITE(str_yr, '(I4.4)')  yr
1010           WRITE(str_mon, '(I2.2)')  mon
1011           WRITE(str_day, '(I2.2)')  day
1012           totalsec = (hr * 60 * 60) + (min * 60) + sec
1013           WRITE(str_sec, '(I5.5)')  totalsec
1014           filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day)//"-"//trim(str_sec)
1015           OutDateStr = filedate
1016
1017           WRITE(message, *) "RASM Statistics:  STATIC_INTERVAL AVG condition met ......... avgOutDateStr:", trim(OutDateStr)
1018           CALL wrf_debug(200, message)
1019
1020        ELSE IF ( output_freq .eq. MONTHLY ) THEN
1021           ! get avg date
1022           call WRFU_TimeIntervalSet( off, s=dtime)
1023           nextTime = currentTime + off
1024           call WRFU_TimeGet( nextTime, yy=yr, mm=mon)
1025           IF (mon .eq. 1) THEN
1026              mon = 12
1027              yr = yr - 1
1028           ELSE
1029              mon = mon - 1
1030           ENDIF
1031           WRITE(str_yr, '(I4.4)')  yr
1032           WRITE(str_mon, '(I2.2)')  mon
1033           filedate = trim(str_yr)//"-"//trim(str_mon)
1034           OutDateStr = filedate
1035
1036           WRITE(message, *) "RASM Statistics:  AVG condition met ......... avgOutDateStr:", trim(OutDateStr)
1037           CALL wrf_debug(200, message)
1038
1039        ELSE IF (output_freq .eq. DAYS ) THEN
1040           ! get avg date
1041           call WRFU_TimeIntervalSet( off, s=mean_interval-dtime)
1042           prevTime = currentTime - off
1043           call WRFU_TimeGet( prevTime, yy=yr, mm=mon, dd=day)
1044           WRITE(str_yr, '(I4.4)')  yr
1045           WRITE(str_mon, '(I2.2)')  mon
1046           WRITE(str_day, '(I2.2)')  day
1047           filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day)
1048           OutDateStr = filedate
1049
1050           WRITE(message, *) "RASM Statistics:  AVG condition met ......... avgOutDateStr:", trim(OutDateStr)
1051           CALL wrf_debug(200, message)
1052        ENDIF
1053     endif
1054
1055   END SUBROUTINE getAvgState
1056
1057   SUBROUTINE getDiurnalState(currentTime, xtime, dt, diurn_interval, output_freq, compute_diurn, OutDateStr)
1058     ! Subroutine DESCRIPTION:
1059     ! Determine if data diurnal averages are to be calculated at the current time step
1060     ! True implies that diurnal averages are to be calculated
1061
1062    ! USES:
1063     USE module_utility
1064     !USE ESMF_Mod
1065
1066     IMPLICIT NONE
1067
1068     TYPE(WRFU_Time), INTENT(IN)   :: currentTime
1069     REAL, INTENT(IN)              :: dt, xtime
1070     INTEGER, INTENT(IN)           :: output_freq
1071     integer, INTENT(IN)           :: diurn_interval
1072     LOGICAL, INTENT(INOUT)        :: compute_diurn
1073     CHARACTER(*), INTENT(INOUT)   :: OutDateStr
1074
1075     INTEGER, PARAMETER :: NONE = 0
1076     INTEGER, PARAMETER :: SECS = 1
1077     INTEGER, PARAMETER :: MINS = 2
1078     INTEGER, PARAMETER :: HRS  = 3
1079     INTEGER, PARAMETER :: DAYS = 4
1080     INTEGER, PARAMETER :: MONTHLY = 5
1081
1082     ! LOCAL VARIABLES:
1083     TYPE(WRFU_TimeInterval) :: off
1084     TYPE(WRFU_Time)         :: nextTime
1085     TYPE(WRFU_Time)         :: prevTime
1086
1087     integer :: yr         !nstep year
1088     integer :: mon        !nstep months (1 -> 12)
1089     integer :: nextMon    !nstep+1 months (1 -> 12)
1090     integer :: dtime
1091
1092
1093     CHARACTER (LEN=10) ::str_yr
1094     CHARACTER (LEN=10) ::str_mon
1095     CHARACTER (LEN=80) ::filedate
1096
1097     CHARACTER (LEN=1024) :: message
1098
1099     integer :: mean_interval
1100     CHARACTER (LEN=10) ::str_day
1101     integer :: day        !nstep days (1 -> 31)
1102
1103     dtime = INT (dt)
1104
1105     ! Determine if time to average data
1106     compute_diurn = .false.
1107
1108     if ( output_freq .EQ. MONTHLY) then
1109        ! get date for current time_step
1110        call WRFU_TimeGet( currentTime, mm=mon)
1111
1112        ! get date for next time_step
1113        call WRFU_TimeIntervalSet( off, s=dtime)
1114        nextTime = currentTime + off
1115        call WRFU_TimeGet( nextTime, mm=nextMon)
1116
1117        if ( (nextMon-mon) /= 0)  then
1118           compute_diurn = .true.
1119
1120           WRITE(message, *) "RASM Statistics: Diurnal AVG condition met (return TRUE) "
1121           CALL wrf_debug(200, message)
1122        endif
1123     else
1124        if ((MOD(NINT((xtime+dt/60.)*60./dt),NINT(diurn_interval/dt)) == 0)) then
1125           compute_diurn = .true.
1126
1127           WRITE(message, *) "RASM Statistics: Diurnal AVG condition met DAILY TEST (return TRUE) "
1128           CALL wrf_debug(200, message)
1129        endif
1130     endif
1131
1132     ! generate date used for hourly, min and sec averages
1133     if (compute_diurn) then
1134
1135        if ( output_freq .EQ. MONTHLY) then
1136           ! get date
1137           call WRFU_TimeIntervalSet( off, s=dtime)
1138           nextTime = currentTime + off
1139           call WRFU_TimeGet( nextTime, yy=yr, mm=mon)
1140           IF (mon .eq. 1) THEN
1141              mon = 12
1142              yr = yr - 1
1143           ELSE
1144              mon = mon - 1
1145           ENDIF
1146           WRITE(str_yr, '(I4.4)')  yr
1147           WRITE(str_mon, '(I2.2)')  mon
1148           filedate = trim(str_yr)//"-"//trim(str_mon)
1149           OutDateStr = filedate
1150
1151           WRITE(message, *) "RASM Statistics:  Diurnal ACG condition met ......... avgOutDateStr:", trim(OutDateStr)
1152           CALL wrf_debug(200, message)
1153        else
1154           ! get avg date
1155           call WRFU_TimeIntervalSet( off, s=diurn_interval-dtime)
1156           prevTime = currentTime - off
1157           call WRFU_TimeGet( prevTime, yy=yr, mm=mon, dd=day)
1158           WRITE(str_yr, '(I4.4)')  yr
1159           WRITE(str_mon, '(I2.2)')  mon
1160           WRITE(str_day, '(I2.2)')  day
1161           filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day)
1162           OutDateStr = filedate
1163
1164           WRITE(message, *) "RASM Statistics:  Diurnal AVG condition met DAILY TEST......... avgOutDateStr:", trim(OutDateStr)
1165           CALL wrf_debug(200, message)
1166        endif
1167     endif
1168
1169   END SUBROUTINE getDiurnalState
1170
1171   SUBROUTINE  get_diurn_cycle(currentTime, xtime, dt, diurn_cycle)
1172     ! Subroutine DESCRIPTION:
1173     ! Get the current diurnal cycle
1174
1175     ! USES:
1176     USE module_utility
1177     !USE ESMF_Mod
1178
1179     IMPLICIT NONE
1180
1181     TYPE(WRFU_Time), INTENT(IN)   :: currentTime
1182     REAL, INTENT(IN)              :: dt, xtime
1183     INTEGER, INTENT(INOUT)        :: diurn_cycle
1184
1185     INTEGER, PARAMETER :: NONE = 0
1186     INTEGER, PARAMETER :: SECS = 1
1187     INTEGER, PARAMETER :: MINS = 2
1188     INTEGER, PARAMETER :: HRS  = 3
1189     INTEGER, PARAMETER :: DAYS = 4
1190     INTEGER, PARAMETER :: MONTHLY = 5
1191
1192     ! LOCAL VARIABLES:
1193     TYPE(WRFU_TimeInterval) :: off
1194     TYPE(WRFU_Time)         :: nextTime
1195     TYPE(WRFU_Time)         :: prevTime
1196
1197     integer :: yr         !nstep year
1198     integer :: mon        !nstep months (1 -> 12)
1199     integer :: day        !nstep days (1 -> 31)
1200     integer :: hr         !nstep hrs
1201     integer :: dtime
1202
1203
1204     CHARACTER (LEN=1024) :: message
1205
1206     dtime = INT (dt)
1207     diurn_cycle = -1
1208
1209     ! get date for next time_step
1210     call WRFU_TimeIntervalSet( off, s=dtime)
1211     nextTime = currentTime + off
1212     call WRFU_TimeGet( nextTime, yy=yr, mm=mon, dd=day, h=hr)
1213
1214     ! This is a 3hr cycle, therfore it the diurn_cycle
1215     ! hr should be either (0,3,6,9,12,15,18 or 21)
1216     if (hr .eq. 3) then
1217        diurn_cycle = 1
1218     else if (hr .eq. 6) then
1219        diurn_cycle = 2
1220     else if (hr .eq. 9) then
1221        diurn_cycle = 3
1222     else if (hr .eq. 12) then
1223        diurn_cycle = 4
1224     else if (hr .eq. 15) then
1225        diurn_cycle = 5
1226     else if (hr .eq. 18) then
1227        diurn_cycle = 6
1228     else if (hr .eq. 21) then
1229        diurn_cycle = 7
1230     else if (hr .eq. 0) then
1231        diurn_cycle = 8
1232     else
1233        WRITE (message, * )"RASM Statistics:: DIURNAL ERROR -- error -- ERROR -- error : Did not find valid diurnal cycle"
1234        CALL wrf_debug(0, message)
1235        WRITE (message, * )"RASM Statistics:: DIURNAL ERROR -- Valid diurnal cycles (0,3,6,9,12,15,18 or 21) ... reported ",  diurn_cycle
1236        CALL wrf_error_fatal ( TRIM(message) )
1237     endif
1238
1239   END SUBROUTINE  get_diurn_cycle
1240
1241 END MODULE module_diag_rasm
1242 #endif