source: trunk/WRF.COMMON/WRFV3/dyn_nmm/BUCKETS.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 13.3 KB
Line 
1!-----------------------------------------------------------------------
2!
3!NCEP_MESO:MODEL_LAYER: ACCUMULATION BUCKETS
4!
5!-----------------------------------------------------------------------
6      SUBROUTINE BUCKETS(NTSD,NPREC,NSRFC,NRDSW,NRDLW                   &
7     &                  ,RESTART,TSTART                                 &
8     &                  ,NCLOD,NHEAT,NPHS,TSPH                          &
9     &                  ,ACPREC,CUPREC,ACSNOW,ACSNOM,SSROFF,BGROFF      &
10     &                  ,SFCEVP,POTEVP,SFCSHX,SFCLHX,SUBSHX,SNOPCX      &
11     &                  ,SFCUVX,POTFLX                                  &
12     &                  ,ARDSW,ASWIN,ASWOUT,ASWTOA                      &
13     &                  ,ARDLW,ALWIN,ALWOUT,ALWTOA                      &
14     &                  ,ACFRST,NCFRST,ACFRCV,NCFRCV                    &
15     &                  ,AVCNVC,AVRAIN,TCUCN,TRAIN                      &
16     &                  ,ASRFC                                          &
17     &                  ,T,TLMAX,TLMIN,TSHLTR,PSHLTR,QSHLTR             &
18     &                  ,T02_MAX,T02_MIN,RH02_MAX,RH02_MIN              &
19     &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
20     &                  ,IMS,IME,JMS,JME,KMS,KME                        &
21     &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
22!-----------------------------------------------------------------------
23!$$$  SUBPROGRAM DOCUMENTATION BLOCK
24!                .      .    .     
25! SUBPROGRAM:    BUCKETS     EMPTY ACCUMULATION BUCKETS WHEN NEEDED
26!   PRGRMMR: BLACK           ORG: W/NP22     DATE: 04-08-18
27!     
28! ABSTRACT:
29!     VARIOUS ACCUMULATING QUANTITIES NEED TO BE RESET TO ZERO AT
30!     SPECIFIED INTERVALS.
31!     
32! USAGE: CALL BUCKETS FROM SOLVE_NMM
33!   INPUT ARGUMENT LIST:
34!        NTSD - CURRENT TIMESTEP
35!       NPREC - NUMBER OF TIMESTEPS BETWEEN EMPTYING BUCKETS FOR PRECIP
36!       NHEAT - NUMBER OF TIMESTEPS BETWEEN EMPTYING BUCKETS FOR
37!               LATENT HEATING
38!       NCNVC - NUMBER OF TIMESTEPS BETWEEN CALLS TO CONVECTION
39!       TSPH - NUMBER OF DYNAMICS TIMESTEPS PER HOUR
40!      ACPREC - ACCUMULATED TOTAL PRECIPITATION (M)
41!      CUPREC - ACCUMULATED CONVECTIVE PRECIPITATION (M)
42!      ACSNOW - ACCUMULATED SNOWFALL (M)
43!      ACSNOM - ACCUMULATED SNOWMELT (M)
44!      SSROFF - ACCUMULATED SURFACE RUNOFF
45!      BGROFF - ACCUMULATED BELOW GROUND RUNOFF
46!      SFCEVP - ACCUMULATED SURFACE EVAPORATION
47!      POTEVP - ACCUMULATED POTENTIAL EVAPORATION
48!           T - TEMPERATURE
49!       TLMAX - MAX TEMPERATURE EACH HOUR IN LOWEST LAYER
50!       TLMIN - MIN TEMPERATURE EACH HOUR IN LOWEST LAYER
51!      TSHLTR - SHELTER LEVEL (2m) POTENTIAL TEMPERATURE (K)
52!      PSHLTR - SHELTER LEVEL (2m) PRESSURE (Pa)
53!      QSHLTR - SHELTER LEVEL (2m) SPECIFIC HUMIDITY (kg/kg)
54!     T02_MAX - 2m HOURLY MAX TEMPERATURE (K)
55!     T02_MIN - 2m HOURLY MIN TEMPERATURE (K)
56!    RH02_MAX - 2m HOURLY MAX RELATIVE HUMIDITY (fraction)
57!    RH02_MIN - 2m HOURLY MIN RELATIVE HUMIDITY (fraction)
58! 
59!   OUTPUT ARGUMENT LIST:  THE ACCUMULATED QUANTITIES
60!     
61!   OUTPUT FILES:  NONE
62!     
63!   SUBPROGRAMS CALLED:  NONE
64! 
65!   UNIQUE: NONE
66! 
67!   LIBRARY: NONE
68! 
69! ATTRIBUTES:
70!   LANGUAGE: FORTRAN 90
71!   MACHINE : IBM
72!$$$ 
73!-----------------------------------------------------------------------
74!
75      USE MODULE_MODEL_CONSTANTS,ONLY: CP,CPV,R_D,R_V,RCP
76      USE MODULE_MP_ETANEW,ONLY: C1XPVS,C1XPVS0,C2XPVS,C2XPVS0          &
77                                ,FPVS,FPVS0,NX,TBPVS,TBPVS0             &
78                                ,GPVS
79!
80!-----------------------------------------------------------------------
81!
82      IMPLICIT NONE
83!
84!-----------------------------------------------------------------------
85!*** ARGUMENTS
86!-----------------------------------------------------------------------
87!
88      INTEGER,INTENT(IN) :: NCLOD,NHEAT,NPHS,NPREC,NRDLW,NRDSW          &
89                           ,NSRFC,NTSD                                  &
90                           ,IDS,IDE,JDS,JDE,KDS,KDE                     &
91                           ,IMS,IME,JMS,JME,KMS,KME                     &
92                           ,ITS,ITE,JTS,JTE,KTS,KTE
93!
94      INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: NCFRST,NCFRCV
95!
96      REAL,INTENT(IN) :: TSPH,TSTART
97!
98      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: PSHLTR,QSHLTR,TSHLTR
99!
100      REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: T
101!
102      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: TLMAX,TLMIN
103!
104      REAL,INTENT(OUT) :: ARDLW,ARDSW,ASRFC,AVCNVC,AVRAIN
105!
106      REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: ACPREC,ACSNOM      &
107     &                                              ,ACSNOW,ALWIN       &
108     &                                              ,ACFRST,ACFRCV      &
109     &                                              ,ALWOUT,ALWTOA      &
110     &                                              ,ASWIN,ASWOUT       &
111     &                                              ,ASWTOA,BGROFF      &
112     &                                              ,CUPREC,POTEVP      &
113     &                                              ,POTFLX,SFCEVP      &
114     &                                              ,RH02_MAX,RH02_MIN  &
115     &                                              ,SFCLHX,SFCSHX      &
116     &                                              ,SFCUVX,SNOPCX      &
117     &                                              ,SSROFF,SUBSHX      &
118     &                                              ,T02_MAX,T02_MIN
119!
120      REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(OUT) :: TCUCN      &
121     &                                                      ,TRAIN
122!
123      LOGICAL,INTENT(IN) :: RESTART
124!
125!-----------------------------------------------------------------------
126!***  LOCAL VARIABLES
127!-----------------------------------------------------------------------
128!
129      INTEGER :: I,J,K,NTSD_BUCKET,NTSPH
130      LOGICAL ::  FIRST_PASS=.TRUE.
131      LOGICAL ::  WRF_DM_ON_MONITOR
132      EXTERNAL WRF_DM_ON_MONITOR
133!
134      REAL :: CAPPA_MOIST,RH02,SAT_VAPOR_PRESS,VAPOR_PRESS
135      REAL,SAVE :: CP_FACTOR,EPSILON,ONE_MINUS_EPSILON,R_FACTOR
136      REAL,SAVE :: P00_INV=1.E-5
137!
138      REAL,DIMENSION(ITS:ITE,JTS:JTE) :: T02
139!
140!-----------------------------------------------------------------------
141!***********************************************************************
142!-----------------------------------------------------------------------
143!***  COMPUTE AND SAVE THE FACTORS IN R AND CP TO ACCOUNT FOR
144!***  WATER VAPOR IN THE AIR.
145!***
146!***  RECALL: R  = Rd * (1. + Q * (1./EPSILON - 1.))
147!***          CP = CPd * (1. + Q * (CPv/CPd - 1.))
148!
149      IF(FIRST_PASS)THEN
150        FIRST_PASS=.FALSE.
151!
152        EPSILON=R_D/R_V
153        ONE_MINUS_EPSILON=1.-EPSILON
154        R_FACTOR=1./EPSILON-1.
155        CP_FACTOR=CPV/CP-1.
156! Make sure saturation vapor pressure lookup table is initialized
157        CALL GPVS
158      ENDIF
159!
160!-----------------------------------------------------------------------
161!
162      NTSD_BUCKET=NTSD
163!
164!-----------------------------------------------------------------------
165!***  TOTAL AND CONVECTIVE PRECIPITATION ARRAYS.
166!***  TOTAL SNOW AND SNOW MELT ARRAYS.
167!***  STORM SURFACE AND BASE GROUND RUN OFF ARRAYS.
168!***  EVAPORATION ARRAYS.
169!-----------------------------------------------------------------------
170!
171!     IF(MOD(NTSD,NPREC)<NPHS)THEN
172      IF(MOD(NTSD_BUCKET,NPREC)==0)THEN
173        DO J=JTS,JTE
174        DO I=ITS,ITE
175          ACPREC(I,J)=0.
176          CUPREC(I,J)=0.
177          ACSNOW(I,J)=0.
178          ACSNOM(I,J)=0.
179          SSROFF(I,J)=0.
180          BGROFF(I,J)=0.
181          SFCEVP(I,J)=0.
182          POTEVP(I,J)=0.
183        ENDDO
184        ENDDO
185!
186        IF ( WRF_DM_ON_MONITOR() ) THEN
187        CALL WRF_MESSAGE('ZEROED OUT PRECIP/RUNOFF ARRAYS')
188        ENDIF
189!
190      ENDIF
191!
192!-----------------------------------------------------------------------
193!***  SFC FLUX ARRAYS.
194!-----------------------------------------------------------------------
195!
196!     IF(MOD(NTSD,NSRFC)<NPHS)THEN
197      IF(MOD(NTSD_BUCKET,NSRFC)==0)THEN
198        ASRFC=0.
199        DO J=JTS,JTE
200        DO I=ITS,ITE
201          SFCSHX(I,J)=0.
202          SFCLHX(I,J)=0.
203          SUBSHX(I,J)=0.
204          SNOPCX(I,J)=0.
205          SFCUVX(I,J)=0.
206          POTFLX(I,J)=0.
207        ENDDO
208        ENDDO
209!
210        IF ( WRF_DM_ON_MONITOR() ) THEN
211        CALL WRF_MESSAGE('ZEROED OUT SFC EVAP/FLUX ARRAYS')
212        ENDIF
213!
214      ENDIF
215!
216!-----------------------------------------------------------------------
217!***  SHORTWAVE FLUX ACCUMULATION ARRAYS.
218!-----------------------------------------------------------------------
219!
220!     IF(MOD(NTSD,NRDSW)<NPHS)THEN
221      IF(MOD(NTSD_BUCKET,NRDSW)==0)THEN
222        ARDSW=0.
223        DO J=JTS,JTE
224        DO I=ITS,ITE
225          ASWIN(I,J) =0.
226          ASWOUT(I,J)=0.
227          ASWTOA(I,J)=0.
228        ENDDO
229        ENDDO
230!
231        IF ( WRF_DM_ON_MONITOR() ) THEN
232        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED SHORTWAVE FLUX ARRAYS')
233        ENDIF
234!
235      ENDIF
236!
237!-----------------------------------------------------------------------
238!***  LONGWAVE FLUX ACCUMULATION ARRAYS.
239!-----------------------------------------------------------------------
240!
241!     IF(MOD(NTSD,NRDLW)<NPHS)THEN
242      IF(MOD(NTSD_BUCKET,NRDLW)==0)THEN
243        ARDLW=0.
244        DO J=JTS,JTE
245        DO I=ITS,ITE
246          ALWIN(I,J) =0.
247          ALWOUT(I,J)=0.
248          ALWTOA(I,J)=0.
249        ENDDO
250        ENDDO
251!
252        IF ( WRF_DM_ON_MONITOR() ) THEN
253        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED LONGWAVE FLUX ARRAYS')
254        ENDIF
255!
256      ENDIF
257!
258!-----------------------------------------------------------------------
259!***  TIME-AVERAGED CLOUD FRACTION ARRAYS.
260!-----------------------------------------------------------------------
261!
262!     IF(MOD(NTSD,NCLOD)<NPHS)THEN
263      IF(MOD(NTSD_BUCKET,NCLOD)==0)THEN
264!***
265  !--- Ferrier 11/2/05:  Right now no accumulator variable is used (e.g.,
266  !    "ACLOD"), but instead the 2D arrays NCFRST & NCFRCV are used.  These
267  !    can be removed later to streamline the code.
268!***
269        DO J=JTS,JTE
270        DO I=ITS,ITE
271          ACFRCV(I,J)=0.
272          ACFRST(I,J)=0.
273          NCFRCV(I,J)=0
274          NCFRST(I,J)=0
275        ENDDO
276        ENDDO
277!
278        IF ( WRF_DM_ON_MONITOR() ) THEN
279        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED CLOUD FRACTION ARRAYS')
280        ENDIF
281!
282      ENDIF
283!
284!-----------------------------------------------------------------------
285!***  GRID-SCALE AND CONVECTIVE (LATENT) HEATING ARRAYS.
286!-----------------------------------------------------------------------
287!
288!     IF(MOD(NTSD,NHEAT)<NPHS)THEN
289      IF(MOD(NTSD_BUCKET,NHEAT)==0)THEN
290        AVCNVC=0.
291        AVRAIN=0.
292!
293        DO K=KTS,KTE
294        DO J=JTS,JTE
295        DO I=ITS,ITE
296          TRAIN(I,J,K)=0.
297          TCUCN(I,J,K)=0.
298        ENDDO
299        ENDDO
300        ENDDO
301!
302        IF ( WRF_DM_ON_MONITOR() ) THEN
303        CALL WRF_MESSAGE('ZEROED OUT ACCUMULATED LATENT HEATING ARRAYS')
304        ENDIF
305!
306      ENDIF
307!
308!-----------------------------------------------------------------------
309!***  MAX/MIN TEMPERATURES
310!-----------------------------------------------------------------------
311!
312      NTSPH=NINT(TSPH)
313      IF(MOD(NTSD_BUCKET,NTSPH)==0)THEN
314        DO J=JTS,JTE
315        DO I=ITS,ITE
316          TLMAX(I,J)=-999.
317          TLMIN(I,J)=999.
318          T02_MAX(I,J)=-999.
319          T02_MIN(I,J)=999.
320        ENDDO
321        ENDDO
322!
323        IF ( WRF_DM_ON_MONITOR() ) THEN
324        CALL WRF_MESSAGE('RESET MAX/MIN TEMPERATURES')
325        ENDIF
326      ENDIF
327!
328      DO J=JTS,JTE
329      DO I=ITS,ITE
330        TLMAX(I,J)=MAX(TLMAX(I,J),T(I,J,1))         !<--- Hourly max lowest layer T
331        TLMIN(I,J)=MIN(TLMIN(I,J),T(I,J,1))         !<--- Hourly min lowest layer T
332!
333        CAPPA_MOIST=RCP*(1.+QSHLTR(I,J)*R_FACTOR)/(1.+QSHLTR(I,J)*CP_FACTOR)
334        T02(I,J)=TSHLTR(I,J)*(P00_INV*PSHLTR(I,J))**CAPPA_MOIST
335!
336        IF(NTSD>0)THEN
337          T02_MAX(I,J)=MAX(T02_MAX(I,J),T02(I,J))     !<--- Hourly max shelter T
338          T02_MIN(I,J)=MIN(T02_MIN(I,J),T02(I,J))     !<--- Hourly min shelter T
339        ENDIF
340      ENDDO
341      ENDDO
342!
343!-----------------------------------------------------------------------
344!***  MAX/MIN RELATIVE HUMIDITY
345!-----------------------------------------------------------------------
346!
347      IF(MOD(NTSD_BUCKET,NTSPH)==0.OR.NTSD==1)THEN
348        DO J=JTS,JTE
349        DO I=ITS,ITE
350          RH02_MAX(I,J)=-999.
351          RH02_MIN(I,J)=999.
352        ENDDO
353        ENDDO
354!
355        IF ( WRF_DM_ON_MONITOR() ) THEN
356          CALL WRF_MESSAGE('RESET MAX/MIN RH')
357        ENDIF
358      ENDIF
359!
360      IF(NTSD>0)THEN
361!
362        DO J=JTS,JTE
363        DO I=ITS,ITE
364          VAPOR_PRESS=PSHLTR(I,J)*QSHLTR(I,J)/                          &
365                     (EPSILON+QSHLTR(I,J)*ONE_MINUS_EPSILON)
366!
367!         IF(T02(I,J)>273.15)THEN
368            SAT_VAPOR_PRESS=1.E3*FPVS0(T02(I,J))
369!         ELSE
370!           SAT_VAPOR_PRESS=1.E3*FPVS(T02(I,J))
371!         ENDIF
372!
373          RH02=MIN(VAPOR_PRESS/SAT_VAPOR_PRESS,0.99)
374!
375          RH02_MAX(I,J)=MAX(RH02_MAX(I,J),RH02)     !<--- Hourly max shelter RH
376          RH02_MIN(I,J)=MIN(RH02_MIN(I,J),RH02)     !<--- Hourly min shelter RH
377        ENDDO
378        ENDDO
379!
380      ELSE                         !<-- If timestep is 0, simply set max/min to zero.
381        DO J=JTS,JTE
382        DO I=ITS,ITE
383          RH02_MAX(I,J)=0.
384          RH02_MIN(I,J)=0.
385        ENDDO
386        ENDDO
387!
388      ENDIF
389!
390!-----------------------------------------------------------------------
391!
392      END SUBROUTINE BUCKETS
393!
394!-----------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.