| blob | 84eb1b859f65fb98e8a5196edd9ebf50470a2226 |
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,P_QNR
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_GWD
25 USE MODULE_CU_BMJ
26 USE MODULE_CUMULUS_DRIVER
27 USE MODULE_MP_ETANEW
28 USE MODULE_MICROPHYSICS_DRIVER
29 USE MODULE_MICROPHYSICS_ZERO_OUT
30 !-----------------------------------------------------------------------
31 !
32 CONTAINS
33 !
34 !-----------------------------------------------------------------------
35 !***********************************************************************
36 SUBROUTINE RADIATION(NTSD,DT,JULDAY,JULYR,XTIME,JULIAN &
37 & ,IHRST,NPHS,GLAT,GLON &
38 & ,NRADS,NRADL &
39 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
40 & ,PD,RES,PINT,T,Q,MOIST,THS,ALBEDO,EPSR &
41 & ,F_ICE,F_RAIN &
42 #ifdef WRF_CHEM
43 & ,GD_CLOUD,GD_CLOUD2 &
44 #endif
45 & ,SM,HBM2,CLDFRA,N_MOIST,RESTRT &
46 & ,RLWTT,RSWTT,RLWIN,RSWIN,RSWINC,RSWOUT &
47 & ,RLWTOA,RSWTOA,CZMEAN &
48 & ,CFRACL,CFRACM,CFRACH,SIGT4 &
49 & ,ACFRST,NCFRST,ACFRCV,NCFRCV &
50 & ,CUPPT,VEGFRC,SNOW,HTOP,HBOT &
51 & ,Z,SICE,NUM_AEROSOLC,NUM_OZMIXM &
52 & ,GRID,CONFIG_FLAGS &
53 & ,RTHRATEN &
54 #ifdef WRF_CHEM
55 & ,PM2_5_DRY, PM2_5_WATER, PM2_5_DRY_EC &
56 & ,TAUAER1, TAUAER2, TAUAER3, TAUAER4 &
57 & ,GAER1, GAER2, GAER3, GAER4 &
58 & ,WAER1, WAER2, WAER3, WAER4 &
59 #endif
60 & ,IDS,IDE,JDS,JDE,KDS,KDE &
61 & ,IMS,IME,JMS,JME,KMS,KME &
62 & ,ITS,ITE,JTS,JTE,KTS,KTE)
63 !*** NOTE ***
64 ! RLWIN - downward longwave at the surface (=TOTLWDN, now a local array)
65 ! RSWIN - downward shortwave at the surface (=TOTSWDN, now a local array)
66 ! RSWINC - CLEAR-SKY downward shortwave at the surface (=TOTSWDNC, new for AQ)
67 !***********************************************************************
68 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
69 ! . . .
70 ! SUBPROGRAM: RADIATION RADIATION OUTER DRIVER
71 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 2002-06-04
72 !
73 ! ABSTRACT:
74 ! RADIATION SERVES AS THE INTERFACE BETWEEN THE NCEP NONHYDROSTATIC
75 ! MESOSCALE MODEL AND THE WRF RADIATION DRIVER.
76 !
77 ! PROGRAM HISTORY LOG:
78 ! 02-06-04 BLACK - ORIGINATOR
79 ! 02-09-09 WOLFE - CONVERTING TO GLOBAL INDEXING
80 ! 04-11-18 BLACK - THREADED
81 ! 05-12-15 BLACK - CONVERTED FROM IKJ TO IJK
82 !
83 ! USAGE: CALL RADIATION FROM SOLVE_NMM
84 !
85 ! ATTRIBUTES:
86 ! LANGUAGE: FORTRAN 90
87 ! MACHINE : IBM
88 !$$$
89 !-----------------------------------------------------------------------
90 !
91 IMPLICIT NONE
92 !
93 !-----------------------------------------------------------------------
94 !
95 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
96 & ,IMS,IME,JMS,JME,KMS,KME &
97 & ,ITS,ITE,JTS,JTE,KTS,KTE &
98 & ,IHRST,JULDAY,JULYR &
99 & ,N_MOIST,NPHS,NRADL,NRADS,NTSD &
100 & ,NUM_AEROSOLC,NUM_OZMIXM
101 !
102 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: NCFRCV,NCFRST
103 !
104 REAL,INTENT(IN) :: DT,PDTOP,PT,XTIME,JULIAN
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,SICE,SM &
114 & ,SNOW,THS,VEGFRC
115 !
116 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CUPPT
118 !
119 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: Q,T,Z
120 !
121 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE & !<--- Used only with physics (IKJ)
122 & ,F_RAIN
123 !
124 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: RTHRATEN !<--- Used only with physics (IKJ)
125 !
126 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_MOIST) &
127 ,INTENT(INOUT) :: MOIST
128 !
129 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACFRCV,ACFRST &
130 & ,HBOT,HTOP &
131 & ,RLWIN,RLWTOA &
132 & ,RSWIN,RSWOUT &
133 & ,RSWINC,RSWTOA
134 !
135 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: PINT &
136 & ,RLWTT &
137 & ,RSWTT
138 !
139 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: CFRACH,CFRACL &
140 & ,CFRACM,CZMEAN &
141 & ,SIGT4
142 !
143 #ifdef WRF_CHEM
144 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME ),INTENT(IN) :: & !<--- Used only with physics (IKJ)
145 & GAER1,GAER2,GAER3,GAER4, &
146 & GD_CLOUD,GD_CLOUD2, &
147 & PM2_5_DRY,PM2_5_WATER,PM2_5_DRY_EC, &
148 & TAUAER1,TAUAER2,TAUAER3,TAUAER4, &
149 & WAER1,WAER2,WAER3,WAER4
150 #endif
151 !
152 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: CLDFRA
153 !
154 LOGICAL,INTENT(IN) :: RESTRT
155 !
156 TYPE(DOMAIN),TARGET :: GRID
157 !
158 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
159 !
160 !-----------------------------------------------------------------------
161 !***
162 !*** LOCAL VARIABLES
163 !***
164 !-----------------------------------------------------------------------
165 INTEGER :: I,ICLOUD,IENDX,II,ISTAT,J,JDAY,JMONTH,K,KMNTH,N,NRAD
166 !
167 INTEGER,DIMENSION(3) :: IDAT
168 INTEGER,DIMENSION(12) :: MONTH=(/31,28,31,30,31,30,31,31 &
169 & ,30,31,30,31/)
170 !
171 REAL :: CAPA,DAYI,DPL,FICE,FRAIN,GMT,HOUR,PLYR,PSFC &
172 & ,QI,QR,QW,RADT,TIMES,WC,TDUM
173 !
174 REAL,DIMENSION(KMS:KME-1) :: QL,TL
175 !
176 REAL,DIMENSION(IMS:IME,JMS:JME) :: CUPPTR,CZEN,HBOTR,HTOPR &
177 & ,PDSL,REXNSFC,SWNETDN &
178 & ,TOT,TOTLWDN,TOTSWDN,TOTSWDNC &
179 & ,TSFC,XLAND,XLAT,XLON
180 !
181 !
182 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: CLFR,DZ & !<--- Used only with physics (IKJ)
183 & ,P8W,P_PHY,PI_PHY &
184 & ,RR,T8W &
185 & ,THRATENLW,THRATENSW &
186 & ,TH_PHY,T_PHY,Z_PHY
187 !
188 REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: MOIST_TRANS
189 !
190 LOGICAL :: WARM_RAIN
191 !
192 !-----------------------------------------------------------------------
193 !***********************************************************************
194 !-----------------------------------------------------------------------
195 !*****
196 !***** NOTE: THIS IS HARDWIRED FOR CALLS TO LONGWAVE AND SHORTWAVE
197 !***** AT EQUAL INTERVALS
198 !*****
199 !-----------------------------------------------------------------------
200 !
201 NRAD=NRADS
202 RADT=DT*NRADS/60.
203 !
204 !-----------------------------------------------------------------------
205 !
206 ALLOCATE(MOIST_TRANS(IMS:IME,KMS:KME,JMS:JME,N_MOIST),STAT=ISTAT)
207 !
208 !-----------------------------------------------------------------------
209 !
210 CAPA=R_D/CP
211 !
212 !-----------------------------------------------------------------------
213 !
214 !$omp parallel do &
215 !$omp& private(i,j)
216 DO J=MYJS2,MYJE2
217 DO I=MYIS1,MYIE1
218 !
219 PDSL(I,J)=PD(I,J)*RES(I,J)
220 P8W(I,KTE+1,J)=PT
221 XLAT(I,J)=GLAT(I,J)/DEGRAD
222 XLON(I,J)=GLON(I,J)/DEGRAD
223 XLAND(I,J)=SM(I,J)+1.
224 PSFC=PD(I,J)+PDTOP+PT
225 REXNSFC(I,J)=(PSFC*1.E-5)**CAPA
226 TSFC(I,J)=THS(I,J)*REXNSFC(I,J)
227 T8W(I,KTS,J)=TSFC(I,J)
228 P8W(I,KTS,J)=ETA1(KTS)*PDTOP+ETA2(KTS)*PDSL(I,J)+PT
229 Z_PHY(I,KTS,J)=Z(I,J,KTS)
230 ENDDO
231 ENDDO
232 !
233 !-----------------------------------------------------------------------
234 !*** FILL THE SINGLE-COLUMN INPUT
235 !-----------------------------------------------------------------------
236 !
237 !$omp parallel do &
238 !$omp& private(dpl,i,j,k,plyr,ql,qr,tl)
239 DO J=MYJS2,MYJE2
240 DO I=MYIS1,MYIE1
241 DO K=KTS,KTE
242 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
243 QL(K)=MAX(Q(I,J,K),EPSQ)
244 PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL(I,J)+PT
245 TL(K)=T(I,J,K)
246 !
247 RR(I,K,J)=PLYR/(R_D*TL(K)*(1.+P608*QL(K)))
248 T_PHY(I,K,J)=TL(K)
249 TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
250 P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL(I,J)+PT
251 P_PHY(I,K,J)=PLYR
252 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
253 DZ(I,K,J)=TL(K)*(P608*QL(K)+1.)*R_D &
254 & *(P8W(I,K,J)-P8W(I,K+1,J)) &
255 & /(P_PHY(I,K,J)*G)
256 !
257 RTHRATEN(I,K,J)=0.
258 THRATENLW(I,K,J)=0.
259 THRATENSW(I,K,J)=0.
260 ! PM2_5_DRY(I,K,J)=0.
261 ! PM2_5_WATER(I,K,J)=0.
263 ENDDO
264 !
265 DO K=KTS+1,KTE
266 T8W(I,K,J)=0.5*(TL(K-1)+TL(K))
267 ENDDO
268 ! T8W(I,KTE+1,J)=-1.E20
269 ! For RRTM
270 T8W(I,KTE+1,J)=T8W(I,KTE,J) + 0.5*(T8W(I,KTE,J)-T8W(I,KTE-1,J))
271 !
272 ENDDO
273 ENDDO
274 !
275 ICLOUD=999
276 !
277 GMT=REAL(IHRST)
278 !
279 !$omp parallel do &
280 !$omp& private(i,j,k)
281 DO K=KMS,KME
282 DO J=JMS,JME
283 DO I=IMS,IME
284 CLDFRA(I,J,K)=0.
285 ENDDO
286 ENDDO
287 ENDDO
288 !
289 !$omp parallel do &
290 !$omp& private(i,j)
291 DO J=JMS,JME
292 DO I=IMS,IME
293 CFRACH(I,J)=0.
294 CFRACL(I,J)=0.
295 CFRACM(I,J)=0.
296 CZMEAN(I,J)=0.
297 SIGT4(I,J)=0.
298 TOTSWDN(I,J)=0. ! TOTAL (clear+cloudy sky) shortwave down at the surface
299 TOTSWDNC(I,J)=0. ! CLEAR SKY shortwave down at the surface
300 SWNETDN(I,J)=0. ! Net (down - up) total (clear+cloudy sky) shortwave at the surface
301 TOTLWDN(I,J)=0. ! Total longwave down at the surface
302 CUPPTR(I,J)=CUPPT(I,J) ! Temporary array set to zero in radiation
303 HTOPR(I,J) =0.
304 HBOTR(I,J) =0.
305 !
306 !-- NOTE: HBOTR, HTOPR are passed into radiation and set equal to HBOT, HTOP. HBOT, HTOP are
307 ! reset to clear sky values to be used by the ARW. At the bottom of this subroutine,
308 ! HBOT, HTOP are re-defined again to values stored in HBOTR, HTOPR. HBOT, HTOP are
309 ! reset to clear sky values after the call to radiation and after the top of the hour
310 ! in subroutine CUCNVC below.
311 !
312 ENDDO
313 ENDDO
314 !
315 !-----------------------------------------------------------------------
316 !*** TRANSPOSE THE MOIST ARRAY (IJK) FOR THE PHYSICS (IKJ).
317 !*** REMEMBER THAT MOIST AND MOIST_TRANS ARE ONLY USED WITH
318 !*** THE PHYSICS AND THUS THE P_QV SLOT (=2) IS MIXING RATIO,
319 !*** NOT SPECIFIC HUMIDITY.
320 !-----------------------------------------------------------------------
321 !
322 DO N=1,N_MOIST
323 !$omp parallel do &
324 !$omp& private(i,j,k)
325 DO K=KMS,KME
326 DO J=JMS,JME
327 DO I=IMS,IME
328 MOIST_TRANS(I,K,J,N)=MOIST(I,J,K,N)
329 ENDDO
330 ENDDO
331 ENDDO
332 ENDDO
333 !
334 !-----------------------------------------------------------------------
335 !
336 !*** CALL THE INNER DRIVER.
337 !
338 !-----------------------------------------------------------------------
339 !
340 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
341 !
342 CALL RADIATION_DRIVER( &
343 & IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
344 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
345 & ,I_START=GRID%I_START,I_END=GRID%I_END &
346 & ,J_START=GRID%J_START,J_END=GRID%J_END &
347 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
348 & ,ITIMESTEP=NTSD,DT=DT &
349 #ifdef WRF_CHEM
350 & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback &
351 & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback &
352 & ,PM2_5_DRY=pm2_5_dry,PM2_5_WATER=pm2_5_water &
353 & ,PM2_5_DRY_EC=pm2_5_dry_ec &
354 & ,TAUAER300=tauaer1,TAUAER400=tauaer2,TAUAER600=tauaer3,TAUAER999=tauaer4 & ! jcb
355 & ,GAER300=gaer1,GAER400=gaer2,GAER600=gaer3,GAER999=gaer4 & ! jcb
356 & ,WAER300=waer1,WAER400=waer2,WAER600=waer3,WAER999=waer4 & ! jcb
357 & ,QC_ADJUST=GD_CLOUD,QI_ADJUST=GD_CLOUD2 &
358 #endif
359 & ,RTHRATENLW=THRATENLW,RTHRATENSW=THRATENSW &
360 & ,RTHRATEN=RTHRATEN &
361 & ,CEN_LAT=grid%cen_lat &
362 & ,GLW=TOTLWDN,GSW=SWNETDN,SWDOWN=TOTSWDN &
363 & ,XLAT=XLAT,XLONG=XLON,ALBEDO=ALBEDO,EMISS=EPSR &
364 & ,XICE=SICE,XLAND=XLAND,Z=Z,TSK=TSFC &
365 & ,N_AEROSOLC=NUM_AEROSOLC,PAERLEV=GRID%PAERLEV &
366 & ,CAM_ABS_DIM1=GRID%CAM_ABS_DIM1 &
367 & ,CAM_ABS_DIM2=GRID%CAM_ABS_DIM2 &
368 & ,CAM_ABS_FREQ_S=GRID%CAM_ABS_FREQ_S &
369 & ,LEVSIZ=GRID%LEVSIZ,N_OZMIXM=NUM_OZMIXM &
370 & ,HTOP=HTOP,HBOT=HBOT,CUPPT=CUPPTR &
371 & ,HTOPR=HTOPR,HBOTR=HBOTR &
372 & ,VEGFRA=VEGFRC,SNOW=SNOW &
373 & ,RHO=RR,P8W=P8W,P=P_PHY,PI=PI_PHY &
374 & ,DZ8W=DZ,T=T_PHY,T8W=T8W,GMT=GMT &
375 & ,JULDAY=JULDAY,JULYR=JULYR,NPHS=NPHS &
376 & ,JULIAN=JULIAN,XTIME=XTIME &
377 & ,LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &
378 & ,SW_PHYSICS=CONFIG_FLAGS%RA_SW_PHYSICS &
379 & ,RADT=RADT,RA_CALL_OFFSET=GRID%RA_CALL_OFFSET &
380 & ,STEPRA=NRAD,ICLOUD=ICLOUD &
381 & ,WARM_RAIN=WARM_RAIN &
382 & ,SWDOWNC=TOTSWDNC,CLDFRA=CLFR &
383 & ,RSWTOA=RSWTOA,RLWTOA=RLWTOA &
384 & ,CZMEAN=CZMEAN,CFRACL=CFRACL &
385 & ,CFRACM=CFRACM,CFRACH=CFRACH &
386 & ,ACFRST=ACFRST,NCFRST=NCFRST &
387 & ,ACFRCV=ACFRCV,NCFRCV=NCFRCV &
388 & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &
389 & ,QV=MOIST_TRANS(IMS,KMS,JMS,P_QV),F_QV=F_QV &
390 & ,QC=MOIST_TRANS(IMS,KMS,JMS,P_QC),F_QC=F_QC &
391 & ,QR=MOIST_TRANS(IMS,KMS,JMS,P_QR),F_QR=F_QR &
392 & ,QI=MOIST_TRANS(IMS,KMS,JMS,P_QI),F_QI=F_QI &
393 & ,QS=MOIST_TRANS(IMS,KMS,JMS,P_QS),F_QS=F_QS &
394 & ,QG=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG )
396 !
397 !-----------------------------------------------------------------------
398 !
399 !*** UPDATE FLUXES AND TEMPERATURE TENDENCIES.
400 !
401 !-----------------------------------------------------------------------
402 !*** SHORTWAVE
403 !-----------------------------------------------------------------------
404 !
405 !-----------------------------------------------------------------------
406 nrads_block: IF(MOD(NTSD,NRADS)==0)THEN
407 !-----------------------------------------------------------------------
408 !
409 IF(CONFIG_FLAGS%RA_SW_PHYSICS/=GFDLSWSCHEME)THEN
410 !
411 !-----------------------------------------------------------------------
412 !*** COMPUTE CZMEAN FOR NON-GFDL SHORTWAVE
413 !-----------------------------------------------------------------------
414 !
415 !$omp parallel do &
416 !$omp& private(i,j)
417 DO J=MYJS,MYJE
418 DO I=MYIS,MYIE
419 CZMEAN(I,J)=0.
420 TOT(I,J)=0.
421 ENDDO
422 ENDDO
423 !
424 CALL CAL_MON_DAY(JULDAY,JULYR,JMONTH,JDAY)
425 IDAT(1)=JMONTH
426 IDAT(2)=JDAY
427 IDAT(3)=JULYR
428 !
429 DO II=0,NRADS,NPHS
430 TIMES=NTSD*DT+II*DT
431 CALL ZENITH(TIMES,DAYI,HOUR,IDAT,IHRST,GLON,GLAT,CZEN &
432 & ,MYIS,MYIE,MYJS,MYJE &
433 & ,IDS,IDE,JDS,JDE,KDS,KDE &
434 & ,IMS,IME,JMS,JME,KMS,KME &
435 & ,ITS,ITE,JTS,JTE,KTS,KTE)
436 !
437 !$omp parallel do &
438 !$omp& private(i,j)
439 DO J=MYJS,MYJE
440 DO I=MYIS,MYIE
441 IF(CZEN(I,J)>0.)THEN
442 CZMEAN(I,J)=CZMEAN(I,J)+CZEN(I,J)
443 TOT(I,J)=TOT(I,J)+1.
444 ENDIF
445 ENDDO
446 ENDDO
447 !
448 ENDDO
449 !
450 !$omp parallel do &
451 !$omp& private(i,j)
452 DO J=MYJS,MYJE
453 DO I=MYIS,MYIE
454 IF(TOT(I,J)>0.)CZMEAN(I,J)=CZMEAN(I,J)/TOT(I,J)
455 ENDDO
456 ENDDO
457 !
458 !-----------------------------------------------------------------------
459 !*** COMPUTE TOTAL SFC SHORTWAVE DOWN FOR NON-GFDL SCHEMES
460 !-----------------------------------------------------------------------
461 !
462 !$omp parallel do &
463 !$omp& private(i,j)
464 DO J=MYJS2,MYJE2
465 DO I=MYIS1,MYIE1
466 !
467 IF(HBM2(I,J)>0.5)THEN
468 TOTSWDN(I,J)=SWNETDN(I,J)/(1.-ALBEDO(I,J))
469 !
470 !--- No value currently available for clear-sky solar fluxes from
471 ! non GFDL schemes, though it's needed for air quality forecasts.
472 ! For the time being, set to the total downward solar fluxes.
473 !
474 TOTSWDNC(I,J)=TOTSWDN(I,J)
475 ENDIF
476 !
477 ENDDO
478 ENDDO
479 !
480 ENDIF !End non-GFDL block
481 !-----------------------------------------------------------------------
482 !
483 !$omp parallel do &
484 !$omp& private(i,iendx,j)
485 DO J=MYJS2,MYJE2
486 IENDX=MYIE1
487 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
488 DO I=MYIS1,IENDX
489 !
490 RSWIN(I,J)=TOTSWDN(I,J)
491 RSWINC(I,J)=TOTSWDNC(I,J)
492 RSWOUT(I,J)=TOTSWDN(I,J)-SWNETDN(I,J)
493 !
494 ENDDO
495 ENDDO
496 !
497 !$omp parallel do &
498 !$omp& private(i,iendx,j,k)
499 DO J=MYJS2,MYJE2
500 IENDX=MYIE1
501 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
502 DO I=MYIS1,IENDX
503 DO K=KTS,KTE
504 RSWTT(I,J,K)=THRATENSW(I,K,J)*PI_PHY(I,K,J)
505 ENDDO
506 !
507 ENDDO
508 ENDDO
509 !
510 ENDIF nrads_block
511 !
512 !-----------------------------------------------------------------------
513 !*** LONGWAVE
514 !-----------------------------------------------------------------------
515 !
516 nradl_block: IF(MOD(NTSD,NRADL)==0)THEN
517 !
518 !$omp parallel do &
519 !$omp& private(i,iendx,j)
520 DO J=MYJS2,MYJE2
521 IENDX=MYIE1
522 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
523 DO I=MYIS1,IENDX
524 !
525 IF(HBM2(I,J)>0.5)THEN
526 TDUM=T(I,J,KTS)
527 SIGT4(I,J)=STBOLT*TDUM*TDUM*TDUM*TDUM
528 RLWIN(I,J)=TOTLWDN(I,J)
529 ENDIF
530 !
531 ENDDO
532 ENDDO
533 !
534 !$omp parallel do &
535 !$omp& private(i,iendx,j,k)
536 DO J=MYJS2,MYJE2
537 IENDX=MYIE1
538 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
539 !
540 DO K=KTS,KTE
541 DO I=MYIS1,IENDX
542 IF(HBM2(I,J)>0.5)THEN
543 RLWTT(I,J,K)=THRATENLW(I,K,J)*PI_PHY(I,K,J)
544 ENDIF
545 ENDDO
546 ENDDO
547 !
548 ENDDO
549 !
550 ENDIF nradl_block
551 !
552 !-----------------------------------------------------------------------
553 !*** STORE 3D CLOUD FRACTIONS.
554 !-----------------------------------------------------------------------
555 !
556 !$omp parallel do &
557 !$omp& private(i,iendx,j,k)
558 DO K=KTS,KTE
559 DO J=MYJS2,MYJE2
560 IENDX=MYIE1
561 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
562 DO I=MYIS1,IENDX
563 CLDFRA(I,J,K)=CLFR(I,K,J)
564 ENDDO
565 ENDDO
566 ENDDO
567 !
568 !-----------------------------------------------------------------------
569 !*** RESET THE DIAGNOSTIC CONVECTIVE CLOUD TOPS/BOTTOMS AFTER
570 !*** EACH RADIATION CALL.
571 !-----------------------------------------------------------------------
572 !
573 !$omp parallel do &
574 !$omp& private(i,iendx,j)
575 !if (config_flags%ra_sw_physics/=hwrfswscheme.and.config_flags%ra_lw_physics/=hwrflwscheme)then
576 DO J=MYJS2,MYJE2
577 IENDX=MYIE1
578 IF(MOD(J,2)==0.AND.ITE==IDE)IENDX=IENDX-1
579 DO I=MYIS1,IENDX
580 HBOT(I,J)=HBOTR(I,J)
581 HTOP(I,J)=HTOPR(I,J)
582 CUPPT(I,J)=CUPPTR(I,J)
583 ENDDO
584 ENDDO
585 !endif
586 !
587 !-----------------------------------------------------------------------
588 !*** ZERO OUT BOUNDARY ROWS.
589 !-----------------------------------------------------------------------
590 !
591 DO J=JTS,JTE
592 DO I=ITS,ITE
593 IF(HBM2(I,J)<0.5)THEN
594 ACFRST(I,J)=0.
595 ACFRCV(I,J)=0.
596 CFRACL(I,J)=0.
597 CFRACM(I,J)=0.
598 CFRACH(I,J)=0.
599 RSWTOA(I,J)=0.
600 RLWTOA(I,J)=0.
601 ENDIF
602 ENDDO
603 ENDDO
604 !
605 !
606 !-----------------------------------------------------------------------
607 !*** UPDATE THE PROGNOSTIC MOIST ARRAY.
608 !-----------------------------------------------------------------------
609 !
610 DO N=2,N_MOIST
611 !$omp parallel do &
612 !$omp& private(i,j,k)
613 DO J=JMS,JME
614 DO K=KMS,KME
615 DO I=IMS,IME
616 MOIST(I,J,K,N)=MOIST_TRANS(I,K,J,N)
617 ENDDO
618 ENDDO
619 ENDDO
620 ENDDO
621 !
622 DEALLOCATE(MOIST_TRANS,STAT=ISTAT)
623 !
624 !-----------------------------------------------------------------------
625 !
626 END SUBROUTINE RADIATION
627 !
628 !-----------------------------------------------------------------------
629 !***********************************************************************
630 !-----------------------------------------------------------------------
631 SUBROUTINE TURBL(NTSD,DT,NPHS,RESTRT &
632 & ,N_MOIST,NSOIL,SLDPTH,DZSOIL &
633 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2,PDTOP,PT &
634 & ,SM,HBM2,VBM2,DX_ARRAY,DFRLG &
635 & ,CZEN,CZMEAN,SIGT4,RLWIN,RSWIN,RADOT &
636 !- RLWIN/RSWIN - downward longwave/shortwave at the surface (also TOTLWDN/TOTSWDN in RADIATION)
637 & ,PD,RES,PINT,T,Q,CWM,F_ICE,F_RAIN,SR &
638 & ,Q2,U,V,THS,TSFC,SST,PREC,SNO &
639 & ,FIS,Z0,Z0BASE,USTAR,MIXHT,PBLH,LPBL,EL_MYJ &
640 & ,MOIST,RMOL,MOL &
641 & ,EXCH_H,EXCH_M,F,AKHS,AKMS,AKHS_OUT,AKMS_OUT &
642 & ,THZ0,QZ0,UZ0,VZ0,QS,MAVAIL &
643 & ,STC,SMC,CMC,SMSTAV,SMSTOT,SSROFF,BGROFF &
644 & ,IVGTYP,ISLTYP,VEGFRC,SHDMIN,SHDMAX,GRNFLX &
645 & ,SNOTIME &
646 & ,SFCEXC,ACSNOW,ACSNOM,SNOPCX,SICE,TG,SOILTB &
647 & ,ALBASE,MXSNAL,ALBEDO,SH2O,SI,EPSR,EMBCK &
648 & ,U10,V10,TH10,Q10,TSHLTR,QSHLTR,PSHLTR &
649 & ,T2,QSG,QVG,QCG,SOILT1,TSNAV,SMFR3D,KEEPFR3DFLAG &
650 & ,TWBS,QWBS,TAUX,TAUY,SFCSHX,SFCLHX,SFCEVP &
651 & ,POTEVP,POTFLX,SUBSHX &
652 & ,APHTIM,ARDSW,ARDLW,ASRFC &
653 & ,RSWOUT,RSWTOA,RLWTOA &
654 & ,ASWIN,ASWOUT,ASWTOA,ALWIN,ALWOUT,ALWTOA &
655 & ,UZ0H,VZ0H,DUDT,DVDT,UGWDsfc,VGWDsfc,SFENTH & ! GWD
656 & ,RTHBLTEN,RQVBLTEN &
657 & ,PCPFLG,DDATA & ! PRECIP ASSIM
658 & ,HSTDV,HCNVX,HASYW,HASYS,HASYSW,HASYNW,HLENW & ! GWD
659 & ,HLENS,HLENSW,HLENNW,HANGL,HANIS,HSLOP,HZMAX & ! GWD
660 & ,CROT,SROT & ! GWD
661 & ,DEW & ! RUC LSM
662 & ,GRID,CONFIG_FLAGS &
663 & ,IHE,IHW,IVE,IVW &
664 & ,DISHEAT &
665 & ,IDS,IDE,JDS,JDE,KDS,KDE &
666 & ,IMS,IME,JMS,JME,KMS,KME &
667 & ,ITS,ITE,JTS,JTE,KTS,KTE)
668 !***********************************************************************
669 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
670 ! . . .
671 ! SUBPROGRAM: TURBL TURBULENCE OUTER DRIVER
672 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-04-19
673 !
674 ! ABSTRACT:
675 ! TURBL DRIVES THE TURBULENCE SCHEMES
676 !
677 ! PROGRAM HISTORY LOG (with changes to called routines) :
678 ! 95-03-15 JANJIC - ORIGINATOR OF THE SUBROUTINES CALLED
679 ! BLACK & JANJIC - ORIGINATORS OF THE DRIVER
680 ! 95-03-28 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
681 ! 96-03-29 BLACK - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON
682 ! 96-07-19 MESINGER - ADDED Z0 EFFECTIVE
683 ! 98-??-?? TUCCILLO - MODIFIED FOR CLASS VIII PARALLELISM
684 ! 98-10-27 BLACK - PARALLEL CHANGES INTO MOST RECENT CODE
685 ! 02-01-10 JANJIC - MOIST TURBULENCE (DRIVER, MIXLEN, VDIFH)
686 ! 02-01-10 JANJIC - VERT. DIF OF Q2 INCREASED (Grenier & Bretherton)
687 ! 02-02-02 JANJIC - NEW SFCDIF
688 ! 02-04-19 BLACK - ORIGINATOR OF THIS OUTER DRIVER FOR WRF
689 ! 02-05-03 JANJIC - REMOVAL OF SUPERSATURATION AT 2m AND 10m
690 ! 04-11-18 BLACK - THREADED
691 ! 05-12-15 BLACK - CONVERTED FROM IKJ TO IJK
692 ! 07-05-15 FERRIER - ADDED GRAVITY WAVE DRAG (GWD) & MOUNTAIN BLOCKING
693 !
694 ! USAGE: CALL TURBL FROM SOLVE_NMM
695 !
696 ! ATTRIBUTES:
697 ! LANGUAGE: FORTRAN 90
698 ! MACHINE : IBM
699 !$$$
700 !-----------------------------------------------------------------------
701 !
702 IMPLICIT NONE
703 !
704 !-----------------------------------------------------------------------
705 !
706 #if (NMM_CORE==1)
707 LOGICAL,INTENT(IN) :: DISHEAT ! hwrf's doing
708 #endif
709 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
710 & ,IMS,IME,JMS,JME,KMS,KME &
711 & ,ITS,ITE,JTS,JTE,KTS,KTE &
712 & ,N_MOIST,NPHS,NSOIL,NTSD
713 !
714 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
715 !
716 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ISLTYP,IVGTYP
717 !
718 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: LPBL
719 !
720 REAL,INTENT(IN) :: DT,PDTOP,PT
721 !
722 REAL,INTENT(IN) :: SFENTH
723 REAL,INTENT(INOUT) :: APHTIM,ARDSW,ARDLW,ASRFC
724 !
725 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
726 !
727 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFRLG,ETA1,ETA2
728 !
729 REAL,DIMENSION(NSOIL),INTENT(IN) :: DZSOIL,SLDPTH
730 !
731 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CZEN,CZMEAN &
732 & ,DX_ARRAY &
733 & ,F,FIS,HBM2 &
734 & ,PD,RES &
735 & ,RLWIN,RLWTOA &
736 & ,RSWIN,RSWOUT,RSWTOA &
737 & ,SHDMIN,SHDMAX &
738 ! & ,SICE,SIGT4,SM,SR & !Bandaid
739 & ,SIGT4 &
740 & ,HSTDV,HCNVX,HASYW,HASYS,HASYSW,HASYNW,HLENW & ! GWD
741 & ,HLENS,HLENSW,HLENNW,HANGL,HANIS,HSLOP,HZMAX & ! GWD
742 & ,CROT,SROT & ! GWD
743 & ,VBM2,VEGFRC
744 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: SST
745 !
746 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: SM,EPSR,SR & !Bandaid
747 ,TG,SICE &
748 ,EMBCK
749 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ALBASE,MXSNAL
750 !
751 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACSNOM,ACSNOW &
752 & ,SNOTIME &
753 & ,AKHS,AKMS &
754 & ,ALBEDO &
755 & ,BGROFF,CMC &
756 & ,MAVAIL,MOL &
757 & ,MIXHT &
758 & ,PBLH,POTEVP &
759 & ,POTFLX,PREC &
760 & ,QCG,QS,QSG &
761 & ,QVG,QZ0 &
762 & ,RMOL &
763 & ,SFCEVP &
764 & ,SFCLHX,SFCSHX &
765 & ,SI,SMSTOT &
766 & ,SNO,SNOPCX &
767 & ,SOILT1 &
768 & ,SSROFF,SUBSHX &
769 & ,T2,THS,THZ0 &
770 & ,TSFC,TSNAV &
771 & ,USTAR,UZ0,UZ0H &
772 & ,VZ0,VZ0H &
773 & ,DEW & !RUC LSM
774 & ,Z0,Z0BASE
775 !
776 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: AKHS_OUT,AKMS_OUT &
777 & ,ALWIN,ALWOUT &
778 & ,ALWTOA,ASWIN &
779 & ,ASWOUT,ASWTOA &
780 & ,PSHLTR,Q10,QSHLTR &
781 & ,TH10,TSHLTR &
782 & ,U10,V10 & ! GWD
783 & ,UGWDsfc,VGWDsfc ! GWD
784 !
785 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: GRNFLX,QWBS,RADOT &
786 ,SFCEXC,SMSTAV &
787 ,SOILTB,TWBS
788 !
790 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: taux, tauy
791 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: PINT
792 !
793 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: CWM &
794 & ,DUDT &
795 & ,DVDT &
796 & ,Q,Q2 &
797 & ,T,U,V
798 !
799 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: F_ICE & !<--- Used only in physics (IKJ)
800 & ,F_RAIN &
801 & ,RQVBLTEN &
802 & ,RTHBLTEN
803 !
804 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: EL_MYJ & !<--- Used only in physics (IKJ)
805 & ,EXCH_H &
806 & ,EXCH_M
807 !
808 REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME),INTENT(INOUT) :: KEEPFR3DFLAG & !<--- Used only in physics (IKJ)
809 & ,SH2O,SMC &
810 & ,SMFR3D,STC
811 !
812 REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME) :: SMCREL
813 !
814 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_MOIST) &
815 & ,INTENT(INOUT) :: MOIST
816 !
817 LOGICAL,INTENT(IN) :: RESTRT
818 !
819 TYPE(DOMAIN),TARGET :: GRID
820 !
821 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
822 !
823 ! For precip assimilation:
824 LOGICAL,INTENT(IN) :: PCPFLG
825 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDATA
826 !
827 !-----------------------------------------------------------------------
828 !***
829 !*** LOCAL VARIABLES
830 !***
831 !-----------------------------------------------------------------------
832 INTEGER :: I,I_M,IDUMMY,IEND,ISFFLX,ISTAT,ISTR,J,K,KOUNT_ALL &
833 & ,LENGTH_ROW,LLIJ,LLYR,N,SST_UPDATE,SF_URBAN_PHYSICS,NUM_URBAN_LAYERS
834 !
835 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LOWLYR
836 !
837 REAL :: TRESH=0.95
838 !
839 REAL :: ALTITUDE,CWML,DQDT,DTDT,DTPHS,DX,DZHALF,FACTR,FACTRL &
840 & ,G_INV,PLYR,PSFC,QI,QL,QOLD,QR,QW,RATIOMX,RDTPHS &
841 & ,ROG,RWMSK,SDEPTH,SNO_FACTR,TL,TLMH,TLMH4,TNEW,TSFC2 &
842 & ,U_FRAME,V_FRAME,XLVRW
843 !
844 REAL :: APES,CAPA,CKLQ,EXNER,FACTOR,FFS,PQ0X,Q2SAT,QFC1,QLOWX &
845 & ,RLIVWV,THBOT,DPL
846 !
847 REAL,DIMENSION(IMS:IME,JMS:JME) :: BR,CHKLOWQ,CT,CWMLOW,ELFLX &
848 & ,EXNSFC,FACTRS,FLHC,FLQC,GZ1OZ0 &
849 & ,ONE,PDSL,PLM,PSFC_OUT,PSIH &
850 & ,PSIM,Q2X,QLOW,RAIN,RAINBL &
851 & ,RLW_DN_SFC,RSW_NET_SFC &
852 & ,RSW_DN_SFC &
853 & ,SFCEVPX,SFCZ,SNOW,SNOWC,SNOWH &
854 & ,TH2X,THLOW,TLOW,VGFRCK &
855 & ,WSPD,XLAND,REGIME,HOL
856 !
857 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DUDT_PHY,DVDT_PHY,DZ &
858 & ,P_PHY,P8W,PI_PHY &
859 & ,RQCBLTEN,RQIBLTEN &
860 !BSF & ,RQSBLTEN,RQRBLTEN,RQGBLTEN &
861 & ,RR,DELP & ! GWD
862 & ,T_PHY,TH_PHY,TKE &
863 & ,DUDT_GWD,DVDT_GWD & ! GWD
864 & ,U_PHY,V_PHY,Z
865 !
866 REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: MOIST_TRANS
867 !
868 REAL,DIMENSION(IMS:IME,NSOIL,JMS:JME) :: ZERO_SOIL
869 !
870 LOGICAL :: E_BDY,WARM_RAIN
871 !
872 INTEGER :: NUM_ROOF_LAYERS,NUM_WALL_LAYERS,NUM_ROAD_LAYERS ! urban
873 INTEGER :: FRACTIONAL_SEAICE
874 !
875 INTEGER :: IGS,IGE,JGS,JGE, PQ_I !BSF
876 LOGICAL :: FQ_I !BSF
878 CHARACTER(len=255) :: message
879 !dbg integer :: kpblmin,kpblmax,lpblmin,lpblmax !dbg
880 !
881 !
882 INTEGER :: isurban
883 CHARACTER(len=256) :: MMINLU
884 !-----------------------------------------------------------------------
885 !***********************************************************************
886 !-----------------------------------------------------------------------
887 !
888 ALLOCATE(MOIST_TRANS(IMS:IME,KMS:KME,JMS:JME,N_MOIST),STAT=ISTAT)
889 !
890 SF_URBAN_PHYSICS=CONFIG_FLAGS%SF_URBAN_PHYSICS
892 if ( config_flags%bl_pbl_physics == BOULACSCHEME ) then
893 call wrf_error_fatal("Cannot use BOULAC PBL with NMM")
894 endif
896 FRACTIONAL_SEAICE = CONFIG_FLAGS%FRACTIONAL_SEAICE
897 IF ( FRACTIONAL_SEAICE == 1 ) THEN
898 CALL WRF_ERROR_FATAL("NMM cannot use FRACTIONAL_SEAICE = 1.")
899 ENDIF
900 !
901 DTPHS=NPHS*DT
902 RDTPHS=1./DTPHS
903 G_INV=1./G
904 ROG=R_D*G_INV
905 FACTOR=-XLV*RHOWATER/DTPHS
906 CAPA=R_D/CP
907 !
908 U_FRAME=0.
909 V_FRAME=0.
910 !
911 IDUMMY=0
912 ISFFLX=1
913 DX=0.
914 SST_UPDATE=config_flags%SST_UPDATE
915 !
916 !$omp parallel do &
917 !$omp& private(i,j)
918 DO J=JMS,JME
919 DO I=IMS,IME
920 UZ0H(I,J)=0.
921 VZ0H(I,J)=0.
922 ONE(I,J)=1.
923 RMOL(I,J)=0. !Reciprocal of Monin-Obukhov length
924 SFCEVPX(I,J)=0. !Dummy for accumulated latent energy, not flux
925 ENDDO
926 ENDDO
927 !
928 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
929 SNO_FACTR=1.
930 ELSE
931 SNO_FACTR=0.001
932 ENDIF
933 !
934 !$omp parallel do &
935 !$omp& private(i,j)
936 DO J=MYJS,MYJE
937 DO I=MYIS,MYIE
938 LOWLYR(I,J)=1
939 VGFRCK(I,J)=100.*VEGFRC(I,J)
940 SNOW(I,J)=SNO(I,J)
941 SNOWH(I,J)=SI(I,J)*SNO_FACTR
942 XLAND(I,J)=SM(I,J)+1.
943 T2(I,J)=TSFC(I,J)
944 ENDDO
945 ENDDO
946 !
947 IF(NTSD==0)THEN
948 !$omp parallel do &
949 !$omp& private(i,j)
950 DO J=MYJS,MYJE
951 DO I=MYIS,MYIE
952 Z0BASE(I,J)=Z0(I,J)
953 IF(SM(I,J)>0.5.AND.SICE(I,J)>0.5)THEN !Bandaid
954 SM(I,J)=0.
955 ENDIF
956 ENDDO
957 ENDDO
958 ENDIF
959 !
960 !$omp parallel do &
961 !$omp& private(i,j,k)
962 DO J=MYJS,MYJE
963 DO K=KTS,KTE+1
964 DO I=MYIS,MYIE
965 Z(I,K,J)=0.
966 DZ(I,K,J)=0.
967 EXCH_H(I,K,J)=0.
968 EXCH_M(I,K,J)=0.
969 ENDDO
970 ENDDO
971 ENDDO
972 !
973 !-----------------------------------------------------------------------
974 !
975 !*** PREPARE NEEDED ARRAYS FOR CALLING THE INNER DRIVER.
976 !
977 !-----------------------------------------------------------------------
978 !
979 !$omp parallel do &
980 !$omp& private(factrl,i,j,llij,tlmh)
981 DO J=MYJS,MYJE
982 DO I=MYIS,MYIE
983 !
984 PDSL(I,J)=PD(I,J)*RES(I,J)
985 !!! PSFC=PD(I,J)+PDTOP+PT
986 !!! P8W(I,KTS,J)=PSFC
987 P8W(I,KTS,J)=PINT(I,J,KTS)
988 PSFC=PINT(I,J,KTS)
989 LOWLYR(I,J)=KTS !<---- The lowest model layer counted from the bottom.
990 EXNSFC(I,J)=(1.E5/PSFC)**CAPA
991 THS(I,J)=(SST(I,J)*EXNSFC(I,J))*SM(I,J)+THS(I,J)*(1.-SM(I,J))
992 TSFC(I,J)=THS(I,J)/EXNSFC(I,J)
993 SFCZ(I,J)=FIS(I,J)*G_INV
994 !YL RAIN(I,J)=PREC(I,J)*RHOWATER
995 IF (PCPFLG.AND.DDATA(I,J)<100.)THEN
996 RAIN(I,J)=DDATA(I,J)*RHOWATER
997 ELSE
998 RAIN(I,J)=PREC(I,J)*RHOWATER
999 ENDIF
1000 !YL
1001 RAINBL(I,J)=0.
1002 IF(SNO(I,J)>0.)SNOWC(I,J)=1.
1003 LLIJ=LOWLYR(I,J)
1004 PLM(I,J)=(PINT(I,J,LLIJ)+PINT(I,J,LLIJ+1))*0.5
1005 TH2X(I,J)=T(I,J,LLIJ)*(1.E5/PLM(I,J))**CAPA
1006 Q2X(I,J)=Q(I,J,LLIJ)
1007 !
1008 !-----------------------------------------------------------------------
1009 !*** LONG AND SHORTWAVE FLUX AT GROUND SURFACE
1010 !-----------------------------------------------------------------------
1011 !
1012 IF(CZMEAN(I,J)>0.)THEN
1013 FACTRS(I,J)=CZEN(I,J)/CZMEAN(I,J)
1014 ELSE
1015 FACTRS(I,J)=0.
1016 ENDIF
1017 !
1018 IF(SIGT4(I,J)>0.)THEN
1019 TLMH=T(I,J,LLIJ)
1020 FACTRL=STBOLT*TLMH*TLMH*TLMH*TLMH/SIGT4(I,J)
1021 ELSE
1022 FACTRL=0.
1023 ENDIF
1024 !
1025 !- RLWIN/RSWIN - downward longwave/shortwave at the surface
1026 !
1027 RLW_DN_SFC(I,J)=RLWIN(I,J)*HBM2(I,J)*FACTRL
1028 RSW_NET_SFC(I,J)=(RSWIN(I,J)-RSWOUT(I,J))*HBM2(I,J)*FACTRS(I,J)
1029 !
1030 !- Instant downward solar for nmm_lsm
1031 !
1032 RSW_DN_SFC(I,J)=RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
1033 !
1034 Z(I,KTS,J)=SFCZ(I,J)
1035 !
1036 ENDDO
1037 ENDDO
1038 !
1039 !-----------------------------------------------------------------------
1040 !*** FILL THE ARRAYS FOR CALLING THE INNER DRIVER.
1041 !-----------------------------------------------------------------------
1042 !
1043 !$omp parallel do &
1044 !$omp& private(cwml,i,j,k,plyr,qi,ql,qr,qw,tl)
1045 DO J=MYJS,MYJE
1046 DO K=KTS,KTE
1047 DO I=MYIS,MYIE
1048 Q2(I,J,K)=MAX(Q2(I,J,K)*HBM2(I,J),EPSQ2)
1049 QL=MAX(Q(I,J,K),EPSQ)
1050 PLYR=(PINT(I,J,K)+PINT(I,J,K+1))*0.5
1051 !!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL(I,J)+PT
1052 TL=T(I,J,K)
1053 CWML=CWM(I,J,K)
1054 !
1055 RR(I,K,J)=PLYR/(R_D*TL)
1056 T_PHY(I,K,J)=TL
1057 !
1058 EXNER=(1.E5/PLYR)**CAPA
1059 PI_PHY(I,K,J)=1./EXNER
1060 TH_PHY(I,K,J)=TL*EXNER
1061 P8W(I,K+1,J)=PINT(I,J,K+1)
1062 !!! P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL(I,J)+PT
1063 P_PHY(I,K,J)=PLYR
1064 TKE(I,K,J)=0.5*Q2(I,J,K)
1065 !
1066 RTHBLTEN(I,K,J)=0.
1067 RQVBLTEN(I,K,J)=0.
1068 RQCBLTEN(I,K,J)=0.
1069 RQIBLTEN(I,K,J)=0.
1070 !BSF RQSBLTEN(I,K,J)=0.
1071 !BSF RQRBLTEN(I,K,J)=0.
1072 !BSF RQGBLTEN(I,K,J)=0.
1073 !
1074 !-- Next 3 lines modified for GWD
1075 !
1076 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
1077 Z(I,K+1,J)=Z(I,K,J)+TL/PLYR*DPL*ROG*(Q(I,J,K)*P608-CWML+1.)
1078 DELP(I,K,J)=DPL
1079 DZ(I,K,J)=Z(I,K+1,J)-Z(I,K,J)
1080 ENDDO
1081 ENDDO
1082 ENDDO
1083 !
1084 !$omp parallel do &
1085 !$omp& private(i,j,llyr,qlowx)
1086 DO J=MYJS,MYJE
1087 DO I=MYIS,MYIE
1088 TWBS(I,J)=0.
1089 QWBS(I,J)=0.
1090 LLYR=LOWLYR(I,J)
1091 THLOW(I,J)=TH_PHY(I,LLYR,J)
1092 TLOW(I,J)=T_PHY(I,LLYR,J)
1093 QLOW(I,J)=MAX(Q(I,J,LLYR),EPSQ)
1094 QLOWX=QLOW(I,J)/(1.-QLOW(I,J))
1095 QLOW(I,J)=QLOWX/(1.+QLOWX)
1096 CWMLOW(I,J)=CWM(I,J,LLYR)
1097 PBLH(I,J)=MAX(PBLH(I,J),0.)
1098 PBLH(I,J)=MIN(PBLH(I,J),Z(I,KTE,J))
1099 ENDDO
1100 ENDDO
1101 !-----------------------------------------------------------------------
1102 !
1103 !*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS
1104 !
1105 !-----------------------------------------------------------------------
1106 !$omp parallel do &
1107 !$omp& private(i,j,k)
1108 DO K=KTS,KTE
1109 DO J=MYJS1_P1,MYJE1_P1
1110 DO I=MYIS_P1,MYIE_P1
1111 U_PHY(I,K,J)=(U(I+IHE(J),J,K)+U(I+IHW(J),J,K) &
1112 & +U(I,J+1,K)+U(I,J-1,K)) &
1113 & *0.25
1114 V_PHY(I,K,J)=(V(I+IHE(J),J,K)+V(I+IHW(J),J,K) &
1115 & +V(I,J+1,K)+V(I,J-1,K)) &
1116 & *0.25
1117 ENDDO
1118 ENDDO
1119 ENDDO
1120 !
1121 !$omp parallel do &
1122 !$omp& private(i,iend,istr,j)
1123 DO J=MYJS1_P1,MYJE1_P1
1124 IF(MOD(J,2)==0)THEN
1125 ISTR=MYIS_P1
1126 IEND=MIN(MYIE_P1,IDE-1)
1127 ELSE
1128 ISTR=MAX(MYIS_P1,IDS+1)
1129 IEND=MIN(MYIE_P1,IDE-1)
1130 ENDIF
1131 !
1132 DO I=ISTR,IEND
1133 UZ0H(I,J)=(UZ0(I+IHE(J),J)+UZ0(I+IHW(J),J) &
1134 & +UZ0(I,J+1)+UZ0(I,J-1))*0.25
1135 !!! & +UZ0(I,J+1)+UZ0(I,J-1))*HBM2(I,J)*0.25
1136 VZ0H(I,J)=(VZ0(I+IHE(J),J)+VZ0(I+IHW(J),J) &
1137 & +VZ0(I,J+1)+VZ0(I,J-1))*0.25
1138 !!! & +VZ0(I,J+1)+VZ0(I,J-1))*HBM2(I,J)*0.25
1139 ENDDO
1140 ENDDO
1141 !
1142 !-----------------------------------------------------------------------
1143 !*** SET MAVAIL EQUAL TO 1. ONLY FOR NMM LSM
1144 !-----------------------------------------------------------------------
1145 !
1146 DO J=JTS,JTE
1147 DO I=ITS,ITE
1148 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==2.OR. &
1149 MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
1150 ONE(I,J)=1.
1151 ELSE
1152 !*** MAVAIL should not be equal to 1. for other LSMs
1153 ONE(I,J)=MAVAIL(I,J)
1154 ENDIF
1155 ENDDO
1156 ENDDO
1157 !
1158 !-----------------------------------------------------------------------
1159 !*** TRANSPOSE THE MOIST ARRAY (IJK) FOR THE PHYSICS (IKJ).
1160 !-----------------------------------------------------------------------
1161 !
1162 DO N=1,N_MOIST
1163 !$omp parallel do &
1164 !$omp& private(i,j,k)
1165 DO K=KMS,KME
1166 DO J=JMS,JME
1167 DO I=IMS,IME
1168 MOIST_TRANS(I,K,J,N)=MOIST(I,J,K,N)
1169 ENDDO
1170 ENDDO
1171 ENDDO
1172 ENDDO
1173 !
1174 !-----------------------------------------------------------------------
1175 !*** URBAN RELATED VARIABLES ARE ADDED TO ARGUMENTS OF SURFACE_DRIVER
1176 !-----------------------------------------------------------------------
1177 !
1178 NUM_ROOF_LAYERS=GRID%NUM_SOIL_LAYERS !urban
1179 NUM_WALL_LAYERS=GRID%NUM_SOIL_LAYERS !urban
1180 NUM_ROAD_LAYERS=GRID%NUM_SOIL_LAYERS !urban
1181 CALL nl_get_isurban(grid%id, isurban)
1182 call nl_get_mminlu(grid%id, mminlu)
1183 !
1184 !-----------------------------------------------------------------------
1185 !
1186 !*** CALL SURFACE LAYER AND LAND SURFACE PHYSICS
1187 !
1188 !-----------------------------------------------------------------------
1189 !
1190 CALL SET_TILES(GRID,IDS,IDE-1,JDS+1,JDE-1,ITS,ITE,JTS,JTE)
1191 !
1192 CALL SURFACE_DRIVER( &
1193 & ACSNOM=ACSNOM,ACSNOW=ACSNOW,AKHS=AKHS,AKMS=AKMS &
1194 & ,ALBEDO=ALBEDO,BR=BR,CANWAT=CMC,CHKLOWQ=CHKLOWQ &
1195 & ,DT=DT,DX=DX,DZ8W=DZ,DZS=DZSOIL,GLW=RLW_DN_SFC &
1196 & ,GRDFLX=GRNFLX,GSW=RSW_NET_SFC,SWDOWN=RSW_DN_SFC &
1197 & ,GZ1OZ0=GZ1OZ0,HFX=TWBS &
1198 & ,HT=SFCZ,IFSNOW=IDUMMY,ISFFLX=ISFFLX &
1199 & ,FRACTIONAL_SEAICE=FRACTIONAL_SEAICE &
1200 & ,TICE2TSK_IF2COLD=CONFIG_FLAGS%TICE2TSK_IF2COLD &
1201 & ,ISLTYP=ISLTYP &
1202 & ,ITIMESTEP=NTSD,IVGTYP=IVGTYP,LOWLYR=LOWLYR &
1203 & ,MAVAIL=ONE,RMOL=RMOL,MOL=MOL &
1204 & ,NUM_SOIL_LAYERS=NSOIL,P8W=P8W &
1205 & ,PBLH=PBLH,PI_PHY=PI_PHY,PSHLTR=PSHLTR,PSIH=PSIH &
1206 & ,PSIM=PSIM,P_PHY=P_PHY,Q10=Q10,Q2=Q2X,QFX=QWBS,TAUX=TAUX,TAUY=TAUY,QSFC=QS &
1207 & ,QSHLTR=QSHLTR,QZ0=QZ0,RAINCV=RAIN &
1208 & ,RHO=RR,SFCEVP=SFCEVPX,SFCEXC=SFCEXC,SFCRUNOFF=SSROFF &
1209 & ,SMOIS=SMC,SMSTAV=SMSTAV,SMSTOT=SMSTOT,SNOALB=MXSNAL &
1210 & ,SNOW=SNOW,SNOWC=SNOWC,SNOWH=SNOWH,STEPBL=NPHS &
1211 & ,SMCREL=SMCREL &
1212 & ,SST=SST,SST_UPDATE=SST_UPDATE &
1213 & ,TH10=TH10,TH2=TH2X,T2=T2,THZ0=THZ0,TH_PHY=TH_PHY &
1214 & ,TMN=TG,TSHLTR=TSHLTR,TSK=TSFC,TSLB=STC,T_PHY=T_PHY &
1215 & ,U10=U10,UDRUNOFF=BGROFF,UST=USTAR,UZ0=UZ0H &
1216 & ,U_FRAME=U_FRAME,U_PHY=U_PHY,V10=V10,VEGFRA=VGFRCK &
1217 & ,VZ0=VZ0H,V_FRAME=V_FRAME,V_PHY=V_PHY &
1218 & ,WARM_RAIN=WARM_RAIN,WSPD=WSPD,XICE=SICE,XICEM=SICE &
1219 & ,ISICE=GRID%LANDUSE_ISICE,ISWATER=GRID%ISWATER &
1220 & ,XLAND=XLAND,Z=Z,ZNT=Z0,ZS=SLDPTH,CT=CT,TKE_PBL=TKE,SFENTH=SFENTH &
1221 & ,ALBBCK=ALBASE,LH=ELFLX,SH2O=SH2O,SHDMAX=SHDMAX &
1222 & ,SHDMIN=SHDMIN,Z0=Z0BASE,FLQC=FLQC,FLHC=FLHC &
1223 & ,PSFC=PSFC_OUT,EMISS=EPSR,EMBCK=EMBCK &
1224 & ,SF_SFCLAY_PHYSICS=CONFIG_FLAGS%SF_SFCLAY_PHYSICS &
1225 & ,SF_SURFACE_PHYSICS=CONFIG_FLAGS%SF_SURFACE_PHYSICS &
1226 & ,RA_LW_PHYSICS=CONFIG_FLAGS%RA_LW_PHYSICS &
1227 & ,LAI=GRID%LAI,IZ0TLND=CONFIG_FLAGS%IZ0TLND &
1228 & ,SF_URBAN_PHYSICS=SF_URBAN_PHYSICS &
1229 ! & ,GMT=GMT,XLAT=XLAT,XLONG=XLONG,JULDAY=JULDAY &
1230 & ,NUM_URBAN_LAYERS=NUM_URBAN_LAYERS &
1231 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1232 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1233 & ,I_START=GRID%I_START,I_END=GRID%I_END &
1234 & ,J_START=GRID%J_START,J_END=GRID%J_END &
1235 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
1236 ! Optional args
1237 & ,QV_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QV),F_QV=F_QV &
1238 & ,QC_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QC),F_QC=F_QC &
1239 & ,QR_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QR),F_QR=F_QR &
1240 & ,QI_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QI),F_QI=F_QI &
1241 & ,QS_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QS),F_QS=F_QS &
1242 & ,QG_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG &
1243 & ,RAINBL=RAINBL &
1244 & ,LAGDAY=1 & ! tmn_update
1245 ! for RUCLSM
1246 & ,QSG=QSG,QVG=QVG,QCG=QCG,SOILT1=SOILT1 &
1247 & ,TSNAV=TSNAV,SMFR3D=SMFR3D,KEEPFR3DFLAG=KEEPFR3DFLAG &
1248 & ,POTEVP=POTEVP,SNOPCX=SNOPCX,SOILTB=SOILTB,SR=SR &
1249 & ,DEW=DEW &
1250 ! for URBAN
1251 & ,NUM_ROOF_LAYERS=NUM_ROOF_LAYERS & ! urban
1252 & ,NUM_WALL_LAYERS=NUM_WALL_LAYERS & ! urban
1253 & ,NUM_ROAD_LAYERS=NUM_ROAD_LAYERS & ! urban
1254 ! for YSU
1255 & ,REGIME=REGIME &
1256 ! for PX LSM
1257 & ,NLCAT=grid%num_land_cat, NSCAT=grid%num_soil_cat & ! P-X LSM
1258 & ,ISURBAN=isurban, MMINLU=TRIM(mminlu) &
1259 & ,SNOTIME = grid%SNOTIME &
1260 & ,RDLAI2D=config_flags%rdlai2d &
1261 & ,usemonalb=config_flags%usemonalb &
1262 & ,NOAHRES=grid%noahres &
1263 & )
1264 !
1265 !-----------------------------------------------------------------------
1266 !
1267 !*** CALL FREE ATMOSPHERE TURBULENCE
1268 !
1269 !-----------------------------------------------------------------------
1270 !
1271 !$omp parallel do &
1272 !$omp& private(i,j,k)
1273 DO J=JMS,JME
1274 DO K=KMS,KME
1275 DO I=IMS,IME
1276 DUDT_PHY(I,K,J)=0.
1277 DVDT_PHY(I,K,J)=0.
1278 ENDDO
1279 ENDDO
1280 ENDDO
1281 !
1282 !*** THE SURFACE EXCHANGE COEFFICIENTS AKHS AND AKMS ARE ACTUALLY
1283 !*** MULTIPLIED BY HALF THE DEPTH OF THE LOWEST LAYER. WE MUST RETAIN
1284 !*** THOSE VALUES FOR THE NEXT TIMESTEP SO USE AUXILLIARY ARRAYS FOR
1285 !*** THE OUTPUT.
1286 !
1287 !$omp parallel do &
1288 !$omp& private(dzhalf,i,j)
1289 DO J=JTS,JTE
1290 DO I=ITS,ITE
1291 DZHALF=0.5*DZ(I,KTS,J)
1292 AKHS_OUT(I,J)=AKHS(I,J)*DZHALF
1293 AKMS_OUT(I,J)=AKMS(I,J)*DZHALF
1294 ENDDO
1295 ENDDO
1296 !
1297 !BSF: Logical FQ_I index PQ_I are set to values associated with snow
1298 ! for the ETAMPNEW scheme so that they can be mixed by the PBL schemes.
1299 !
1300 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
1301 FQ_I=F_QS
1302 PQ_I=P_QS
1303 ELSE
1304 FQ_I=F_QI
1305 PQ_I=P_QI
1306 ENDIF
1307 !
1308 CALL PBL_DRIVER( &
1309 & ITIMESTEP=NTSD,DT=DT &
1310 & ,U_FRAME=U_FRAME,V_FRAME=V_FRAME &
1311 & ,RUBLTEN=DUDT_PHY,RVBLTEN=DVDT_PHY &
1312 & ,RTHBLTEN=RTHBLTEN,RQVBLTEN=RQVBLTEN & !BSF
1313 & ,RQCBLTEN=RQCBLTEN,RQIBLTEN=RQIBLTEN & !BSF
1314 !BSF & ,RQRBLTEN=RQRBLTEN,RQSBLTEN=RQSBLTEN & !BSF
1315 !BSF & ,RQGBLTEN=RQGBLTEN & !BSF
1316 & ,TSK=TSFC,XLAND=XLAND,ZNT=Z0,HT=SFCZ &
1317 & ,UST=USTAR,MIXHT=MIXHT,PBLH=PBLH &
1318 & ,HFX=TWBS,QFX=QWBS,GRDFLX=GRNFLX &
1319 & ,U_PHY=U_PHY,V_PHY=V_PHY,TH_PHY=TH_PHY,RHO=RR &
1320 & ,P_PHY=P_PHY,PI_PHY=PI_PHY,P8W=P8W,T_PHY=T_PHY &
1321 & ,DZ8W=DZ,Z=Z,TKE_PBL=TKE,EL_PBL=EL_MYJ,F=F &
1322 & ,EXCH_H=EXCH_H,EXCH_M=EXCH_M,AKHS=AKHS,AKMS=AKMS &
1323 & ,THZ0=THZ0,QZ0=QZ0,UZ0=UZ0H,VZ0=VZ0H &
1324 & ,QSFC=QS,LOWLYR=LOWLYR &
1325 & ,PSIM=PSIM,PSIH=PSIH,GZ1OZ0=GZ1OZ0 &
1326 & ,U10=U10,V10=V10,T2=T2,WSPD=WSPD,BR=BR,CHKLOWQ=CHKLOWQ &
1327 & ,DX=DX,STEPBL=NPHS,WARM_RAIN=WARM_RAIN &
1328 & ,KPBL=KPBL,CT=CT,LH=ELFLX,SNOW=SNOW,XICE=SICE &
1329 & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics &
1330 & ,RA_LW_PHYSICS=config_flags%ra_lw_physics &
1331 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1332 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1333 & ,I_START=GRID%I_START,I_END=GRID%I_END &
1334 & ,J_START=GRID%J_START,J_END=GRID%J_END &
1335 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
1336 #if (NMM_CORE==1)
1337 & ,DISHEAT=DISHEAT &
1338 #endif
1339 ! Optional args
1340 & ,QV_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QV),F_QV=F_QV &
1341 & ,QC_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QC),F_QC=F_QC &
1342 & ,QI_CURR=MOIST_TRANS(IMS,KMS,JMS,PQ_I),F_QI=FQ_I &
1343 & ,QR_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QR),F_QR=F_QR &
1344 & ,QS_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QS),F_QS=F_QS &
1345 & ,QG_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG &
1346 & ,HOL=HOL,sf_sfclay_physics=CONFIG_FLAGS%SF_SFCLAY_PHYSICS &
1347 & ,sf_urban_physics=CONFIG_FLAGS%SF_URBAN_PHYSICS)
1348 !
1349 !*** NOTE THAT THE EXCHANGE COEFFICIENTS FOR HEAT EXCH_H COMING OUT OF
1350 !*** PBL_DRIVER ARE DEFINED AT THE TOPS OF THE LAYERS KTS TO KTE-1
1351 !*** IF MODULE_BL_MYJPBL WAS INVOKED.
1352 !
1353 !-----------------------------------------------------------------------
1354 ! UNCOMPUTED LOCATIONS MUST BE FILLED IN FOR THE POST-PROCESSOR
1355 !-----------------------------------------------------------------------
1356 !
1357 !*** EASTERN GLOBAL BOUNDARY
1358 !
1359 IF(MYIE==IDE)THEN
1360 !$omp parallel do &
1361 !$omp& private(i,j)
1362 DO J=JDS,JDE
1363 IF (J>=MYJS.AND.J<=MYJE)THEN
1364 TH10(MYIE,J)=TH10(MYIE-1,J)
1365 Q10(MYIE,J)=Q10(MYIE-1,J)
1366 U10(MYIE,J)=U10(MYIE-1,J)
1367 V10(MYIE,J)=V10(MYIE-1,J)
1368 TSHLTR(MYIE,J)=TSHLTR(MYIE-1,J)
1369 QSHLTR(MYIE,J)=QSHLTR(MYIE-1,J)
1370 ENDIF
1371 ENDDO
1372 ENDIF
1373 !
1374 !*** SOUTHERN GLOBAL BOUNDARY
1375 !
1377 IF(MYJS==JDS)THEN
1378 DO J=JDS,JDS+1
1379 DO I=IDS,IDE
1380 IF (I>=MYIS.AND.I<=MYIE) THEN
1381 TH10(I,J)=TH10(I,MYJS+2)
1382 Q10(I,J)=Q10(I,MYJS+2)
1383 U10(I,J)=U10(I,MYJS+2)
1384 V10(I,J)=V10(I,MYJS+2)
1385 TSHLTR(I,J)=TSHLTR(I,MYJS+2)
1386 QSHLTR(I,J)=QSHLTR(I,MYJS+2)
1387 ENDIF
1388 ENDDO
1389 ENDDO
1390 ENDIF
1391 !
1392 !*** NORTHERN GLOBAL BOUNDARY
1393 !
1394 IF(MYJE==JDE)THEN
1395 !$omp parallel do &
1396 !$omp& private(i,j)
1397 DO J=MYJE-1,MYJE
1398 DO I=IDS,IDE
1399 IF (I>=MYIS.AND.I<=MYIE) THEN
1400 TH10(I,J)=TH10(I,MYJE-2)
1401 Q10(I,J)=Q10(I,MYJE-2)
1402 U10(I,J)=U10(I,MYJE-2)
1403 V10(I,J)=V10(I,MYJE-2)
1404 TSHLTR(I,J)=TSHLTR(I,MYJE-2)
1405 QSHLTR(I,J)=QSHLTR(I,MYJE-2)
1406 ENDIF
1407 ENDDO
1408 ENDDO
1409 ENDIF
1410 !
1411 IF(CONFIG_FLAGS%SF_SFCLAY_PHYSICS==1)THEN ! non-NMM package
1412 !$omp parallel do &
1413 !$omp& private(i,j)
1414 DO J=MYJS1,MYJE1
1415 DO I=MYIS,MYIE1
1416 ! TSHLTR(I,J)=TSHLTR(I,J)*(1.E5/PSHLTR(I,J))**RCP
1417 IF(TSHLTR(I,J)<200..OR.TSHLTR(I,J)>350.)THEN
1418 WRITE(message,*)'Troublesome TSHLTR...I,J,TSHLTR,PSHLTR: ' &
1419 ,I,J,TSHLTR(I,J),PSHLTR(I,J)
1420 CALL wrf_message(trim(message))
1421 ENDIF
1422 ENDDO
1423 ENDDO
1424 ENDIF
1425 !
1426 !-----------------------------------------------------------------------
1427 !*** COMPUTE MODEL LAYER CONTAINING THE TOP OF THE BOUNDARY LAYER
1428 !-----------------------------------------------------------------------
1429 !
1430 IF(CONFIG_FLAGS%BL_PBL_PHYSICS/=MYJPBLSCHEME)THEN
1431 LENGTH_ROW=MYIE1-MYIS1+1
1432 DO J=MYJS2,MYJE2
1433 DO I=MYIS1,MYIE1
1434 KPBL(I,J)=-1000
1435 ENDDO
1436 ENDDO
1437 !
1438 !$omp parallel do &
1439 !$omp& private(altitude,i,j,k,kount_all)
1440 DO J=MYJS2,MYJE2
1441 KOUNT_ALL=0
1442 find_kpbl : DO K=KTS,KTE
1443 DO I=MYIS1,MYIE1
1444 ALTITUDE=Z(I,K+1,J)-SFCZ(I,J)
1445 IF(PBLH(I,J)<=ALTITUDE.AND.KPBL(I,J)<0)THEN
1446 KPBL(I,J)=K
1447 KOUNT_ALL=KOUNT_ALL+1
1448 ENDIF
1449 IF(KOUNT_ALL==LENGTH_ROW)EXIT find_kpbl
1450 ENDDO
1451 ENDDO find_kpbl
1452 ENDDO
1453 ENDIF
1454 !
1455 IF(MODEL_CONFIG_REC%SF_SURFACE_PHYSICS(GRID%ID)==99)THEN
1456 SNO_FACTR=1.
1457 ELSE
1458 SNO_FACTR=1000.
1459 ENDIF
1460 !
1461 !$omp parallel do &
1462 !$omp& private(i,j)
1463 DO J=MYJS2,MYJE2
1464 DO I=MYIS1,MYIE1
1465 SNO(I,J)=SNOW(I,J)
1466 SI(I,J)=SNOWH(I,J)*SNO_FACTR
1467 LPBL(I,J)=KTE-KPBL(I,J)+1
1468 ENDDO
1469 ENDDO
1470 !
1471 !-----------------------------------------------------------------------
1472 !*** DIAGNOSTIC RADIATION ACCUMULATION
1473 !-----------------------------------------------------------------------
1474 !
1475 !$omp parallel do &
1476 !$omp& private(i,j,tsfc2)
1477 DO J=MYJS2,MYJE2
1478 DO I=MYIS,MYIE
1479 ASWIN (I,J)=ASWIN (I,J)+RSWIN(I,J)*HBM2(I,J)*FACTRS(I,J)
1480 ASWOUT(I,J)=ASWOUT(I,J)-RSWOUT(I,J)*HBM2(I,J)*FACTRS(I,J)
1481 ASWTOA(I,J)=ASWTOA(I,J)+RSWTOA(I,J)*HBM2(I,J)*FACTRS(I,J)
1482 ALWIN (I,J)=ALWIN (I,J)+RLW_DN_SFC(I,J)
1483 ALWOUT(I,J)=ALWOUT(I,J)-RADOT (I,J)*HBM2(I,J)
1484 ALWTOA(I,J)=ALWTOA(I,J)+RLWTOA(I,J)*HBM2(I,J)
1485 !
1486 TSFC2=TSFC(I,J)*TSFC(I,J)
1487 RADOT(I,J)=HBM2(I,J)*EPSR(I,J)*STBOLT*TSFC2*TSFC2
1488 THS(I,J)=TSFC(I,J)*EXNSFC(I,J)
1489 PREC(I,J)=0.
1490 ENDDO
1491 ENDDO
1492 !
1493 !=======================================================================
1494 !=== Begin gravity wave drag (GWD) and mountain blocking (MB) ========
1495 !=======================================================================
1496 !
1497 IGS=MYIS1
1498 IGE=MYIE1
1499 JGS=MYJS2
1500 JGE=MYJE2
1501 !dbg !dbg
1502 !dbg kpblmin=100
1503 !dbg kpblmax=-100
1504 !dbg DO J=JGS,JGE
1505 !dbg DO I=IGS,IGE
1506 !dbg kpblmin=min(kpblmin,kpbl(i,j))
1507 !dbg kpblmax=max(kpblmax,kpbl(i,j))
1508 !dbg enddo
1509 !dbg enddo
1510 !dbg print *,'TURBL: IGS,IGE,JGS,JGE,kpblmin,kpblmax=',IGS,IGE,JGS,JGE,kpblmin,kpblmax
1511 !dbg
1513 ! print *,'grid%id gwd_opt at module_PHYSICS ',grid%id, grid%gwd_opt
1514 ! WRITE(0,*)'grid%id gwd_opt at module_PHYSICS ',grid%id, grid%gwd_opt
1515 ! WRITE(MESSAGE,125)grid%gwd_opt
1516 !125 FORMAT(1X,'grid%id module_PHYSICS.F : gwd_opt ',I2,2X,I2)
1519 #ifdef HWRF
1520 IF (grid%gwd_opt .eq. 2 .AND. grid%id.eq.1) THEN !Kwon's doing for parent only now
1521 #else
1522 IF (grid%gwd_opt .eq. 2) THEN
1523 #endif
1524 ! print *,'==grid%id gwd_opt at module_PHYSICS inside gwd ',grid%id, grid%gwd_opt !because there is no data for nest domain
1526 CALL wrf_message("GWD usage currently may be problematic for some cases - use at own risk")
1528 CALL GWD_driver(U=U_PHY,V=V_PHY,T=T_PHY &
1529 & ,Q=MOIST_TRANS(IMS,KMS,JMS,P_QV) &
1530 & ,Z=Z,DP=DELP,PINT=P8W,PMID=P_PHY,EXNR=PI_PHY &
1531 & ,KPBL=KPBL,ITIME=NTSD &
1532 & ,HSTDV=HSTDV,HCNVX=HCNVX,HASYW=HASYW,HASYS=HASYS &
1533 & ,HASYSW=HASYSW,HASYNW=HASYNW,HLENW=HLENW &
1534 & ,HLENS=HLENS,HLENSW=HLENSW,HLENNW=HLENNW &
1535 & ,HANGL=HANGL,HANIS=HANIS,HSLOP=HSLOP,HZMAX=HZMAX &
1536 & ,CROT=CROT,SROT=SROT &
1537 & ,DUDT=DUDT_GWD,DVDT=DVDT_GWD &
1538 & ,UGWDsfc=UGWDsfc,VGWDsfc=VGWDsfc &
1539 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
1540 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
1541 & ,ITS=IGS,ITE=IGE,JTS=JGS,JTE=JGE,KTS=KTS,KTE=KTE )
1543 !=======================================================================
1544 !===== End gravity wave drag (GWD) and mountain blocking (MB) ========
1545 !=======================================================================
1546 !
1547 !-----------------------------------------------------------------------
1548 !*** TRANSFER THE WIND TENDENCIES.
1549 !-----------------------------------------------------------------------
1550 !
1551 DO K=KTS,KTE
1552 DO J=JTS,JTE
1553 DO I=ITS,ITE
1556 !mp temporary bandaid limiting GWD/MB wind tendencies
1558 IF (DUDT_GWD(I,K,J) .gt. 1.6) then
1559 write(message,*) 'BIG DUDT_GWD:: ', I,K,J, DUDT_GWD(I,K,J)
1560 CALL wrf_message(message)
1561 DUDT_GWD(I,K,J)=1.6
1562 ENDIF
1564 IF (DUDT_GWD(I,K,J) .lt. -1.6) then
1565 write(message,*) 'BIG DUDT_GWD:: ', I,K,J, DUDT_GWD(I,K,J)
1566 CALL wrf_message(message)
1567 DUDT_GWD(I,K,J)=-1.6
1568 ENDIF
1570 IF (DVDT_GWD(I,K,J) .gt. 1.6) then
1571 write(message,*) 'BIG DVDT_GWD:: ', I,K,J, DVDT_GWD(I,K,J)
1572 CALL wrf_message(message)
1573 DVDT_GWD(I,K,J)=1.6
1574 ENDIF
1576 IF (DVDT_GWD(I,K,J) .lt. -1.6) then
1577 write(message,*) 'BIG DVDT_GWD:: ', I,K,J, DVDT_GWD(I,K,J)
1578 CALL wrf_message(message)
1579 DVDT_GWD(I,K,J)=-1.6
1580 ENDIF
1582 !mp end temporary bandaid
1584 DUDT(I,J,K)=DUDT_PHY(I,K,J)+DUDT_GWD(I,K,J)
1585 DVDT(I,J,K)=DVDT_PHY(I,K,J)+DVDT_GWD(I,K,J)
1587 ENDDO
1588 ENDDO
1589 ENDDO
1591 ELSE ! no GWD
1593 DO K=KTS,KTE
1594 DO J=JTS,JTE
1595 DO I=ITS,ITE
1596 DUDT(I,J,K)=DUDT_PHY(I,K,J)
1597 DVDT(I,J,K)=DVDT_PHY(I,K,J)
1598 ENDDO
1599 ENDDO
1600 ENDDO
1602 ENDIF ! gwd_opt
1603 !
1604 !-----------------------------------------------------------------------
1605 !*** TRANSPOSE THE MOIST_TRANS ARRAY BACK TO THE PROGNOSTIC MOIST ARRAY.
1606 !-----------------------------------------------------------------------
1607 !
1608 DO N=1,N_MOIST
1609 !$omp parallel do &
1610 !$omp& private(i,j,k)
1611 DO J=JMS,JME
1612 DO K=KMS,KME
1613 DO I=IMS,IME
1614 MOIST(I,J,K,N)=MOIST_TRANS(I,K,J,N)
1615 ENDDO
1616 ENDDO
1617 ENDDO
1618 ENDDO
1619 !
1620 DEALLOCATE(MOIST_TRANS,STAT=ISTAT)
1621 !
1622 !-----------------------------------------------------------------------
1623 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD, AND TKE.
1624 !-----------------------------------------------------------------------
1625 !
1626 E_BDY=(ITE>=IDE)
1627 !
1628 !$omp parallel do &
1629 !$omp& private(dqdt,dtdt,i,iend,j,k,qi,qold,qr,qw,ratiomx,i_m)
1630 DO K=KTS,KTE
1631 DO J=MYJS2,MYJE2
1632 IEND=MYIE1
1633 IF(E_BDY.AND.MOD(J,2)==0)IEND=IEND-1
1634 !
1635 DO I=MYIS1,IEND
1636 DTDT=RTHBLTEN(I,K,J)*PI_PHY(I,K,J)
1637 DQDT=RQVBLTEN(I,K,J) !Mixing ratio tendency
1638 T(I,J,K)=T(I,J,K)+DTDT*DTPHS
1639 QOLD=Q(I,J,K)
1640 RATIOMX=QOLD/(1.-QOLD)+DQDT*DTPHS
1641 Q(I,J,K)=RATIOMX/(1.+RATIOMX)
1642 ! Q(I,J,K)=MAX(Q(I,J,K),EPSQ)
1643 MOIST(I,J,K,P_QV)=MAX(EPSQ,(MOIST(I,J,K,P_QV)+RQVBLTEN(I,K,J)*DTPHS) )
1644 CWM(I,J,K)=0.
1645 !
1646 IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW.and.CONFIG_FLAGS%MP_PHYSICS/=etamp_hwrf)THEN
1647 DO I_M=1,N_MOIST
1648 IF(I_M==P_QC) THEN
1649 MOIST(I,J,K,I_M)=MAX(EPSQ,(MOIST(I,J,K,I_M)+RQCBLTEN(I,K,J)*DTPHS) )
1650 ELSE IF(I_M==P_QI) THEN
1651 MOIST(I,J,K,I_M)=MAX(EPSQ,(MOIST(I,J,K,I_M)+RQIBLTEN(I,K,J)*DTPHS) )
1652 !BSF ELSE IF(I_M==P_QS) THEN
1653 !BSF MOIST(I,J,K,I_M)=MAX(EPSQ,(MOIST(I,J,K,I_M)+RQSBLTEN(I,K,J)*DTPHS) )
1654 !BSF ELSE IF(I_M==P_QR) THEN
1655 !BSF MOIST(I,J,K,I_M)=MAX(EPSQ,(MOIST(I,J,K,I_M)+RQRBLTEN(I,K,J)*DTPHS) )
1656 !BSF ELSE IF(I_M==P_QG) THEN
1657 !BSF MOIST(I,J,K,I_M)=MAX(EPSQ,(MOIST(I,J,K,I_M)+RQGBLTEN(I,K,J)*DTPHS) )
1658 ENDIF
1659 IF(I_M/=P_QV) CWM(I,J,K)=CWM(I,J,K)+MOIST(I,J,K,I_M)
1660 ENDDO
1661 ELSE
1662 !
1663 !-- Allow vertical mixing to modify cloud ice + snow for ETAMPNEW
1664 !
1665 QW=MAX(0.,MOIST(I,J,K,P_QC)+RQCBLTEN(I,K,J)*DTPHS )
1666 if(CONFIG_FLAGS%MP_PHYSICS.eq.etampnew)then
1667 QI=MAX(0.,MOIST(I,J,K,P_QS)+RQIBLTEN(I,K,J)*DTPHS ) !-- Total ice
1668 !BSF QR=MAX(0.,MOIST(I,J,K,P_QR)+RQRBLTEN(I,K,J)*DTPHS )
1669 QR=MAX(0.,MOIST(I,J,K,P_QR) )
1670 MOIST(I,J,K,P_QC)=QW
1671 MOIST(I,J,K,P_QS)=QI
1672 MOIST(I,J,K,P_QR)=QR
1673 elseif(CONFIG_FLAGS%MP_PHYSICS.eq.etamp_hwrf)then
1674 QI=MAX(0.,MOIST(I,J,K,P_QI)+RQIBLTEN(I,K,J)*DTPHS ) !-- Total ice
1675 !BSF QR=MAX(0.,MOIST(I,J,K,P_QR)+RQRBLTEN(I,K,J)*DTPHS )
1676 QR=MAX(0.,MOIST(I,J,K,P_QR) )
1677 MOIST(I,J,K,P_QC)=QW
1678 MOIST(I,J,K,P_QI)=QI
1679 MOIST(I,J,K,P_QR)=QR
1680 endif
1681 CWM(I,J,K)=QW+QI+QR
1682 !
1683 IF(QI<=EPSQ)THEN
1684 F_ICE(I,K,J)=0.
1685 ELSE
1686 F_ICE(I,K,J)=MAX(0.,MIN(1.,QI/CWM(I,J,K)))
1687 ENDIF
1688 !
1689 IF(QR<=EPSQ)THEN
1690 F_RAIN(I,K,J)=0.
1691 ELSE
1692 F_RAIN(I,K,J)=QR/(QW+QR)
1693 ENDIF
1694 !
1695 ENDIF !-- IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW)THEN
1696 !
1697 Q2(I,J,K)=2.*TKE(I,K,J)
1698 ENDDO
1699 ENDDO
1700 !
1701 ENDDO
1702 !
1703 !-----------------------------------------------------------------------
1704 !***
1705 !*** SAVE SURFACE-RELATED FIELDS.
1706 !***
1707 !-----------------------------------------------------------------------
1708 !$omp parallel do &
1709 !$omp& private(i,j,llij,xlvrw)
1710 DO J=MYJS2,MYJE2
1711 DO I=MYIS1,MYIE1
1712 LLIJ=LOWLYR(I,J)
1713 !
1714 !-----------------------------------------------------------------------
1715 !*** INSTANTANEOUS SENSIBLE AND LATENT HEAT FLUX
1716 !-----------------------------------------------------------------------
1717 !
1718 TWBS(I,J)=-TWBS(I,J)
1719 QWBS(I,J)=-QWBS(I,J)*XLV*CHKLOWQ(I,J)
1720 !
1721 !-----------------------------------------------------------------------
1722 !*** ACCUMULATED QUANTITIES.
1723 !*** IN OPNL LSM, SFCEVP APPEARS TO BE IN UNITS OF
1724 !*** METERS OF LIQUID WATER. IT IS COMING FROM
1725 !*** WRF MODULE AS KG/M**2.
1726 !-----------------------------------------------------------------------
1727 !
1728 SFCSHX(I,J)=SFCSHX(I,J)+TWBS(I,J)
1729 SFCLHX(I,J)=SFCLHX(I,J)+QWBS(I,J)
1730 XLVRW=DTPHS/(XLV*RHOWATER)
1731 SFCEVP(I,J)=SFCEVP(I,J)-QWBS(I,J)*XLVRW
1732 POTEVP(I,J)=POTEVP(I,J)-QWBS(I,J)*SM(I,J)*XLVRW
1733 POTFLX(I,J)=POTEVP(I,J)*FACTOR
1734 SUBSHX(I,J)=SUBSHX(I,J)+GRNFLX(I,J)
1735 ENDDO
1736 ENDDO
1737 !
1738 !-----------------------------------------------------------------------
1739 !*** COUNTERS
1740 !-----------------------------------------------------------------------
1741 !
1742 APHTIM=APHTIM+1.
1743 ARDSW =ARDSW +1.
1744 ARDLW =ARDLW +1.
1745 ASRFC =ASRFC +1.
1746 !-----------------------------------------------------------------------
1747 !
1748 END SUBROUTINE TURBL
1749 !
1750 !-----------------------------------------------------------------------
1751 !***********************************************************************
1752 SUBROUTINE UV_H_TO_V(NTSD,DT,NPHS,UZ0H,VZ0H,UZ0,VZ0 &
1753 & ,DUDT,DVDT,U,V,HBM2,IVE,IVW &
1754 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1755 & ,IMS,IME,JMS,JME,KMS,KME &
1756 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1757 !***********************************************************************
1758 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1759 ! . . .
1760 ! SUBPROGRAM: UV_H_TO_V INTERPOLATE WINDS FROM H TO V POINTS
1761 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 05-02-22
1762 !
1763 ! ABSTRACT:
1764 ! INTERPOLATE WINDS BACK TO V POINTS AFTER TURBULENCE
1765 !
1766 ! PROGRAM HISTORY LOG :
1767 ! 05-02-22 BLACK - ORIGINATOR
1768 ! 05-12-12 BLACK - CONVERTED FROM IKJ TO IJK
1769 !
1770 ! USAGE: CALL TURBL FROM SOLVE_NMM
1771 !
1772 ! ATTRIBUTES:
1773 ! LANGUAGE: FORTRAN 90
1774 ! MACHINE : IBM
1775 !$$$
1776 !-----------------------------------------------------------------------
1777 !
1778 IMPLICIT NONE
1779 !
1780 !-----------------------------------------------------------------------
1781 !
1782 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1783 & ,IMS,IME,JMS,JME,KMS,KME &
1784 & ,ITS,ITE,JTS,JTE,KTS,KTE &
1785 & ,NPHS,NTSD
1786 !
1787 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IVE,IVW
1788 !
1789 REAL,INTENT(IN) :: DT
1790 !
1791 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,UZ0H,VZ0H
1792 !
1793 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: DUDT,DVDT
1794 !
1795 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: UZ0,VZ0
1796 !
1797 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: U,V
1798 !
1799 !-----------------------------------------------------------------------
1800 !***
1801 !*** LOCAL VARIABLES
1802 !***
1803 !-----------------------------------------------------------------------
1804 !
1805 INTEGER :: I,IEND,J,K
1806 !
1807 REAL :: DTPHS
1808 !
1809 LOGICAL :: E_BDY
1810 !
1811 !-----------------------------------------------------------------------
1812 !-----------------------------------------------------------------------
1813 !
1814 DTPHS=NPHS*DT
1815 E_BDY=(ITE>=IDE)
1816 !
1817 !-----------------------------------------------------------------------
1818 !*** RECONSTRUCT UZ0 AND VZ0 ON VELOCITY POINTS.
1819 !-----------------------------------------------------------------------
1820 !
1821 !$omp parallel do &
1822 !$omp& private(i,j)
1823 DO J=MYJS2,MYJE2
1824 DO I=MYIS,MYIE
1825 UZ0(I,J)=(UZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &
1826 & +UZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &
1827 & +UZ0H(I,J+1)*HBM2(I,J+1)+UZ0H(I,J-1)*HBM2(I,J-1))*0.25
1828 VZ0(I,J)=(VZ0H(I+IVE(J),J)*HBM2(I+IVE(J),J) &
1829 & +VZ0H(I+IVW(J),J)*HBM2(I+IVW(J),J) &
1830 & +VZ0H(I,J+1)*HBM2(I,J+1)+VZ0H(I,J-1)*HBM2(I,J-1))*0.25
1831 ENDDO
1832 ENDDO
1833 !
1834 !-----------------------------------------------------------------------
1835 !*** INTERPOLATE WIND TENDENCIES TO VELOCITY POINTS AND UPDATE WINDS.
1836 !-----------------------------------------------------------------------
1837 !
1838 !$omp parallel do &
1839 !$omp& private(i,iend,j,k)
1840 DO K=KTS,KTE
1841 DO J=MYJS2,MYJE2
1842 IEND=MYIE1
1843 IF(E_BDY.AND.MOD(J,2)==1)IEND=IEND-1
1844 !
1845 DO I=MYIS1,IEND
1846 U(I,J,K)=(DUDT(I+IVE(J),J,K)+DUDT(I+IVW(J),J,K) &
1847 & +DUDT(I,J+1,K)+DUDT(I,J-1,K))*0.25*DTPHS &
1848 & +U(I,J,K)
1849 V(I,J,K)=(DVDT(I+IVE(J),J,K)+DVDT(I+IVW(J),J,K) &
1850 & +DVDT(I,J+1,K)+DVDT(I,J-1,K))*0.25*DTPHS &
1851 & +V(I,J,K)
1852 ENDDO
1853 ENDDO
1854 ENDDO
1855 !-----------------------------------------------------------------------
1856 !
1857 END SUBROUTINE UV_H_TO_V
1858 !
1859 !-----------------------------------------------------------------------
1860 !***********************************************************************
1861 !-----------------------------------------------------------------------
1862 SUBROUTINE CUCNVC(NTSD,DT,NCNVC,NRADS,NRADL &
1863 & ,GPS,RESTRT,HYDRO &
1864 & ,CLDEFI,N_MOIST,ENSDIM &
1865 & ,MOIST &
1866 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
1867 & ,F_ICE,F_RAIN &
1868 !*** Changes for other cu-schemes, most for gd scheme
1869 & ,APR_GR,APR_W,APR_MC,TTEN,QTEN &
1870 & ,APR_ST,APR_AS,APR_CAPMA &
1871 & ,APR_CAPME ,APR_CAPMI &
1872 & ,MASS_FLUX ,XF_ENS &
1873 & ,PR_ENS,GSW &
1874 #ifdef WRF_CHEM
1875 & ,GD_CLOUD,GD_CLOUD2,RAINCV &
1876 #endif
1877 !
1878 & ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TCUCN &
1879 & ,OMGALF,U,V,W,Z,FIS,W0AVG &
1880 & ,PREC,ACPREC,CUPREC,CUPPT,CPRATE &
1881 & ,SM,HBM2,LPBL,CNVBOT,CNVTOP &
1882 & ,HTOP,HBOT,HTOPD,HBOTD,HTOPS,HBOTS &
1883 & ,RTHBLTEN,RQVBLTEN,RTHRATEN &
1884 #if (NMM_CORE==1)
1885 & ,DUCUDT, DVCUDT, MOMMIX, store_rand &
1886 #endif
1887 & ,AVCNVC,ACUTIM,IHE,IHW &
1888 & ,GRID,CONFIG_FLAGS &
1889 & ,NRND1 & ! NRND1 for random no restart
1890 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1891 & ,IMS,IME,JMS,JME,KMS,KME &
1892 & ,IPS,IPE,JPS,JPE,KPS,KPE &
1893 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1894 !***********************************************************************
1895 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1896 ! . . .
1897 ! SUBPROGRAM: CUCNVC CONVECTIVE PRECIPITATION OUTER DRIVER
1898 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-21
1899 !
1900 ! ABSTRACT:
1901 ! CUCVNC DRIVES THE WRF CONVECTION SCHEMES
1902 !
1903 ! PROGRAM HISTORY LOG:
1904 ! 02-03-21 BLACK - ORIGINATOR
1905 ! 04-11-18 BLACK - THREADED
1906 ! 05-12-15 BLACK - CONVERTED FROM IKJ TO IJK
1907 !
1908 ! USAGE: CALL CUCNVC FROM SOLVE_NMM
1909 !
1910 ! ATTRIBUTES:
1911 ! LANGUAGE: FORTRAN 90
1912 ! MACHINE : IBM
1913 !$$$
1914 !-----------------------------------------------------------------------
1915 !
1916 IMPLICIT NONE
1917 !
1918 !-----------------------------------------------------------------------
1919 !
1920 INTEGER,INTENT(IN) :: ENSDIM &
1921 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1922 & ,IMS,IME,JMS,JME,KMS,KME &
1923 & ,IPS,IPE,JPS,JPE,KPS,KPE &
1924 & ,ITS,ITE,JTS,JTE,KTS,KTE &
1925 & ,N_MOIST,NCNVC,NTSD,NRADS,NRADL
1926 !
1927 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW
1928 !
1929 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LPBL
1930 !
1931 REAL,INTENT(IN) :: DT,GPS,PDTOP,PT
1932 !
1933 REAL,INTENT(INOUT) :: ACUTIM,AVCNVC
1934 !
1935 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
1936 REAL,DIMENSION(KMS:KME ),INTENT(IN) :: ETA1,ETA2
1937 !
1938 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
1939 !
1940 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,CLDEFI &
1941 & ,CNVBOT,CNVTOP &
1942 & ,CUPPT,CUPREC &
1943 & ,HBOT,HTOP &
1944 & ,HBOTD,HTOPD &
1945 & ,HBOTS,HTOPS &
1946 & ,PREC,CPRATE &
1947 & ,APR_GR,APR_W,APR_MC &
1948 & ,APR_ST,APR_AS,APR_CAPMA &
1949 & ,APR_CAPME,APR_CAPMI &
1950 & ,GSW,MASS_FLUX
1951 #if (NMM_CORE==1)
1952 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: store_rand
1953 #endif
1954 !
1955 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE &
1956 & ,F_RAIN
1957 !
1958 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: QTEN &
1959 & ,RQVBLTEN &
1960 & ,RTHBLTEN &
1961 & ,RTHRATEN &
1962 & ,TTEN
1963 !
1964 #if (NMM_CORE==1)
1965 REAL, INTENT(INOUT)::MOMMIX
1966 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT):: DUCUDT, DVCUDT
1967 REAL,DIMENSION(IDS:IDE,JDS:JDE) :: DATA1
1968 LOGICAL, EXTERNAL::wrf_dm_on_monitor
1969 #endif
1970 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: CWM &
1971 & ,OMGALF &
1972 & ,Q,T &
1973 & ,TCUCN &
1974 & ,U,V &
1975 & ,W,Z
1976 !
1977 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: PINT
1978 !
1979 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: W0AVG
1980 !
1981 REAL,DIMENSION(IMS:IME,JMS:JME,1:ENSDIM),INTENT(INOUT) :: PR_ENS &
1982 & ,XF_ENS
1983 !
1984 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_MOIST) &
1985 & ,INTENT(INOUT) :: MOIST
1986 !
1987 #ifdef WRF_CHEM
1988 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: GD_CLOUD &
1989 & ,GD_CLOUD2
1990 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: RAINCV
1991 #endif
1992 !
1993 LOGICAL,INTENT(IN) :: HYDRO,RESTRT
1994 !
1995 TYPE(DOMAIN),TARGET :: GRID
1996 !
1997 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
1998 !
1999 !-----------------------------------------------------------------------
2000 !*** LOCAL VARIABLES
2001 !-----------------------------------------------------------------------
2002 !
2003 INTEGER :: I,ICLDCK,IENDX,ISTAT,J,K,MNTO,N,N_TIMSTPS_OUTPUT &
2004 & ,NCUBOT,NCUTOP,NSTEP_CNV
2005 !
2006 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: KPBL,LBOT,LOWLYR,LTOP
2007 !
2008 REAL :: CAPA,CF_HI,DPL,DQDT,DTCNVC,DTDT,FICE,FRAIN,G_INV &
2009 & ,PCPCOL,PLYR,QI,QL_K,QR,QW,RDTCNVC,TL_K,WC,WMID
2010 !
2011 REAL,DIMENSION(KMS:KME-1) :: QL,TL
2012 !
2013 REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,NCA,PDSL &
2014 & ,RAINC,SFCZ,XLAND
2015 #ifndef WRF_CHEM
2016 REAL,DIMENSION(IMS:IME,JMS:JME) :: RAINCV
2017 #endif
2018 !
2019 REAL,DIMENSION(ITS:ITE,JTS:JTE) :: WMID_L
2020 !
2021 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: DZ,P8W,P_PHY,PI_PHY &
2022 & ,RQCCUTEN,RQRCUTEN &
2023 & ,RQICUTEN,RQSCUTEN &
2024 & ,RQVCUTEN,RR,RTHCUTEN &
2025 & ,T_PHY,TH_PHY &
2026 & ,U_PHY,V_PHY,WINT
2027 !
2028 REAL,DIMENSION(IMS:IME,JMS:JME,ENSDIM) :: ZERO_GD
2029 !
2030 REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: MOIST_TRANS
2031 !
2032 LOGICAL :: RESTART,WARM_RAIN
2033 LOGICAL,DIMENSION(IMS:IME,JMS:JME) :: CU_ACT_FLAG
2034 !
2035 CHARACTER(LEN=255) :: message
2036 !
2037 !-----------------------------------------------------------------------
2038 !*** FOR TEMPERATURE CHANGE CHECK ONLY.
2039 !-----------------------------------------------------------------------
2040 INTEGER :: DTEMP_CHECK=2.0
2041 REAL :: TCHANGE
2042 ! random number restart
2043 INTEGER,DIMENSION(:),INTENT(INOUT) :: NRND1
2044 INTEGER, SAVE :: nfirst
2045 data nfirst /0/
2046 #if (NMM_CORE==1)
2047 INTEGER :: IDT
2048 REAL, DIMENSION(2) :: RND1
2049 #endif
2050 !-----------------------------------------------------------------------
2051 !***********************************************************************
2052 !-----------------------------------------------------------------------
2053 !
2054 !-----------------------------------------------------------------------
2055 !*** RESET THE HBOT/HTOP CONVECTIVE CLOUD BOTTOM (BASE) AND TOP ARRAYS
2056 !*** USED IN RADIATION. THEY STORE THE MAXIMUM VERTICAL LIMITS OF
2057 !*** CONVECTIVE CLOUD BETWEEN RADIATION CALLS. CUPPT IS THE ACCUMULATED
2058 !*** CONVECTIVE PRECIPITATION BETWEEN RADIATION CALLS.
2059 !-----------------------------------------------------------------------
2060 !
2061 IF(MOD(NTSD,NRADS)==0.OR.MOD(NTSD,NRADL)==0)THEN
2062 DO J=JMS,JME
2063 DO I=IMS,IME
2064 HTOP(I,J)=0.
2065 HBOT(I,J)=REAL(KTE+1)
2066 CUTOP(I,J)=0.
2067 CUBOT(I,J)=REAL(KTE+1)
2068 CUPPT(I,J)=0.
2069 ENDDO
2070 ENDDO
2071 ENDIF
2072 !-----------------------------------------------------------------------
2073 IF(MOD(NTSD,NCNVC)/=0.AND. &
2074 & CONFIG_FLAGS%CU_PHYSICS==BMJSCHEME)RETURN
2075 IF(MOD(NTSD,NCNVC)/=0.AND. &
2076 & CONFIG_FLAGS%CU_PHYSICS==OSASSCHEME)RETURN
2077 IF(MOD(NTSD,NCNVC)/=0.AND. &
2078 & CONFIG_FLAGS%CU_PHYSICS==SASSCHEME)RETURN
2080 !-----------------------------------------------------------------------
2081 NSTEP_CNV=NCNVC
2082 !
2083 RESTART=RESTRT
2084 !-----------------------------------------------------------------------
2085 IF(CONFIG_FLAGS%CU_PHYSICS==KFETASCHEME)THEN
2086 !
2087 IF(.NOT.RESTART.AND.NTSD==0)THEN
2088 !$omp parallel do &
2089 !$omp& private(i,j,k)
2090 DO J=JTS,JTE
2091 DO K=KTS,KTE
2092 DO I=ITS,ITE
2093 W0AVG(I,K,J)=0.
2094 ENDDO
2095 ENDDO
2096 ENDDO
2097 ENDIF
2098 !
2099 ENDIF
2100 !
2101 !-----------------------------------------------------------------------
2102 !*** GENERAL PREPARATION
2103 !-----------------------------------------------------------------------
2104 !
2105 AVCNVC=AVCNVC+1.
2106 ACUTIM=ACUTIM+1.
2107 !
2108 DTCNVC=NCNVC*DT
2109 RDTCNVC=1./DTCNVC
2110 CAPA=R_D/CP
2111 G_INV=1./G
2112 !
2113 !$omp parallel do &
2114 !$omp& private(I,J)
2115 DO J=MYJS2,MYJE2
2116 DO I=MYIS1,MYIE1
2117 !
2118 PDSL(I,J)=PD(I,J)*RES(I,J)
2119 RAINCV(I,J)=0.
2120 RAINC(I,J)=0.
2121 P8W(I,KTS,J)=PD(I,J)+PDTOP+PT
2122 LOWLYR(I,J)=KTS !<---- The lowest model layer counted from the bottom.
2123 XLAND(I,J)=SM(I,J)+1.
2124 NCA(I,J)=0.
2125 SFCZ(I,J)=FIS(I,J)*G_INV
2126 !
2127 CUTOP(I,J)=HTOP(I,J)
2128 CUBOT(I,J)=HBOT(I,J)
2129 !
2130 !*** LPBL IS THE MODEL LAYER CONTAINING THE PBL TOP
2131 !*** COUNTING DOWNWARD FROM THE TOP OF THE DOMAIN
2132 !*** SO KPBL IS THE SAME LAYER COUNTING UPWARD FROM
2133 !*** THE GROUND.
2134 !
2135 KPBL(I,J)=KTE-LPBL(I,J)+1
2136 ENDDO
2137 ENDDO
2138 !
2139 !$omp parallel do &
2140 !$omp& private(dpl,fice,frain,i,j,k,plyr,qi,ql,qr,qw,wc)
2141 DO J=MYJS2,MYJE2
2142 DO K=KTS,KTE
2143 DO I=MYIS1,MYIE1
2144 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
2145 QL(K)=MAX(Q(I,J,K),EPSQ)
2146 PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL(I,J)+PT
2147 TL(K)=T(I,J,K)
2148 !
2149 RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
2150 T_PHY(I,K,J)=TL(K)
2152 TH_PHY(I,K,J)=TL(K)*(1.E5/PLYR)**CAPA
2153 !!! P8W(I,KFLIP,J)=PINT(I,J,K+1)
2154 P8W(I,K+1,J)=ETA1(K+1)*PDTOP+ETA2(K+1)*PDSL(I,J)+PT
2155 P_PHY(I,K,J)=PLYR
2156 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
2157 !
2158 RTHCUTEN(I,K,J)=0.
2159 RQVCUTEN(I,K,J)=0.
2160 RQCCUTEN(I,K,J)=0.
2161 RQRCUTEN(I,K,J)=0.
2162 RQICUTEN(I,K,J)=0.
2163 RQSCUTEN(I,K,J)=0.
2164 ENDDO
2165 !
2166 ENDDO
2167 ENDDO
2168 !
2169 !-----------------------------------------------------------------------
2170 !
2172 IF(.NOT.HYDRO)THEN
2173 !$omp parallel do &
2174 !$omp& private(i,j,k)
2175 DO K=KTS,KTE
2176 DO J=MYJS2,MYJE2
2177 DO I=MYIS1,MYIE1
2178 DZ(I,K,J)=Z(I,J,K+1)-Z(I,J,K)
2179 ENDDO
2180 ENDDO
2181 ENDDO
2182 !
2183 IF(NTSD==0)THEN
2184 !$omp parallel do &
2185 !$omp& private(i,j,k)
2186 DO J=MYJS2,MYJE2
2187 DO K=KTS,KTE+1 ! zero for all interfaces
2188 DO I=MYIS1,MYIE1
2189 WINT(I,K,J)=0.
2190 ENDDO
2191 ENDDO
2192 ENDDO
2194 ELSE ! not NTSD=0
2196 DO J=MYJS2,MYJE2
2197 DO I=MYIS1,MYIE1
2198 WINT(I,KTS,J)=0.
2199 WINT(I,KTE+1,J)=0.
2200 ENDDO
2201 ENDDO
2203 DO J=MYJS2,MYJE2
2204 DO K=KTS+1,KTE
2205 DO I=MYIS1,MYIE1
2206 WINT(I,K,J)=0.5*(W(I,J,K)+W(I,J,K-1))
2207 ENDDO
2208 ENDDO
2209 ENDDO
2211 ENDIF
2213 ELSE ! hydrostatic
2215 DO J=MYJS2,MYJE2
2216 DO I=MYIS1,MYIE1
2217 WINT(I,KTS,J)=0.
2218 WINT(I,KTE+1,J)=0.
2219 ENDDO
2220 ENDDO
2221 !
2222 !$omp parallel do &
2223 !$omp& private(i,j,k,plyr)
2224 DO J=MYJS2,MYJE2
2225 DO I=MYIS1,MYIE1
2226 WMID_L(I,J)=-OMGALF(I,J,KTS)*CP/(G*DT)
2227 PDSL(I,J)=PD(I,J)*RES(I,J)
2228 PLYR=AETA1(KTS)*PDTOP+AETA2(KTS)*PDSL(I,J)+PT
2229 DZ(I,KTS,J)=T(I,J,KTS)*(P608*Q(I,J,KTS)+1.)*R_D &
2230 & *(P8W(I,KTS,J)-P8W(I,KTS+1,J)) &
2231 & /(PLYR*G)
2232 ENDDO
2233 ENDDO
2234 !
2235 !$omp parallel do &
2236 !$omp& private(i,j,k,ql_k,tl_k,wmid)
2237 DO J=MYJS2,MYJE2
2238 DO K=KTS+1,KTE
2239 DO I=MYIS1,MYIE1
2240 TL_K=T_PHY(I,K,J)
2241 QL_K=MAX(Q(I,J,K),EPSQ)
2242 WMID=-OMGALF(I,J,K)*CP/(G*DT)
2243 WINT(I,K,J)=0.5*(WMID_L(I,J)+WMID)
2244 WMID_L(I,J)=WMID
2245 DZ(I,K,J)=TL_K*(P608*QL_K+1.)*R_D &
2246 & *(P8W(I,K,J)-P8W(I,K+1,J)) &
2247 & /(P_PHY(I,K,J)*G)
2248 ENDDO
2249 ENDDO
2250 ENDDO
2251 !
2252 ENDIF
2253 !
2254 !-----------------------------------------------------------------------
2255 !*** COMPUTE VELOCITY COMPONENTS AT MASS POINTS
2256 !-----------------------------------------------------------------------
2257 !
2258 IF(CONFIG_FLAGS%CU_PHYSICS/=BMJSCHEME)THEN
2259 !
2260 !$omp parallel do &
2261 !$omp& private(i,j,k)
2262 DO K=KTS,KTE
2263 !
2264 DO J=MYJS1_P1,MYJE1_P1
2265 DO I=MYIS_P1,MYIE_P1
2266 U_PHY(I,K,J)=(U(I+IHE(J),J,K)+U(I+IHW(J),J,K) &
2267 & +U(I,J+1,K)+U(I,J-1,K)) &
2268 & *0.25
2269 V_PHY(I,K,J)=(V(I+IHE(J),J,K)+V(I+IHW(J),J,K) &
2270 & +V(I,J+1,K)+V(I,J-1,K)) &
2271 & *0.25
2272 ENDDO
2273 ENDDO
2274 !
2275 ENDDO
2276 !
2277 ENDIF
2278 !
2279 !-----------------------------------------------------------------------
2280 !*** TRANSPOSE THE MOIST ARRAY (IJK) FOR THE PHYSICS (IKJ).
2281 !-----------------------------------------------------------------------
2282 !
2283 IF(.NOT.ALLOCATED(MOIST_TRANS))THEN
2284 ALLOCATE(MOIST_TRANS(IMS:IME,KMS:KME,JMS:JME,N_MOIST),STAT=ISTAT)
2285 ENDIF
2286 !
2287 DO N=1,N_MOIST
2288 !$omp parallel do &
2289 !$omp& private(i,j,k)
2290 DO K=KMS,KME
2291 DO J=JMS,JME
2292 DO I=IMS,IME
2293 MOIST_TRANS(I,K,J,N)=MOIST(I,J,K,N)
2294 ENDDO
2295 ENDDO
2296 ENDDO
2297 ENDDO
2300 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
2301 #if (NMM_CORE==1)
2302 !#ifdef HWRF
2303 !
2304 !-----------------------------------------------------------------------
2305 !
2306 ! SAS CONVECTION NEEDS RANDOM NUMBER WHICH IS STORED HERE FOR
2307 ! EACH OF THE DOMAIN AND THEN THEY ARE PASSED ON INTO THE
2308 ! CUMULUS DRIVER. THIS IS gopal's doing
2309 !
2311 IF(CONFIG_FLAGS%CU_PHYSICS==OSASSCHEME .or. CONFIG_FLAGS%CU_PHYSICS==SASSCHEME)THEN
2312 !
2313 IF(GRID%ID .EQ. 1)THEN ! Both parent and nest set to 5 minutes for random number calls
2314 IDT=MOD(NTSD,NCNVC)
2315 ELSE
2316 IDT=MOD(NTSD,5*NCNVC)
2317 ENDIF
2319 IF(IDT.EQ.0 .OR. NTSD .EQ. 0)THEN
2320 !$omp parallel do &
2321 !$omp& private(i,j)
2322 IF (wrf_dm_on_monitor()) THEN !!!! For bit reproducibility of random numbers
2323 if (restart .and. nfirst .eq. 0 ) then
2324 call random_seed(put=nrnd1)
2325 nfirst=1
2326 endif
2327 call random_seed(get=nrnd1)
2328 DO J=JDS,JDE !JTS,JTE
2329 DO I=IDS,IDE !ITS,ITE
2330 CALL RANDOM_NUMBER(rnd1)
2331 DATA1(I,J)=rnd1(2)
2332 ENDDO
2333 ENDDO
2334 ENDIF
2335 CALL wrf_dm_bcast_bytes (DATA1,IDE*JDE*RWORDSIZE) !!! broadcast random nos. to other processors
2337 DO J=JDS,JDE
2338 DO I =IDS,IDE
2339 IF(I.GE.ITS .AND. I .LE. MIN(ide,ite) .AND. J.GE.JTS .AND. J .LE. MIN(jde,jte))THEN
2340 STORE_RAND(I,J)=DATA1(I,J)
2341 ENDIF
2342 ENDDO
2343 ENDDO
2344 !
2345 ENDIF ! for IF(IDT.EQ.0 .OR. NTSD .EQ. 0)
2346 !
2347 ELSE
2348 !jm STORE_RAND(I,J) = 0.0
2349 STORE_RAND = 0.0
2350 ENDIF
2352 !$omp parallel do &
2353 !$omp& private(i,j,k)
2354 DO K=KMS,KME
2355 DO J=JMS,JME
2356 DO I=IMS,IME
2357 DUCUDT(i,j,k)=0.0
2358 DVCUDT(i,j,k)=0.0
2359 ENDDO
2360 ENDDO
2361 ENDDO
2362 !#endif
2363 #endif
2364 CALL CUMULUS_DRIVER(GRID &
2365 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
2366 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
2367 & ,IPS=ips,IPE=ipe,JPS=jps,JPE=jpe,KPS=kps,KPE=kpe &
2368 & ,I_START=GRID%I_START,I_END=GRID%I_END &
2369 & ,J_START=GRID%J_START,J_END=GRID%J_END &
2370 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
2371 ! Prognostic
2372 & ,U=U_PHY,V=V_PHY,TH=TH_PHY,T=T_PHY,W=WINT &
2373 & ,P=P_PHY,PI=PI_PHY,RHO=RR,W0AVG=W0AVG &
2374 ! Others
2375 & ,ITIMESTEP=NTSD,DT=DT,DX=GPS &
2376 & ,RAINC=RAINC,RAINCV=RAINCV,NCA=NCA &
2377 & ,DZ8W=DZ,P8W=P8W,FORCET=TTEN,FORCEQ=QTEN &
2378 & ,CLDEFI=CLDEFI,LOWLYR=LOWLYR,XLAND=XLAND &
2379 & ,CU_ACT_FLAG=CU_ACT_FLAG,WARM_RAIN=WARM_RAIN &
2380 & ,STEPCU=NSTEP_CNV,GSW=GSW &
2381 & ,PERIODIC_X=.FALSE.,PERIODIC_Y=.FALSE. &
2382 & ,HTOP=CUTOP,HBOT=CUBOT,KPBL=KPBL,HT=SFCZ,Z=Z &
2383 & ,APR_GR=APR_GR,APR_W=APR_W,APR_MC=APR_MC &
2384 & ,APR_ST=APR_ST,APR_AS=APR_AS,APR_CAPMA=APR_CAPMA &
2385 & ,APR_CAPME=APR_CAPME,APR_CAPMI=APR_CAPMI &
2386 & ,MASS_FLUX=MASS_FLUX,XF_ENS=XF_ENS &
2387 & ,PR_ENS=PR_ENS &
2388 #ifdef WRF_CHEM
2389 & ,GD_CLOUD=GD_CLOUD,GD_CLOUD2=GD_CLOUD2 &
2390 #endif
2392 & ,ENSDIM=ENSDIM,MAXIENS=1,MAXENS=3 &
2393 & ,MAXENS2=3,MAXENS3=16 &
2394 & ,RTHCUTEN=RTHCUTEN,RQVCUTEN=RQVCUTEN &
2395 & ,RQCCUTEN=RQCCUTEN,RQRCUTEN=RQRCUTEN &
2396 & ,RQICUTEN=RQICUTEN,RQSCUTEN=RQSCUTEN &
2397 & ,RTHBLTEN=RTHBLTEN,RQVBLTEN=RQVBLTEN &
2398 & ,RTHRATEN=RTHRATEN &
2399 #if (NMM_CORE==1)
2400 & ,RUCUTEN=DUCUDT, RVCUTEN=DVCUDT, MOMMIX=MOMMIX &
2401 ,store_rand=store_rand &
2402 #endif
2403 ! Selection argument
2404 & ,CU_PHYSICS=CONFIG_FLAGS%CU_PHYSICS &
2405 ! Moisture tracer arguments
2406 & ,QV_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QV),F_QV=F_QV &
2407 & ,QC_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QC),F_QC=F_QC &
2408 & ,QR_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QR),F_QR=F_QR &
2409 & ,QI_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QI),F_QI=F_QI &
2410 & ,QS_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QS),F_QS=F_QS &
2411 & ,QG_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG)
2412 !
2413 !-----------------------------------------------------------------------
2414 !
2415 !*** CNVTOP/CNVBOT HOLD THE MAXIMUM VERTICAL LIMITS OF CONVECTIVE CLOUD
2416 !*** BETWEEN HISTORY OUTPUT TIMES. HBOTS/HTOPS STORE SIMILIAR INFORMATION
2417 !*** FOR SHALLOW (NONPRECIPITATING) CONVECTION, AND HBOTD/HTOPD ARE FOR
2418 !*** DEEP (PRECIPITATING) CONVECTION.
2419 !
2420 CF_HI=CONFIG_FLAGS%HISTORY_INTERVAL
2421 N_TIMSTPS_OUTPUT=NINT(60.*CF_HI/DT)
2422 MNTO=MOD(NTSD,N_TIMSTPS_OUTPUT)
2423 !
2424 IF(MNTO>0.AND.MNTO<=NCNVC)THEN
2425 DO J=MYJS2,MYJE2
2426 IENDX=MYIE1
2427 IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
2428 DO I=MYIS1,IENDX
2429 CNVBOT(I,J)=REAL(KTE+1.)
2430 CNVTOP(I,J)=0.
2431 HBOTD(I,J)=REAL(KTE+1.)
2432 HTOPD(I,J)=0.
2433 HBOTS(I,J)=REAL(KTE+1.)
2434 HTOPS(I,J)=0.
2435 ENDDO
2436 ENDDO
2437 ENDIF
2438 !
2439 !-----------------------------------------------------------------------
2440 !
2441 !$omp parallel do &
2442 !$omp& private(i,iendx,j,ncubot,ncutop,pcpcol)
2443 pcp_cloud: DO J=MYJS2,MYJE2
2444 IENDX=MYIE1
2445 IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
2446 DO I=MYIS1,IENDX
2447 !
2448 !*** UPDATE PRECIPITATION
2449 !
2450 PCPCOL=RAINCV(I,J)*1.E-3*NSTEP_CNV
2451 PREC(I,J)=PREC(I,J)+PCPCOL
2452 ACPREC(I,J)=ACPREC(I,J)+PCPCOL
2453 CUPREC(I,J)=CUPREC(I,J)+PCPCOL
2454 CUPPT(I,J)=CUPPT(I,J)+PCPCOL
2455 CPRATE(I,J)=PCPCOL
2456 !
2457 !*** SAVE CLOUD TOP AND BOTTOM FOR RADIATION (HTOP/HBOT) AND
2458 !*** FOR OUTPUT (CNVTOP/CNVBOT, HTOPS/HBOTS, HTOPD/HBOTD) ARRAYS.
2459 !*** THEY MUST BE TREATED SEPARATELY FROM EACH OTHER.
2460 !
2461 CUTOP(I,J)=MIN(CUTOP(I,J),REAL(KDE))
2462 CUTOP(I,J)=MAX(CUTOP(I,J),0.0)
2463 CUBOT(I,J)=MIN(CUBOT(I,J),REAL(KDE))
2464 CUBOT(I,J)=MAX(CUBOT(I,J),0.0)
2466 NCUTOP=NINT(CUTOP(I,J))
2467 NCUBOT=NINT(CUBOT(I,J))
2468 !
2469 IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
2470 HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
2471 CNVTOP(I,J)=MAX(CUTOP(I,J),CNVTOP(I,J))
2472 IF(PCPCOL>0.)THEN
2473 HTOPD(I,J)=MAX(CUTOP(I,J),HTOPD(I,J))
2474 ELSE
2475 HTOPS(I,J)=MAX(CUTOP(I,J),HTOPS(I,J))
2476 ENDIF
2477 ENDIF
2478 !
2479 IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
2480 HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
2481 CNVBOT(I,J)=MIN(CUBOT(I,J),CNVBOT(I,J))
2482 IF(PCPCOL>0.)THEN
2483 HBOTD(I,J)=MIN(CUBOT(I,J),HBOTD(I,J))
2484 ELSE
2485 HBOTS(I,J)=MIN(CUBOT(I,J),HBOTS(I,J))
2486 ENDIF
2487 ENDIF
2488 !
2489 ENDDO
2490 ENDDO pcp_cloud
2491 !
2492 !-----------------------------------------------------------------------
2493 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, AND HEATING.
2494 !-----------------------------------------------------------------------
2495 !
2496 !$omp parallel do &
2497 !$omp& private(dqdt,dtdt,i,iendx,j,k,tchange)
2498 DO K=KTS,KTE
2499 DO J=MYJS2,MYJE2
2500 IENDX=MYIE1
2501 IF(MOD(J,2)==0.AND.ITE==IDE-1)IENDX=IENDX-1
2502 DO I=MYIS1,IENDX
2503 !
2504 !*** RQVCUTEN IN BMJDRV IS THE MIXING RATIO TENDENCY,
2505 !*** SO RETRIEVE DQDT BY CONVERTING TO SPECIFIC HUMIDITY.
2506 !
2507 DQDT=RQVCUTEN(I,K,J)/(1.+MOIST_TRANS(I,K,J,P_QV))**2
2508 !
2509 !*** RTHCUTEN IN BMJDRV IS DTDT OVER PI.
2510 !
2511 DTDT=RTHCUTEN(I,K,J)*PI_PHY(I,K,J)
2512 T(I,J,K)=T(I,J,K)+DTDT*DTCNVC
2513 Q(I,J,K)=Q(I,J,K)+DQDT*DTCNVC
2514 TCUCN(I,J,K)=TCUCN(I,J,K)+DTDT
2515 MOIST_TRANS(I,K,J,P_QV)=Q(I,J,K)/(1.-Q(I,J,K)) !Convert to mixing ratio
2516 !
2517 cps_select: SELECT CASE(config_flags%cu_physics)
2518 !
2519 CASE (KFSCHEME,KFETASCHEME,GDSCHEME,SASSCHEME,OSASSCHEME)
2520 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW)THEN
2521 MOIST_TRANS(I,K,J,P_QS)=MAX(0.,MOIST_TRANS(I,K,J,P_QS)+RQICUTEN(I,K,J)*DTCNVC+RQSCUTEN(I,K,J)*DTCNVC)
2522 ELSE
2523 MOIST_TRANS(I,K,J,P_QI)=MAX(0.,MOIST_TRANS(I,K,J,P_QI)+RQICUTEN(I,K,J)*DTCNVC)
2524 MOIST_TRANS(I,K,J,P_QS)=MAX(0.,MOIST_TRANS(I,K,J,P_QS)+RQSCUTEN(I,K,J)*DTCNVC)
2525 ENDIF
2526 MOIST_TRANS(I,K,J,P_QR)=MAX(0.,MOIST_TRANS(I,K,J,P_QR)+RQRCUTEN(I,K,J)*DTCNVC)
2527 MOIST_TRANS(I,K,J,P_QC)=MAX(0.,MOIST_TRANS(I,K,J,P_QC)+RQCCUTEN(I,K,J)*DTCNVC)
2528 END SELECT cps_select
2529 !
2530 TCHANGE=DTDT*DTCNVC
2531 IF(ABS(TCHANGE)>DTEMP_CHECK)THEN
2532 WRITE(message,*)'BIG T CHANGE BY CONVECTION=',TCHANGE &
2533 ,' AT (',I,',',J,',',K,') FOR NTSD=',NTSD
2534 CALL wrf_message(trim(message))
2535 ENDIF
2536 !
2537 ENDDO
2538 ENDDO
2539 ENDDO
2540 !-----------------------------------------------------------------------
2541 !*** REFILL THE MOIST ARRAY.
2542 !-----------------------------------------------------------------------
2543 !
2544 DO N=1,N_MOIST
2545 !$omp parallel do &
2546 !$omp& private(i,j,k)
2547 DO J=JMS,JME
2548 DO K=KMS,KME
2549 DO I=IMS,IME
2550 MOIST(I,J,K,N)=MOIST_TRANS(I,K,J,N)
2551 ENDDO
2552 ENDDO
2553 ENDDO
2554 ENDDO
2555 !
2556 !-----------------------------------------------------------------------
2557 !
2558 DEALLOCATE(MOIST_TRANS,STAT=ISTAT)
2559 !
2560 !-----------------------------------------------------------------------
2561 !
2562 END SUBROUTINE CUCNVC
2563 !
2564 !-----------------------------------------------------------------------
2565 !***********************************************************************
2566 SUBROUTINE GSMDRIVE(NTSD,DT,NPHS,N_MOIST &
2567 & ,DX,DY,SM,HBM2,FIS &
2568 & ,DETA1,DETA2,AETA1,AETA2,ETA1,ETA2 &
2569 & ,PDTOP,PT,PD,RES,PINT,T,Q,CWM,TRAIN &
2570 & ,MOIST,SCALAR,N_SCALAR &
2571 & ,F_ICE,F_RAIN,F_RIMEF,SR &
2572 & ,PREC,ACPREC,AVRAIN &
2573 & ,MP_RESTART_STATE &
2574 & ,TBPVS_STATE &
2575 & ,TBPVS0_STATE &
2576 & ,GRID,CONFIG_FLAGS &
2577 & ,IDS,IDE,JDS,JDE,KDS,KDE &
2578 & ,IMS,IME,JMS,JME,KMS,KME &
2579 & ,ITS,ITE,JTS,JTE,KTS,KTE)
2580 !***********************************************************************
2581 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
2582 ! . . .
2583 ! SUBPROGRAM: GSMDRIVE MICROPHYSICS OUTER DRIVER
2584 ! PRGRMMR: BLACK ORG: W/NP22 DATE: 02-03-26
2585 !
2586 ! ABSTRACT:
2587 ! GSMDRIVE DRIVES THE MICROPHYSICS SCHEMES
2588 !
2589 ! PROGRAM HISTORY LOG:
2590 ! 02-03-26 BLACK - ORIGINATOR
2591 ! 04-11-18 BLACK - THREADED
2592 ! 05-12-19 BLACK - CONVERTED FROM IKJ TO IJK
2593 !
2594 ! USAGE: CALL GSMDRIVE FROM SOLVE_NMM
2595 !
2596 ! ATTRIBUTES:
2597 ! LANGUAGE: FORTRAN 90
2598 ! MACHINE : IBM
2599 !$$$
2600 !-----------------------------------------------------------------------
2601 !
2602 IMPLICIT NONE
2603 !
2604 !-----------------------------------------------------------------------
2605 !
2606 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
2607 & ,IMS,IME,JMS,JME,KMS,KME &
2608 & ,ITS,ITE,JTS,JTE,KTS,KTE &
2609 & ,N_MOIST,N_SCALAR,NPHS,NTSD
2610 !
2611 REAL,INTENT(IN) :: DT,DX,DY,PDTOP,PT
2612 !
2613 REAL,INTENT(INOUT) :: AVRAIN
2614 !
2615 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: AETA1,AETA2,DETA1,DETA2
2616 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA1,ETA2
2617 !
2618 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PD,RES,SM
2619 !
2620 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: PINT
2621 !
2622 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: ACPREC,PREC
2623 !
2624 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: CWM,Q &
2625 & ,T,TRAIN
2626 !
2627 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: F_ICE & !<--- Used only with physics (IKJ)
2628 & ,F_RAIN &
2629 & ,F_RIMEF
2631 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_MOIST) &
2632 & ,INTENT(INOUT) :: MOIST
2633 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_SCALAR) &
2634 & ,INTENT(INOUT) :: SCALAR
2635 !
2636 !*** State var for etampnew microphysics (JM, 2005 05 02)
2637 !
2638 REAL,DIMENSION(:),INTENT(INOUT) :: MP_RESTART_STATE &
2639 & ,TBPVS_STATE,TBPVS0_STATE
2640 !
2641 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: SR
2642 !
2643 TYPE(DOMAIN),TARGET :: GRID
2644 !
2645 TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
2646 !
2647 !-----------------------------------------------------------------------
2648 !*** LOCAL VARIABLES
2649 !-----------------------------------------------------------------------
2650 !
2651 INTEGER :: I,IENDX,IJ,ISTAT,J,K,N
2652 !
2653 INTEGER,DIMENSION(IMS:IME,JMS:JME) :: LOWLYR
2654 !
2655 REAL :: CAPA,DPL,DTPHS,PCPCOL,PLYR,RDTPHS,RG,TNEW
2656 !
2657 REAL,DIMENSION(KMS:KME-1) :: QL,TL
2658 !
2659 REAL,DIMENSION(IMS:IME,JMS:JME) :: CUBOT,CUTOP,PDSL &
2660 & ,RAINNC,RAINNCV,XLAND
2661 !
2662 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: CWM_PHY,DZ &
2663 & ,P8W,P_PHY,PI_PHY &
2664 & ,RR,T_PHY,TH_PHY
2665 !
2666 REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: MOIST_TRANS
2667 REAL,DIMENSION(:,:,:,:),ALLOCATABLE :: SCALAR_TRANS
2668 !
2669 LOGICAL :: E_BDY,F_QT,QT_PRESENT,WARM_RAIN
2670 !
2671 !-----------------------------------------------------------------------
2672 !***********************************************************************
2673 !-----------------------------------------------------------------------
2674 !
2675 ALLOCATE(MOIST_TRANS(IMS:IME,KMS:KME,JMS:JME,N_MOIST),STAT=ISTAT)
2676 ALLOCATE(SCALAR_TRANS(IMS:IME,KMS:KME,JMS:JME,N_SCALAR),STAT=ISTAT)
2677 !
2678 !-----------------------------------------------------------------------
2679 !*** TRANSPOSE THE MOIST ARRAY (IJK) FOR THE PHYSICS (IKJ).
2680 !-----------------------------------------------------------------------
2681 !
2682 DO N=1,N_MOIST
2683 !$omp parallel do &
2684 !$omp& private(i,j,k)
2685 DO K=KMS,KME
2686 DO J=JMS,JME
2687 DO I=IMS,IME
2688 MOIST_TRANS(I,K,J,N)=MOIST(I,J,K,N)
2689 ENDDO
2690 ENDDO
2691 ENDDO
2692 ENDDO
2693 !
2694 !-----------------------------------------------------------------------
2695 !
2696 IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW.and.config_flags%mp_physics/=etamp_hwrf)THEN
2697 DO N=1,N_SCALAR
2698 !$omp parallel do &
2699 !$omp& private(i,j,k)
2700 DO K=KMS,KME
2701 DO J=JMS,JME
2702 DO I=IMS,IME
2703 SCALAR_TRANS(I,K,J,N)=SCALAR(I,J,K,N)
2704 ENDDO
2705 ENDDO
2706 ENDDO
2707 ENDDO
2708 ENDIF
2709 !
2710 !-----------------------------------------------------------------------
2711 !
2712 IF(CONFIG_FLAGS%MP_PHYSICS==ETAMPNEW.or.config_flags%mp_physics==etamp_hwrf)THEN
2713 QT_PRESENT=.TRUE.
2714 ELSE
2715 QT_PRESENT=.FALSE.
2716 ENDIF
2717 !
2718 DTPHS=NPHS*DT
2719 RDTPHS=1./DTPHS
2720 CAPA=R_D/CP
2721 RG=1./G
2722 AVRAIN=AVRAIN+1.
2723 !
2724 !-----------------------------------------------------------------------
2725 !
2726 !*** PREPARE NEEDED ARRAYS
2727 !
2728 !-----------------------------------------------------------------------
2729 !$omp parallel do &
2730 !$omp& private(i,j)
2731 DO J=MYJS2,MYJE2
2732 DO I=MYIS1,MYIE1
2733 !
2734 PDSL(I,J)=PD(I,J)*RES(I,J)
2735 P8W(I,KTE+1,J)=PT
2736 LOWLYR(I,J)=KTS !<---- The lowest model layer counted from the bottom.
2737 XLAND(I,J)=SM(I,J)+1.
2738 !-----------------------------------------------------------------------
2739 !*** FILL RAINNC WITH ZERO (NORMALLY CONTAINS THE NONCONVECTIVE
2740 !*** ACCUMULATED RAIN BUT NOT YET USED BY NMM).
2741 !*** CAN BE OBTAINED FROM ACPREC AND CUPREC (ACPREC-CUPREC).
2742 !-----------------------------------------------------------------------
2743 RAINNC(I,J)=0.
2744 !
2745 ENDDO
2746 ENDDO
2747 !
2748 !-----------------------------------------------------------------------
2749 !*** FILL THE SINGLE-COLUMN INPUT
2750 !-----------------------------------------------------------------------
2751 !
2752 !$omp parallel do &
2753 !$omp& private(dpl,i,j,k,plyr,ql,tl)
2754 DO J=MYJS2,MYJE2
2755 DO K=KTS,KTE
2756 DO I=MYIS1,MYIE1
2757 DPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
2758 QL(K)=MAX(Q(I,J,K),EPSQ)
2759 !!! PLYR=AETA1(K)*PDTOP+AETA2(K)*PDSL(I,J)+PT
2760 PLYR=(PINT(I,J,K)+PINT(I,J,K+1))*0.5
2761 TL(K)=T(I,J,K)
2762 !
2763 RR(I,K,J)=PLYR/(R_D*TL(K)*(P608*QL(K)+1.))
2764 T_PHY(I,K,J)=TL(K)
2765 PI_PHY(I,K,J)=(PLYR*1.E-5)**CAPA
2766 TH_PHY(I,K,J)=TL(K)/PI_PHY(I,K,J)
2767 !!! P8W(I,KFLIP,J)=PINT(I,J,K+1)
2768 P8W(I,K,J)=ETA1(K)*PDTOP+ETA2(K)*PDSL(I,J)+PT
2769 P_PHY(I,K,J)=PLYR
2770 DZ(I,K,J)=DPL*RG/RR(I,K,J)
2771 CWM_PHY(I,K,J)=CWM(I,J,K)
2772 ENDDO
2773 !
2774 ENDDO
2775 ENDDO
2776 !-----------------------------------------------------------------------
2777 !
2778 !*** CALL MICROPHYSICS
2779 !
2780 !-----------------------------------------------------------------------
2781 !
2782 CALL SET_TILES(GRID,IDS+1,IDE-1,JDS+2,JDE-2,ITS,ITE,JTS,JTE)
2783 !
2784 CALL MICROPHYSICS_DRIVER( &
2785 & TH=TH_PHY,RHO=RR,PI_PHY=PI_PHY,P=P_PHY &
2786 & ,RAINNC=RAINNC,RAINNCV=RAINNCV &
2787 & ,DZ8W=DZ,P8W=P8W,DT=DTPHS,DX=DX,DY=DY &
2788 & ,MP_PHYSICS=CONFIG_FLAGS%MP_PHYSICS &
2789 #ifdef WRF_CHEM
2790 & ,CHEM_OPT=CONFIG_FLAGS%CHEM_OPT &
2791 & ,PROGN=CONFIG_FLAGS%PROGN &
2792 #endif
2793 & ,SPECIFIED=CONFIG_FLAGS%SPECIFIED &
2794 & .OR.CONFIG_FLAGS%NESTED &
2795 & ,SPEC_ZONE=0,WARM_RAIN=WARM_RAIN &
2796 & ,XLAND=XLAND,ITIMESTEP=NTSD-1 &
2797 & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN &
2798 & ,F_RIMEF_PHY=F_RIMEF &
2799 & ,LOWLYR=LOWLYR,SR=SR &
2800 & ,QV_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QV),F_QV=F_QV &
2801 & ,QC_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QC),F_QC=F_QC &
2802 & ,QR_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QR),F_QR=F_QR &
2803 & ,QI_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QI),F_QI=F_QI &
2804 & ,QS_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QS),F_QS=F_QS &
2805 & ,QG_CURR=MOIST_TRANS(IMS,KMS,JMS,P_QG),F_QG=F_QG &
2806 & ,QNI_CURR=SCALAR_TRANS(IMS,KMS,JMS,P_QNI),F_QNI=F_QNI &
2807 & ,QNR_CURR=SCALAR_TRANS(IMS,KMS,JMS,P_QNR),F_QNR=F_QNR &
2808 & ,QT_CURR=CWM_PHY,F_QT=QT_PRESENT &
2809 & ,MP_RESTART_STATE=MP_RESTART_STATE &
2810 & ,TBPVS_STATE=TBPVS_STATE &
2811 & ,TBPVS0_STATE=TBPVS0_STATE &
2812 & ,IDS=IDS,IDE=IDE,JDS=JDS,JDE=JDE,KDS=KDS,KDE=KDE &
2813 & ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,KMS=KMS,KME=KME &
2814 & ,I_START=GRID%I_START,I_END=GRID%I_END &
2815 & ,J_START=GRID%J_START,J_END=GRID%J_END &
2816 & ,KTS=KTS,KTE=KTE,NUM_TILES=GRID%NUM_TILES &
2817 & ,ID=grid%id &
2818 )
2820 !$omp parallel do &
2821 !$omp& private(ij)
2822 DO IJ=1,GRID%NUM_TILES
2823 CALL MICROPHYSICS_ZERO_OUTA( &
2824 MOIST_TRANS,N_MOIST,CONFIG_FLAGS &
2825 ,IDS,IDE,JDS,JDE,KDS,KDE &
2826 ,IMS,IME,JMS,JME,KMS,KME &
2827 ,GRID%I_START(IJ),GRID%I_END(IJ) &
2828 ,GRID%J_START(IJ),GRID%J_END(IJ) &
2829 ,KTS,KTE )
2830 ENDDO
2834 !
2835 !-----------------------------------------------------------------------
2836 !
2837 E_BDY=(ITE>=IDE)
2838 !
2839 !-----------------------------------------------------------------------
2840 !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING.
2841 !-----------------------------------------------------------------------
2842 !$omp parallel do &
2843 !$omp& private(i,iendx,j,k,tnew)
2844 DO K=KTS,KTE
2845 DO J=MYJS2,MYJE2
2846 IENDX=MYIE1
2847 IF(E_BDY.AND.MOD(J,2)==0)IENDX=IENDX-1
2848 DO I=MYIS1,IENDX
2849 TNEW=TH_PHY(I,K,J)*PI_PHY(I,K,J)
2850 TRAIN(I,J,K)=TRAIN(I,J,K)+(TNEW-T(I,J,K))*RDTPHS
2851 T(I,J,K)=TNEW
2852 Q(I,J,K)=MOIST_TRANS(I,K,J,P_QV)/(1.+MOIST_TRANS(I,K,J,P_QV))
2853 CWM(I,J,K)=CWM_PHY(I,K,J)
2854 ENDDO
2855 ENDDO
2856 ENDDO
2857 !
2858 !-----------------------------------------------------------------------
2859 !*** UPDATE PRECIPITATION.
2860 !*** NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT
2861 !*** OUT ABOVE SINCE IT IS ONLY A LOCAL ARRAY FOR NOW.
2862 !-----------------------------------------------------------------------
2863 !
2864 !$omp parallel do &
2865 !$omp& private(i,iendx,j,pcpcol)
2866 DO J=MYJS2,MYJE2
2867 IENDX=MYIE1
2868 IF(E_BDY.AND.MOD(J,2)==0)IENDX=IENDX-1
2869 DO I=MYIS1,IENDX
2870 PCPCOL=RAINNCV(I,J)*1.E-3
2871 PREC(I,J)=PREC(I,J)+PCPCOL
2872 ACPREC(I,J)=ACPREC(I,J)+PCPCOL
2873 ENDDO
2874 ENDDO
2875 !
2876 !-----------------------------------------------------------------------
2877 !*** REFILL THE MOIST ARRAY.
2878 !-----------------------------------------------------------------------
2879 !
2880 DO N=1,N_MOIST
2881 !$omp parallel do &
2882 !$omp& private(i,j,k)
2883 DO J=JMS,JME
2884 DO K=KMS,KME
2885 DO I=IMS,IME
2886 MOIST(I,J,K,N)=MOIST_TRANS(I,K,J,N)
2887 ENDDO
2888 ENDDO
2889 ENDDO
2890 ENDDO
2891 !
2892 !-----------------------------------------------------------------------
2893 !
2894 IF(CONFIG_FLAGS%MP_PHYSICS/=ETAMPNEW.and.config_flags%mp_physics/=etamp_hwrf)THEN
2895 DO N=1,N_SCALAR
2896 !$omp parallel do &
2897 !$omp& private(i,j,k)
2898 DO J=JMS,JME
2899 DO K=KMS,KME
2900 DO I=IMS,IME
2901 SCALAR(I,J,K,N)=SCALAR_TRANS(I,K,J,N)
2902 ENDDO
2903 ENDDO
2904 ENDDO
2905 ENDDO
2906 ENDIF
2907 !
2908 !-----------------------------------------------------------------------
2909 !
2910 DEALLOCATE(MOIST_TRANS,STAT=ISTAT)
2911 DEALLOCATE(SCALAR_TRANS,STAT=ISTAT)
2912 !
2913 !-----------------------------------------------------------------------
2914 !
2915 END SUBROUTINE GSMDRIVE
2916 !
2917 !-----------------------------------------------------------------------
2918 !***********************************************************************
2919 SUBROUTINE UPDATE_MOIST(MOIST,Q,CWM,F_ICE,F_RAIN,N_MOIST &
2920 & ,IDS,IDE,JDS,JDE,KDS,KDE &
2921 & ,IMS,IME,JMS,JME,KMS,KME &
2922 & ,ITS,ITE,JTS,JTE,KTS,KTE)
2923 !***********************************************************************
2924 !-----------------------------------------------------------------------
2925 !
2926 IMPLICIT NONE
2927 !
2928 !-----------------------------------------------------------------------
2929 !
2930 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
2931 & ,IMS,IME,JMS,JME,KMS,KME &
2932 & ,ITS,ITE,JTS,JTE,KTS,KTE &
2933 & ,N_MOIST
2934 !
2935 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: CWM,Q
2936 !
2937 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: F_ICE & !<--- Used only with physics (IKJ)
2938 & ,F_RAIN
2939 !
2940 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME,N_MOIST),INTENT(OUT) :: MOIST
2941 !
2942 !-----------------------------------------------------------------------
2943 !*** LOCAL VARIABLES
2944 !-----------------------------------------------------------------------
2945 !
2946 INTEGER :: I,J,K
2947 !
2948 REAL :: FICE,FRAIN,QI,QR,QW,WC
2949 !
2950 !-----------------------------------------------------------------------
2951 !***********************************************************************
2952 !-----------------------------------------------------------------------
2953 !
2954 DO K=KTS,KTE
2955 DO J=MYJS,MYJE
2956 DO I=MYIS,MYIE
2957 MOIST(I,J,K,P_QV)=Q(I,J,K)/(1.-Q(I,J,K))
2958 WC=CWM(I,J,K)
2959 QI=0.
2960 QR=0.
2961 QW=0.
2962 FICE=F_ICE(I,K,J)
2963 FRAIN=F_RAIN(I,K,J)
2964 !
2965 IF(FICE>=1.)THEN
2966 QI=WC
2967 ELSEIF(FICE<=0.)THEN
2968 QW=WC
2969 ELSE
2970 QI=FICE*WC
2971 QW=WC-QI
2972 ENDIF
2973 !
2974 IF(QW>0..AND.FRAIN>0.)THEN
2975 IF(FRAIN>=1.)THEN
2976 QR=QW
2977 QW=0.
2978 ELSE
2979 QR=FRAIN*QW
2980 QW=QW-QR
2981 ENDIF
2982 ENDIF
2983 !
2984 MOIST(I,J,K,P_QC)=QW
2985 MOIST(I,J,K,P_QR)=QR
2986 MOIST(I,J,K,P_QI)=0.
2987 MOIST(I,J,K,P_QS)=QI
2988 MOIST(I,J,K,P_QG)=0.
2989 ENDDO
2990 ENDDO
2991 ENDDO
2992 !
2993 !-----------------------------------------------------------------------
2994 !
2995 END SUBROUTINE UPDATE_MOIST
2996 !
2997 !-----------------------------------------------------------------------
2998 !***********************************************************************
2999 !-----------------------------------------------------------------------
3000 !
3001 END MODULE MODULE_PHYSICS_CALLS
3002 !
3003 !-------------------------------------------------------------------