module_PHYSICS_CALLS.F
References to this file elsewhere.
1 !-----------------------------------------------------------------------
2 !
3 !NCEP_MESO:MODEL_LAYER: PHYSICS
4 !
5 !-----------------------------------------------------------------------
6 #include "nmm_loop_basemacros.h"
7 #include "nmm_loop_macros.h"
8 !-----------------------------------------------------------------------
9 !
10 MODULE MODULE_PHYSICS_CALLS
11 !
12 !-----------------------------------------------------------------------
13 USE MODULE_DOMAIN
14 USE MODULE_DM
15 USE MODULE_CONFIGURE
16 USE MODULE_TILES
17 USE MODULE_STATE_DESCRIPTION,ONLY : P_QV,P_QC,P_QR,P_QI,P_QS,P_QG,P_QNI
18 USE MODULE_MODEL_CONSTANTS
19 USE MODULE_RA_GFDLETA,ONLY : CAL_MON_DAY,ZENITH
20 USE MODULE_RADIATION_DRIVER
21 USE MODULE_SF_MYJSFC
22 USE MODULE_SURFACE_DRIVER
23 USE MODULE_PBL_DRIVER
24 USE MODULE_CU_BMJ
25 USE MODULE_CUMULUS_DRIVER
26 USE MODULE_MP_ETANEW
27 USE MODULE_MICROPHYSICS_DRIVER
28 USE MODULE_MICROPHYSICS_ZERO_OUT
29 !-----------------------------------------------------------------------
30 !
31 CONTAINS
32 !
33 !-----------------------------------------------------------------------
34 !***********************************************************************
35 SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
36 & ,IHRST,NPHS,GLAT,GLON &
37 & ,NRADS,NRADL &
38 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
39 & ,PD,RES,PINT,T,Q,MOIST,THS,ALBEDO,EPSR &
40 & ,F_ICE,F_RAIN &
41 #ifdef WRF_CHEM
42 & ,GD_CLOUD,GD_CLOUD2 &
43 #endif
44 & ,SM,HBM2,LMH,CLDFRA,N_MOIST,RESTRT &
45 & ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT &
46 & ,RLWTOA,RSWTOA,CZMEAN &
47 & ,CFRACL,CFRACM,CFRACH,SIGT4 &
48 & ,ACFRST,NCFRST,ACFRCV,NCFRCV &
49 & ,CUPPT,VEGFRC,SNOW,HTOP,HBOT &
50 & ,Z,SICE,NUM_AEROSOLC,NUM_OZMIXM &
51 & ,GRID,CONFIG_FLAGS &
52 & ,RTHRATEN &
53 #ifdef WRF_CHEM
54 & ,PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC &
55 & ,TAUAER1, TAUAER2, TAUAER3, TAUAER4 &
56 & ,GAER1, GAER2, GAER3, GAER4 &
57 & ,WAER1, WAER2, WAER3, WAER4 &
58 #endif
59 & ,IDS,IDE,JDS,JDE,KDS,KDE &
60 & ,IMS,IME,JMS,JME,KMS,KME &
61 & ,ITS,ITE,JTS,JTE,KTS,KTE)
62 !*** NOTE ***
63 ! RLWIN - downward longwave at the surface (=TOTLWDN, now a local array)
64 ! RSWIN - downward shortwave at the surface (=TOTSWDN, now a local array)
65 ! RSWINC - CLEAR-SKY downward shortwave at the surface (=TOTSWDNC, new for AQ)
66 !***********************************************************************
67 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
68 ! . . .
69 ! SUBPROGRAM: RADIATION RADIATION OUTER DRIVER
70 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 2002-06-04
71 !
72 ! ABSTRACT:
73 ! RADIATION SERVES AS THE INTERFACE BETWEEN THE NCEP NONHYDROSTATIC
74 ! MESOSCALE MODEL AND THE WRF RADIATION DRIVER.
75 !
76 ! PROGRAM HISTORY LOG:
77 ! 02-06-04 BLACK - ORIGINATOR
78 ! 02-09-09 WOLFE - CONVERTING TO GLOBAL INDEXING
79 ! 04-11-18 BLACK - THREADED
80 !
81 ! USAGE: CALL RADIATION FROM SOLVE_NMM
82 !
83 ! ATTRIBUTES:
84 ! LANGUAGE: FORTRAN 90
85 ! MACHINE : IBM
86 !$$$
87 !-----------------------------------------------------------------------
88 !
89 IMPLICIT NONE
90 !
91 !-----------------------------------------------------------------------
92 !
93 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
94 & ,IMS,IME,JMS,JME,KMS,KME &
95 & ,ITS,ITE,JTS,JTE,KTS,KTE &
96 & ,IHRST,JULDAY,JULYR &
97 & ,N_MOIST,NPHS,NRADL,NRADS,NTSD &
98 & ,NUM_AEROSOLC,NUM_OZMIXM
99 !
100 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: NCFRCV,NCFRST
101 !
102 REAL,INTENT(IN) :: DT,PDTOP,PT,XTIME,JULIAN
103 !
104 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
105 !
106 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
107 !
108 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
109 !
110 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ALBEDO &
111 & ,EPSR,GLAT,GLON &
112 & ,HBM2 &
113 & ,PD,RES,SM &
114 & ,SNOW,THS,VEGFRC,SICE
115 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CUPPT
116
117 !
118 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE &
119 & ,F_RAIN &
120 & ,Q,T,Z
121 !
122 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RTHRATEN
123 !
124 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST),INTENT(INOUT) :: MOIST
125 !
126 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACFRCV,ACFRST &
127 & ,RLWIN,RLWTOA &
128 & ,RSWIN,RSWOUT &
129 & ,HBOT,HTOP &
130 & ,RSWINC,RSWTOA
131 !
132 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT &
133 & ,RLWTT &
134 & ,RSWTT
135 !
136 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CFRACH,CFRACL &
137 & ,CFRACM,CZMEAN &
138 & ,SIGT4
139 #ifdef WRF_CHEM
140 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME ),INTENT(IN) :: &
141 & GAER1,GAER2,GAER3,GAER4, &
142 & GD_CLOUD,GD_CLOUD2, &
143 & PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC, &
144 & TAUAER1,TAUAER2,TAUAER3,TAUAER4, &
145 & WAER1,WAER2,WAER3,WAER4
146 #endif
147 !
148 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CLDFRA
149 !
150 LOGICAL,INTENT(IN) :: RESTRT
151 !
152 TYPE(DOMAIN),TARGET :: GRID
153 !
154 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
155 !
156 !-----------------------------------------------------------------------
157 !***
158 !*** LOCAL VARIABLES
159 !***
160 !-----------------------------------------------------------------------
161 INTEGER :: I,ICLOUD,IENDX,II,J,JDAY,JMONTH,K,KMNTH,LMHIJ,NRAD
162 !
163 INTEGER,DIMENSION(3) :: IDAT
164 INTEGER,DIMENSION(12) :: MONTH=(/31,28,31,30,31,30,31,31 &
165 & ,30,31,30,31/)
166 !
167 REAL :: CAPA,DAYI,DPL,FICE,FRAIN,GMT,HOUR,PDSL,PLYR,PSFC &
168 & ,QI,QR,QW,RADT,TIMES,WC,TDUM
169 !
170 REAL,DIMENSION(KMS:KME-1) :: QL,TL
171 !
172 REAL,DIMENSION(IMS:IME,JMS:JME) :: REXNSFC,SWNETDN &
173 & ,TOT,TSFC,XLAND,XLAT,XLON &
174 & ,TOTLWDN,TOTSWDN,TOTSWDNC,CZEN &
175 & ,HBOTR,HTOPR,CUPPTR
176 !
177 !
178 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &
179 & ,RR,T8W &
180 & ,THRATENLW,THRATENSW &
181 & ,TH_PHY,T_PHY,CLFR
182 !
183 !
184 !*** Different way to include cloud effects in radiation.
185 !
186 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: QC1R,QI1R
187 !
188 LOGICAL :: WARM_RAIN
189 !
190 !-----------------------------------------------------------------------
191 !-----------------------------------------------------------------------
192 !*****
193 !***** NOTE: THIS IS HARDWIRED FOR CALLS TO LONGWAVE AND SHORTWAVE
194 !***** AT EQUAL INTERVALS
195 !*****
196 NRAD=NRADS
197 RADT=DT*NRADS/60.
198 !-----------------------------------------------------------------------
199 !-----------------------------------------------------------------------
200 CAPA=R_D/CP
201 !-----------------------------------------------------------------------
202 !
203 !$omp parallel do &
204 !$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,ql,tl)
205 DO J=MYJS2,MYJE2
206 DO I=MYIS1,MYIE1
207 !
208 PDSL=PD(I,J)*RES(I,J)
209 P8W(I,KTE+1,J)=PT
210 XLAT(I,J)=GLAT(I,J)/DEGRAD
211 XLON(I,J)=GLON(I,J)/DEGRAD
212 XLAND(I,J)=SM(I,J)+1.
213 PSFC=PD(I,J)+PDTOP+PT
214 REXNSFC(I,J)=(PSFC*1.E-5)**CAPA
215 TSFC(I,J)=THS(I,J)*REXNSFC(I,J)
216 T8W(I,1,J)=TSFC(I,J)
217 P8W(I,KTS,J)=ETA1(KTS)*PDTOP+ETA2(KTS)*PDSL+PT
218 !
219 !-----------------------------------------------------------------------
220 !*** FILL THE SINGLE-COLUMN INPUT
221 !-----------------------------------------------------------------------
222 !
223 DO K=KTS,KTE
224 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
225 QL(K)=AMAX1(Q(I,K,J),EPSQ)
226 PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
227 TL(K)=T(I,K,J)
228 !
229 RR(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))
230 T_PHY(I,K,J)=TL(K)
231 TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
232 P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
233 P_PHY(I,K,J)=PLYR
234 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
235 DZ(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D &
236 & *(P8W(I,K,J)-P8W(I,K+1,J)) &
237 & /(P_PHY(I,K,J)*G)
238 !!! & *ALOG(P8W(I,KFLIP,J)/P8W(I,KFLIP+1,J))/G &
239 !!! & *ALOG(PINT(I,K+1,J)/PINT(I,K,J))/G &
240 !
241 RTHRATEN(I,K,J)=0.
242 THRATENLW(I,K,J)=0.
243 THRATENSW(I,K,J)=0.
244 ! PM2_5_DRY(I,K,J)=0.
245 ! PM2_5_WATER(I,K,J)=0.
246
247 ENDDO
248 !
249 DO K=KTS+1,KTE
250 T8W(I,K,J)=0.5*(TL(K-1)+TL(K))
251 ENDDO
252 T8W(I,KTE+1,J)=-1.E20
253 !
254 ENDDO
255 ENDDO
256 !
257 ICLOUD=999
258 !
259 GMT=REAL(IHRST)
260 !
261 !-----------------------------------------------------------------------
262 !
263 !*** CALL THE INNER DRIVER.
264 !
265 !-----------------------------------------------------------------------
266 !
267 DO J=JMS,JME
268 DO K=KMS,KME
269 DO I=IMS,IME
270 QC1R(I,K,J)=0.
271 QI1R(I,K,J)=0.
272 ENDDO
273 ENDDO
274 ENDDO
275 !
276 DO J=MYJS2,MYJE2
277 DO K=KTS,KTE
278 DO I=MYIS1,MYIE1
279 QC1R(I,K,J)=MOIST(I,K,J,P_QC)
280 QI1R(I,K,J)=MOIST(I,K,J,P_QI)
281 ENDDO
282 ENDDO
283 ENDDO
284 DO J=JMS,JME
285 DO K=KMS,KME
286 DO I=IMS,IME
287 CLDFRA(I,K,J)=0.
288 ENDDO
289 ENDDO
290 !
291 DO I=IMS,IME
292 CFRACH(I,J)=0.
293 CFRACL(I,J)=0.
294 CFRACM(I,J)=0.
295 CZMEAN(I,J)=0.
296 SIGT4(I,J)=0.
297 TOTSWDN(I,J)=0. ! TOTAL (clear+cloudy sky) shortwave down at the surface
298 TOTSWDNC(I,J)=0. ! CLEAR SKY shortwave down at the surface
299 SWNETDN(I,J)=0. ! Net (down - up) total (clear+cloudy sky) shortwave at the surface
300 TOTLWDN(I,J)=0. ! Total longwave down at the surface
301 CUPPTR(I,J)=CUPPT(I,J) ! Temporary array set to zero in radiation
302 !-- NOTE: HBOTR, HTOPR are passed into radiation and set equal to HBOT, HTOP. HBOT, HTOP are
303 ! reset to clear sky values to be used by the ARW. At the bottom of this subroutine,
304 ! HBOT, HTOP are re-defined again to values stored in HBOTR, HTOPR. HBOT, HTOP are
305 ! reset to clear sky values after the call to radiation and after the top of the hour
306 ! in subroutine CUCNVC below.
307 ENDDO
308 ENDDO
309 !
310 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
311 !
312 CALL RADIATION_DRIVER( &
313 & IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
314 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
315 & ,I_START=GRID%I_START,I_END=GRID%I_END &
316 & ,J_START=GRID%J_START,J_END=GRID%J_END &
317 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
318 & ,ITIMESTEP=NTSD,DT=DT &
319 #ifdef WRF_CHEM
320 & ,cu_rad_feedback=config_flags%cu_rad_feedback &
321 & ,aer_ra_feedback=config_flags%aer_ra_feedback &
322 & ,PM2_5_DRY=pm2_5_dry, PM2_5_WATER=pm2_5_water &
323 & ,PM2_5_DRY_EC=pm2_5_dry_ec &
324 & ,TAUAER300=tauaer1, TAUAER400=tauaer2, TAUAER600=tauaer3, TAUAER999=tauaer4 & ! jcb
325 & ,GAER300=gaer1, GAER400=gaer2, GAER600=gaer3, GAER999=gaer4 & ! jcb
326 & ,WAER300=waer1, WAER400=waer2, WAER600=waer3, WAER999=waer4 & ! jcb
327 & ,qc_adjust=GD_CLOUD,qi_adjust=GD_CLOUD2 &
328 #endif
329 & ,RTHRATENLW=THRATENLW,RTHRATENSW=THRATENSW &
330 & ,RTHRATEN=RTHRATEN &
331 & ,GLW=TOTLWDN,GSW=SWNETDN,SWDOWN=TOTSWDN &
332 & ,XLAT=XLAT,XLONG=XLON,ALBEDO=ALBEDO,EMISS=EPSR &
333 & ,XICE=SICE,XLAND=XLAND,Z=Z,TSK=TSFC &
334 & ,N_AEROSOLC=NUM_AEROSOLC,PAERLEV=GRID%PAERLEV &
335 & ,CAM_ABS_DIM1=GRID%CAM_ABS_DIM1 &
336 & ,CAM_ABS_DIM2=GRID%CAM_ABS_DIM2 &
337 & ,CAM_ABS_FREQ_S=GRID%CAM_ABS_FREQ_S &
338 & ,LEVSIZ=GRID%LEVSIZ,N_OZMIXM=NUM_OZMIXM &
339 & ,HTOP=HTOP,HBOT=HBOT,CUPPT=CUPPTR &
340 & ,HTOPR=HTOPR,HBOTR=HBOTR &
341 & ,VEGFRA=VEGFRC,SNOW=SNOW &
342 & ,RHO=RR,P8W=P8W,P=P_PHY,PI=PI_PHY &
343 & ,DZ8W=DZ,T=T_PHY,T8W=T8W,GMT=GMT &
344 & ,JULDAY=JULDAY,JULYR=JULYR,NPHS=NPHS &
345 & ,JULIAN=JULIAN,XTIME=XTIME &
346 & ,LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &
347 & ,SW_PHYSICS=CONFIG_FLAGS%RA_SW_PHYSICS &
348 & ,RADT=RADT,RA_CALL_OFFSET=GRID%RA_CALL_OFFSET &
349 & ,STEPRA=NRAD,ICLOUD=ICLOUD &
350 & ,WARM_RAIN=WARM_RAIN &
351 & ,SWDOWNC=TOTSWDNC,CLDFRA=CLFR &
352 & ,RSWTOA=RSWTOA,RLWTOA=RLWTOA &
353 & ,CZMEAN=CZMEAN,CFRACL=CFRACL &
354 & ,CFRACM=CFRACM,CFRACH=CFRACH &
355 & ,ACFRST=ACFRST,NCFRST=NCFRST &
356 & ,ACFRCV=ACFRCV,NCFRCV=NCFRCV &
357 & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &
358 & ,QV=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV &
359 & ,QC=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC &
360 & ,QR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR &
361 & ,QI=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI &
362 & ,QS=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS &
363 & ,QG=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG )
364
365 !
366 !-----------------------------------------------------------------------
367 !
368 !*** UPDATE FLUXES AND TEMPERATURE TENDENCIES.
369 !
370 !-----------------------------------------------------------------------
371 !*** SHORTWAVE
372 !-----------------------------------------------------------------------
373 !
374 !-----------------------------------------------------------------------
375 IF(MOD(NTSD,NRADS)==0)THEN
376 !-----------------------------------------------------------------------
377 !
378 IF(CONFIG_FLAGS%RA_SW_PHYSICS/=GFDLSWSCHEME)THEN
379 !
380 !-----------------------------------------------------------------------
381 !*** COMPUTE CZMEAN FOR NON-GFDL SHORTWAVE
382 !-----------------------------------------------------------------------
383 !
384 DO J=MYJS,MYJE
385 DO I=MYIS,MYIE
386 CZMEAN(I,J)=0.
387 TOT(I,J)=0.
388 ENDDO
389 ENDDO
390 !
391 CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
392 IDAT(1)=JMONTH
393 IDAT(2)=JDAY
394 IDAT(3)=JULYR
395 !
396 DO II=0,NRADS,NPHS
397 TIMES=NTSD*DT+II*DT
398 CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN &
399 & ,MYIS &
400 & ,MYIE &
401 & ,MYJS &
402 & ,MYJE &
403 & ,IDS,IDE,JDS,JDE,KDS,KDE &
404 & ,IMS,IME,JMS,JME,KMS,KME &
405 & ,ITS,ITE,JTS,JTE,KTS,KTE)
406 DO J=MYJS,MYJE
407 DO I=MYIS,MYIE
408 IF(CZEN(I,J)>0.)THEN
409 CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J)
410 TOT(I,J)=TOT(I,J)+1.
411 ENDIF
412 ENDDO
413 ENDDO
414 !
415 ENDDO
416 !
417 DO J=MYJS,MYJE
418 DO I=MYIS,MYIE
419 IF(TOT(I,J)>0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J)
420 ENDDO
421 ENDDO
422 !
423 !-----------------------------------------------------------------------
424 !*** COMPUTE TOTAL SFC SHORTWAVE DOWN FOR NON-GFDL SCHEMES
425 !-----------------------------------------------------------------------
426 !
427 !$omp parallel do &
428 !$omp& private(i,j)
429 DO J=MYJS2,MYJE2
430 DO I=MYIS1,MYIE1
431 !
432 IF(HBM2(I,J)>0.5)THEN
433 TOTSWDN(I,J)=SWNETDN(I,J)/(1.-ALBEDO(I,J))
434 !--- No value currently available for clear-sky solar fluxes from
435 ! non GFDL schemes, though it's needed for air quality forecasts.
436 ! For the time being, set to the total downward solar fluxes.
437 TOTSWDNC(I,J)=TOTSWDN(I,J)
438 ENDIF
439 !
440 ENDDO
441 ENDDO
442 !
443 ENDIF !End non-GFDL block
444 !-----------------------------------------------------------------------
445 !
446 !$omp parallel do &
447 !$omp& private(i,iendx,j,k)
448 DO J=MYJS2,MYJE2
449 IENDX=MYIE1
450 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
451 DO I=MYIS1,IENDX
452 !
453 RSWIN(I,J)=TOTSWDN(I,J)
454 RSWINC(I,J)=TOTSWDNC(I,J)
455 RSWOUT(I,J)=TOTSWDN(I,J)-SWNETDN(I,J)
456 !
457 DO K=KTS,KTE
458 RSWTT(I,K,J)=THRATENSW(I,K,J)*PI_PHY(I,K,J)
459 ENDDO
460 !
461 ENDDO
462 ENDDO
463 !
464 ENDIF
465 !
466 !-----------------------------------------------------------------------
467 !*** LONGWAVE
468 !-----------------------------------------------------------------------
469 !
470 IF(MOD(NTSD,NRADL)==0)THEN
471 !
472 !$omp parallel do &
473 !$omp& private(i,iendx,j,k,lmhij)
474 DO J=MYJS2,MYJE2
475 IENDX=MYIE1
476 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
477 DO I=MYIS1,IENDX
478 !
479 IF(HBM2(I,J)>0.5)THEN
480 LMHIJ=KTE+1-LMH(I,J)
481 TDUM=T(I,LMHIJ,J)
482 SIGT4(I,J)=STBOLT*TDUM*TDUM*TDUM*TDUM
483 !
484 DO K=KTS,KTE
485 RLWTT(I,K,J)=THRATENLW(I,K,J)*PI_PHY(I,K,J)
486 ENDDO
487 !
488 RLWIN(I,J)=TOTLWDN(I,J)
489 ENDIF
490 !
491 ENDDO
492 ENDDO
493 !
494 ENDIF
495 !
496 !-- Store 3D cloud fractions & restore HBOT/HTOP arrays
497 !
498 DO J=MYJS2,MYJE2
499 IENDX=MYIE1
500 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
501 DO K=KTS,KTE
502 DO I=MYIS1,IENDX
503 CLDFRA(I,K,J)=CLFR(I,K,J)
504 ENDDO
505 ENDDO
506 DO I=MYIS1,IENDX
507 HBOT(I,J)=HBOTR(I,J)
508 HTOP(I,J)=HTOPR(I,J)
509 CUPPT(I,J)=CUPPTR(I,J)
510 ENDDO
511 ENDDO
512 !-----------------------------------------------------------------------
513 !*** ZERO OUT BOUNDARY ROWS.
514 !-----------------------------------------------------------------------
515 !
516 DO J=JTS,JTE
517 DO I=ITS,ITE
518 IF(HBM2(I,J)<0.5)THEN
519 ACFRST(I,J)=0.
520 ACFRCV(I,J)=0.
521 CFRACL(I,J)=0.
522 CFRACM(I,J)=0.
523 CFRACH(I,J)=0.
524 RSWTOA(I,J)=0.
525 RLWTOA(I,J)=0.
526 ENDIF
527 ENDDO
528 ENDDO
529 !
530 !-----------------------------------------------------------------------
531 !
532
533 END SUBROUTINE RADIATION
534 !
535 !-----------------------------------------------------------------------
536 !***********************************************************************
537 SUBROUTINE TURBL(NTSD,DT,NPHS,RESTRT &
538 & ,N_MOIST,NSOIL,SLDPTH,DZSOIL &
539 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
540 & ,SM,LMH,HTM,VTM,HBM2,VBM2,DX_ARRAY,DFRLG &
541 & ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT &
542 !- RLWIN/RSWIN - downward longwave/shortwave at the surface (also TOTLWDN/TOTSWDN in RADIATION)
543 & ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR &
544 & ,Q2,U,V,THS,TSFC,SST,PREC,SNO,ZERO_3D &
545 & ,FIS,Z0,Z0BASE,USTAR,PBLH,LPBL,EL_MYJ &
546 & ,MOIST,RMOL &
547 & ,EXCH_H,AKHS,AKMS,AKHS_OUT,AKMS_OUT &
548 & ,THZ0,QZ0,UZ0,VZ0,QS,MAVAIL &
549 & ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF &
550 & ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX &
551 & ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB &
552 & ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR &
553 & ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR &
554 & ,T2,QSG,QVG,QCG,SOILT1,TSNAV,SMFR3D,KEEPFR3DFLAG &
555 & ,TWBS,QWBS,SFCSHX,SFCLHX,SFCEVP &
556 & ,POTEVP,POTFLX,SUBSHX &
557 & ,APHTIM,ARDSW,ARDLW,ASRFC &
558 & ,RSWOUT,RSWTOA,RLWTOA &
559 & ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA &
560 & ,UZ0H,VZ0H,DUDT,DVDT &
561 & ,RTHBLTEN,RQVBLTEN &
562 & ,PCPFLG,DDATA & ! PRECIP ASSIM
563 & ,GRID,CONFIG_FLAGS &
564 & ,IHE,IHW,IVE,IVW &
565 & ,IDS,IDE,JDS,JDE,KDS,KDE &
566 & ,IMS,IME,JMS,JME,KMS,KME &
567 & ,ITS,ITE,JTS,JTE,KTS,KTE)
568 !***********************************************************************
569 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
570 ! . . .
571 ! SUBPROGRAM: TURBL TURBULENCE OUTER DRIVER
572 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-04-19
573 !
574 ! ABSTRACT:
575 ! TURBL DRIVES THE TURBULENCE SCHEMES
576 !
577 ! PROGRAM HISTORY LOG (with changes to called routines) :
578 ! 95-03-15 JANJIC - ORIGINATOR OF THE SUBROUTINES CALLED
579 ! BLACK & JANJIC - ORIGINATORS OF THE DRIVER
580 ! 95-03-28 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
581 ! 96-03-29 BLACK - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON
582 ! 96-07-19 MESINGER - ADDED Z0 EFFECTIVE
583 ! 98-??-?? TUCCILLO - MODIFIED FOR CLASS VIII PARALLELISM
584 ! 98-10-27 BLACK - PARALLEL CHANGES INTO MOST RECENT CODE
585 ! 02-01-10 JANJIC - MOIST TURBULENCE (DRIVER, MIXLEN, VDIFH)
586 ! 02-01-10 JANJIC - VERT. DIF OF Q2 INCREASED (Grenier & Bretherton)
587 ! 02-02-02 JANJIC - NEW SFCDIF
588 ! 02-04-19 BLACK - ORIGINATOR OF THIS OUTER DRIVER FOR WRF
589 ! 02-05-03 JANJIC - REMOVAL OF SUPERSATURATION AT 2m AND 10m
590 ! 04-11-18 BLACK - THREADED
591 !
592 ! USAGE: CALL TURBL FROM SOLVE_NMM
593 !
594 ! ATTRIBUTES:
595 ! LANGUAGE: FORTRAN 90
596 ! MACHINE : IBM
597 !$$$
598 !-----------------------------------------------------------------------
599 !
600 IMPLICIT NONE
601 !
602 !-----------------------------------------------------------------------
603 !
604 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
605 & ,IMS,IME,JMS,JME,KMS,KME &
606 & ,ITS,ITE,JTS,JTE,KTS,KTE &
607 & ,N_MOIST,NPHS,NSOIL,NTSD
608 !
609 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
610 !
611 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: ISLTYP,IVGTYP &
612 & ,LMH
613 !
614 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: LPBL
615 !
616 REAL,INTENT(IN) :: DT,PDTOP,PT
617 !
618 REAL,INTENT(INOUT) :: APHTIM,ARDSW,ARDLW,ASRFC
619 !
620 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
621 !
622 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFRLG,ETA1,ETA2
623 !
624 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ALBASE,MXSNAL
625 !
626 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZEN,CZMEAN &
627 & ,DX_ARRAY &
628 & ,FIS,HBM2 &
629 & ,PD,RES &
630 & ,RLWIN,RLWTOA &
631 & ,RSWIN,RSWOUT,RSWTOA &
632 & ,SHDMIN,SHDMAX &
633 ! & ,SICE,SIGT4,SM,SR & !Bandaid
634 & ,SICE,SIGT4 &
635 & ,SST,TG,VBM2,VEGFRC
636 !
637 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: SM,EPSR,SR !Bandaid
638 !
639 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: GRNFLX,QWBS,RADOT &
640 ,SFCEXC,SMSTAV &
641 ,SOILTB,TWBS
642 !
643 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACSNOM,ACSNOW &
644 & ,AKHS,AKMS &
645 & ,ALBEDO &
646 & ,MAVAIL &
647 & ,BGROFF,CMC &
648 & ,PBLH,POTEVP &
649 & ,POTFLX,PREC &
650 & ,QCG,QS,QSG &
651 & ,QVG,QZ0 &
652 & ,SFCEVP &
653 & ,SFCLHX,SFCSHX &
654 & ,SI,SMSTOT &
655 & ,SNO,SNOPCX &
656 & ,SOILT1 &
657 & ,SSROFF,SUBSHX &
658 & ,T2,THS,THZ0 &
659 & ,TSFC,TSNAV &
660 & ,USTAR,UZ0,UZ0H &
661 & ,VZ0,VZ0H &
662 & ,Z0,Z0BASE
663 !
664 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: AKHS_OUT,AKMS_OUT &
665 & ,ALWIN,ALWOUT &
666 & ,ALWTOA,ASWIN &
667 & ,ASWOUT,ASWTOA &
668 & ,PSHLTR,Q10,QSHLTR &
669 & ,TH10,TSHLTR &
670 & ,U10,V10
671 !
672 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM &
673 & ,DUDT &
674 & ,DVDT &
675 & ,EXCH_H &
676 & ,F_ICE &
677 & ,F_RAIN &
678 & ,Q,Q2 &
679 & ,T,U,V
680 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RQVBLTEN,RTHBLTEn
681 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST),INTENT(INOUT) :: MOIST
682 !
683 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM
684 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
685 !
686 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
687 !
688 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: EL_MYJ
689 !
690 REAL,DIMENSION(NSOIL),INTENT(IN) :: DZSOIL,SLDPTH
691 !
692 REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME),INTENT(INOUT) :: KEEPFR3DFLAG &
693 & ,SH2O,SMC &
694 & ,SMFR3D,STC
695 !
696 LOGICAL,INTENT(IN) :: RESTRT
697 !
698 TYPE(DOMAIN),TARGET :: GRID
699 !
700 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
701 !
702 ! For precip assimilation:
703 LOGICAL,INTENT(IN) :: PCPFLG
704 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDATA
705 !
706 !-----------------------------------------------------------------------
707 !***
708 !*** LOCAL VARIABLES
709 !***
710 !-----------------------------------------------------------------------
711 INTEGER :: I,I_M,IDUMMY,IEND,ISFFLX,ISTR,J,K,KOUNT_ALL,LENGTH_ROW &
712 & ,LLIJ,LLMH,LLYR,N,SST_UPDATE
713 !
714 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LOWLYR
715 !
716 REAL :: TRESH=0.95
717 !
718 REAL :: ALTITUDE,CWML,DQDT,DTDT,DTPHS,DX,DZHALF,FACTR,FACTRL &
719 & ,G_INV,PDSL,PLYR,PSFC,QI,QL,QOLD,QR,QW,RATIOMX,RDTPHS &
720 & ,ROG,RWMSK,SDEPTH,SNO_FACTR,TL,TLMH,TLMH4,TNEW,TSFC2 &
721 & ,U_FRAME,V_FRAME,WMSK,XLVRW
722 !
723 REAL :: APES,CKLQ,FACTOR,FFS,PQ0X,Q2SAT,QFC1,QLOWX,RLIVWV &
724 & ,THBOT
725 !
726 REAL,DIMENSION(IMS:IME,JMS:JME) :: BR,CHKLOWQ,CT,CWMLOW,ELFLX &
727 & ,EXNSFC,FACTRS,FLHC,FLQC,GZ1OZ0 &
728 & ,ONE,PLM,PSFC_OUT,PSIH,PSIM &
729 & ,Q2X,QLOW,RAIN,RAINBL &
730 & ,RLW_DN_SFC,RMOL,RSW_NET_SFC &
731 & ,RSW_DN_SFC &
732 & ,SFCEVPX,SFCZ,SNOW,SNOWC,SNOWH &
733 & ,TH2X,THLOW,TLOW,VGFRCK &
734 & ,WSPD,XLAND,ZERO_2D,EMISS
735 !
736 REAL,DIMENSION(IMS:IME,KMS:KME-1,JMS:JME) :: EXNER
737 !
738 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W &
739 & ,P_PHY,PI_PHY &
740 & ,RQCBLTEN,RQIBLTEN &
741 & ,RR &
742 ! & ,RQVBLTEN,RR,RTHBLTEN &
743 & ,T_PHY,TH_PHY,TKE &
744 & ,U_PHY,V_PHY,Z
745 !
746 REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME) :: ZERO_SOIL
747 !
748 LOGICAL :: E_BDY,WARM_RAIN
749 !
750 INTEGER :: ucmcall
751 !
752 !-----------------------------------------------------------------------
753 !-----------------------------------------------------------------------
754 ucmcall=config_flags%ucmcall
755 !
756 DTPHS=NPHS*DT
757 RDTPHS=1./DTPHS
758 G_INV=1./G
759 ROG=R_D*G_INV
760 FACTOR=-XLV*RHOWATER/DTPHS
761 !
762 U_FRAME=0.
763 V_FRAME=0.
764 !
765 IDUMMY=0
766 ISFFLX=1
767 DX=0.
768 SST_UPDATE=0
769 !
770 DO J=JMS,JME
771 DO I=IMS,IME
772 UZ0H(I,J)=0.
773 VZ0H(I,J)=0.
774 ONE(I,J)=1.
775 RMOL(I,J)=0. !Reciprocal of Monin-Obukhov length
776 SFCEVPX(I,J)=0. !Dummy for accumulated latent energy, not flux
777 ENDDO
778 ENDDO
779 !
780 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
781 SNO_FACTR=1.
782 ELSE
783 SNO_FACTR=0.001
784 ENDIF
785 !
786 !$omp parallel do &
787 !$omp& private(i,j)
788 DO J=MYJS,MYJE
789 DO I=MYIS,MYIE
790 LOWLYR(I,J)=1
791 VGFRCK(I,J)=100.*VEGFRC(I,J)
792 SNOW(I,J)=SNO(I,J)
793 SNOWH(I,J)=SI(I,J)*SNO_FACTR
794 XLAND(I,J)=SM(I,J)+1.
795 T2(I,J)=TSFC(I,J)
796 EMISS(I,J)=EPSR(I,J)
797 ENDDO
798 ENDDO
799 !
800 IF(NTSD==0)THEN
801 !$omp parallel do &
802 !$omp& private(i,j)
803 DO J=MYJS,MYJE
804 DO I=MYIS,MYIE
805 Z0BASE(I,J)=Z0(I,J)
806 IF(SM(I,J)>0.5.AND.SICE(I,J)>0.5)THEN !Bandaid
807 SM(I,J)=0.
808 ENDIF
809 ENDDO
810 ENDDO
811 ENDIF
812 !
813 !$omp parallel do &
814 !$omp& private(i,j,k)
815 DO J=MYJS,MYJE
816 DO K=KTS,KTE+1
817 DO I=MYIS,MYIE
818 Z(I,K,J)=0.
819 DZ(I,K,J)=0.
820 EXCH_H(I,K,J)=0.
821 ENDDO
822 ENDDO
823 ENDDO
824 !
825 !-----------------------------------------------------------------------
826 !
827 !*** PREPARE NEEDED ARRAYS
828 !
829 !-----------------------------------------------------------------------
830 !
831 !$omp parallel do &
832 !$omp& private(cwml,factrl,i,j,k,llij,llmh,pdsl,plyr,psfc,qi,ql,qr,qw &
833 !$omp& ,tl,tlmh,tlmh4)
834 DO J=MYJS,MYJE
835 DO I=MYIS,MYIE
836 !
837 LLMH=LMH(I,J)
838 PDSL=PD(I,J)*RES(I,J)
839 !!! PSFC=PD(I,J)+PDTOP+PT
840 !!! P8W(I,KTS,J)=PSFC
841 P8W(I,KTS,J)=PINT(I,KTS,J)
842 PSFC=PINT(I,KTS,J)
843 LOWLYR(I,J)=KTE+1-LLMH
844 EXNSFC(I,J)=(1.E5/PSFC)**CAPA
845 THS(I,J)=(SST(I,J)*EXNSFC(I,J))*SM(I,J)+THS(I,J)*(1.-SM(I,J))
846 TSFC(I,J)=THS(I,J)/EXNSFC(I,J)
847 SFCZ(I,J)=FIS(I,J)*G_INV
848 ZERO_2D(I,J)=0.
849 !YL RAIN(I,J)=PREC(I,J)*RHOWATER
850 IF (PCPFLG.AND.DDATA(I,J)<100.)THEN
851 RAIN(I,J)=DDATA(I,J)*RHOWATER
852 ELSE
853 RAIN(I,J)=PREC(I,J)*RHOWATER
854 ENDIF
855 !YL
856 RAINBL(I,J)=0.
857 IF(SNO(I,J)>0.)SNOWC(I,J)=1.
858 LLIJ=LOWLYR(I,J)
859 PLM(I,J)=(PINT(I,LLIJ,J)+PINT(I,LLIJ+1,J))*0.5
860 TH2X(I,J)=T(I,LLIJ,J)*(1.E5/PLM(I,J))**CAPA
861 Q2X(I,J)=Q(I,LLIJ,J)
862 !
863 !-----------------------------------------------------------------------
864 !*** LONG AND SHORTWAVE FLUX AT GROUND SURFACE
865 !-----------------------------------------------------------------------
866 !
867 IF(CZMEAN(I,J)>0.)THEN
868 FACTRS(I,J)=CZEN(I,J)/CZMEAN(I,J)
869 ELSE
870 FACTRS(I,J)=0.
871 ENDIF
872 !
873 IF(SIGT4(I,J)>0.)THEN
874 TLMH=T(I,LLIJ,J)
875 FACTRL=STBOLT*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J)
876 ELSE
877 FACTRL=0.
878 ENDIF
879 !
880 !- RLWIN/RSWIN - downward longwave/shortwave at the surface
881 !
882 RLW_DN_SFC(I,J)=RLWIN(I,J)*HBM2(I,J)*FACTRL
883 RSW_NET_SFC(I,J)=(RSWIN(I,J)-RSWOUT(I,J))*HBM2(I,J)*FACTRS(I,J)
884 !
885 !- Instant downward solar for nmm_lsm
886 !
887 RSW_DN_SFC(I,J)=RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
888 !
889 !-----------------------------------------------------------------------
890 !*** FILL THE ARRAYS FOR CALLING THE INNER DRIVER.
891 !-----------------------------------------------------------------------
892 !
893 Z(I,KTS,J)=SFCZ(I,J)
894 !
895 DO K=KTS,KTE
896 Q2(I,K,J)=AMAX1(Q2(I,K,J)*HBM2(I,J),EPSQ2)
897 QL=AMAX1(Q(I,K,J),EPSQ)
898 PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5
899 !!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
900 TL=T(I,K,J)
901 CWML=CWM(I,K,J)
902 !
903 RR(I,K,J)=PLYR/(R_D*TL)
904 T_PHY(I,K,J)=TL
905 !
906 EXNER(I,K,J)=(1.E5/PLYR)**CAPA
907 PI_PHY(I,K,J)=1./EXNER(I,K,J)
908 TH_PHY(I,K,J)=TL*EXNER(I,K,J)
909 P8W(I,K+1,J)=PINT(I,K+1,J)
910 !!! P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
911 P_PHY(I,K,J)=PLYR
912 TKE(I,K,J)=0.5*Q2(I,K,J)
913 !
914 RTHBLTEN(I,K,J)=0.
915 RQVBLTEN(I,K,J)=0.
916 RQCBLTEN(I,K,J)=0.
917 RQIBLTEN(I,K,J)=0.
918 !
919 Z(I,K+1,J)=Z(I,K,J)+TL/PLYR &
920 & *(DETA1(K)*PDTOP+DETA2(K)*PDSL)*ROG &
921 *(Q(I,K,J)*P608-CWML+1.)
922 Z(I,K+1,J)=(Z(I,K+1,J)-DFRLG(K+1))*HTM(I,K,J)+DFRLG(K+1)
923 !!! FACTR=1.-HTM(I,K,J)
924 !!! Z(I,K+1,J)=Z(I,K+1,J)*HTM(I,K,J)+FACTR*DFRLG(K+1)
925 DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)
926 ENDDO
927 ENDDO
928 ENDDO
929 !
930 !$omp parallel do &
931 !$omp& private(i,j,llyr,qlowx)
932 DO J=MYJS,MYJE
933 DO I=MYIS,MYIE
934 TWBS(I,J)=0.
935 QWBS(I,J)=0.
936 LLYR=LOWLYR(I,J)
937 THLOW(I,J)=TH_PHY(I,LLYR,J)
938 TLOW(I,J)=T_PHY(I,LLYR,J)
939 QLOW(I,J)=MAX(Q(I,LLYR,J),EPSQ)
940 QLOWX=QLOW(I,J)/(1.-QLOW(I,J))
941 QLOW(I,J)=QLOWX/(1.+QLOWX)
942 CWMLOW(I,J)=CWM(I,LLYR,J)
943 PBLH(I,J)=MAX(PBLH(I,J),0.)
944 PBLH(I,J)=MIN(PBLH(I,J),Z(I,KTE,J))
945 ENDDO
946 ENDDO
947 !-----------------------------------------------------------------------
948 !
949 !*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS
950 !
951 !-----------------------------------------------------------------------
952 !$omp parallel do &
953 !$omp& private(i,j,k,rwmsk,wmsk)
954 DO J=MYJS1_P1,MYJE1_P1
955 !
956 DO K=KTS,KTE
957 DO I=MYIS_P1,MYIE_P1
958 WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J) &
959 & +VTM(I,K,J+1)+VTM(I,K,J-1)
960 IF(WMSK>0.)THEN
961 RWMSK=1./WMSK
962 U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &
963 & +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &
964 & +U(I,K,J+1)*VTM(I,K,J+1) &
965 & +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK
966 V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &
967 & +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &
968 & +V(I,K,J+1)*VTM(I,K,J+1) &
969 & +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK
970 ELSE
971 U_PHY(I,K,J)=0.
972 V_PHY(I,K,J)=0.
973 ENDIF
974 ENDDO
975 ENDDO
976 ENDDO
977 !
978 !$omp parallel do &
979 !$omp& private(i,iend,istr,j)
980 DO J=MYJS1_P1,MYJE1_P1
981 IF(MOD(J,2)==0)THEN
982 ISTR=MYIS_P1
983 IEND=MIN(MYIE_P1,IDE-1)
984 ELSE
985 ISTR=MAX(MYIS_P1,IDS+1)
986 IEND=MIN(MYIE_P1,IDE-1)
987 ENDIF
988 !
989 DO I=ISTR,IEND
990 UZ0H(I,J)=(UZ0(I+IHE(J),J)+UZ0(I+IHW(J),J) &
991 & +UZ0(I,J+1)+UZ0(I,J-1))*0.25
992 !!! & +UZ0(I,J+1)+UZ0(I,J-1))*HBM2(I,J)*0.25
993 VZ0H(I,J)=(VZ0(I+IHE(J),J)+VZ0(I+IHW(J),J) &
994 & +VZ0(I,J+1)+VZ0(I,J-1))*0.25
995 !!! & +VZ0(I,J+1)+VZ0(I,J-1))*HBM2(I,J)*0.25
996 ENDDO
997 ENDDO
998 !-----------------------------------------------------------------------
999 !
1000 !*** CALL SURFACE LAYER AND LAND SURFACE PHYSICS
1001 !
1002 !-----------------------------------------------------------------------
1003 !
1004 CALL SET_TILES(GRID,IDS,IDE-1,JDS+1,JDE-1,ITS,ITE,JTS,JTE)
1005 !
1006 DO J=JTS,JTE !jm was JTS
1007 DO I=ITS,ITE
1008 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
1009 ONE(I,J)=1.
1010 ELSE
1011 !tgs - MAVAIL should not be equal to 1. for other LSMs
1012 ONE(I,J)=MAVAIL(I,J)
1013 ENDIF
1014 ENDDO
1015 ENDDO
1016 !
1017 CALL SURFACE_DRIVER( &
1018 & ACSNOM=ACSNOM,ACSNOW=ACSNOW,AKHS=AKHS,AKMS=AKMS &
1019 & ,ALBEDO=ALBEDO,BR=BR,CANWAT=CMC,CHKLOWQ=CHKLOWQ &
1020 & ,DT=DT,DX=DX,DZ8W=DZ,DZS=DZSOIL,GLW=RLW_DN_SFC &
1021 & ,GRDFLX=GRNFLX,GSW=RSW_NET_SFC,SWDOWN=RSW_DN_SFC &
1022 & ,GZ1OZ0=GZ1OZ0,HFX=TWBS &
1023 & ,HT=SFCZ,IFSNOW=IDUMMY,ISFFLX=ISFFLX,ISLTYP=ISLTYP &
1024 & ,ITIMESTEP=NTSD,IVGTYP=IVGTYP,LOWLYR=LOWLYR &
1025 & ,MAVAIL=ONE,RMOL=RMOL,NUM_SOIL_LAYERS=NSOIL,P8W=P8W &
1026 & ,PBLH=PBLH,PI_PHY=PI_PHY,PSHLTR=PSHLTR,PSIH=PSIH &
1027 & ,PSIM=PSIM,P_PHY=P_PHY,Q10=Q10,Q2=Q2X,QFX=QWBS,QSFC=QS &
1028 & ,QSHLTR=QSHLTR,QZ0=QZ0,RAINCV=RAIN &
1029 & ,RHO=RR,SFCEVP=SFCEVPX,SFCEXC=SFCEXC,SFCRUNOFF=SSROFF &
1030 & ,SMOIS=SMC,SMSTAV=SMSTAV,SMSTOT=SMSTOT,SNOALB=MXSNAL &
1031 & ,SNOW=SNOW,SNOWC=SNOWC,SNOWH=SNOWH,STEPBL=NPHS &
1032 & ,SST=SST,SST_UPDATE=SST_UPDATE &
1033 & ,TH10=TH10,TH2=TH2X,T2=T2,THZ0=THZ0,TH_PHY=TH_PHY &
1034 & ,TMN=TG,TSHLTR=TSHLTR,TSK=TSFC,TSLB=STC,T_PHY=T_PHY &
1035 & ,U10=U10,UDRUNOFF=BGROFF,UST=USTAR,UZ0=UZ0H &
1036 & ,U_FRAME=U_FRAME,U_PHY=U_PHY,V10=V10,VEGFRA=VGFRCK &
1037 & ,VZ0=VZ0H,V_FRAME=V_FRAME,V_PHY=V_PHY &
1038 & ,WARM_RAIN=WARM_RAIN,WSPD=WSPD,XICE=SICE &
1039 & ,XLAND=XLAND,Z=Z,ZNT=Z0,ZS=SLDPTH,CT=CT,TKE_MYJ=TKE &
1040 & ,ALBBCK=ALBASE,LH=ELFLX,SH2O=SH2O,SHDMAX=SHDMAX &
1041 & ,SHDMIN=SHDMIN,Z0=Z0BASE,FLQC=FLQC,FLHC=FLHC &
1042 & ,PSFC=PSFC_OUT,EMISS=EPSR &
1043 & ,SF_SFCLAY_PHYSICS=CONFIG_FLAGS%SF_SFCLAY_PHYSICS &
1044 & ,SF_SURFACE_PHYSICS=CONFIG_FLAGS%SF_SURFACE_PHYSICS &
1045 & ,RA_LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &
1046 & ,UCMCALL=ucmcall &
1047 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1048 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1049 & ,I_START=GRID%I_START,I_END=GRID%I_END &
1050 & ,J_START=GRID%J_START,J_END=GRID%J_END &
1051 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
1052 ! Optional args
1053 & ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV &
1054 & ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC &
1055 & ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR &
1056 & ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI &
1057 & ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS &
1058 & ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG &
1059 & ,RAINBL=RAINBL &
1060 ! for RUCLSM
1061 & ,QSG=QSG, QVG=QVG, QCG=QCG, SOILT1=SOILT1 &
1062 & ,TSNAV=TSNAV, SMFR3D=SMFR3D, KEEPFR3DFLAG=KEEPFR3DFLAG &
1063 & ,POTEVP=POTEVP,SNOPCX=SNOPCX,SOILTB=SOILTB,SR=SR)
1064 !
1065 !-----------------------------------------------------------------------
1066 !
1067 !*** CALL FREE ATMOSPHERE TURBULENCE
1068 !
1069 !-----------------------------------------------------------------------
1070 !
1071 !$omp parallel do &
1072 !$omp& private(i,j,k)
1073 DO J=JMS,JME
1074 DO K=KMS,KME
1075 DO I=IMS,IME
1076 DUDT(I,K,J)=0.
1077 DVDT(I,K,J)=0.
1078 ENDDO
1079 ENDDO
1080 ENDDO
1081 !
1082 !*** THE SURFACE EXCHANGE COEFFICIENTS AKHS AND AKMS ARE ACTUALLY
1083 !*** MULTIPLIED BY HALF THE DEPTH OF THE LOWEST LAYER. WE MUST RETAIN
1084 !*** THOSE VALUES FOR THE NEXT TIMESTEP SO USE AUXILLIARY ARRAYS FOR
1085 !*** THE OUTPUT.
1086 !
1087 !$omp parallel do &
1088 !$omp& private(dzhalf,i,j)
1089 DO J=JTS,JTE
1090 DO I=ITS,ITE
1091 DZHALF=0.5*DZ(I,KTS,J)
1092 AKHS_OUT(I,J)=AKHS(I,J)*DZHALF
1093 AKMS_OUT(I,J)=AKMS(I,J)*DZHALF
1094 ENDDO
1095 ENDDO
1096 !
1097 CALL PBL_DRIVER( &
1098 & ITIMESTEP=NTSD,DT=DT &
1099 & ,U_FRAME=U_FRAME,V_FRAME=V_FRAME &
1100 & ,RUBLTEN=DUDT,RVBLTEN=DVDT,RTHBLTEN=RTHBLTEN &
1101 & ,RQVBLTEN=RQVBLTEN,RQCBLTEN=RQCBLTEN &
1102 & ,RQIBLTEN=RQIBLTEN &
1103 & ,TSK=TSFC,XLAND=XLAND,ZNT=Z0,HT=SFCZ &
1104 & ,UST=USTAR, PBLH=PBLH &
1105 & ,HFX=TWBS,QFX=QWBS, GRDFLX=GRNFLX &
1106 & ,U_PHY=U_PHY,V_PHY=V_PHY,TH_PHY=TH_PHY,RHO=RR &
1107 & ,P_PHY=P_PHY,PI_PHY=PI_PHY,P8W=P8W,T_PHY=T_PHY &
1108 & ,DZ8W=DZ,Z=Z,TKE_MYJ=TKE,EL_MYJ=EL_MYJ &
1109 & ,EXCH_H=EXCH_H,AKHS=AKHS,AKMS=AKMS &
1110 & ,THZ0=THZ0,QZ0=QZ0,UZ0=UZ0H,VZ0=VZ0H &
1111 & ,QSFC=QS,LOWLYR=LOWLYR &
1112 & ,PSIM=PSIM,PSIH=PSIH,GZ1OZ0=GZ1OZ0 &
1113 & ,WSPD=WSPD,BR=BR,CHKLOWQ=CHKLOWQ &
1114 & ,DX=DX,STEPBL=NPHS,WARM_RAIN=WARM_RAIN &
1115 & ,KPBL=KPBL,CT=CT,LH=ELFLX,SNOW=SNOW,XICE=SICE &
1116 & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics &
1117 & ,RA_LW_PHYSICS=config_flags%ra_lw_physics &
1118 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1119 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1120 & ,I_START=GRID%I_START,I_END=GRID%I_END &
1121 & ,J_START=GRID%J_START,J_END=GRID%J_END &
1122 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
1123 ! Optional args
1124 & ,QV_CURR=moist(IMS,KMS,JMS,P_QV) , F_QV=F_QV &
1125 & ,QC_CURR=moist(IMS,KMS,JMS,P_QC) , F_QC=F_QC &
1126 & ,QR_CURR=moist(IMS,KMS,JMS,P_QR) , F_QR=F_QR &
1127 & ,QI_CURR=moist(IMS,KMS,JMS,P_QI) , F_QI=F_QI &
1128 & ,QS_CURR=moist(IMS,KMS,JMS,P_QS) , F_QS=F_QS &
1129 & ,QG_CURR=moist(IMS,KMS,JMS,P_QG) , F_QG=F_QG )
1130 !
1131 !*** NOTE THAT THE EXCHANGE COEFFICIENTS FOR HEAT EXCH_H COMING OUT OF
1132 !*** PBL_DRIVER ARE DEFINED AT THE TOPS OF THE LAYERS KTS TO KTE-1
1133 !*** IF MODULE_BL_MYJPBL WAS INVOKED.
1134 !
1135 !-----------------------------------------------------------------------
1136 ! UNCOMPUTED LOCATIONS MUST BE FILLED IN FOR THE POST-PROCESSOR
1137 !-----------------------------------------------------------------------
1138 !
1139 !*** EASTERN GLOBAL BOUNDARY
1140 !
1141 IF(MYIE==IDE)THEN
1142 !$omp parallel do &
1143 !$omp& private(i,j)
1144 DO J=JDS,JDE
1145 IF (J>=MYJS.AND.J<=MYJE)THEN
1146 TH10(MYIE,J)=TH10(MYIE-1,J)
1147 Q10(MYIE,J)=Q10(MYIE-1,J)
1148 U10(MYIE,J)=U10(MYIE-1,J)
1149 V10(MYIE,J)=V10(MYIE-1,J)
1150 TSHLTR(MYIE,J)=TSHLTR(MYIE-1,J)
1151 QSHLTR(MYIE,J)=QSHLTR(MYIE-1,J)
1152 ENDIF
1153 ENDDO
1154 ENDIF
1155 !
1156 !*** SOUTHERN GLOBAL BOUNDARY
1157 !
1158
1159 IF(MYJS==1)THEN
1160 DO J=1,2
1161 DO I=IDS,IDE
1162 IF (I>=MYIS.AND.I<=MYIE) THEN
1163 TH10(I,J)=TH10(I,MYJS+2)
1164 Q10(I,J)=Q10(I,MYJS+2)
1165 U10(I,J)=U10(I,MYJS+2)
1166 V10(I,J)=V10(I,MYJS+2)
1167 TSHLTR(I,J)=TSHLTR(I,MYJS+2)
1168 QSHLTR(I,J)=QSHLTR(I,MYJS+2)
1169 ENDIF
1170 ENDDO
1171 ENDDO
1172 ENDIF
1173 !
1174 !*** NORTHERN GLOBAL BOUNDARY
1175 !
1176 IF(MYJE==JDE)THEN
1177 !$omp parallel do &
1178 !$omp& private(i,j)
1179 DO J=MYJE-1,MYJE
1180 DO I=IDS,IDE
1181 IF (I>=MYIS.AND.I<=MYIE) THEN
1182 TH10(I,J)=TH10(I,MYJE-2)
1183 Q10(I,J)=Q10(I,MYJE-2)
1184 U10(I,J)=U10(I,MYJE-2)
1185 V10(I,J)=V10(I,MYJE-2)
1186 TSHLTR(I,J)=TSHLTR(I,MYJE-2)
1187 QSHLTR(I,J)=QSHLTR(I,MYJE-2)
1188 ENDIF
1189 ENDDO
1190 ENDDO
1191 ENDIF
1192 !
1193 IF(CONFIG_FLAGS%SF_SFCLAY_PHYSICS==1)THEN ! non-NMM package
1194 !$omp parallel do &
1195 !$omp& private(i,j)
1196 DO J=MYJS1,MYJE1
1197 DO I=MYIS,MYIE1
1198 ! TSHLTR(I,J)=TSHLTR(I,J)*(1.E5/PSHLTR(I,J))**RCP
1199 IF(TSHLTR(I,J)<200..OR.TSHLTR(I,J)>350.)THEN
1200 WRITE(0,*)'Troublesome TSHLTR...I,J,TSHLTR,PSHLTR: ', &
1201 I,J,TSHLTR(I,J),PSHLTR(I,J)
1202 ENDIF
1203 ENDDO
1204 ENDDO
1205 ENDIF
1206 !
1207 !-----------------------------------------------------------------------
1208 !*** COMPUTE MODEL LAYER CONTAINING THE TOP OF THE BOUNDARY LAYER
1209 !-----------------------------------------------------------------------
1210 !
1211 IF(CONFIG_FLAGS%BL_PBL_PHYSICS/=MYJPBLSCHEME)THEN
1212 LENGTH_ROW=MYIE1-MYIS1+1
1213 DO J=MYJS2,MYJE2
1214 DO I=MYIS1,MYIE1
1215 KPBL(I,J)=-1000
1216 ENDDO
1217 ENDDO
1218 !
1219 !$omp parallel do &
1220 !$omp& private(altitude,i,j,k,kount_all)
1221 DO J=MYJS2,MYJE2
1222 KOUNT_ALL=0
1223 find_kpbl : DO K=KTS,KTE
1224 DO I=MYIS1,MYIE1
1225 ALTITUDE=Z(I,K+1,J)-SFCZ(I,J)
1226 IF(PBLH(I,J)<=ALTITUDE.AND.KPBL(I,J)<0)THEN
1227 KPBL(I,J)=K
1228 KOUNT_ALL=KOUNT_ALL+1
1229 ENDIF
1230 IF(KOUNT_ALL==LENGTH_ROW)EXIT find_kpbl
1231 ENDDO
1232 ENDDO find_kpbl
1233 ENDDO
1234 ENDIF
1235 !
1236 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
1237 SNO_FACTR=1.
1238 ELSE
1239 SNO_FACTR=1000.
1240 ENDIF
1241 !
1242 !$omp parallel do &
1243 !$omp& private(i,j)
1244 DO J=MYJS2,MYJE2
1245 DO I=MYIS1,MYIE1
1246 SNO(I,J)=SNOW(I,J)
1247 SI(I,J)=SNOWH(I,J)*SNO_FACTR
1248 LPBL(I,J)=KTE-KPBL(I,J)+1
1249 ENDDO
1250 ENDDO
1251 !
1252 !-----------------------------------------------------------------------
1253 !*** DIAGNOSTIC RADIATION ACCUMULATION
1254 !-----------------------------------------------------------------------
1255 !
1256 !$omp parallel do &
1257 !$omp& private(i,j,tsfc2)
1258 DO J=MYJS2,MYJE2
1259 DO I=MYIS,MYIE
1260 ASWIN (I,J)=ASWIN (I,J)+RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
1261 ASWOUT(I,J)=ASWOUT(I,J)-RSWOUT(I,J)*HBM2(I,J)*FACTRS(I,J)
1262 ASWTOA(I,J)=ASWTOA(I,J)+RSWTOA(I,J)*HBM2(I,J)*FACTRS(I,J)
1263 ALWIN (I,J)=ALWIN (I,J)+RLW_DN_SFC(I,J)
1264 ALWOUT(I,J)=ALWOUT(I,J)-RADOT (I,J)*HBM2(I,J)
1265 ALWTOA(I,J)=ALWTOA(I,J)+RLWTOA(I,J)*HBM2(I,J)
1266 !
1267 TSFC2=TSFC(I,J)*TSFC(I,J)
1268 RADOT(I,J)=HBM2(I,J)*EPSR(I,J)*STBOLT*TSFC2*TSFC2
1269 THS(I,J)=TSFC(I,J)*EXNSFC(I,J)
1270 PREC(I,J)=0.
1271 ENDDO
1272 ENDDO
1273 !
1274 !-----------------------------------------------------------------------
1275 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD, AND TKE.
1276 !-----------------------------------------------------------------------
1277 !
1278 E_BDY=(ITE>=IDE)
1279 !
1280 !$omp parallel do &
1281 !$omp& private(dqdt,dtdt,i,iend,j,k,qi,qold,qr,qw,ratiomx,i_m)
1282 DO J=MYJS2,MYJE2
1283 IEND=MYIE1
1284 IF(E_BDY.AND.MOD(J,2)==0)IEND=IEND-1
1285 !
1286 DO K=KTS,KTE
1287 DO I=MYIS1,IEND
1288 DTDT=RTHBLTEN(I,K,J)*PI_PHY(I,K,J)
1289 DQDT=RQVBLTEN(I,K,J) !Mixing ratio tendency
1290 T(I,K,J)=T(I,K,J)+DTDT*DTPHS
1291 QOLD=Q(I,K,J)
1292 RATIOMX=QOLD/(1.-QOLD)+DQDT*DTPHS
1293 Q(I,K,J)=RATIOMX/(1.+RATIOMX)
1294 ! Q(I,K,J)=MAX(Q(I,K,J),EPSQ)
1295 QW=max(0.,MOIST(I,K,J,P_QC)+RQCBLTEN(I,K,J)*DTPHS )
1296 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
1297 QI=max(0.,MOIST(I,K,J,P_QS)+RQIBLTEN(I,K,J)*DTPHS )
1298 ELSE
1299 QI=max(0.,MOIST(I,K,J,P_QI)+RQIBLTEN(I,K,J)*DTPHS )
1300 ENDIF
1301 QR=max(0.,MOIST(I,K,J,P_QR) )
1302 ! CWM(I,K,J)=QW+QI+QR
1303 CWM(I,K,J)=0.
1304 !
1305 DO I_M=1,N_MOIST
1306 IF(I_M/=P_QV)THEN
1307 CWM(I,K,J)=CWM(I,K,J)+MOIST(I,K,J,I_M)
1308 ENDIF
1309 IF(I_M==P_QV)THEN
1310 MOIST(I,K,J,P_QV)=MAX(EPSQ,(MOIST(I,K,J,P_QV) + RQVBLTEN(I,K,J)*DTPHS) )
1311 ELSEIF (I_M==P_QC)THEN
1312 CWM(I,K,J)=MAX(0., (CWM(I,K,J) + RQCBLTEN(I,K,J)*DTPHS) )
1313 ELSEIF(I_M==P_QI)THEN
1314 CWM(I,K,J)=MAX(0., (CWM(I,K,J) + RQIBLTEN(I,K,J)*DTPHS) )
1315 ENDIF
1316 ENDDO
1317 !
1318 MOIST(I,K,J,P_QC)=QW
1319 MOIST(I,K,J,P_QR)=QR
1320 !
1321 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
1322 MOIST(I,K,J,P_QS)=QI
1323 IF(QI<=EPSQ)THEN
1324 F_ICE(I,K,J)=0.
1325 ELSE
1326 F_ICE(I,K,J)=MAX(0.,MIN(1.,QI/CWM(I,K,J)))
1327 ENDIF
1328 !
1329 IF(QR<=EPSQ)THEN
1330 F_RAIN(I,K,J)=0.
1331 ELSE
1332 F_RAIN(I,K,J)=QR/(QW+QR)
1333 ENDIF
1334 ELSE
1335 MOIST(I,K,J,P_QI)=QI
1336 ENDIF
1337 !
1338 Q2(I,K,J)=2.*TKE(I,K,J)
1339 ENDDO
1340 ENDDO
1341 !
1342 ENDDO
1343 !
1344 !-----------------------------------------------------------------------
1345 !***
1346 !*** SAVE SURFACE-RELATED FIELDS.
1347 !***
1348 !-----------------------------------------------------------------------
1349 !$omp parallel do &
1350 !$omp& private(i,j,llij,xlvrw)
1351 DO J=MYJS2,MYJE2
1352 DO I=MYIS1,MYIE1
1353 LLIJ=LOWLYR(I,J)
1354 !
1355 !-----------------------------------------------------------------------
1356 !*** INSTANTANEOUS SENSIBLE AND LATENT HEAT FLUX
1357 !-----------------------------------------------------------------------
1358 !
1359 TWBS(I,J)=-TWBS(I,J)
1360 QWBS(I,J)=-QWBS(I,J)*XLV*CHKLOWQ(I,J)
1361 !
1362 !-----------------------------------------------------------------------
1363 !*** ACCUMULATED QUANTITIES.
1364 !*** IN OPNL LSM, SFCEVP APPEARS TO BE IN UNITS OF
1365 !*** METERS OF LIQUID WATER. IT IS COMING FROM
1366 !*** WRF MODULE AS KG/M**2.
1367 !-----------------------------------------------------------------------
1368 !
1369 SFCSHX(I,J)=SFCSHX(I,J)+TWBS(I,J)
1370 SFCLHX(I,J)=SFCLHX(I,J)+QWBS(I,J)
1371 XLVRW=DTPHS/(XLV*RHOWATER)
1372 SFCEVP(I,J)=SFCEVP(I,J)-QWBS(I,J)*XLVRW
1373 POTEVP(I,J)=POTEVP(I,J)-QWBS(I,J)*SM(I,J)*XLVRW
1374 POTFLX(I,J)=POTEVP(I,J)*FACTOR
1375 SUBSHX(I,J)=SUBSHX(I,J)+GRNFLX(I,J)
1376 ENDDO
1377 ENDDO
1378 !
1379 !-----------------------------------------------------------------------
1380 !*** COUNTERS
1381 !-----------------------------------------------------------------------
1382 !
1383 APHTIM=APHTIM+1.
1384 ARDSW =ARDSW +1.
1385 ARDLW =ARDLW +1.
1386 ASRFC =ASRFC +1.
1387 !-----------------------------------------------------------------------
1388 !
1389 END SUBROUTINE TURBL
1390 !
1391 !-----------------------------------------------------------------------
1392 !***********************************************************************
1393 SUBROUTINE UV_H_TO_V(NTSD,DT,NPHS,UZ0H,VZ0H,UZ0,VZ0 &
1394 & ,DUDT,DVDT,U,V,HBM2,VTM,IVE,IVW &
1395 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1396 & ,IMS,IME,JMS,JME,KMS,KME &
1397 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1398 !***********************************************************************
1399 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1400 ! . . .
1401 ! SUBPROGRAM: UV_H_TO_V INTERPOLATE WINDS FROM H TO V POINTS
1402 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 05-02-22
1403 !
1404 ! ABSTRACT:
1405 ! INTERPOLATE WINDS BACK TO V POINTS AFTER TURBULENCE
1406 !
1407 ! PROGRAM HISTORY LOG :
1408 ! 05-02-22 BLACK - ORIGINATOR
1409 !
1410 ! USAGE: CALL TURBL FROM SOLVE_NMM
1411 !
1412 ! ATTRIBUTES:
1413 ! LANGUAGE: FORTRAN 90
1414 ! MACHINE : IBM
1415 !$$$
1416 !-----------------------------------------------------------------------
1417 !
1418 IMPLICIT NONE
1419 !
1420 !-----------------------------------------------------------------------
1421 !
1422 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1423 & ,IMS,IME,JMS,JME,KMS,KME &
1424 & ,ITS,ITE,JTS,JTE,KTS,KTE &
1425 & ,NPHS,NTSD
1426 !
1427 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IVE,IVW
1428 !
1429 REAL,INTENT(IN) :: DT
1430 !
1431 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,UZ0H,VZ0H
1432 !
1433 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DUDT,DVDT &
1434 & ,VTM
1435 !
1436 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: UZ0,VZ0
1437 !
1438 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: U,V
1439 !
1440 !-----------------------------------------------------------------------
1441 !***
1442 !*** LOCAL VARIABLES
1443 !***
1444 !-----------------------------------------------------------------------
1445 !
1446 INTEGER :: I,IEND,J,K
1447 !
1448 REAL :: DTPHS
1449 !
1450 LOGICAL :: E_BDY
1451 !
1452 !-----------------------------------------------------------------------
1453 !-----------------------------------------------------------------------
1454 !
1455 DTPHS=NPHS*DT
1456 E_BDY=(ITE>=IDE)
1457 !
1458 !-----------------------------------------------------------------------
1459 !*** RECONSTRUCT UZ0 AND VZ0 ON VELOCITY POINTS.
1460 !-----------------------------------------------------------------------
1461 !
1462 !$omp parallel do &
1463 !$omp& private(i,j)
1464 DO J=MYJS2,MYJE2
1465 DO I=MYIS,MYIE
1466 UZ0(I,J)=(UZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &
1467 & +UZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &
1468 & +UZ0H(I,J+1)*HBM2(I,J+1)+UZ0H(I,J-1)*HBM2(I,J-1))*0.25
1469 VZ0(I,J)=(VZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &
1470 & +VZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &
1471 & +VZ0H(I,J+1)*HBM2(I,J+1)+VZ0H(I,J-1)*HBM2(I,J-1))*0.25
1472 ENDDO
1473 ENDDO
1474 !
1475 !-----------------------------------------------------------------------
1476 !*** INTERPOLATE WIND TENDENCIES TO VELOCITY POINTS AND UPDATE WINDS.
1477 !-----------------------------------------------------------------------
1478 !
1479 !$omp parallel do &
1480 !$omp& private(i,iend,j,k)
1481 DO J=MYJS2,MYJE2
1482 IEND=MYIE1
1483 IF(E_BDY.AND.MOD(J,2)==1)IEND=IEND-1
1484 !
1485 DO K=KTS,KTE
1486 DO I=MYIS1,IEND
1487 U(I,K,J)=(DUDT(I+IVE(J),K,J)+DUDT(I+IVW(J),K,J) &
1488 & +DUDT(I,K,J+1)+DUDT(I,K,J-1))*0.25*DTPHS &
1489 & *VTM(I,K,J)+U(I,K,J)
1490 V(I,K,J)=(DVDT(I+IVE(J),K,J)+DVDT(I+IVW(J),K,J) &
1491 & +DVDT(I,K,J+1)+DVDT(I,K,J-1))*0.25*DTPHS &
1492 & *VTM(I,K,J)+V(I,K,J)
1493 ENDDO
1494 ENDDO
1495 ENDDO
1496 !-----------------------------------------------------------------------
1497 !
1498 END SUBROUTINE UV_H_TO_V
1499 !
1500 !-----------------------------------------------------------------------
1501 !***********************************************************************
1502 SUBROUTINE CUCNVC(NTSD,DT,NCNVC,NRADS,NRADL &
1503 & ,GPS,RESTRT,HYDRO &
1504 & ,CLDEFI,LMH,N_MOIST,ENSDIM &
1505 & ,MOIST &
1506 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
1507 & ,F_ICE,F_RAIN &
1508 !*** Changes for other cu-schemes, most for gd scheme
1509 & ,APR_GR,APR_W,APR_MC,TTEN,QTEN &
1510 & ,APR_ST,APR_AS,APR_CAPMA &
1511 & ,APR_CAPME ,APR_CAPMI &
1512 & ,MASS_FLUX ,XF_ENS &
1513 & ,PR_ENS,GSW &
1514 #ifdef WRF_CHEM
1515 & ,GD_CLOUD,GD_CLOUD2,RAINCV &
1516 #endif
1517 !
1518 & ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN &
1519 & ,OMGALF,U,V,VTM,WINT,Z,FIS,W0AVG &
1520 & ,PREC,ACPREC,CUPREC,CUPPT,CPRATE &
1521 & ,SM,HBM2,LPBL,CNVBOT,CNVTOP &
1522 & ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS &
1523 & ,RTHBLTEN,RQVBLTEN,RTHRATEN &
1524 & ,AVCNVC,ACUTIM,ZERO_3D,IHE,IHW &
1525 & ,GRID,CONFIG_FLAGS &
1526 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1527 & ,IMS,IME,JMS,JME,KMS,KME &
1528 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1529 !***********************************************************************
1530 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1531 ! . . .
1532 ! SUBPROGRAM: CUCNVC CONVECTIVE PRECIPITATION OUTER DRIVER
1533 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-21
1534 !
1535 ! ABSTRACT:
1536 ! CUCVNC DRIVES THE WRF CONVECTION SCHEMES
1537 !
1538 ! PROGRAM HISTORY LOG:
1539 ! 02-03-21 BLACK - ORIGINATOR
1540 ! 04-11-18 BLACK - THREADED
1541 !
1542 ! USAGE: CALL CUCNVC FROM SOLVE_NMM
1543 !
1544 ! ATTRIBUTES:
1545 ! LANGUAGE: FORTRAN 90
1546 ! MACHINE : IBM
1547 !$$$
1548 !-----------------------------------------------------------------------
1549 !
1550 IMPLICIT NONE
1551 !
1552 !-----------------------------------------------------------------------
1553 !
1554 INTEGER,INTENT(IN) :: ENSDIM &
1555 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1556 & ,IMS,IME,JMS,JME,KMS,KME &
1557 & ,ITS,ITE,JTS,JTE,KTS,KTE &
1558 & ,N_MOIST,NCNVC,NTSD,NRADS,NRADL
1559 !
1560 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW
1561 !
1562 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH,LPBL
1563 !
1564 REAL,INTENT(IN) :: DT,GPS,PDTOP,PT
1565 !
1566 REAL,INTENT(INOUT) :: ACUTIM,AVCNVC
1567 !
1568 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
1569 REAL,DIMENSION(KMS:KME ),INTENT(IN) :: ETA1,ETA2
1570 !
1571 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
1572 !
1573 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,CLDEFI &
1574 & ,CNVBOT,CNVTOP &
1575 & ,CUPPT,CUPREC &
1576 & ,HBOT,HTOP &
1577 & ,HBOTD,HTOPD &
1578 & ,HBOTS,HTOPS &
1579 & ,APR_GR,APR_W,APR_MC &
1580 & ,APR_ST,APR_AS,APR_CAPMA &
1581 & ,APR_CAPME ,APR_CAPMI &
1582 & ,MASS_FLUX &
1583 & ,GSW ,PREC,CPRATE
1584 !
1585 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE &
1586 & ,F_RAIN
1587 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: TTEN &
1588 & ,QTEN &
1589 & ,RTHBLTEN,RQVBLTEN,RTHRATEN
1590
1591 !
1592 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: Q,T &
1593 & ,CWM &
1594 & ,TCUCN &
1595 & ,W0AVG &
1596 & ,WINT
1597 !
1598 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: OMGALF &
1599 & ,PINT,U,V &
1600 & ,VTM,Z
1601 !
1602 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
1603 REAL,DIMENSION(IMS:IME,jMS:jME,1:ENSDIM),INTENT(INOUT) :: &
1604 & XF_ENS &
1605 & ,PR_ENS
1606
1607 !
1608 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,N_MOIST) &
1609 & ,INTENT(INOUT) :: moist
1610 #ifdef WRF_CHEM
1611 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: GD_CLOUD &
1612 & ,GD_CLOUD2
1613 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: RAINCV
1614 #endif
1615 !
1616 LOGICAL,INTENT(IN) :: HYDRO,RESTRT
1617 !
1618 TYPE(DOMAIN),TARGET :: GRID
1619 !
1620 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
1621 !
1622 !-----------------------------------------------------------------------
1623 !***
1624 !*** LOCAL VARIABLES
1625 !***
1626 !-----------------------------------------------------------------------
1627 INTEGER :: I,ICLDCK,IENDX,J,K,MNTO,NCUBOT,NCUTOP,NSTEP_CNV &
1628 & ,N_TIMSTPS_OUTPUT
1629 !
1630 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LBOT,LOWLYR,LTOP
1631 !
1632 REAL :: CAPA,CF_HI,DPL,DQDT,DTCNVC,DTDT,FICE,FRAIN,G_INV &
1633 & ,PCPCOL,PDSL,PLYR,QI,QL_K,QR,QW,RDTCNVC,RWMSK,WMSK,WC
1634 !
1635 REAL,DIMENSION(KMS:KME-1) :: QL,TL
1636 !
1637 REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,NCA,RAINC &
1638 & ,SFCZ,XLAND
1639 !
1640 #ifndef WRF_CHEM
1641 REAL,DIMENSION(IMS:IME,JMS:JME) :: RAINCV
1642 #endif
1643 !
1644 REAL,DIMENSION(IMS:IME,KMS:KME) :: WMID
1645 !
1646 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &
1647 & ,RQCCUTEN,RQRCUTEN &
1648 & ,RQICUTEN,RQSCUTEN &
1649 & ,RQVCUTEN,RR,RTHCUTEN &
1650 & ,T_PHY,TH_PHY &
1651 & ,U_PHY,V_PHY
1652 !
1653 REAL,DIMENSION(IMS:IME,JMS:JME) :: ZERO_2D
1654 REAL,DIMENSION(IMS:IME,JMS:JME,ENSDIM) :: ZERO_GD
1655 !
1656 LOGICAL :: RESTART,WARM_RAIN
1657 LOGICAL,DIMENSION(IMS:IME,JMS:JME) :: CU_ACT_FLAG
1658 !
1659 !-----------------------------------------------------------------------
1660 !*** FOR TEMPERATURE CHANGE CHECK ONLY.
1661 !-----------------------------------------------------------------------
1662 INTEGER :: DTEMP_CHECK=1.0
1663 REAL :: TCHANGE
1664 !-----------------------------------------------------------------------
1665 !***********************************************************************
1666 !-----------------------------------------------------------------------
1667 !*** RESET THE HBOT/HTOP CONVECTIVE CLOUD BOTTOM (BASE) AND TOP ARRAYS
1668 !*** USED IN RADIATION. THEY STORE THE MAXIMUM VERTICAL LIMITS OF
1669 !*** CONVECTIVE CLOUD BETWEEN RADIATION CALLS. CUPPT IS THE ACCUMULATED
1670 !*** CONVECTIVE PRECIPITATION BETWEEN RADIATION CALLS.
1671 !-----------------------------------------------------------------------
1672 !
1673 IF(MOD(NTSD,NRADS)==0.OR.MOD(NTSD,NRADL)==0)THEN
1674 DO J=JMS,JME
1675 DO I=IMS,IME
1676 HTOP(I,J)=0.
1677 HBOT(I,J)=REAL(KTE+1)
1678 CUPPT(I,J)=0.
1679 ENDDO
1680 ENDDO
1681 ENDIF
1682 !-----------------------------------------------------------------------
1683 IF(MOD(NTSD,NCNVC)/=0.AND. &
1684 & CONFIG_FLAGS%CU_PHYSICS==BMJSCHEME)RETURN
1685 IF(MOD(NTSD,NCNVC)/=0.AND. &
1686 & CONFIG_FLAGS%CU_PHYSICS==SASSCHEME)RETURN
1687 !-----------------------------------------------------------------------
1688 NSTEP_CNV=NCNVC
1689 !
1690 RESTART=RESTRT
1691 !-----------------------------------------------------------------------
1692 IF(CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN
1693 !
1694 IF(.NOT.RESTART.AND.NTSD==0)THEN
1695 !$omp parallel do &
1696 !$omp& private(i,j,k)
1697 DO J=JTS,JTE
1698 DO K=KTS,KTE
1699 DO I=ITS,ITE
1700 W0AVG(I,K,J)=0.
1701 ENDDO
1702 ENDDO
1703 ENDDO
1704 ENDIF
1705 !
1706 ENDIF
1707 !
1708 !-----------------------------------------------------------------------
1709 !*** GENERAL PREPARATION
1710 !-----------------------------------------------------------------------
1711 !
1712 AVCNVC=AVCNVC+1.
1713 ACUTIM=ACUTIM+1.
1714 !
1715 DTCNVC=NCNVC*DT
1716 RDTCNVC=1./DTCNVC
1717 CAPA=R_D/CP
1718 G_INV=1./G
1719 !
1720 !$omp parallel do &
1721 !$omp& private(dpl,fice,frain,i,j,k,pdsl,plyr,ql,tl)
1722 DO J=MYJS2,MYJE2
1723 DO I=MYIS1,MYIE1
1724 !
1725 PDSL=PD(I,J)*RES(I,J)
1726 RAINCV(I,J)=0.
1727 RAINC(I,J)=0.
1728 P8W(I,KTS,J)=PD(I,J)+PDTOP+PT
1729 LOWLYR(I,J)=KTE+1-LMH(I,J)
1730 XLAND(I,J)=SM(I,J)+1.
1731 NCA(I,J)=0.
1732 SFCZ(I,J)=FIS(I,J)*G_INV
1733 !tgs
1734 CUTOP(I,J)=HTOP(I,J)
1735 CUBOT(I,J)=HBOT(I,J)
1736 !
1737 !*** LPBL IS THE MODEL LAYER CONTAINING THE PBL TOP
1738 !*** COUNTING DOWNWARD FROM THE TOP OF THE DOMAIN
1739 !*** SO KPBL IS THE SAME LAYER COUNTING UPWARD FROM
1740 !*** THE GROUND.
1741 !
1742 KPBL(I,J)=KTE-LPBL(I,J)+1
1743 ZERO_2D(I,J)=0
1744 !
1745 DO K=KTS,KTE
1746 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
1747 QL(K)=AMAX1(Q(I,K,J),EPSQ)
1748 PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
1749 TL(K)=T(I,K,J)
1750 !
1751 RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
1752 T_PHY(I,K,J)=TL(K)
1753
1754 TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
1755 !!! P8W(I,KFLIP,J)=PINT(I,K+1,J)
1756 P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL+PT
1757 P_PHY(I,K,J)=PLYR
1758 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
1759 !
1760 RTHCUTEN(I,K,J)=0.
1761 RQVCUTEN(I,K,J)=0.
1762 RQCCUTEN(I,K,J)=0.
1763 RQRCUTEN(I,K,J)=0.
1764 RQICUTEN(I,K,J)=0.
1765 RQSCUTEN(I,K,J)=0.
1766 ENDDO
1767 !
1768 ENDDO
1769 ENDDO
1770 !
1771 !-----------------------------------------------------------------------
1772 !
1773
1774 IF(.NOT.HYDRO)THEN
1775 !$omp parallel do &
1776 !$omp& private(i,j,k)
1777 DO J=MYJS2,MYJE2
1778 DO K=KTS,KTE
1779 DO I=MYIS1,MYIE1
1780 DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)
1781 ENDDO
1782 ENDDO
1783 ENDDO
1784 !
1785 IF(NTSD==0)THEN
1786 !$omp parallel do &
1787 !$omp& private(i,j,k)
1788 DO J=MYJS2,MYJE2
1789 DO K=KTS,KTE
1790 DO I=MYIS1,MYIE1
1791 WINT(I,K,J)=0.
1792 ENDDO
1793 ENDDO
1794 ENDDO
1795 ENDIF
1796 ELSE
1797 DO J=MYJS2,MYJE2
1798 DO I=MYIS1,MYIE1
1799 WINT(I,1,J)=0.
1800 WINT(I,KTE+1,J)=0.
1801 ENDDO
1802 ENDDO
1803 !
1804 !$omp parallel do &
1805 !$omp& private(i,j,k,plyr,wmid)
1806 DO J=MYJS2,MYJE2
1807 DO I=MYIS1,MYIE1
1808 WMID(I,KTS)=-OMGALF(I,KTS,J)*CP/(G*DT)
1809 PDSL=PD(I,J)*RES(I,J)
1810 PLYR=AETA1(KTS)*PDTOP+AETA2(KTS)*PDSL+PT
1811 DZ(I,KTS,J)=T(I,KTS,J)*(P608*Q(I,KTS,J)+1.)*R_D &
1812 & *(P8W(I,KTS,J)-P8W(I,KTS+1,J)) &
1813 & /(PLYR*G)
1814 ENDDO
1815 !
1816 DO K=KTS+1,KTE
1817 DO I=MYIS1,MYIE1
1818 QL_K=AMAX1(Q(I,K,J),EPSQ)
1819 WMID(I,K)=-OMGALF(I,K,J)*CP/(G*DT)
1820 WINT(I,K,J)=0.5*(WMID(I,K-1)+WMID(I,K))
1821 DZ(I,K,J)=T_PHY(I,K,J)*(P608*QL_K+1.)*R_D &
1822 & *(P8W(I,K,J)-P8W(I,K+1,J)) &
1823 & /(P_PHY(I,K,J)*G)
1824 ENDDO
1825 ENDDO
1826 ENDDO
1827 !
1828 ENDIF
1829 !
1830 !-----------------------------------------------------------------------
1831 !*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS
1832 !-----------------------------------------------------------------------
1833 !
1834 IF(CONFIG_FLAGS%CU_PHYSICS.NE.BMJSCHEME)THEN
1835 !
1836 !$omp parallel do &
1837 !$omp& private(i,j,k,rwmsk,wmsk)
1838 DO J=MYJS1_P1,MYJE1_P1
1839 !
1840 DO K=KTS,KTE
1841 DO I=MYIS_P1,MYIE_P1
1842 WMSK=VTM(I+IHE(J),K,J)+VTM(I+IHW(J),K,J) &
1843 & +VTM(I,K,J+1)+VTM(I,K,J-1)
1844 IF(WMSK>0.)THEN
1845 RWMSK=1./WMSK
1846 U_PHY(I,K,J)=(U(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &
1847 & +U(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &
1848 & +U(I,K,J+1)*VTM(I,K,J+1) &
1849 & +U(I,K,J-1)*VTM(I,K,J-1))*RWMSK
1850 V_PHY(I,K,J)=(V(I+IHE(J),K,J)*VTM(I+IHE(J),K,J) &
1851 & +V(I+IHW(J),K,J)*VTM(I+IHW(J),K,J) &
1852 & +V(I,K,J+1)*VTM(I,K,J+1) &
1853 & +V(I,K,J-1)*VTM(I,K,J-1))*RWMSK
1854 ELSE
1855 U_PHY(I,K,J)=0.
1856 V_PHY(I,K,J)=0.
1857 ENDIF
1858 ENDDO
1859 ENDDO
1860 !
1861 ENDDO
1862 !
1863 ENDIF
1864 !-----------------------------------------------------------------------
1865 !
1866 !*** SINGLE-COLUMN CONVECTION
1867 !
1868 !-----------------------------------------------------------------------
1869 !
1870 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
1871 !
1872 CALL CUMULUS_DRIVER( &
1873 & IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1874 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1875 & ,I_START=GRID%I_START,I_END=GRID%I_END &
1876 & ,J_START=GRID%J_START,J_END=GRID%J_END &
1877 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
1878 ! Prognostic
1879 & ,U=U_PHY,V=V_PHY,TH=TH_PHY,T=T_PHY,W=WINT &
1880 & ,P=P_PHY,PI=PI_PHY,RHO=RR,W0AVG=W0AVG &
1881 ! Others
1882 & ,ITIMESTEP=NTSD,DT=DT,DX=GPS &
1883 & ,RAINC=RAINC,RAINCV=RAINCV,NCA=NCA &
1884 & ,DZ8W=DZ,P8W=P8W,FORCET=TTEN,FORCEQ=QTEN &
1885 & ,CLDEFI=cldefi,LOWLYR=lowlyr,XLAND=xland &
1886 & ,CU_ACT_FLAG=cu_act_flag,WARM_RAIN=warm_rain &
1887 & ,STEPCU=NSTEP_CNV,GSW=gsw &
1888 & ,HTOP=CUTOP,HBOT=CUBOT,KPBL=KPBL,HT=SFCZ &
1889 & ,APR_GR=apr_gr,APR_W=apr_w,APR_MC=apr_mc &
1890 & ,APR_ST=apr_st,APR_AS=apr_as,APR_CAPMA=apr_capma &
1891 & ,APR_CAPME=apr_capme,APR_CAPMI=apr_capmi &
1892 & ,MASS_FLUX=mass_flux,XF_ENS=xf_ens &
1893 & ,PR_ENS=pr_ens &
1894 #ifdef WRF_CHEM
1895 & ,gd_cloud=gd_cloud,gd_cloud2=gd_cloud2 &
1896 #endif
1897
1898 & ,ENSDIM=ENSDIM,MAXIENS=1,MAXENS=3 &
1899 & ,MAXENS2=3,MAXENS3=16 &
1900 & ,RTHCUTEN=RTHCUTEN ,RQVCUTEN=RQVCUTEN &
1901 & ,RQCCUTEN=RQCCUTEN ,RQRCUTEN=RQRCUTEN &
1902 & ,RQICUTEN=RQICUTEN ,RQSCUTEN=RQSCUTEN &
1903 & ,RTHBLTEN=RTHBLTEN,RQVBLTEN=RQVBLTEN &
1904 & ,RTHRATEN=RTHRATEN &
1905 ! Selection argument
1906 & ,CU_PHYSICS=CONFIG_FLAGS%CU_PHYSICS &
1907 ! Moisture tracer arguments
1908 & ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV &
1909 & ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC &
1910 & ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR &
1911 & ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI &
1912 & ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS &
1913 & ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG )
1914 !
1915 !-----------------------------------------------------------------------
1916 !
1917 !*** CNVTOP/CNVBOT HOLD THE MAXIMUM VERTICAL LIMITS OF CONVECTIVE CLOUD
1918 !*** BETWEEN HISTORY OUTPUT TIMES. HBOTS/HTOPS STORE SIMILIAR INFORMATION
1919 !*** FOR SHALLOW (NONPRECIPITATING) CONVECTION, AND HBOTD/HTOPD ARE FOR
1920 !*** DEEP (PRECIPITATING) CONVECTION.
1921 !
1922 CF_HI=CONFIG_FLAGS%HISTORY_INTERVAL
1923 N_TIMSTPS_OUTPUT=NINT(60.*CF_HI/DT)
1924 MNTO=MOD(NTSD,N_TIMSTPS_OUTPUT)
1925 !
1926 IF(MNTO>0.AND.MNTO<=NCNVC)THEN
1927 DO J=MYJS2,MYJE2
1928 IENDX=MYIE1
1929 IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
1930 DO I=MYIS1,IENDX
1931 CNVBOT(I,J)=REAL(KTE+1.)
1932 CNVTOP(I,J)=0.
1933 HBOTD(I,J)=REAL(KTE+1.)
1934 HTOPD(I,J)=0.
1935 HBOTS(I,J)=REAL(KTE+1.)
1936 HTOPS(I,J)=0.
1937 ENDDO
1938 ENDDO
1939 ENDIF
1940 !
1941 !-----------------------------------------------------------------------
1942 !
1943 !$omp parallel do &
1944 !$omp& private(dqdt,dtdt,i,iendx,j,k,ncubot,ncutop,pcpcol &
1945 !$omp& ,tchange &
1946 !$omp& )
1947 DO J=MYJS2,MYJE2
1948 IENDX=MYIE1
1949 IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
1950 DO I=MYIS1,IENDX
1951 !
1952 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, AND HEATING.
1953 !*** THE FLIP IS BECAUSE RTHCUTEN AND RQVCUTEN REACH THIS POINT
1954 !*** WITH LAYER 1 AT THE BOTTOM.
1955 !
1956 DO K=KTS,KTE
1957 !
1958 !*** RQVCUTEN IN BMJDRV IS THE MIXING RATIO TENDENCY,
1959 !*** SO RETRIEVE DQDT BY CONVERTING TO SPECIFIC HUMIDITY.
1960 !
1961 DQDT=RQVCUTEN(I,K,J)/(1.+MOIST(I,K,J,P_QV))**2
1962 !
1963 !*** RTHCUTEN IN BMJDRV IS DTDT OVER PI.
1964 !
1965 DTDT=RTHCUTEN(I,K,J)*PI_PHY(I,K,J)
1966 T(I,K,J)=T(I,K,J)+DTDT*DTCNVC
1967 Q(I,K,J)=Q(I,K,J)+DQDT*DTCNVC
1968 MOIST(I,K,J,P_QV)=Q(I,K,J)/(1.-Q(I,K,J)) !Convert to mixing ratio
1969 !tgs - added next two lines
1970 cps_select: SELECT CASE(config_flags%cu_physics)
1971 !
1972 CASE (KFSCHEME,KFETASCHEME,GDSCHEME,SASSCHEME)
1973 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
1974 MOIST(I,K,J,P_QS)=MAX(0.,MOIST(I,K,J,P_QS)+RQICUTEN(I,K,J)*DTCNVC+RQSCUTEN(I,K,J)*DTCNVC)
1975 ELSE
1976 MOIST(I,K,J,P_QI)=MAX(0.,MOIST(I,K,J,P_QI)+RQICUTEN(I,K,J)*DTCNVC)
1977 MOIST(I,K,J,P_QS)=MAX(0.,MOIST(I,K,J,P_QS)+RQSCUTEN(I,K,J)*DTCNVC)
1978 ENDIF
1979 MOIST(I,K,J,P_QR)=MAX(0.,MOIST(I,K,J,P_QR)+RQRCUTEN(I,K,J)*DTCNVC)
1980 MOIST(I,K,J,P_QC)=MAX(0.,MOIST(I,K,J,P_QC)+RQCCUTEN(I,K,J)*DTCNVC)
1981 END SELECT cps_select
1982 !
1983 TCUCN(I,K,J)=TCUCN(I,K,J)+DTDT
1984 !
1985 TCHANGE=DTDT*DTCNVC
1986 IF(ABS(TCHANGE)>DTEMP_CHECK)THEN
1987 WRITE(0,*)'BIG T CHANGE BY CONVECTION: I,J,K,NTSD',TCHANGE,I,J,K,NTSD
1988 ENDIF
1989 !
1990 ENDDO
1991 !
1992 !*** UPDATE PRECIPITATION
1993 !
1994 PCPCOL=RAINCV(I,J)*1.E-3*NSTEP_CNV
1995 PREC(I,J)=PREC(I,J)+PCPCOL
1996 ACPREC(I,J)=ACPREC(I,J)+PCPCOL
1997 CUPREC(I,J)=CUPREC(I,J)+PCPCOL
1998 CUPPT(I,J)=CUPPT(I,J)+PCPCOL
1999 CPRATE(I,J)=PCPCOL
2000 !
2001 !*** SAVE CLOUD TOP AND BOTTOM FOR RADIATION (HTOP/HBOT) AND
2002 !*** FOR OUTPUT (CNVTOP/CNVBOT, HTOPS/HBOTS, HTOPD/HBOTD) ARRAYS.
2003 !*** MUST BE TREATED SEPARATELY FROM EACH OTHER.
2004 !
2005 NCUTOP=NINT(CUTOP(I,J))
2006 NCUBOT=NINT(CUBOT(I,J))
2007 !
2008 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
2009 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
2010 CNVTOP(I,J)=MAX(CUTOP(I,J),CNVTOP(I,J))
2011 IF(PCPCOL>0.)THEN
2012 HTOPD(I,J)=MAX(CUTOP(I,J),HTOPD(I,J))
2013 ELSE
2014 HTOPS(I,J)=MAX(CUTOP(I,J),HTOPS(I,J))
2015 ENDIF
2016 ENDIF
2017 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
2018 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
2019 CNVBOT(I,J)=MIN(CUBOT(I,J),CNVBOT(I,J))
2020 IF(PCPCOL>0.)THEN
2021 HBOTD(I,J)=MIN(CUBOT(I,J),HBOTD(I,J))
2022 ELSE
2023 HBOTS(I,J)=MIN(CUBOT(I,J),HBOTS(I,J))
2024 ENDIF
2025 ENDIF
2026 !
2027 ENDDO
2028 ENDDO
2029 !
2030 !$omp parallel do &
2031 !$omp& private(i,j,k)
2032 DO J=JMS,JME
2033 DO K=KMS,KME
2034 DO I=IMS,IME
2035 ZERO_3D(I,K,J)=0.
2036 ENDDO
2037 ENDDO
2038 ENDDO
2039 !-----------------------------------------------------------------------
2040 !
2041 END SUBROUTINE CUCNVC
2042 !
2043 !-----------------------------------------------------------------------
2044 !***********************************************************************
2045 SUBROUTINE GSMDRIVE(NTSD,DT,NPHS,N_MOIST &
2046 & ,DX,DY,LMH,SM,HBM2,FIS &
2047 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
2048 & ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN &
2049 & ,MOIST,SCALAR,N_SCALAR &
2050 & ,F_ICE,F_RAIN,F_RIMEF,SR &
2051 & ,PREC,ACPREC,AVRAIN,ZERO_3D &
2052 & ,MP_RESTART_STATE &
2053 & ,TBPVS_STATE &
2054 & ,TBPVS0_STATE &
2055 & ,GRID,CONFIG_FLAGS &
2056 & ,IDS,IDE,JDS,JDE,KDS,KDE &
2057 & ,IMS,IME,JMS,JME,KMS,KME &
2058 & ,ITS,ITE,JTS,JTE,KTS,KTE)
2059 !***********************************************************************
2060 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
2061 ! . . .
2062 ! SUBPROGRAM: GSMDRIVE MICROPHYSICS OUTER DRIVER
2063 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-26
2064 !
2065 ! ABSTRACT:
2066 ! GSMDRIVE DRIVES THE MICROPHYSICS SCHEMES
2067 !
2068 ! PROGRAM HISTORY LOG:
2069 ! 02-03-26 BLACK - ORIGINATOR
2070 ! 04-11-18 BLACK - THREADED
2071 !
2072 ! USAGE: CALL GSMDRIVE FROM SOLVE_NMM
2073 !
2074 ! ATTRIBUTES:
2075 ! LANGUAGE: FORTRAN 90
2076 ! MACHINE : IBM
2077 !$$$
2078 !-----------------------------------------------------------------------
2079 !
2080 IMPLICIT NONE
2081 !
2082 !-----------------------------------------------------------------------
2083 !
2084 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
2085 & ,IMS,IME,JMS,JME,KMS,KME &
2086 & ,ITS,ITE,JTS,JTE,KTS,KTE &
2087 & ,N_MOIST,N_SCALAR,NPHS,NTSD
2088 !
2089 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
2090 !
2091 REAL,INTENT(IN) :: DT,DX,DY,PDTOP,PT
2092 !
2093 REAL,INTENT(INOUT) :: AVRAIN
2094 !
2095 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
2096 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
2097 !
2098 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
2099 !
2100 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
2101 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: ZERO_3D
2102 !
2103 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,PREC
2104 !
2105 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: CWM,Q,T &
2106 & ,TRAIN
2107 !
2108 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: F_ICE &
2109 & ,F_RAIN &
2110 & ,F_RIMEF
2111
2112 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,n_moist),INTENT(INOUT) :: MOIST
2113 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME,n_scalar),INTENT(INOUT) :: SCALAR
2114 !
2115 !*** State var for etampnew microphysics (JM, 2005 05 02)
2116 !
2117 REAL,DIMENSION(:),INTENT(INOUT) :: MP_RESTART_STATE &
2118 & ,TBPVS_STATE &
2119 & ,TBPVS0_STATE
2120
2121 !
2122 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: SR
2123 !
2124 TYPE(DOMAIN),TARGET :: GRID
2125 !
2126 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
2127 !
2128 !-----------------------------------------------------------------------
2129 !***
2130 !*** LOCAL VARIABLES
2131 !***
2132 !-----------------------------------------------------------------------
2133 INTEGER :: I,I_M,IENDX,J,K,IJ
2134 !
2135 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: LOWLYR
2136 !
2137 REAL :: CAPA,DPL,DTPHS,PCPCOL,PDSL,PLYR,RDTPHS,RG,TNEW
2138 !
2139 REAL,DIMENSION(KMS:KME-1) :: QL,TL
2140 !
2141 REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,RAINNC,RAINNCV,XLAND &
2142 & ,ZERO_2D
2143 !
2144 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &
2145 & ,RR,T_PHY,TH_PHY
2146 !
2147 LOGICAL :: E_BDY,F_QT,QT_PRESENT,WARM_RAIN
2148 !
2149 !-----------------------------------------------------------------------
2150 !***********************************************************************
2151 !-----------------------------------------------------------------------
2152 !
2153 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
2154 QT_PRESENT=.TRUE.
2155 ELSE
2156 QT_PRESENT=.FALSE.
2157 ENDIF
2158 !
2159 DTPHS=NPHS*DT
2160 RDTPHS=1./DTPHS
2161 CAPA=R_D/CP
2162 RG=1./G
2163 AVRAIN=AVRAIN+1.
2164 !
2165 !-----------------------------------------------------------------------
2166 !
2167 !*** PREPARE NEEDED ARRAYS
2168 !
2169 !-----------------------------------------------------------------------
2170 !$omp parallel do &
2171 !$omp& private(dpl,i,j,k,pdsl,plyr,ql,tl)
2172 DO J=MYJS2,MYJE2
2173 DO I=MYIS1,MYIE1
2174 !
2175 PDSL=PD(I,J)*RES(I,J)
2176 P8W(I,KTE+1,J)=PT
2177 LOWLYR(I,J)=KTE+1-LMH(I,J)
2178 XLAND(I,J)=SM(I,J)+1.
2179 ZERO_2D(I,J)=0.
2180 ! FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE
2181 ! ACCUMULATED RAIN BUT NOT YET USED BY NMM)
2182 ! COULD BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC)
2183 RAINNC(I,J)=0.
2184 !
2185 !*** FILL THE SINGLE-COLUMN INPUT
2186 !
2187 DO K=KTS,KTE
2188 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL
2189 QL(K)=AMAX1(Q(I,K,J),EPSQ)
2190 !!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL+PT
2191 PLYR=(PINT(I,K,J)+PINT(I,K+1,J))*0.5
2192 TL(K)=T(I,K,J)
2193 !
2194 RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
2195 T_PHY(I,K,J)=TL(K)
2196 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
2197 TH_PHY(I,K,J)=TL(K)/PI_PHY(I,K,J)
2198 !!! P8W(I,KFLIP,J)=PINT(I,K+1,J)
2199 P8W(I,K,J)=ETA1(K)*PDTOP+ETA2(K)*PDSL+PT
2200 P_PHY(I,K,J)=PLYR
2201 DZ(I,K,J)=DPL*RG/RR(I,K,J)
2202 ENDDO
2203 !
2204 ENDDO
2205 ENDDO
2206 !-----------------------------------------------------------------------
2207 !
2208 !*** CALL MICROPHYSICS
2209 !
2210 !-----------------------------------------------------------------------
2211 !
2212 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
2213 !
2214 CALL MICROPHYSICS_DRIVER( &
2215 & TH=TH_PHY,RHO=RR,PI_PHY=PI_PHY,P=P_PHY &
2216 & ,RAINNC=RAINNC,RAINNCV=RAINNCV &
2217 & ,DZ8W=DZ,P8W=P8W,DT=DTPHS,DX=DX,DY=DY &
2218 & ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS &
2219 & ,SPECIFIED=CONFIG_FLAGS%SPECIFIED &
2220 & .OR.CONFIG_FLAGS%NESTED &
2221 & ,SPEC_ZONE=0,WARM_RAIN=WARM_RAIN &
2222 & ,XLAND=XLAND,ITIMESTEP=NTSD-1 &
2223 & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &
2224 & ,F_RIMEF_PHY=F_RIMEF &
2225 & ,LOWLYR=LOWLYR,SR=SR &
2226 & ,QV_CURR=MOIST(IMS,KMS,JMS,P_QV),F_QV=F_QV &
2227 & ,QC_CURR=MOIST(IMS,KMS,JMS,P_QC),F_QC=F_QC &
2228 & ,QR_CURR=MOIST(IMS,KMS,JMS,P_QR),F_QR=F_QR &
2229 & ,QI_CURR=MOIST(IMS,KMS,JMS,P_QI),F_QI=F_QI &
2230 & ,QS_CURR=MOIST(IMS,KMS,JMS,P_QS),F_QS=F_QS &
2231 & ,QG_CURR=MOIST(IMS,KMS,JMS,P_QG),F_QG=F_QG &
2232 & ,QNI_CURR=SCALAR(IMS,KMS,JMS,P_QNI),F_QNI=F_QNI &
2233 & ,QT_CURR=CWM,F_QT=qt_present &
2234 & ,MP_RESTART_STATE=MP_RESTART_STATE &
2235 & ,TBPVS_STATE=TBPVS_STATE &
2236 & ,TBPVS0_STATE=TBPVS0_STATE &
2237 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
2238 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
2239 & ,I_START=GRID%I_START,I_END=GRID%I_END &
2240 & ,J_START=GRID%J_START,J_END=GRID%J_END &
2241 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
2242 )
2243
2244 !$omp parallel do &
2245 !$omp& private(ij)
2246 DO IJ=1,GRID%NUM_TILES
2247 CALL MICROPHYSICS_ZERO_OUT( &
2248 MOIST,N_MOIST,CONFIG_FLAGS &
2249 ,IDS,IDE,JDS,JDE,KDS,KDE &
2250 ,IMS,IME,JMS,JME,KMS,KME &
2251 ,GRID%I_START(IJ),GRID%I_END(IJ) &
2252 ,GRID%J_START(IJ),GRID%J_END(IJ) &
2253 ,KTS,KTE )
2254 ENDDO
2255
2256
2257
2258 !
2259 !-----------------------------------------------------------------------
2260 !
2261 E_BDY=(ITE>=IDE)
2262 !
2263 !$omp parallel do &
2264 !$omp& private(i,iendx,j,k,pcpcol,tnew,i_m)
2265 DO J=MYJS2,MYJE2
2266 IENDX=MYIE1
2267 IF(E_BDY.AND.MOD(J,2)==0)IENDX=IENDX-1
2268 DO I=MYIS1,IENDX
2269 !
2270 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING.
2271 !
2272 DO K=KTS,KTE
2273 TNEW=TH_PHY(I,K,J)*PI_PHY(I,K,J)
2274 TRAIN(I,K,J)=TRAIN(I,K,J)+(TNEW-T(I,K,J))*RDTPHS
2275 T(I,K,J)=TNEW
2276 Q(I,K,J)=MOIST(I,K,J,P_QV)/(1.+MOIST(I,K,J,P_QV)) !To s.h.
2277 ! CWM(I,K,J)=0.
2278 ! DO I_M=2,N_MOIST
2279 ! IF(I_M/=P_QV)THEN
2280 ! CWM(I,K,J)=CWM(I,K,J)+MOIST(I,K,J,I_M)
2281 ! ENDIF
2282 ! ENDDO
2283 ENDDO
2284 !
2285 !-----------------------------------------------------------------------
2286 !*** UPDATE PRECIPITATION
2287 !-----------------------------------------------------------------------
2288 !
2289 PCPCOL=RAINNCV(I,J)*1.E-3
2290 PREC(I,J)=PREC(I,J)+PCPCOL
2291 ACPREC(I,J)=ACPREC(I,J)+PCPCOL
2292 ! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE
2293 ! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW
2294 !
2295 ENDDO
2296 ENDDO
2297 !
2298 !-----------------------------------------------------------------------
2299 !$omp parallel do &
2300 !$omp& private(i,j,k)
2301 DO J=JMS,JME
2302 DO K=KMS,KME
2303 DO I=IMS,IME
2304 ZERO_3D(I,K,J)=0.
2305 ENDDO
2306 ENDDO
2307 ENDDO
2308 !-------------------------------------------------------------------
2309 !
2310 END SUBROUTINE GSMDRIVE
2311 !
2312 !-------------------------------------------------------------------
2313 !
2314 END MODULE MODULE_PHYSICS_CALLS
2315 !
2316 !-------------------------------------------------------------------