Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_PHYSICS_CALLS.F @ 3607

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

Rev	Line
[2759]	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