Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_PHYSICS_CALLS.F @ 3553

Last change on this file since 3553 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 103.9 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format