#if (NMM_CORE == 1) MODULE module_diag_rasm CONTAINS SUBROUTINE diag_rasm_stub END SUBROUTINE diag_rasm_stub END MODULE module_diag_rasm #else !WRF:MEDIATION_LAYER:PHYSICS MODULE module_diag_rasm !---------------------------------------------------------------------- ! RASM Climate Diagnostics - Jose Renteria, Amy Solomon, Mark Seefeldt ! -October 2016 ! -handling of diagnostics controlled through namelist parameters !---------------------------------------------------------------------- CONTAINS SUBROUTINE mean_output_calc( & is_restart, currentTime & ,stats_interval, output_freq, run_days & ,dt, xtime & ,psfc, psfc_mean, tsk, tsk_mean & ,pmsl_mean, t2, t2_mean & ,t, t_mean, p, pb, ht, p8w & ,moist, th2, th2_mean, q2, q2_mean & ,u10, u10_mean, v10, v10_mean & ,hfx, hfx_mean, lh, lh_mean & ,swdnb, swdnb_mean, glw, glw_mean & ,u, u_mean, v, v_mean, qv_mean, shum_mean & ,swndr, swndr_mean, swndf, swndf_mean & ,swvdr, swvdr_mean, swvdf, swvdf_mean & ,lwupb, lwupb_mean, swupb, swupb_mean & ,swupt, swupt_mean, swdnt, swdnt_mean & ,lwupt, lwupt_mean, lwdnt, lwdnt_mean & ,raincv, raincv_mean & ,rainncv, rainncv_mean & ,rainshv, rainshv_mean & ,iwp_mean, lwp_mean, pwv_mean & ,avgoutalarm, avgOutDateStr & ,nsteps & ,ids, ide, jds, jde, kds, kde & ,ims, ime, jms, jme, kms, kme & ,ips, ipe, jps, jpe, kps, kpe & ! patch dims ,i_start, i_end, j_start, j_end & ,num_tiles & ) !---------------------------------------------------------------------- ! USES: USE module_utility USE module_streams USE module_domain, ONLY : domain_clock_get USE module_state_description, ONLY: num_moist, p_qv IMPLICIT NONE !====================================================================== ! Definitions !----------- !-- DT time step (second) !-- XTIME forecast time !-- ims start index for i in memory !-- ime end index for i in memory !-- jms start index for j in memory !-- jme end index for j in memory !-- i_start start indices for i in tile !-- i_end end indices for i in tile !-- j_start start indices for j in tile !-- j_end end indices for j in tile !-- num_tiles number of tiles ! !====================================================================== INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme ! memory indices INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde ! domain indices INTEGER, INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe ! patch indices INTEGER, INTENT(IN) :: num_tiles INTEGER, INTENT(IN) :: stats_interval INTEGER, INTENT(IN) :: output_freq ! interval type INTEGER, INTENT(IN) :: run_days INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, j_end TYPE(WRFU_Time), INTENT(IN) :: currentTime TYPE(WRFU_Alarm), INTENT(INOUT) :: avgOutAlarm INTEGER, INTENT(INOUT) :: nsteps ! number of step accumulated CHARACTER(*), INTENT(INOUT) :: avgOutDateStr INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 REAL, INTENT(IN) :: dt, xtime REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: ht REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: psfc, tsk, t2, th2, q2 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: u10, v10 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: hfx, lh REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swdnb, glw, lwupb, swupb REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swndr, swndf, swvdr, swvdf REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swupt, swdnt, lwupt, lwdnt REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: raincv, rainncv, rainshv REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: p, pb, p8w REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: t, u, v REAL, DIMENSION( ims:ime , kms:kme, jms:jme, num_moist ), INTENT(IN):: moist REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: psfc_mean, tsk_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: pmsl_mean, t2_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: th2_mean, q2_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: u10_mean, v10_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: hfx_mean, lh_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swdnb_mean, glw_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: t_mean, u_mean, v_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: qv_mean, shum_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swndr_mean, swndf_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swvdr_mean, swvdf_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupb_mean, swupb_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swupt_mean, swdnt_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupt_mean, lwdnt_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: raincv_mean, rainncv_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: rainshv_mean REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: iwp_mean, lwp_mean, pwv_mean ! LOCAL VAR INTEGER :: i, j, ij REAL :: value LOGICAL :: is_restart INTEGER :: rc LOGICAL :: is_reset ! reset averages LOGICAL :: compute_avg ! compute averages REAL, DIMENSION( ims:ime , jms:jme ) :: raincv_rt, rainncv_rt, rainshv_rt ! precip rates INTEGER :: mean_interval ! interval (s) of mean calculations ! DEBUG LOCAL VAR CHARACTER (LEN=1024) :: message IF ( output_freq .eq. MONTHLY) THEN mean_interval = (run_days + 1) * 24 * 60 * 60 WRITE(message, *) "RASM Diagnostics: Set average output to MONTHLY_INTERVAL ... " CALL wrf_debug(200, message) ELSE IF (output_freq .eq. DAYS ) THEN mean_interval = stats_interval * 24 * 60 * 60 WRITE(message, *) "RASM Diagnostics: Set average output to DAYS ... mean_interval (secs) =", mean_interval CALL wrf_debug(200, message) ELSE IF (output_freq .eq. HRS ) THEN mean_interval = stats_interval * 60 * 60 WRITE(message, *) "RASM Diagnostics: Set average output to HRS ... mean_interval (secs) =", mean_interval CALL wrf_debug(200, message) ELSE IF (output_freq .eq. MINS ) THEN mean_interval = stats_interval * 60 WRITE(message, *) "RASM Diagnostics: Set average output to MINS ... mean_interval (secs) =", mean_interval CALL wrf_debug(200, message) ELSE IF (output_freq .eq. SECS ) THEN mean_interval = stats_interval WRITE(message, *) "RASM Diagnostics: Set average output to SECS ... mean_interval (secs) =", mean_interval CALL wrf_debug(200, message) ELSE !WRITE (wrf_err_message , * )"RASM Diagnostics:: ERROR -- error -- ERROR -- error : NO valid interval provided in namelist.input, please provided" !CALL wrf_error_fatal ( TRIM(wrf_err_message) ) END IF CALL getResetState(currentTime, xtime, dt, mean_interval, output_freq, is_reset) IF (is_reset) THEN DO ij = 1 , num_tiles DO j = j_start(ij), j_end(ij) DO i = i_start(ij), i_end(ij) psfc_mean(i,j)=0.0 tsk_mean(i,j)=0.0 pmsl_mean(i,j)=0.0 t2_mean(i,j)=0.0 t_mean(i,j)=0.0 th2_mean(i,j)=0.0 q2_mean(i,j)=0.0 u10_mean(i,j)=0.0 v10_mean(i,j)=0.0 hfx_mean(i,j)=0.0 lh_mean(i,j)=0.0 swdnb_mean(i,j)=0.0 glw_mean(i,j)=0.0 u_mean(i,j)=0.0 v_mean(i,j)=0.0 u_mean(i+1,j)=0.0 v_mean(i,j+1)=0.0 qv_mean(i,j)=0.0 shum_mean(i,j)=0.0 swndr_mean(i,j)=0.0 swndf_mean(i,j)=0.0 swvdr_mean(i,j)=0.0 swvdf_mean(i,j)=0.0 lwupb_mean(i,j)=0.0 swupb_mean(i,j)=0.0 swupt_mean(i,j)=0.0 swdnt_mean(i,j)=0.0 lwupt_mean(i,j)=0.0 lwdnt_mean(i,j)=0.0 raincv_mean(i,j)=0.0 rainncv_mean(i,j)=0.0 rainshv_mean(i,j)=0.0 iwp_mean(i,j)=0.0 lwp_mean(i,j)=0.0 pwv_mean(i,j)=0.0 ENDDO ENDDO ENDDO ! restart step count nsteps = 0.0 WRITE(message, *) "RASM Statistics: RESET accumaltions and means ..................... nsteps=", nsteps CALL wrf_debug(200, message) ENDIF nsteps = nsteps+1.0 WRITE(message, *) "RASM Statistics: Start accumulate .........................................................." CALL wrf_debug(200, message) WRITE(message, *) "RASM Statistics: nsteps=",nsteps, "time_step=", (xtime+dt/60.)*60./dt, "xtime=", xtime CALL wrf_debug(200, message) ! calculate the rate variables (precip) raincv_rt = raincv/dt rainncv_rt = rainncv/dt rainshv_rt = rainshv/dt ! Surface Pressure CALL var_accum_2d(psfc,ime-ims+1,jme-jms+1,psfc_mean) ! Surface Skin Temperature CALL var_accum_2d(tsk,ime-ims+1,jme-jms+1,tsk_mean) ! SWNDR - shortwave down at surface, near infrared direct component CALL var_accum_2d(swndr,ime-ims+1,jme-jms+1,swndr_mean) ! SWNDF - shortwave down at surface, near infrared diffuse component CALL var_accum_2d(swndf,ime-ims+1,jme-jms+1,swndf_mean) ! SWVDR - shortwave down at surface, visible direct component CALL var_accum_2d(swvdr,ime-ims+1,jme-jms+1,swvdr_mean) ! SWVDF - shortwave down at surface, visible diffuse component CALL var_accum_2d(swvdf,ime-ims+1,jme-jms+1,swvdf_mean) ! U SURFACE WIND SPEED (X-WIND COMPONENT) CALL var_accum_3d_01(u, ime-ims+1, kme-kms+1, jme-jms+1, u_mean) ! V SURFACE WIND SPEED (Y-WIND COMPONENT) CALL var_accum_3d_01(v, ime-ims+1, kme-kms+1, jme-jms+1, v_mean) ! SURFACE HUMIDITY CALL var_accum_3d_01(moist(:,:,:,P_QV), ime-ims+1, kme-kms+1, jme-jms+1, qv_mean) ! SPECIFIC SURFACE HUMIDITY CALL shum_accum_01(moist(:,:,:,P_QV), ime-ims+1, kme-kms+1, jme-jms+1, shum_mean) ! Surface temperature (at lowest level) CALL T_accum_01( t, p, pb, ime-ims+1, kme-kms+1, jme-jms+1, t_mean) ! PMSL CALL PMSL_accum_01(ims, ime, jms, jme, kms, kme, & ide, jde, ips, ipe, jps, jpe, & t, p, pb, moist(:,:,:,P_QV), ht, psfc, pmsl_mean) ! Temperature at 2M CALL var_accum_2d(t2,ime-ims+1,jme-jms+1,t2_mean) ! Potential Temperature at 2M CALL var_accum_2d(th2,ime-ims+1,jme-jms+1,th2_mean) ! Water Vapor Mixing Ratio at 2M CALL var_accum_2d(q2,ime-ims+1,jme-jms+1,q2_mean) ! U-component of Wind at 10M CALL var_accum_2d(u10,ime-ims+1,jme-jms+1,u10_mean) ! V-component of Wind at 10M CALL var_accum_2d(v10,ime-ims+1,jme-jms+1,v10_mean) ! SENSIBLE HEAT FLUX AT THE SURFACE CALL var_accum_2d(hfx,ime-ims+1,jme-jms+1,hfx_mean) ! LATENT HEAT FLUX AT THE SURFACE CALL var_accum_2d(lh,ime-ims+1,jme-jms+1,lh_mean) ! INCOMING SOLAR AT SURFACE (SHORTWAVE DOWN) CALL var_accum_2d(swdnb,ime-ims+1,jme-jms+1,swdnb_mean) ! INCOMING LONGWAVE AT SURFACE (LONGWAVE DOWN) CALL var_accum_2d(glw,ime-ims+1,jme-jms+1,glw_mean) ! OUTGOING LONGWAVE AT SURFACE (LONGWAVE FLUX UP) CALL var_accum_2d(lwupb,ime-ims+1,jme-jms+1,lwupb_mean) ! REFLECTIVE SHORTWAVE AT SURFACE CALL var_accum_2d(swupb,ime-ims+1,jme-jms+1,swupb_mean) ! SWUPT - UPWELLING SHORTWAVE FLUX AT TOP CALL var_accum_2d(swupt,ime-ims+1,jme-jms+1,swupt_mean) ! SWDNT - DOWNWELLING SHORTWAVE FLUX AT TOP CALL var_accum_2d(swdnt,ime-ims+1,jme-jms+1,swdnt_mean) ! LWUPT - UPWELLING LONGWAVE FLUX AT TOP CALL var_accum_2d(lwupt,ime-ims+1,jme-jms+1,lwupt_mean) ! LWDNT - DOWNWELLING LONGWAVE FLUX AT TOP CALL var_accum_2d(lwdnt,ime-ims+1,jme-jms+1,lwdnt_mean) ! RAINCV - CUMULUS PRECIPITATION RATE CALL var_accum_2d(raincv_rt,ime-ims+1,jme-jms+1,raincv_mean) ! RAINNCV - NONCONVECTIVE PRECIPITATION RATE CALL var_accum_2d(rainncv_rt,ime-ims+1,jme-jms+1,rainncv_mean) ! RAINSHV - SHALLOW CUMULUS PRECIPITATION RATE CALL var_accum_2d(rainshv_rt,ime-ims+1,jme-jms+1,rainshv_mean) ! IWP:LWP:PWV - AVERAGE COLUMN INTEGRATED QUANTITY CALL columm_integrated_liqud_ice_accum(ims, ime, jms, jme, kms, kme, & ide, jde, ips, ipe, jps, jpe, moist, p8w, iwp_mean, lwp_mean, pwv_mean) CALL getAvgState(currentTime, xtime, dt, mean_interval, output_freq, compute_avg, avgOutDateStr) IF (compute_avg) THEN psfc_mean=psfc_mean/nsteps tsk_mean=tsk_mean/nsteps pmsl_mean=pmsl_mean/nsteps t2_mean=t2_mean/nsteps t_mean=t_mean/nsteps th2_mean=th2_mean/nsteps q2_mean=q2_mean/nsteps u10_mean=u10_mean/nsteps v10_mean=v10_mean/nsteps hfx_mean=hfx_mean/nsteps lh_mean=lh_mean/nsteps swdnb_mean=swdnb_mean/nsteps glw_mean=glw_mean/nsteps u_mean=u_mean/nsteps v_mean=v_mean/nsteps qv_mean=qv_mean/nsteps shum_mean=shum_mean/nsteps swndr_mean=swndr_mean/nsteps swndf_mean=swndf_mean/nsteps swvdr_mean=swvdr_mean/nsteps swvdf_mean=swvdf_mean/nsteps lwupb_mean=lwupb_mean/nsteps swupb_mean=swupb_mean/nsteps swupt_mean=swupt_mean/nsteps swdnt_mean=swdnt_mean/nsteps lwupt_mean=lwupt_mean/nsteps lwdnt_mean=lwdnt_mean/nsteps raincv_mean=raincv_mean/nsteps rainncv_mean=rainncv_mean/nsteps rainshv_mean=rainshv_mean/nsteps iwp_mean=iwp_mean/nsteps lwp_mean=lwp_mean/nsteps pwv_mean=pwv_mean/nsteps if ( output_freq .EQ. MONTHLY) then WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL turn ON ALARM to generate output ........................" CALL wrf_debug(200, message) endif CALL WRFU_AlarmRingerOn (avgOutAlarm, rc=rc) WRITE(message, *) "RASM Statistics: Mean computed .........................................................." CALL wrf_debug(200, message) END IF END SUBROUTINE mean_output_calc ! RASM: Diurnal SUBROUTINE diurnalcycle_output_calc( & is_restart, currentTime & ,dt, xtime & ,psfc, psfc_dtmp, tsk, tsk_dtmp & ,t2, t2_dtmp, t, t_dtmp & ,p, pb, p8w, moist & ! vars for pmsl calc ,th2, th2_dtmp, q2, q2_dtmp & ,u10, u10_dtmp, v10, v10_dtmp & ,hfx, hfx_dtmp, lh, lh_dtmp & ,swdnb, swdnb_dtmp, glw, glw_dtmp & ,u, u_dtmp, v, v_dtmp, qv_dtmp, shum_dtmp & ,swndr, swndr_dtmp, swndf, swndf_dtmp & ,swvdr, swvdr_dtmp, swvdf, swvdf_dtmp & ,lwupb, lwupb_dtmp, swupb, swupb_dtmp & ,swupt, swupt_dtmp, swdnt, swdnt_dtmp & ,lwupt, lwupt_dtmp, lwdnt, lwdnt_dtmp & ,raincv, raincv_dtmp, rainncv, rainncv_dtmp & ,rainshv, rainshv_dtmp & ,iwp_dtmp, lwp_dtmp, pwv_dtmp & ,avgoutalarm & ,diurnOutDateStr, avg_nsteps & ,diurnal_nsteps & ,psfc_diurn, tsk_diurn, t2_diurn, t_diurn & ,th2_diurn, q2_diurn, u10_diurn, v10_diurn & ,hfx_diurn, lh_diurn & ,swdnb_diurn, glw_diurn & ,u_diurn, v_diurn, qv_diurn & ,shum_diurn, swndr_diurn, swndf_diurn & ,swvdr_diurn, swvdf_diurn & ,lwupb_diurn, swupb_diurn & ,swupt_diurn, swdnt_diurn & ,lwupt_diurn, lwdnt_diurn & ,raincv_diurn, rainncv_diurn & ,rainshv_diurn, iwp_diurn & ,lwp_diurn, pwv_diurn & ,ids, ide, jds, jde, kds, kde & ,ims, ime, jms, jme, kms, kme & ,ips, ipe, jps, jpe, kps, kpe & ! patch dims ,i_start, i_end, j_start, j_end & ,num_tiles ) !---------------------------------------------------------------------- ! USES: USE module_utility USE module_domain, ONLY : domain_clock_get USE module_state_description, ONLY: num_moist, p_qv IMPLICIT NONE !====================================================================== ! Definitions !----------- !-- DT time step (second) !-- XTIME forecast time !-- ims start index for i in memory !-- ime end index for i in memory !-- jms start index for j in memory !-- jme end index for j in memory !-- i_start start indices for i in tile !-- i_end end indices for i in tile !-- j_start start indices for j in tile !-- j_end end indices for j in tile !-- num_tiles number of tiles ! !====================================================================== INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme ! memory indices INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde ! domain indices INTEGER, INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe ! patch indices INTEGER, INTENT(IN) :: num_tiles INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, j_end TYPE(WRFU_Time), INTENT(IN) :: currentTime TYPE(WRFU_Alarm), INTENT(INOUT) :: avgOutAlarm INTEGER, INTENT(INOUT) :: avg_nsteps ! number of avg steps accumulated INTEGER, INTENT(INOUT) :: diurnal_nsteps ! number of diurnal steps accumulated CHARACTER(*), INTENT(INOUT) :: diurnOutDateStr INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 INTEGER, PARAMETER :: NUM_DIURN_CYCLES = 8 INTEGER, PARAMETER :: DIURNAL_3HR = 10800 ! three hour period in seconds REAL, INTENT(IN) :: dt, xtime REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: psfc, tsk, t2, th2, q2 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: u10, v10 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: hfx, lh REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swdnb, glw, lwupb, swupb REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swupt, swdnt, lwupt, lwdnt REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: swndr, swndf, swvdr, swvdf REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) :: raincv, rainncv, rainshv REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: p, pb, p8w REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN) :: t, u, v REAL, DIMENSION( ims:ime , kms:kme, jms:jme, num_moist ), INTENT(IN):: moist REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: psfc_dtmp, tsk_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: t2_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: t_dtmp, u_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: v_dtmp, qv_dtmp, shum_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swndr_dtmp, swndf_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swvdr_dtmp, swvdf_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: th2_dtmp, q2_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: u10_dtmp, v10_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: hfx_dtmp, lh_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swdnb_dtmp, glw_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupb_dtmp, swupb_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: swupt_dtmp, swdnt_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwupt_dtmp, lwdnt_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: raincv_dtmp, rainncv_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: rainshv_dtmp, iwp_dtmp REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: lwp_dtmp, pwv_dtmp REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: psfc_diurn, tsk_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: t2_diurn, t_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: th2_diurn, q2_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: u10_diurn, v10_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: hfx_diurn, lh_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: swdnb_diurn, glw_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: u_diurn, v_diurn, qv_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: shum_diurn, swndr_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: swndf_diurn, swvdr_diurn, swvdf_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: lwupb_diurn, swupb_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: swupt_diurn, swdnt_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: lwupt_diurn, lwdnt_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: raincv_diurn, rainncv_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: rainshv_diurn, iwp_diurn REAL, DIMENSION( ims:ime, 1:NUM_DIURN_CYCLES, jms:jme ), INTENT(OUT) :: lwp_diurn, pwv_diurn ! LOCAL VAR INTEGER :: i, j, k, ij REAL :: value LOGICAL :: is_restart INTEGER :: rc INTEGER :: current_diurn_cycle INTEGER :: diurnal_output_freq ! diurnal interval type INTEGER :: mean_output_freq ! mean interval type INTEGER :: mean_interval ! mean interval LOGICAL :: is_avg_reset ! reset averages LOGICAL :: is_diurnal_reset ! reset dirurnal cycle LOGICAL :: compute_avg ! compute averages LOGICAL :: compute_diurnalcycle ! compute dirurnal cycle REAL, DIMENSION( ims:ime , jms:jme ) :: raincv_rt, rainncv_rt, rainshv_rt ! precip rates ! DEBUG LOCAL VAR CHARACTER (LEN=1024) :: message CHARACTER (LEN=1024) :: EmptyStr LOGICAL :: diurn_test INTEGER :: diurn_interval ! initialize frequencies and intervals mean_interval = DIURNAL_3HR mean_output_freq = HRS diurn_interval = 2 * 24 * 60 * 60 ! dummy variable only used when testing diurnal_output_freq = MONTHLY EmptyStr ="" ! empty string used for processing ! intitialize 2 day test diurn_test = .false. ! if testing generate daily instead of monthy if (diurn_test) then diurnal_output_freq = DAYS else diurnal_output_freq = MONTHLY endif ! get the average state CALL getResetState(currentTime, xtime, dt, mean_interval, mean_output_freq, is_avg_reset) IF (is_avg_reset) THEN DO ij = 1 , num_tiles DO j = j_start(ij), j_end(ij) DO i = i_start(ij), i_end(ij) psfc_dtmp(i,j)=0.0 tsk_dtmp(i,j)=0.0 t2_dtmp(i,j)=0.0 t_dtmp(i,j)=0.0 u_dtmp(i,j)=0.0 v_dtmp(i,j)=0.0 u_dtmp(i+1,j)=0.0 v_dtmp(i,j+1)=0.0 qv_dtmp(i,j)=0.0 shum_dtmp(i,j)=0.0 swndr_dtmp(i,j)=0.0 swndf_dtmp(i,j)=0.0 swvdr_dtmp(i,j)=0.0 swvdf_dtmp(i,j)=0.0 th2_dtmp(i,j)=0.0 q2_dtmp(i,j)=0.0 u10_dtmp(i,j)=0.0 v10_dtmp(i,j)=0.0 hfx_dtmp(i,j)=0.0 lh_dtmp(i,j)=0.0 swdnb_dtmp(i,j)=0.0 glw_dtmp(i,j)=0.0 lwupb_dtmp(i,j)=0.0 swupb_dtmp(i,j)=0.0 swupt_dtmp(i,j)=0.0 swdnt_dtmp(i,j)=0.0 lwupt_dtmp(i,j)=0.0 lwdnt_dtmp(i,j)=0.0 raincv_dtmp(i,j)=0.0 rainncv_dtmp(i,j)=0.0 rainshv_dtmp(i,j)=0.0 iwp_dtmp(i,j)=0.0 lwp_dtmp(i,j)=0.0 pwv_dtmp(i,j)=0.0 ENDDO ENDDO ENDDO ! restart step count avg_nsteps = 0.0 WRITE(message, *) "RASM Statistics: RESET accumaltions and means ..................... avg_nsteps=", avg_nsteps CALL wrf_debug(200, message) ENDIF ! get the diurnal state CALL getResetState(currentTime, xtime, dt, diurn_interval, diurnal_output_freq, is_diurnal_reset) IF (is_diurnal_reset) THEN DO ij = 1 , num_tiles DO k = 1 , NUM_DIURN_CYCLES DO j = j_start(ij), j_end(ij) DO i = i_start(ij), i_end(ij) psfc_diurn(i,k,j)=0.0 tsk_diurn(i,k,j)=0.0 t2_diurn(i,k,j)=0.0 t_diurn(i,k,j)=0.0 u_diurn(i,k,j)=0.0 v_diurn(i,k,j)=0.0 u_diurn(i+1,k,j)=0.0 v_diurn(i,k,j+1)=0.0 qv_diurn(i,k,j)=0.0 shum_diurn(i,k,j)=0.0 swndr_diurn(i,k,j)=0.0 swndf_diurn(i,k,j)=0.0 swvdr_diurn(i,k,j)=0.0 swvdf_diurn(i,k,j)=0.0 th2_diurn(i,k,j)=0.0 q2_diurn(i,k,j)=0.0 u10_diurn(i,k,j)=0.0 v10_diurn(i,k,j)=0.0 hfx_diurn(i,k,j)=0.0 lh_diurn(i,k,j)=0.0 swdnb_diurn(i,k,j)=0.0 glw_diurn(i,k,j)=0.0 lwupb_diurn(i,k,j)=0.0 swupb_diurn(i,k,j)=0.0 swupt_diurn(i,k,j)=0.0 swdnt_diurn(i,k,j)=0.0 lwupt_diurn(i,k,j)=0.0 lwdnt_diurn(i,k,j)=0.0 raincv_diurn(i,k,j)=0.0 rainncv_diurn(i,k,j)=0.0 rainshv_diurn(i,k,j)=0.0 iwp_diurn(i,k,j)=0.0 lwp_diurn(i,k,j)=0.0 pwv_diurn(i,k,j)=0.0 ENDDO ENDDO ENDDO ENDDO ! restart step count diurnal_nsteps = 0.0 WRITE(message, *) "RASM Statistics: RESET Diurnal means ..................... diurnal_nsteps=", diurnal_nsteps CALL wrf_debug(200, message) ENDIF avg_nsteps = avg_nsteps+1.0 ! calculate the rate variables (precip) raincv_rt = raincv/dt rainncv_rt = rainncv/dt rainshv_rt = rainshv/dt ! Surface Pressure CALL var_accum_2d(psfc,ime-ims+1,jme-jms+1,psfc_dtmp) ! Surface Skin Temperature CALL var_accum_2d(tsk,ime-ims+1,jme-jms+1,tsk_dtmp) ! Temperature at 2M CALL var_accum_2d(t2,ime-ims+1,jme-jms+1,t2_dtmp) ! SWNDR - shortwave down at surface, near infrared direct component CALL var_accum_2d(swndr,ime-ims+1,jme-jms+1,swndr_dtmp) ! SWNDF - shortwave down at surface, near infrared diffuse component CALL var_accum_2d(swndf,ime-ims+1,jme-jms+1,swndf_dtmp) ! SWVDR - shortwave down at surface, visible direct component CALL var_accum_2d(swvdr,ime-ims+1,jme-jms+1,swvdr_dtmp) ! SWVDF - shortwave down at surface, visible diffuse component CALL var_accum_2d(swvdf,ime-ims+1,jme-jms+1,swvdf_dtmp) ! U SURFACE WIND SPEED (X-WIND COMPONENT) CALL var_accum_3d_01(u, ime-ims+1, kme-kms+1, jme-jms+1, u_dtmp) ! V SURFACE WIND SPEED (Y-WIND COMPONENT) CALL var_accum_3d_01(v, ime-ims+1, kme-kms+1, jme-jms+1, v_dtmp) ! SURFACE HUMIDITY CALL var_accum_3d_01(moist(:,:,:,P_QV), ime-ims+1, kme-kms+1, jme-jms+1, qv_dtmp) ! SPECIFIC SURFACE HUMIDITY CALL shum_accum_01(moist(:,:,:,P_QV), ime-ims+1, kme-kms+1, jme-jms+1, shum_dtmp) ! Surface temperature (at lowest level) CALL T_accum_01( t, p, pb, ime-ims+1, kme-kms+1, jme-jms+1, t_dtmp) ! Potential Temperature at 2M CALL var_accum_2d(th2,ime-ims+1,jme-jms+1,th2_dtmp) ! WATER VAPOR MIXING RATIO AT 2M CALL var_accum_2d(q2,ime-ims+1,jme-jms+1,q2_dtmp) ! U-COMPONENT OF WIND AT 10M CALL var_accum_2d(u10,ime-ims+1,jme-jms+1,u10_dtmp) ! V-COMPONENT OF WIND AT 10M CALL var_accum_2d(v10,ime-ims+1,jme-jms+1,v10_dtmp) ! SENSIBLE HEAT FLUX AT THE SURFACE CALL var_accum_2d(hfx,ime-ims+1,jme-jms+1,hfx_dtmp) ! LATENT HEAT FLUX AT THE SURFACE CALL var_accum_2d(lh,ime-ims+1,jme-jms+1,lh_dtmp) ! DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE CALL var_accum_2d(swdnb,ime-ims+1,jme-jms+1,swdnb_dtmp) ! DOWNWARD LONG WAVE FLUX AT GROUND SURFACE CALL var_accum_2d(glw,ime-ims+1,jme-jms+1,glw_dtmp) ! UPWELLING LONGWAVE FLUX AT BOTTOM CALL var_accum_2d(lwupb,ime-ims+1,jme-jms+1,lwupb_dtmp) ! UPWELLING SHORTWAVE FLUX AT BOTTOM CALL var_accum_2d(swupb,ime-ims+1,jme-jms+1,swupb_dtmp) ! UPWELLING SHORTWAVE FLUX AT TOP CALL var_accum_2d(swupt,ime-ims+1,jme-jms+1,swupt_dtmp) ! DOWNWELLING SHORTWAVE FLUX AT TOP CALL var_accum_2d(swdnt,ime-ims+1,jme-jms+1,swdnt_dtmp) ! UPWELLING LONGWAVE FLUX AT TOP CALL var_accum_2d(lwupt,ime-ims+1,jme-jms+1,lwupt_dtmp) ! DOWNWELLING LONGWAVE FLUX AT TOP CALL var_accum_2d(lwdnt,ime-ims+1,jme-jms+1,lwdnt_dtmp) ! RAINCV - CUMULUS PRECIPITATION RATE CALL var_accum_2d(raincv_rt,ime-ims+1,jme-jms+1,raincv_dtmp) ! RAINNCV - NONCONVECTIVE PRECIPITATION RATE CALL var_accum_2d(rainncv_rt,ime-ims+1,jme-jms+1,rainncv_dtmp) ! RAINSHV - SHALLOW CUMULUS PRECIPITATION RATE CALL var_accum_2d(rainshv_rt,ime-ims+1,jme-jms+1,rainshv_dtmp) ! IWP:LWP:PWV - AVERAGE COLUMN INTEGRATED QUANTITY CALL columm_integrated_liqud_ice_accum(ims, ime, jms, jme, kms, kme, & ide, jde, ips, ipe, jps, jpe, moist, p8w, iwp_dtmp, lwp_dtmp, pwv_dtmp) ! get average state CALL getAvgState(currentTime, xtime, dt, mean_interval, mean_output_freq, compute_avg, EmptyStr) IF (compute_avg) THEN psfc_dtmp=psfc_dtmp/avg_nsteps tsk_dtmp=tsk_dtmp/avg_nsteps t2_dtmp=t2_dtmp/avg_nsteps t_dtmp=t_dtmp/avg_nsteps u_dtmp=u_dtmp/avg_nsteps v_dtmp=v_dtmp/avg_nsteps qv_dtmp=qv_dtmp/avg_nsteps shum_dtmp=shum_dtmp/avg_nsteps swndr_dtmp=swndr_dtmp/avg_nsteps swndf_dtmp=swndf_dtmp/avg_nsteps swvdr_dtmp=swvdr_dtmp/avg_nsteps swvdf_dtmp=swvdf_dtmp/avg_nsteps th2_dtmp=th2_dtmp/avg_nsteps q2_dtmp=q2_dtmp/avg_nsteps u10_dtmp=u10_dtmp/avg_nsteps v10_dtmp=v10_dtmp/avg_nsteps hfx_dtmp=hfx_dtmp/avg_nsteps lh_dtmp=lh_dtmp/avg_nsteps swdnb_dtmp=swdnb_dtmp/avg_nsteps glw_dtmp=glw_dtmp/avg_nsteps lwupb_dtmp=lwupb_dtmp/avg_nsteps swupb_dtmp=swupb_dtmp/avg_nsteps swupt_dtmp=swupt_dtmp/avg_nsteps swdnt_dtmp=swdnt_dtmp/avg_nsteps lwupt_dtmp=lwupt_dtmp/avg_nsteps lwdnt_dtmp=lwdnt_dtmp/avg_nsteps raincv_dtmp=raincv_dtmp/avg_nsteps rainncv_dtmp=rainncv_dtmp/avg_nsteps rainshv_dtmp=rainshv_dtmp/avg_nsteps iwp_dtmp=iwp_dtmp/avg_nsteps lwp_dtmp=lwp_dtmp/avg_nsteps pwv_dtmp=pwv_dtmp/avg_nsteps CALL get_diurn_cycle(currentTime, xtime, dt, current_diurn_cycle) ! accummulate averages, increment counter by one CALL var_accum_diurnal(psfc_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, psfc_diurn) CALL var_accum_diurnal(tsk_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, tsk_diurn) CALL var_accum_diurnal(t2_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, t2_diurn) CALL var_accum_diurnal(t_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, t_diurn) CALL var_accum_diurnal(u_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, u_diurn) CALL var_accum_diurnal(v_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, v_diurn) CALL var_accum_diurnal(qv_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, qv_diurn) CALL var_accum_diurnal(shum_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, shum_diurn) CALL var_accum_diurnal(swndr_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swndr_diurn) CALL var_accum_diurnal(swndf_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swndf_diurn) CALL var_accum_diurnal(swvdr_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swvdr_diurn) CALL var_accum_diurnal(swvdf_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swvdf_diurn) CALL var_accum_diurnal(th2_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, th2_diurn) CALL var_accum_diurnal(q2_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, q2_diurn) CALL var_accum_diurnal(u10_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, u10_diurn) CALL var_accum_diurnal(v10_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, v10_diurn) CALL var_accum_diurnal(hfx_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, hfx_diurn) CALL var_accum_diurnal(lh_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lh_diurn) CALL var_accum_diurnal(swdnb_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swdnb_diurn) CALL var_accum_diurnal(glw_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, glw_diurn) CALL var_accum_diurnal(lwupb_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwupb_diurn) CALL var_accum_diurnal(swupb_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swupb_diurn) CALL var_accum_diurnal(swupt_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swupt_diurn) CALL var_accum_diurnal(swdnt_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, swdnt_diurn) CALL var_accum_diurnal(lwupt_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwupt_diurn) CALL var_accum_diurnal(lwdnt_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwdnt_diurn) CALL var_accum_diurnal(raincv_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, raincv_diurn) CALL var_accum_diurnal(rainncv_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, rainncv_diurn) CALL var_accum_diurnal(rainshv_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, rainshv_diurn) CALL var_accum_diurnal(iwp_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, iwp_diurn) CALL var_accum_diurnal(lwp_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, lwp_diurn) CALL var_accum_diurnal(pwv_dtmp, ime-ims+1, NUM_DIURN_CYCLES, jme-jms+1, current_diurn_cycle, pwv_diurn) ! increment diurnal count once a day, assuming 3hr cycles if (current_diurn_cycle .eq. 8) then diurnal_nsteps = diurnal_nsteps + 1.0 endif END IF ! get Diurnal average state CALL getDiurnalState(currentTime, xtime, dt, diurn_interval, diurnal_output_freq, compute_diurnalcycle, diurnOutDateStr) IF (compute_diurnalcycle) THEN psfc_diurn=psfc_diurn/diurnal_nsteps tsk_diurn=tsk_diurn/diurnal_nsteps t2_diurn=t2_diurn/diurnal_nsteps t_diurn=t_diurn/diurnal_nsteps u_diurn=u_diurn/diurnal_nsteps v_diurn=v_diurn/diurnal_nsteps qv_diurn=qv_diurn/diurnal_nsteps shum_diurn=shum_diurn/diurnal_nsteps swndr_diurn=swndr_diurn/diurnal_nsteps swndf_diurn=swndf_diurn/diurnal_nsteps swvdr_diurn=swvdr_diurn/diurnal_nsteps swvdf_diurn=swvdf_diurn/diurnal_nsteps th2_diurn=th2_diurn/diurnal_nsteps q2_diurn=q2_diurn/diurnal_nsteps u10_diurn=u10_diurn/diurnal_nsteps v10_diurn=v10_diurn/diurnal_nsteps hfx_diurn=hfx_diurn/diurnal_nsteps lh_diurn=lh_diurn/diurnal_nsteps swdnb_diurn=swdnb_diurn/diurnal_nsteps glw_diurn=glw_diurn/diurnal_nsteps lwupb_diurn=lwupb_diurn/diurnal_nsteps swupb_diurn=swupb_diurn/diurnal_nsteps swupt_diurn=swupt_diurn/diurnal_nsteps swdnt_diurn=swdnt_diurn/diurnal_nsteps lwupt_diurn=lwupt_diurn/diurnal_nsteps lwdnt_diurn=lwdnt_diurn/diurnal_nsteps raincv_diurn=raincv_diurn/diurnal_nsteps rainncv_diurn=rainncv_diurn/diurnal_nsteps rainshv_diurn=rainshv_diurn/diurnal_nsteps iwp_diurn=iwp_diurn/diurnal_nsteps lwp_diurn=lwp_diurn/diurnal_nsteps pwv_diurn=pwv_diurn/diurnal_nsteps CALL WRFU_AlarmRingerOn (avgOutAlarm, rc=rc) WRITE(message, *) "RASM Statistics: Diurnal Mean Cycle computed .........................................................." CALL wrf_debug(200, message) END IF END SUBROUTINE diurnalcycle_output_calc SUBROUTINE var_accum_diurnal(var, dx, dz, dy, current_cycle, var_accum) ! Subroutine accumulates diurnal variable IMPLICIT NONE INTEGER, INTENT(IN) :: dx, dz, dy, current_cycle REAL, DIMENSION(dx,dy), INTENT(IN) :: var REAL, DIMENSION(dx, dz, dy), INTENT(INOUT) :: var_accum !local INTEGER :: k, i, j k = current_cycle ! current cycle DO j=1,dy DO i=1,dx var_accum(i, k, j) = var_accum(i, k, j) + var(i,j) ENDDO ENDDO END SUBROUTINE var_accum_diurnal SUBROUTINE var_accum_2d(var, dx, dy, var_accum) ! Subroutine accumulates 2D variable IMPLICIT NONE INTEGER, INTENT(IN) :: dx, dy REAL, DIMENSION(dx,dy), INTENT(IN) :: var REAL, DIMENSION(dx,dy), INTENT(INOUT) :: var_accum var_accum = var_accum + var END SUBROUTINE var_accum_2d SUBROUTINE var_accum_3d_01(var, dx, dz, dy, var_accum) ! Subroutine accumulates 3D variable at lowest level resulting in 2D output IMPLICIT NONE INTEGER, INTENT(IN) :: dx, dy, dz REAL, DIMENSION(dx, dz, dy), INTENT(IN) :: var REAL, DIMENSION(dx, dy), INTENT(INOUT) :: var_accum !local INTEGER :: k, i, j k = 1 ! lowest level DO j=1,dy DO i=1,dx var_accum(i,j) = var_accum(i,j) + var(i,k,j) ENDDO ENDDO END SUBROUTINE var_accum_3d_01 SUBROUTINE columm_integrated_liqud_ice_accum(ims, ime, jms, jme, kms, kme, ide, jde, & ips, ipe, jps, jpe, moist, p8w, iwp_accum, lwp_accum, pwv_accum) ! Subroutine accumulates IWP, LWP & PWV calulating values ove column from the first eta ! layer to model top USE module_model_constants, only: g USE module_state_description, ONLY: num_moist, p_qv, p_qc, p_qi, p_qg, p_qs, p_qh IMPLICIT NONE INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe REAL, DIMENSION( ims:ime , kms:kme, jms:jme, num_moist ), INTENT(IN):: moist REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN):: p8w REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: iwp_accum, lwp_accum, pwv_accum !local INTEGER :: k, i, j, nz, j_end, i_end, k_end REAL :: iwp, lwp, pwv CHARACTER (LEN=1024) :: message j_end = jpe i_end = ipe if(j_end.eq.jde) j_end=j_end-1 if(i_end.eq.ide) i_end=i_end-1 nz=kme-kms+1 DO j=jps, j_end DO i=ips, i_end iwp = 0 lwp = 0 pwv = 0 DO k=1, nz iwp = ( moist(i,k,j, P_QI) + moist(i,k,j,P_QG) + moist(i,k,j,P_QS) + moist(i,k,j,P_QH) ) * ( p8w(i,k,j)-p8w(i,k+1,j) ) / g iwp_accum(i,j) = iwp_accum(i,j) + iwp lwp = moist(i,k,j,P_QC) * ( p8w(i,k,j)-p8w(i,k+1,j) ) / g lwp_accum(i,j) = lwp_accum(i,j) + lwp pwv = moist(i,k,j,P_QV) * ( p8w(i,k,j)-p8w(i,k+1,j) ) / g pwv_accum(i,j) = pwv_accum(i,j) + pwv ENDDO ENDDO ENDDO END SUBROUTINE columm_integrated_liqud_ice_accum SUBROUTINE shum_accum_01(qv, dx, dz, dy, var_accum) ! Subroutine accumulates specific humidity at lowest level resulting in 2D output IMPLICIT NONE INTEGER, INTENT(IN) :: dx, dy, dz REAL, DIMENSION(dx, dz, dy), INTENT(IN) :: qv REAL, DIMENSION(dx, dy), INTENT(INOUT) :: var_accum !local INTEGER :: k, i, j REAL :: tmp_shum k = 1 ! lowest level DO j=1,dy DO i=1,dx if( qv(i,k,j) .gt. 0 ) then tmp_shum = qv(i,k,j) / (1+qv(i,k,j)) else tmp_shum = 0.0 endif var_accum(i,j) = var_accum(i,j) + tmp_shum ENDDO ENDDO END SUBROUTINE shum_accum_01 SUBROUTINE T_accum_01( t, p, pb, dx, dz, dy, t_accum) ! Subroutine accumulates Temperature at lowest level resulting in 2D output USE module_model_constants, only: t0,p0 USE shr_const_mod IMPLICIT NONE INTEGER, INTENT(IN) :: dx, dy, dz REAL, DIMENSION(dx, dz, dy), INTENT(IN) :: t, p, pb REAL, DIMENSION(dx, dy), INTENT(INOUT) :: t_accum ! local REAL :: t_tmp, cp, rd INTEGER :: k, i, j rd=SHR_CONST_RDAIR cp=SHR_CONST_CPDAIR k = 1 ! lowest level DO j=1,dy DO i=1,dx ! calulate surface tempature at lowest level t_tmp = (t(i,k,j) + t0) * (((p(i,k,j) + pb(i,k,j))/p0) ** (rd/cp)) ! accumulate surface tempature at lowest level t_accum(i,j) = t_accum(i,j) + t_tmp ENDDO ENDDO END SUBROUTINE T_accum_01 SUBROUTINE PMSL_accum_01( ims, ime, jms, jme, kms, kme, & ide, jde, ips, ipe, jps, jpe, & t, p, pb, qv, ht, psfc, pmsl_accum) ! Subroutine calculates and accumulates PMSL resulting in 2D output USE module_model_constants, only: t0,p0 USE shr_const_mod IMPLICIT NONE INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER, INTENT(IN) :: ide, jde, ips, ipe, jps, jpe REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN):: t, p, pb, qv REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN):: ht, psfc REAL, DIMENSION(ims:ime , jms:jme), INTENT(INOUT) :: pmsl_accum ! local REAL :: t_tmp, tmp_pmsl, z, tv, g, cp, rd, xlapse REAL :: alpha, tstar, tt0, alph, beta, psfc_tmp, p_tmp INTEGER :: k, i, j, j_end, i_end CHARACTER (LEN=1024) :: message xlapse = 6.5D-3 rd=SHR_CONST_RDAIR g=SHR_CONST_G cp=SHR_CONST_CPDAIR j_end = jpe i_end = ipe if(j_end.eq.jde) j_end=j_end-1 if(i_end.eq.ide) i_end=i_end-1 k=1 ! lowest level do j=jps, j_end do i=ips, i_end ! calulate surface tempature at lowest level t_tmp = (t(i,k,j) + t0) * (((p(i,k,j) + pb(i,k,j))/p0) ** (rd/cp)) ! calculate virtual temperature at lowest model level tv = t_tmp * (1 + qv(i,k,j) * 0.61) ! Calculate geopotential at surface in m2 s-2 z = ht(i,j) * g ! terrain height in m alpha = rd * xlapse/g ! 0.1903, no units ! Get surface pressure in Pa psfc_tmp = psfc(i,j) ! Calculate pressure in WRF at lowest model level in Pa p_tmp = (p(i,k,j) + pb(i,k,j)) ! Use surface pressure for PMSL if we are at sea level. if ( abs(z/g) < 1.0E-4 )then tmp_pmsl = psfc_tmp ! Othewise, calculate based on ECMWF method else tstar = tv * (1.0 + alpha * (psfc_tmp/p_tmp-1.0)) tt0 = tstar + xlapse*z/g if ( tstar <= 290.5 .and. tt0 > 290.5 ) then alph = rd/z * (290.5 - tstar) else if (tstar > 290.5 .and. tt0 > 290.5) then alph = 0.0 tstar = 0.5 * (290.5 + tstar) else alph=alpha if (tstar < 255.0) then tstar = 0.5 * (255.0 + tstar) endif endif beta = z/(rd*tstar) tmp_pmsl = psfc_tmp * exp( beta*(1.0 - alph * beta/2.0 + ((alph*beta)**2)/3.0)) end if ! accumulate pmsl at lowest level pmsl_accum(i,j) = pmsl_accum(i,j) + tmp_pmsl ENDDO ENDDO END SUBROUTINE PMSL_accum_01 SUBROUTINE getResetState(currentTime, xtime, dt, mean_interval, output_freq, is_reset) ! Subroutine DESCRIPTION: ! Determine if data stats are to be reset at the current time step ! True implies that stats are reinitialized ! USES: USE module_utility !USE ESMF_Mod IMPLICIT NONE TYPE(WRFU_Time), INTENT(IN) :: currentTime INTEGER, INTENT(IN) :: mean_interval REAL, INTENT(IN) :: dt, xtime INTEGER, INTENT(IN) :: output_freq LOGICAL, INTENT(INOUT) :: is_reset INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 ! LOCAL VARIABLES: TYPE(WRFU_TimeInterval) :: off TYPE(WRFU_Time) :: prevTime integer :: yr !nstep year integer :: mon !nstep months (1 -> 12) integer :: prevMon !nstep-1 months (1 -> 12) integer :: day !nstep days (1 -> 31) integer :: dtime CHARACTER (LEN=10) ::str_yr CHARACTER (LEN=10) ::str_mon CHARACTER (LEN=10) ::str_day CHARACTER (LEN=80) ::filedate CHARACTER (LEN=1024) :: message dtime = INT (dt) ! Determine if time to reset data stats is_reset = .false. if (output_freq .eq. MONTHLY) then ! get date for current time_step call WRFU_TimeGet( currentTime, mm=mon) ! get date for previous time_step call WRFU_TimeIntervalSet( off, s=dtime) prevTime = currentTime - off call WRFU_TimeGet( prevTime, mm=prevMon) if ( (mon-prevMon) /= 0) then is_reset = .true. WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL RESET condition met (return TRUE) " CALL wrf_debug(200, message) endif else if ( MOD(NINT(xtime*60./dt),NINT(mean_interval/dt)) == 0 ) then is_reset = .true. WRITE(message, *) "RASM Statistics: STATIC_INTERVAL RESET condition met (return TRUE) " CALL wrf_debug(200, message) endif endif END SUBROUTINE getResetState SUBROUTINE getAvgState(currentTime, xtime, dt, mean_interval, output_freq, compute_avg, OutDateStr) ! Subroutine DESCRIPTION: ! Determine if data averages are to be calculated at the current time step ! True implies calculate avergaes ! USES: USE module_utility !USE ESMF_Mod IMPLICIT NONE TYPE(WRFU_Time), INTENT(IN) :: currentTime INTEGER, INTENT(IN) :: mean_interval REAL, INTENT(IN) :: dt, xtime INTEGER, INTENT(IN) :: output_freq LOGICAL, INTENT(INOUT) :: compute_avg CHARACTER(*), INTENT(INOUT) :: OutDateStr ! LOCAL VARIABLES: TYPE(WRFU_TimeInterval) :: off TYPE(WRFU_Time) :: nextTime TYPE(WRFU_Time) :: prevTime INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 integer :: yr !nstep year integer :: mon !nstep months (1 -> 12) integer :: nextMon !nstep+1 months (1 -> 12) integer :: prevMon !nstep-1 months (1 -> 12) integer :: day !nstep days (1 -> 31) integer :: hr !nstep hrs integer :: min !nstep mins integer :: sec !nstep secs integer :: totalsec !nstep total secs integer :: dtime CHARACTER (LEN=10) ::str_yr CHARACTER (LEN=10) ::str_mon CHARACTER (LEN=10) ::str_day CHARACTER (LEN=10) ::str_sec CHARACTER (LEN=80) ::filedate CHARACTER (LEN=1024) :: message dtime = INT (dt) ! Determine if time to average data compute_avg = .false. if ( output_freq .EQ. MONTHLY) then ! get date for current time_step call WRFU_TimeGet( currentTime, mm=mon) ! get date for next time_step call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, mm=nextMon) if ( (nextMon-mon) /= 0) then compute_avg = .true. WRITE(message, *) "RASM Statistics: MONTHLY_INTERVAL AVG condition met (return TRUE) " CALL wrf_debug(200, message) endif else if ((MOD(NINT((xtime+dt/60.)*60./dt),NINT(mean_interval/dt)) == 0)) then compute_avg = .true. WRITE(message, *) "RASM Statistics: STATIC_INTERVAL AVG condition met (return TRUE) " CALL wrf_debug(200, message) endif endif ! generate date used for hourly, min and sec averages if (compute_avg) then IF ( (output_freq .ne. MONTHLY) .and. (output_freq .ne. DAYS)) THEN ! get date for next time_step call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, yy=yr, mm=mon, dd=day, h=hr, m=min, s=sec) WRITE(str_yr, '(I4.4)') yr WRITE(str_mon, '(I2.2)') mon WRITE(str_day, '(I2.2)') day totalsec = (hr * 60 * 60) + (min * 60) + sec WRITE(str_sec, '(I5.5)') totalsec filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day)//"-"//trim(str_sec) OutDateStr = filedate WRITE(message, *) "RASM Statistics: STATIC_INTERVAL AVG condition met ......... avgOutDateStr:", trim(OutDateStr) CALL wrf_debug(200, message) ELSE IF ( output_freq .eq. MONTHLY ) THEN ! get avg date call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, yy=yr, mm=mon) IF (mon .eq. 1) THEN mon = 12 yr = yr - 1 ELSE mon = mon - 1 ENDIF WRITE(str_yr, '(I4.4)') yr WRITE(str_mon, '(I2.2)') mon filedate = trim(str_yr)//"-"//trim(str_mon) OutDateStr = filedate WRITE(message, *) "RASM Statistics: AVG condition met ......... avgOutDateStr:", trim(OutDateStr) CALL wrf_debug(200, message) ELSE IF (output_freq .eq. DAYS ) THEN ! get avg date call WRFU_TimeIntervalSet( off, s=mean_interval-dtime) prevTime = currentTime - off call WRFU_TimeGet( prevTime, yy=yr, mm=mon, dd=day) WRITE(str_yr, '(I4.4)') yr WRITE(str_mon, '(I2.2)') mon WRITE(str_day, '(I2.2)') day filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day) OutDateStr = filedate WRITE(message, *) "RASM Statistics: AVG condition met ......... avgOutDateStr:", trim(OutDateStr) CALL wrf_debug(200, message) ENDIF endif END SUBROUTINE getAvgState SUBROUTINE getDiurnalState(currentTime, xtime, dt, diurn_interval, output_freq, compute_diurn, OutDateStr) ! Subroutine DESCRIPTION: ! Determine if data diurnal averages are to be calculated at the current time step ! True implies that diurnal averages are to be calculated ! USES: USE module_utility !USE ESMF_Mod IMPLICIT NONE TYPE(WRFU_Time), INTENT(IN) :: currentTime REAL, INTENT(IN) :: dt, xtime INTEGER, INTENT(IN) :: output_freq integer, INTENT(IN) :: diurn_interval LOGICAL, INTENT(INOUT) :: compute_diurn CHARACTER(*), INTENT(INOUT) :: OutDateStr INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 ! LOCAL VARIABLES: TYPE(WRFU_TimeInterval) :: off TYPE(WRFU_Time) :: nextTime TYPE(WRFU_Time) :: prevTime integer :: yr !nstep year integer :: mon !nstep months (1 -> 12) integer :: nextMon !nstep+1 months (1 -> 12) integer :: dtime CHARACTER (LEN=10) ::str_yr CHARACTER (LEN=10) ::str_mon CHARACTER (LEN=80) ::filedate CHARACTER (LEN=1024) :: message integer :: mean_interval CHARACTER (LEN=10) ::str_day integer :: day !nstep days (1 -> 31) dtime = INT (dt) ! Determine if time to average data compute_diurn = .false. if ( output_freq .EQ. MONTHLY) then ! get date for current time_step call WRFU_TimeGet( currentTime, mm=mon) ! get date for next time_step call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, mm=nextMon) if ( (nextMon-mon) /= 0) then compute_diurn = .true. WRITE(message, *) "RASM Statistics: Diurnal AVG condition met (return TRUE) " CALL wrf_debug(200, message) endif else if ((MOD(NINT((xtime+dt/60.)*60./dt),NINT(diurn_interval/dt)) == 0)) then compute_diurn = .true. WRITE(message, *) "RASM Statistics: Diurnal AVG condition met DAILY TEST (return TRUE) " CALL wrf_debug(200, message) endif endif ! generate date used for hourly, min and sec averages if (compute_diurn) then if ( output_freq .EQ. MONTHLY) then ! get date call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, yy=yr, mm=mon) IF (mon .eq. 1) THEN mon = 12 yr = yr - 1 ELSE mon = mon - 1 ENDIF WRITE(str_yr, '(I4.4)') yr WRITE(str_mon, '(I2.2)') mon filedate = trim(str_yr)//"-"//trim(str_mon) OutDateStr = filedate WRITE(message, *) "RASM Statistics: Diurnal ACG condition met ......... avgOutDateStr:", trim(OutDateStr) CALL wrf_debug(200, message) else ! get avg date call WRFU_TimeIntervalSet( off, s=diurn_interval-dtime) prevTime = currentTime - off call WRFU_TimeGet( prevTime, yy=yr, mm=mon, dd=day) WRITE(str_yr, '(I4.4)') yr WRITE(str_mon, '(I2.2)') mon WRITE(str_day, '(I2.2)') day filedate = trim(str_yr)//"-"//trim(str_mon)//"-"//trim(str_day) OutDateStr = filedate WRITE(message, *) "RASM Statistics: Diurnal AVG condition met DAILY TEST......... avgOutDateStr:", trim(OutDateStr) CALL wrf_debug(200, message) endif endif END SUBROUTINE getDiurnalState SUBROUTINE get_diurn_cycle(currentTime, xtime, dt, diurn_cycle) ! Subroutine DESCRIPTION: ! Get the current diurnal cycle ! USES: USE module_utility !USE ESMF_Mod IMPLICIT NONE TYPE(WRFU_Time), INTENT(IN) :: currentTime REAL, INTENT(IN) :: dt, xtime INTEGER, INTENT(INOUT) :: diurn_cycle INTEGER, PARAMETER :: NONE = 0 INTEGER, PARAMETER :: SECS = 1 INTEGER, PARAMETER :: MINS = 2 INTEGER, PARAMETER :: HRS = 3 INTEGER, PARAMETER :: DAYS = 4 INTEGER, PARAMETER :: MONTHLY = 5 ! LOCAL VARIABLES: TYPE(WRFU_TimeInterval) :: off TYPE(WRFU_Time) :: nextTime TYPE(WRFU_Time) :: prevTime integer :: yr !nstep year integer :: mon !nstep months (1 -> 12) integer :: day !nstep days (1 -> 31) integer :: hr !nstep hrs integer :: dtime CHARACTER (LEN=1024) :: message dtime = INT (dt) diurn_cycle = -1 ! get date for next time_step call WRFU_TimeIntervalSet( off, s=dtime) nextTime = currentTime + off call WRFU_TimeGet( nextTime, yy=yr, mm=mon, dd=day, h=hr) ! This is a 3hr cycle, therfore it the diurn_cycle ! hr should be either (0,3,6,9,12,15,18 or 21) if (hr .eq. 3) then diurn_cycle = 1 else if (hr .eq. 6) then diurn_cycle = 2 else if (hr .eq. 9) then diurn_cycle = 3 else if (hr .eq. 12) then diurn_cycle = 4 else if (hr .eq. 15) then diurn_cycle = 5 else if (hr .eq. 18) then diurn_cycle = 6 else if (hr .eq. 21) then diurn_cycle = 7 else if (hr .eq. 0) then diurn_cycle = 8 else WRITE (message, * )"RASM Statistics:: DIURNAL ERROR -- error -- ERROR -- error : Did not find valid diurnal cycle" CALL wrf_debug(0, message) WRITE (message, * )"RASM Statistics:: DIURNAL ERROR -- Valid diurnal cycles (0,3,6,9,12,15,18 or 21) ... reported ", diurn_cycle CALL wrf_error_fatal ( TRIM(message) ) endif END SUBROUTINE get_diurn_cycle END MODULE module_diag_rasm #endif