Context Navigation

module_physics_init.F @ 2759

Last change on this file since 2759 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: 79.9 KB

Line
1	!WRF:MODEL_LAYER:INITIALIZATION
2	!
3
4	! This MODULE holds the routines which are used to perform model start-up operations
5	! for the individual domains. This is the stage after inputting wrfinput and before
6	! calling 'integrate'.
7
8	! This MODULE CONTAINS the following routines:
9
10
11	MODULE module_physics_init
12
13	! USE module_io_domain
14	USE module_state_description
15	USE module_model_constants
16	! USE module_timing
17	USE module_configure
18	#ifdef DM_PARALLEL
19	USE module_dm
20	#endif
21
22	CONTAINS
23
24
25	!=================================================================
26	SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, &
27	p_top, TSK,RADT,BLDT,CUDT,MPDT, &
28	RTHCUTEN, RQVCUTEN, RQRCUTEN, &
29	RQCCUTEN, RQSCUTEN, RQICUTEN, &
30	RUBLTEN,RVBLTEN,RTHBLTEN, &
31	RQVBLTEN,RQCBLTEN,RQIBLTEN, &
32	RTHRATEN,RTHRATENLW,RTHRATENSW, &
33	STEPBL,STEPRA,STEPCU, &
34	W0AVG, RAINNC, RAINC, RAINCV, RAINNCV, &
35	NCA,swrad_scat, &
36	CLDEFI,LOWLYR, &
37	MASS_FLUX, &
38	RTHFTEN, RQVFTEN, &
39	CLDFRA,CLDFRA_OLD,GLW,GSW,EMISS,EMBCK, & !EMBCK new
40	LU_INDEX, &
41	landuse_ISICE, landuse_LUCATS, &
42	landuse_LUSEAS, landuse_ISN, &
43	lu_state, &
44	XLAT,XLONG,ALBEDO,ALBBCK,GMT,JULYR,JULDAY,&
45	levsiz, n_ozmixm, n_aerosolc, paerlev, &
46	TMN,XLAND,ZNT,Z0,UST,MOL,PBLH,TKE_MYJ, &
47	EXCH_H,THC,SNOWC,MAVAIL,HFX,QFX,RAINBL, &
48	TSLB,ZS,DZS,num_soil_layers,warm_rain, &
49	adv_moist_cond, &
50	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
51	APR_CAPMA,APR_CAPME,APR_CAPMI, &
52	XICE,XICEM,VEGFRA,SNOW,CANWAT,SMSTAV, &
53	SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,&
54	ACSNOM,IVGTYP,ISLTYP, SFCEVP, SMOIS, &
55	SH2O, SNOWH, SMFR3D, & ! temporary
56	DX,DY,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
57	mp_restart_state,tbpvs_state,tbpvs0_state,&
58	allowed_to_read, moved, start_of_simulation,&
59	ids, ide, jds, jde, kds, kde, &
60	ims, ime, jms, jme, kms, kme, &
61	its, ite, jts, jte, kts, kte, &
62	ozmixm,pin, & ! Optional
63	m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ! Optional
64	RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & ! Optional
65	RQVNDGDTEN,RMUNDGDTEN, & ! Optional
66	FGDT,STEPFG, & ! Optional
67	cugd_tten,cugd_ttens,cugd_qvten, & ! Optional
68	cugd_qvtens,cugd_qcten, & ! Optional
69	! num_roof_layers,num_wall_layers, & !Optional urban
70	! num_road_layers, & !Optional urban
71	DZR, DZB, DZG, & !Optional urban
72	TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D, & !Optional urban
73	QC_URB2D, XXXR_URB2D,XXXB_URB2D, & !Optional urban
74	XXXG_URB2D, XXXC_URB2D, & !Optional urban
75	TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban
76	SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban
77	TS_URB2D, FRC_URB2D, UTYPE_URB2D, & !Optional urban
78	TML,T0ML,HML,H0ML,HUML,HVML, & !Optional oml
79	itimestep & !Optional obs fdda
80	#if ( EM_CORE == 1 )
81	,fdob & !Optional obs fdda
82	#endif
83	)
84
85	!-----------------------------------------------------------------
86	USE module_domain
87	USE module_wrf_error
88	IMPLICIT NONE
89	!-----------------------------------------------------------------
90	TYPE (grid_config_rec_type) :: config_flags
91
92	INTEGER , INTENT(IN) :: id
93	LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond
94	! LOGICAL , INTENT (IN) :: FNDSOILW, FNDSNOWH
95	LOGICAL, PARAMETER :: FNDSOILW=.true., FNDSNOWH=.true.
96	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
97	ims, ime, jms, jme, kms, kme, &
98	its, ite, jts, jte, kts, kte
99
100	INTEGER , INTENT(IN) :: num_soil_layers
101
102	LOGICAL, INTENT(IN) :: start_of_simulation
103	REAL, INTENT(IN) :: DT, p_top, DX, DY
104	LOGICAL, INTENT(IN) :: restart
105	REAL, INTENT(IN) :: RADT,BLDT,CUDT,MPDT
106	REAL, INTENT(IN) :: swrad_scat
107
108	REAL, DIMENSION( kms:kme ) , INTENT(IN) :: zfull, zhalf
109	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK, XLAT, XLONG
110
111	INTEGER, INTENT(IN ) :: levsiz, n_ozmixm
112	INTEGER, INTENT(IN ) :: paerlev, n_aerosolc
113
114	REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, &
115	INTENT(INOUT) :: OZMIXM
116
117	REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN
118
119	REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2
120	REAL, DIMENSION(paerlev), OPTIONAL,INTENT(INOUT) :: m_hybi
121	REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, &
122	INTENT(INOUT) :: aerosolc_1, aerosolc_2
123
124	REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
125	INTENT(INOUT) :: SMOIS, SH2O,TSLB
126	REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), INTENT(OUT) :: SMFR3D
127
128	REAL, DIMENSION( ims:ime, jms:jme ) , &
129	INTENT(INOUT) :: SNOW, &
130	SNOWC, &
131	SNOWH, &
132	CANWAT, &
133	SMSTAV, &
134	SMSTOT, &
135	SFCRUNOFF, &
136	UDRUNOFF, &
137	SFCEVP, &
138	GRDFLX, &
139	ACSNOW, &
140	XICE, &
141	XICEM, &
142	VEGFRA, &
143	ACSNOM
144
145	INTEGER, DIMENSION( ims:ime, jms:jme ) , &
146	INTENT(INOUT) :: IVGTYP, &
147	ISLTYP
148
149	! rad
150
151	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
152	RTHRATEN, RTHRATENLW, RTHRATENSW, CLDFRA
153
154	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
155	CLDFRA_OLD
156
157	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: &
158	GSW,ALBEDO,ALBBCK,GLW,EMISS,EMBCK !EMBCK new
159
160	REAL, INTENT(IN) :: GMT
161
162	INTEGER , INTENT(OUT) :: STEPRA, STEPBL, STEPCU
163	INTEGER , INTENT(IN) :: JULYR, JULDAY
164
165	! cps
166
167	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
168	RTHCUTEN, RQVCUTEN, RQRCUTEN, RQCCUTEN, RQSCUTEN, &
169	RQICUTEN
170
171	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
172
173	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: MASS_FLUX, &
174	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
175	APR_CAPMA,APR_CAPME,APR_CAPMI
176
177	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
178	RTHFTEN, RQVFTEN
179
180	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: &
181	RAINNC, RAINC, RAINCV, RAINNCV
182
183	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: CLDEFI, NCA
184
185	INTEGER, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: LOWLYR
186
187	!pbl
188
189	! soil layer
190
191
192	REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS
193
194	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
195	RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,RQCBLTEN,RQIBLTEN,EXCH_H,TKE_MYJ
196	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
197	cugd_tten,cugd_ttens,cugd_qvten, &
198	cugd_qvtens,cugd_qcten
199	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: &
200	XLAND,ZNT,Z0,UST,MOL,LU_INDEX, &
201	PBLH,THC,MAVAIL,HFX,QFX,RAINBL
202	INTEGER , INTENT(INOUT) :: landuse_ISICE, landuse_LUCATS
203	INTEGER , INTENT(INOUT) :: landuse_LUSEAS, landuse_ISN
204	REAL , INTENT(INOUT) , DIMENSION( : ) :: lu_state
205
206	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN
207
208	!mp
209	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
210	F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
211	REAL, DIMENSION(:), INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state
212	LOGICAL, INTENT(IN) :: allowed_to_read, moved
213
214	! ocean mixed layer
215	REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: &
216	TML,T0ML,HML,H0ML,HUML,HVML
217
218	!fdda
219	REAL, OPTIONAL, INTENT(IN) :: FGDT
220	INTEGER , OPTIONAL, INTENT(OUT) :: STEPFG
221	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
222	RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, RQVNDGDTEN
223	REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
224	RMUNDGDTEN
225
226	!URBAN
227	! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !urban
228	! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !urban
229	! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !urban
230	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !urban
231	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !urban
232	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !urban
233
234	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !urban
235	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !urban
236	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !urban
237	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !urban
238	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !urban
239	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !urban
240	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !urban
241	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !urban
242	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !urban
243
244	! REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban
245	! REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban
246	! REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban
247	REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban
248	REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban
249	REAL, OPTIONAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban
250
251	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !urban
252	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !urban
253	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !urban
254	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !urban
255	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !urban
256	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !urban
257	INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !urban
258
259	!obs fdda
260	INTEGER, OPTIONAL, INTENT(IN) :: itimestep
261	#if ( EM_CORE == 1 )
262	TYPE(fdob_type), OPTIONAL, INTENT(INOUT) :: fdob
263	#endif
264
265	! Local data
266
267	REAL :: ALBLND,ZZLND,ZZWTR,THINLD,XMAVA,CEN_LAT,pptop
268	REAL, DIMENSION( kms:kme ) :: sfull, shalf
269	REAL :: obs_twindo_cg, obs_twindo
270
271	CHARACTER*4 :: MMINLU_loc
272	CHARACTER*80 :: message
273	INTEGER :: ISWATER
274	INTEGER :: ucmcall
275	INTEGER :: omlcall
276	REAL :: oml_hml0
277	LOGICAL :: usemonalb
278
279	INTEGER :: i, j, k, itf, jtf
280	integer myproc
281
282	!-----------------------------------------------------------------
283
284	ucmcall=config_flags%ucmcall
285	usemonalb=config_flags%usemonalb
286	#if ( EM_CORE == 1 )
287	obs_twindo_cg=model_config_rec%obs_twindo(1)
288	obs_twindo=config_flags%obs_twindo
289	oml_hml0=config_flags%oml_hml0
290	omlcall=config_flags%omlcall
291	#endif
292
293	!-- should be from the namelist
294
295	sfull = 0.
296	shalf = 0.
297
298	CALL wrf_debug(100,'top of phy_init')
299
300	WRITE(wrf_err_message,*) 'phy_init: start_of_simulation = ',start_of_simulation
301	CALL wrf_debug ( 100, TRIM(wrf_err_message) )
302
303	itf=min0(ite,ide-1)
304	jtf=min0(jte,jde-1)
305
306	ZZLND=0.1
307	ZZWTR=0.0001
308	THINLD=0.04
309	ALBLND=0.2
310	XMAVA=0.3
311
312	#if (NMM_CORE == 1)
313	if (.not.usemonalb) CALL wrf_error_fatal('usemonalb should always be true for NMM')
314	#endif
315
316	CALL nl_get_cen_lat(id,cen_lat)
317	CALL wrf_debug(100,'calling nl_get_iswater, nl_get_mminlu_loc')
318	CALL nl_get_iswater(id,iswater)
319	CALL nl_get_mminlu( 1, mminlu_loc )
320	CALL wrf_debug(100,'after nl_get_iswater, nl_get_mminlu_loc')
321
322	IF(.not.restart)THEN
323	!-- initialize common variables
324
325	IF ( .NOT. moved ) THEN
326	DO j=jts,jtf
327	DO i=its,itf
328	XLAND(i,j)=1.
329	GSW(i,j)=0.
330	GLW(i,j)=0.
331	UST(i,j)=0.
332	MOL(i,j)=0.0
333	PBLH(i,j)=0.0
334	HFX(i,j)=0.
335	QFX(i,j)=0.
336	RAINBL(i,j)=0.
337	RAINNCV(i,j)=0.
338	ACSNOW(i,j)=0.
339	DO k=kms,kme !wig, 17-May-2006: Added for idealized chem. runs
340	EXCH_H(i,k,j) = 0.
341	END DO
342	ENDDO
343	ENDDO
344	ENDIF
345
346	!
347	DO j=jts,jtf
348	DO i=its,itf
349	IF(XLAND(i,j) .LT. 1.5)THEN
350	IF(mminlu_loc .EQ. ' ') ALBBCK(i,j)=ALBLND
351	EMBCK(i,j)=0.85
352	ALBEDO(i,j)=ALBBCK(i,j)
353	EMISS(i,j)=EMBCK(i,j)
354	THC(i,j)=THINLD
355	ZNT(i,j)=ZZLND
356	#if ! ( NMM_CORE == 1 )
357	Z0(i,j)=ZZLND
358	#endif
359	MAVAIL(i,j)=XMAVA
360	ELSE
361	IF(mminlu_loc .EQ. ' ') ALBBCK(i,j)=0.08
362	ALBEDO(i,j)=ALBBCK(i,j)
363	EMBCK(i,j)=0.98
364	EMISS(i,j)=EMBCK(i,j)
365	THC(i,j)=THINLD
366	ZNT(i,j)=ZZWTR
367	#if ! ( NMM_CORE == 1 )
368	Z0(i,j)=ZZWTR
369	#endif
370	MAVAIL(i,j)=1.0
371	ENDIF
372
373	ENDDO
374	ENDDO
375
376	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to landuse_init' )
377
378	IF(mminlu_loc .ne. ' ')THEN
379	!-- initialize surface properties
380
381	CALL landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck, &
382	znt, Z0, thc, xland, xice, xicem, julday, cen_lat, iswater, mminlu_loc, &
383	landuse_ISICE, landuse_LUCATS, &
384	landuse_LUSEAS, landuse_ISN, &
385	lu_state, &
386	allowed_to_read , usemonalb , &
387	ids, ide, jds, jde, kds, kde, &
388	ims, ime, jms, jme, kms, kme, &
389	its, ite, jts, jte, kts, kte )
390	ENDIF
391
392	ENDIF
393
394	!-- convert zfull and zhalf to sigma values for ra_init (Eta CO2 needs these)
395	!-- zfull/zhalf may be either zeta or eta
396	!-- what is done here depends on coordinate (check this code if adding new coordinates)
397	CALL z2sigma(zfull,zhalf,sfull,shalf,p_top,pptop,config_flags, &
398	allowed_to_read, &
399	kds,kde,kms,kme,kts,kte)
400
401	!-- initialize physics
402	!-- ra: radiation
403	!-- bl: pbl
404	!-- cu: cumulus
405	!-- mp: microphysics
406
407	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' )
408
409	CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, &
410	RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, &
411	levsiz,XLAT,n_ozmixm, &
412	cldfra_old, & ! Optional
413	ozmixm,pin, & ! Optional
414	m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional
415	paerlev,n_aerosolc, &
416	sfull,shalf,pptop,swrad_scat, &
417	config_flags,restart, &
418	allowed_to_read, start_of_simulation, &
419	ids, ide, jds, jde, kds, kde, &
420	ims, ime, jms, jme, kms, kme, &
421	its, ite, jts, jte, kts, kte )
422
423	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' )
424
425	CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, &
426	RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, &
427	config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, &
428	num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, &
429	SNOW,SNOWC, CANWAT,SMSTAV, &
430	SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, &
431	IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL, &
432	SNOWH,SH2O,FNDSOILW, FNDSNOWH, &
433	#if (NMM_CORE == 1)
434	Z0,XLAND,XICE, &
435	#else
436	ZNT,XLAND,XICE, &
437	#endif
438	SFCEVP,GRDFLX, &
439	allowed_to_read , &
440	start_of_simulation , &
441	DZR, DZB, DZG, & !Optional urban
442	TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban
443	XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban
444	TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban
445	SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban
446	TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL, & !Optional urban
447	ids, ide, jds, jde, kds, kde, &
448	ims, ime, jms, jme, kms, kme, &
449	its, ite, jts, jte, kts, kte, &
450	oml_hml0, omlcall, & !Optional oml
451	TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml
452
453	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' )
454
455	CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, &
456	RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, &
457	RAINCV,W0AVG,config_flags,restart, &
458	CLDEFI,LOWLYR,MASS_FLUX, &
459	RTHFTEN, RQVFTEN, &
460	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
461	APR_CAPMA,APR_CAPME,APR_CAPMI, &
462	cugd_tten,cugd_ttens,cugd_qvten, &
463	cugd_qvtens,cugd_qcten, &
464	allowed_to_read, start_of_simulation, &
465	ids, ide, jds, jde, kds, kde, &
466	ims, ime, jms, jme, kms, kme, &
467	its, ite, jts, jte, kts, kte )
468
469	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' )
470
471	CALL mp_init(RAINNC,config_flags,restart,warm_rain, &
472	adv_moist_cond, &
473	MPDT, DT, DX, DY, LOWLYR, &
474	F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
475	mp_restart_state,tbpvs_state,tbpvs0_state, &
476	allowed_to_read, start_of_simulation, &
477	ids, ide, jds, jde, kds, kde, &
478	ims, ime, jms, jme, kms, kme, &
479	its, ite, jts, jte, kts, kte )
480
481	write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL
482	CALL wrf_message( message )
483
484	#if ( EM_CORE == 1 )
485	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' )
486
487	CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, &
488	RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
489	config_flags,restart, &
490	allowed_to_read , &
491	ids, ide, jds, jde, kds, kde, &
492	ims, ime, jms, jme, kms, kme, &
493	its, ite, jts, jte, kts, kte )
494
495	CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' )
496
497	CALL fdob_init(model_config_rec%obs_nudge_opt, &
498	model_config_rec%max_dom, &
499	id, &
500	model_config_rec%parent_id, &
501	model_config_rec%obs_idynin, &
502	model_config_rec%obs_dtramp, &
503	model_config_rec%fdda_end, &
504	config_flags%restart, &
505	obs_twindo_cg, obs_twindo, &
506	itimestep, &
507	config_flags%cen_lat, &
508	config_flags%cen_lon, &
509	config_flags%stand_lon, &
510	config_flags%truelat1, &
511	config_flags%truelat2, &
512	config_flags%map_proj, &
513	xlat, &
514	xlong, &
515	model_config_rec%s_sn(1), &
516	model_config_rec%e_sn(1), &
517	model_config_rec%s_we(1), &
518	model_config_rec%e_we(1), &
519	fdob, &
520	model_config_rec%obs_ipf_init, &
521	ids, ide, jds, jde, kds, kde, &
522	ims, ime, jms, jme, kms, kme, &
523	its, ite, jts, jte, kts, kte )
524
525	#endif
526
527	END SUBROUTINE phy_init
528
529	!=====================================================================
530	SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, mavail, emiss, embck, &
531	znt,Z0,thc,xland, xice, xicem, julday, cen_lat, iswater, mminlu, &
532	ISICE, LUCATS, LUSEAS, ISN, &
533	lu_state, &
534	allowed_to_read , usemonalb , &
535	ids, ide, jds, jde, kds, kde, &
536	ims, ime, jms, jme, kms, kme, &
537	its, ite, jts, jte, kts, kte )
538
539	USE module_wrf_error
540	IMPLICIT NONE
541
542	!---------------------------------------------------------------------
543	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
544	ims, ime, jms, jme, kms, kme, &
545	its, ite, jts, jte, kts, kte
546
547	INTEGER , INTENT(IN) :: iswater, julday
548	REAL , INTENT(IN) :: cen_lat
549	CHARACTER*4, INTENT(IN) :: mminlu
550	LOGICAL, INTENT(IN) :: allowed_to_read , usemonalb
551	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: lu_index, snowc, xice
552	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT ) :: albedo, albbck, mavail, emiss, &
553	embck, &
554	znt, Z0, thc, xland, xicem
555	INTEGER , INTENT(INOUT) :: ISICE, LUCATS, LUSEAS, ISN
556	REAL , INTENT(INOUT) , DIMENSION( : ) :: lu_state
557
558	!---------------------------------------------------------------------
559	! Local
560	CHARACTER*4 LUTYPE
561	CHARACTER*80 :: message
562	INTEGER :: landuse_unit, LS, LC, LI, LUN, NSN
563	INTEGER :: i, j, itf, jtf, is, cats, seas, curs
564	INTEGER , PARAMETER :: OPEN_OK = 0
565	INTEGER :: ierr
566	INTEGER , PARAMETER :: max_cats = 100 , max_seas = 12
567	REAL , DIMENSION( max_cats, max_seas ) :: ALBD, SLMO, SFEM, SFZ0, THERIN, SFHC
568	REAL , DIMENSION( max_cats ) :: SCFX
569	! save these fields in case nest moves or has to be reinitialized
570	! and this routine is called with allowed_to_read set to false
571	! note that by saving these, we're locking in the same landuse for
572	! the duration of a run; possible implications for long climate runs
573	LOGICAL :: found_lu, end_of_file
574	LOGICAL, EXTERNAL :: wrf_dm_on_monitor
575
576	!---------------------------------------------------------------------
577
578	CALL wrf_debug( 100 , 'top of landuse_init' )
579
580	NSN=-1 ! set this to suppress uninitalized data messages from tools
581
582	! recover LU variables from state
583	IF ( 6(max_catsmax_seas)+1*max_cats .GT. 7501 ) THEN
584	WRITE(message,)'landuse_init: lu_state overflow. Make Registry dimspec p > ',6(max_catsmax_seas)+1max_cats
585	ENDIF
586	curs = 1
587	DO cats = 1, max_cats
588	SCFX(cats) = lu_state(curs) ; curs = curs + 1
589	DO seas = 1, max_seas
590	ALBD(cats,seas) = lu_state(curs) ; curs = curs + 1
591	SLMO(cats,seas) = lu_state(curs) ; curs = curs + 1
592	SFEM(cats,seas) = lu_state(curs) ; curs = curs + 1
593	SFZ0(cats,seas) = lu_state(curs) ; curs = curs + 1
594	SFHC(cats,seas) = lu_state(curs) ; curs = curs + 1
595	THERIN(cats,seas) = lu_state(curs) ; curs = curs + 1
596	ENDDO
597	ENDDO
598
599	! Determine season (summer=1, winter=2)
600	ISN=1
601	IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2
602	IF(CEN_LAT.LT.0.0)ISN=3-ISN
603
604	FOUND_LU = .TRUE.
605	IF ( allowed_to_read ) THEN
606	landuse_unit = 29
607	IF ( wrf_dm_on_monitor() ) THEN
608	OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
609	IF ( ierr .NE. OPEN_OK ) THEN
610	WRITE(message,FMT='(A)') &
611	'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL'
612	CALL wrf_error_fatal ( message )
613	END IF
614	ENDIF
615
616	! Read info from file LANDUSE.TBL
617	IF(MMINLU.EQ.'OLD ')THEN
618	! ISWATER=7
619	ISICE=11
620	ELSE IF(MMINLU.EQ.'USGS')THEN
621	! ISWATER=16
622	ISICE=24
623	ELSE IF(MMINLU.EQ.'SiB ')THEN
624	! ISWATER=15
625	ISICE=16
626	ELSE IF(MMINLU.EQ.'LW12')THEN
627	! ISWATER=15
628	ISICE=3
629	ENDIF
630	PRINT *, 'INPUT LANDUSE = ',MMINLU
631	FOUND_LU = .FALSE.
632	end_of_file = .FALSE.
633	!!! BEGINNING OF 1999 LOOP
634	1999 CONTINUE
635	IF ( wrf_dm_on_monitor() ) THEN
636	READ (landuse_unit,2000,END=2002)LUTYPE
637	GOTO 2003
638	2002 CONTINUE
639	CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' )
640	end_of_file = .TRUE.
641	2003 CONTINUE
642	IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS
643	FOUND_LU = LUTYPE.EQ.MMINLU
644	ENDIF
645	CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE )
646	IF ( .NOT. end_of_file ) THEN
647	CALL wrf_dm_bcast_string(lutype, 4)
648	CALL wrf_dm_bcast_bytes (lucats, IWORDSIZE )
649	CALL wrf_dm_bcast_bytes (luseas, IWORDSIZE )
650	CALL wrf_dm_bcast_bytes (found_lu, LWORDSIZE )
651	2000 FORMAT (A4)
652	IF(FOUND_LU)THEN
653	LUN=LUCATS
654	NSN=LUSEAS
655	PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND', &
656	LUCATS,' CATEGORIES',LUSEAS,' SEASONS', &
657	' WATER CATEGORY = ',ISWATER, &
658	' SNOW CATEGORY = ',ISICE
659	ENDIF
660	DO ls=1,luseas
661	if ( wrf_dm_on_monitor() ) then
662	READ (landuse_unit,*)
663	endif
664	DO LC=1,LUCATS
665	IF(found_lu)THEN
666	IF ( wrf_dm_on_monitor() ) THEN
667	READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS), &
668	SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS)
669	ENDIF
670	CALL wrf_dm_bcast_bytes (LI, IWORDSIZE )
671	IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' )
672	ELSE
673	IF ( wrf_dm_on_monitor() ) THEN
674	READ (landuse_unit,*)
675	ENDIF
676	ENDIF
677	ENDDO
678	ENDDO
679	IF(NSN.EQ.1.AND.FOUND_LU) THEN
680	ISN = 1
681	END IF
682	CALL wrf_dm_bcast_bytes (albd, max_cats * max_seas * RWORDSIZE )
683	CALL wrf_dm_bcast_bytes (slmo, max_cats * max_seas * RWORDSIZE )
684	CALL wrf_dm_bcast_bytes (sfem, max_cats * max_seas * RWORDSIZE )
685	CALL wrf_dm_bcast_bytes (sfz0, max_cats * max_seas * RWORDSIZE )
686	CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE )
687	CALL wrf_dm_bcast_bytes (sfhc, max_cats * max_seas * RWORDSIZE )
688	CALL wrf_dm_bcast_bytes (scfx, max_cats * RWORDSIZE )
689	ENDIF
690
691	IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999
692	!!! END OF 1999 LOOP
693
694	IF(.NOT. found_lu .OR. end_of_file )THEN
695	CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' )
696	ENDIF
697	ENDIF ! allowed_to_read
698
699	IF(FOUND_LU)THEN
700	! Set arrays according to lu_index
701	itf = min0(ite, ide-1)
702	jtf = min0(jte, jde-1)
703	IF(usemonalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' )
704	DO j = jts, jtf
705	DO i = its, itf
706	IS=nint(lu_index(i,j))
707	! only do this check on read-in data
708	IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN
709	WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN
710	CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
711	ENDIF
712	! SET NO-DATA POINTS (IS=0) TO WATER
713	IF(IS.EQ.0)THEN
714	IS=ISWATER
715	ENDIF
716	IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.
717	ALBEDO(I,J)=ALBBCK(I,J)
718	IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS))
719	THC(I,J)=THERIN(IS,ISN)/100.
720	Z0(I,J)=SFZ0(IS,ISN)/100.
721	ZNT(I,J)=Z0(I,J)
722	EMBCK(I,J)=SFEM(IS,ISN)
723	EMISS(I,J)=EMBCK(I,J)
724	MAVAIL(I,J)=SLMO(IS,ISN)
725	IF(IS.NE.ISWATER)THEN
726	XLAND(I,J)=1.0
727	ELSE
728	XLAND(I,J)=2.0
729	ENDIF
730	! SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES
731	XICEM(I,J)=XICE(I,J)
732	IF(XICE(I,J).GT.0.5)THEN
733	XLAND(I,J)=1.0
734	ALBBCK(I,J)=ALBD(ISICE,ISN)/100.
735	ALBEDO(I,J)=ALBBCK(I,J)
736	THC(I,J)=THERIN(ISICE,ISN)/100.
737	Z0(I,J)=SFZ0(ISICE,ISN)/100.
738	ZNT(I,J)=Z0(I,J)
739	EMBCK(I,J)=SFEM(ISICE,ISN)
740	EMISS(I,J)=EMBCK(I,J)
741	MAVAIL(I,J)=SLMO(ISICE,ISN)
742	ENDIF
743	ENDDO
744	ENDDO
745	ENDIF
746	if ( wrf_dm_on_monitor() .and. allowed_to_read ) then
747	CLOSE (landuse_unit)
748	endif
749	CALL wrf_debug( 100 , 'returning from of landuse_init' )
750
751	! restore LU variables from state
752	curs = 1
753	DO cats = 1, max_cats
754	lu_state(curs) = SCFX(cats) ; curs = curs + 1
755	DO seas = 1, max_seas
756	lu_state(curs) = ALBD(cats,seas) ; curs = curs + 1
757	lu_state(curs) = SLMO(cats,seas) ; curs = curs + 1
758	lu_state(curs) = SFEM(cats,seas) ; curs = curs + 1
759	lu_state(curs) = SFZ0(cats,seas) ; curs = curs + 1
760	lu_state(curs) = SFHC(cats,seas) ; curs = curs + 1
761	lu_state(curs) = THERIN(cats,seas) ; curs = curs + 1
762	ENDDO
763	ENDDO
764
765	RETURN
766
767	END SUBROUTINE landuse_init
768
769	!=====================================================================
770	SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, &
771	RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, &
772	levsiz,XLAT,n_ozmixm, &
773	cldfra_old, & ! Optional
774	ozmixm,pin, & ! Optional
775	m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional
776	paerlev,n_aerosolc, &
777	sfull,shalf,pptop,swrad_scat, &
778	config_flags,restart, &
779	allowed_to_read, start_of_simulation, &
780	ids, ide, jds, jde, kds, kde, &
781	ims, ime, jms, jme, kms, kme, &
782	its, ite, jts, jte, kts, kte )
783	!---------------------------------------------------------------------
784	USE module_ra_rrtm
785	USE module_ra_cam
786	USE module_ra_sw
787	USE module_ra_gsfcsw
788	USE module_ra_gfdleta
789	USE module_ra_hs
790	USE module_domain
791	!---------------------------------------------------------------------
792	IMPLICIT NONE
793	!---------------------------------------------------------------------
794	INTEGER, INTENT(IN) :: id
795	TYPE (grid_config_rec_type) :: config_flags
796	LOGICAL , INTENT(IN) :: restart
797	LOGICAL, INTENT(IN) :: allowed_to_read
798
799	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
800	ims, ime, jms, jme, kms, kme, &
801	its, ite, jts, jte, kts, kte
802
803	INTEGER , INTENT(IN) :: JULDAY,JULYR
804	REAL , INTENT(IN) :: DT, RADT, cen_lat, GMT, pptop, &
805	swrad_scat
806	LOGICAL, INTENT(IN) :: start_of_simulation
807
808	INTEGER, INTENT(IN ) :: levsiz, n_ozmixm
809	INTEGER, INTENT(IN ) :: paerlev, n_aerosolc
810
811	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAT
812
813	REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, &
814	INTENT(INOUT) :: OZMIXM
815
816	REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2
817	REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi
818	REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, &
819	INTENT(INOUT) :: aerosolc_1, aerosolc_2
820
821	REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN
822
823	INTEGER , INTENT(INOUT) :: STEPRA
824	INTEGER :: isn
825
826	REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf
827	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
828	RTHRATEN, &
829	RTHRATENLW, &
830	RTHRATENSW, &
831	CLDFRA
832
833	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
834	CLDFRA_OLD
835
836	REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS
837	LOGICAL :: etalw = .false.
838	LOGICAL :: camlw = .false.
839	LOGICAL :: etamp = .false.
840	integer :: month,iday
841	INTEGER :: i, j, k, itf, jtf, ktf
842	!---------------------------------------------------------------------
843
844	jtf=min0(jte,jde-1)
845	ktf=min0(kte,kde-1)
846	itf=min0(ite,ide-1)
847
848	!---------------------------------------------------------------------
849
850	!-- calculate radiation time step
851
852	STEPRA = nint(RADT*60./DT)
853	STEPRA = max(STEPRA,1)
854
855	!-- initialization
856
857	IF(start_of_simulation)THEN
858	DO j=jts,jtf
859	DO k=kts,ktf
860	DO i=its,itf
861	RTHRATEN(i,k,j)=0.
862	RTHRATENLW(i,k,j)=0.
863	RTHRATENSW(i,k,j)=0.
864	CLDFRA(i,k,j)=0.
865	ENDDO
866	ENDDO
867	ENDDO
868
869	if( present(cldfra_old) ) then
870	DO j=jts,jtf
871	DO k=kts,ktf
872	DO i=its,itf
873	cldfra_old(i,k,j) = 0.
874	ENDDO
875	ENDDO
876	ENDDO
877	end if
878	ENDIF
879
880	!-- find out which microphysics option is used first
881
882	mp_select: SELECT CASE(config_flags%mp_physics)
883
884	CASE (ETAMPNEW)
885	etamp = .true.
886
887	END SELECT mp_select
888
889	!-- chose long wave radiation scheme
890
891	lwrad_select: SELECT CASE(config_flags%ra_lw_physics)
892
893	CASE (RRTMSCHEME)
894	CALL rrtminit( &
895	allowed_to_read , &
896	ids, ide, jds, jde, kds, kde, &
897	ims, ime, jms, jme, kms, kme, &
898	its, ite, jts, jte, kts, kte )
899
900	CASE (CAMLWSCHEME)
901	#ifdef MAC_KLUDGE
902	CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
903	#endif
904	IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. &
905	PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND. &
906	PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1) &
907	.AND. PRESENT(AEROSOLC_2)) THEN
908	CALL camradinit( &
909	R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, &
910	ozmixm,pin,levsiz,XLAT,n_ozmixm, &
911	m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
912	paerlev, n_aerosolc, &
913	ids, ide, jds, jde, kds, kde, &
914	ims, ime, jms, jme, kms, kme, &
915	its, ite, jts, jte, kts, kte )
916	ELSE
917	CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' )
918	ENDIF
919
920	camlw = .true.
921
922	CASE (GFDLLWSCHEME)
923	CALL nl_get_start_month(id,month)
924	CALL nl_get_start_day(id,iday)
925	CALL gfdletainit(emiss,sfull,shalf,pptop, &
926	julyr,month,iday,gmt, &
927	config_flags,allowed_to_read, &
928	ids, ide, jds, jde, kds, kde, &
929	ims, ime, jms, jme, kms, kme, &
930	its, ite, jts, jte, kts, kte )
931	etalw = .true.
932	CASE (HELDSUAREZ)
933	CALL hsinit(RTHRATEN,restart, &
934	ids, ide, jds, jde, kds, kde, &
935	ims, ime, jms, jme, kms, kme, &
936	its, ite, jts, jte, kts, kte )
937	CASE DEFAULT
938
939	END SELECT lwrad_select
940	!-- initialize short wave radiation scheme
941
942	swrad_select: SELECT CASE(config_flags%ra_sw_physics)
943
944	CASE (SWRADSCHEME)
945	CALL swinit( &
946	swrad_scat, &
947	allowed_to_read , &
948	ids, ide, jds, jde, kds, kde, &
949	ims, ime, jms, jme, kms, kme, &
950	its, ite, jts, jte, kts, kte )
951
952	CASE (CAMSWSCHEME)
953	#ifdef MAC_KLUDGE
954	CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
955	#endif
956	IF(.not.camlw)THEN
957	CALL camradinit( &
958	R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, &
959	ozmixm,pin,levsiz,XLAT,n_ozmixm, &
960	m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
961	paerlev, n_aerosolc, &
962	ids, ide, jds, jde, kds, kde, &
963	ims, ime, jms, jme, kms, kme, &
964	its, ite, jts, jte, kts, kte )
965	ENDIF
966
967	CASE (GSFCSWSCHEME)
968	CALL gsfc_swinit(cen_lat, allowed_to_read )
969
970	CASE (GFDLSWSCHEME)
971	IF(.not.etalw)THEN
972	CALL nl_get_start_month(id,month)
973	CALL nl_get_start_day(id,iday)
974	CALL gfdletainit(emiss,sfull,shalf,pptop, &
975	julyr,month,iday,gmt, &
976	config_flags,allowed_to_read, &
977	ids, ide, jds, jde, kds, kde, &
978	ims, ime, jms, jme, kms, kme, &
979	its, ite, jts, jte, kts, kte )
980	ENDIF
981
982	CASE DEFAULT
983
984	END SELECT swrad_select
985
986	END SUBROUTINE ra_init
987
988	SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, &
989	RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, &
990	config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, &
991	num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, &
992	SNOW,SNOWC, CANWAT,SMSTAV, &
993	SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, &
994	IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail, &
995	SNOWH,SH2O,FNDSOILW, FNDSNOWH, &
996	#if ( NMM_CORE == 1 )
997	Z0,XLAND,XICE, &
998	#else
999	ZNT,XLAND,XICE, &
1000	#endif
1001	SFCEVP,GRDFLX, &
1002	allowed_to_read, &
1003	start_of_simulation, &
1004	! num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban
1005	DZR, DZB, DZG, & !Optional urban
1006	TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban
1007	XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban
1008	TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban
1009	SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, & !Optional urban
1010	TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL, & !Optional urban
1011	ids, ide, jds, jde, kds, kde, &
1012	ims, ime, jms, jme, kms, kme, &
1013	its, ite, jts, jte, kts, kte, &
1014	oml_hml0, omlcall, & !Optional oml
1015	TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml
1016	!--------------------------------------------------------------------
1017	USE module_sf_sfclay
1018	USE module_sf_slab
1019	USE module_sf_pxsfclay
1020	USE module_bl_ysu
1021	USE module_bl_mrf
1022	USE module_bl_gfs
1023	USE module_bl_acm
1024	USE module_sf_myjsfc
1025	USE module_sf_noahdrv
1026	USE module_sf_urban
1027	USE module_sf_ruclsm
1028	USE module_sf_pxlsm
1029	USE module_bl_myjpbl
1030	#if (NMM_CORE == 1)
1031	USE module_sf_lsm_nmm
1032	#endif
1033	!--------------------------------------------------------------------
1034	IMPLICIT NONE
1035	!--------------------------------------------------------------------
1036	TYPE (grid_config_rec_type) :: config_flags
1037	LOGICAL , INTENT(IN) :: restart
1038	LOGICAL, INTENT(IN) :: FNDSOILW, FNDSNOWH
1039
1040	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1041	ims, ime, jms, jme, kms, kme, &
1042	its, ite, jts, jte, kts, kte
1043	INTEGER , INTENT(IN) :: num_soil_layers
1044	INTEGER , INTENT(IN) :: UCMCALL
1045
1046	REAL , INTENT(IN) :: DT, BLDT
1047	INTEGER , INTENT(INOUT) :: STEPBL
1048
1049	REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), &
1050	INTENT(OUT) :: SMFR3D
1051
1052	REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
1053	INTENT(INOUT) :: SMOIS,SH2O,TSLB
1054
1055	REAL, DIMENSION( ims:ime, jms:jme ) , &
1056	INTENT(INOUT) :: SNOW, &
1057	SNOWH, &
1058	SNOWC, &
1059	CANWAT, &
1060	MAVAIL, &
1061	SMSTAV, &
1062	SMSTOT, &
1063	SFCRUNOFF, &
1064	UDRUNOFF, &
1065	ACSNOW, &
1066	VEGFRA, &
1067	ACSNOM, &
1068	SFCEVP, &
1069	GRDFLX, &
1070	UST, &
1071	#if ( NMM_CORE == 1 )
1072	Z0, &
1073	#else
1074	ZNT, &
1075	#endif
1076	XLAND, &
1077	XICE
1078
1079	INTEGER, DIMENSION( ims:ime, jms:jme ) , &
1080	INTENT(INOUT) :: IVGTYP, &
1081	ISLTYP, &
1082	LOWLYR
1083
1084
1085	REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS
1086
1087	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
1088	RUBLTEN, &
1089	RVBLTEN, &
1090	EXCH_H, &
1091	RTHBLTEN, &
1092	RQVBLTEN, &
1093	RQCBLTEN, &
1094	RQIBLTEN, &
1095	TKE_MYJ
1096
1097	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK
1098	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN
1099	LOGICAL, INTENT(IN) :: allowed_to_read
1100	INTEGER :: isn, isfc
1101
1102	!URBAN
1103	! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban
1104	! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !Optional urban
1105	! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !Optional urban
1106	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !Optional urban
1107	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !Optional urban
1108	REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !Optional urban
1109	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban
1110	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban
1111	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban
1112	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban
1113	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban
1114	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban
1115	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban
1116	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban
1117	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban
1118	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban
1119	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban
1120	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban
1121	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban
1122	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban
1123	REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban
1124	INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban
1125	! REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
1126	! REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
1127	! REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
1128	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
1129	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
1130	REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
1131
1132	! Optional OML variables
1133	REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: &
1134	TML,T0ML,HML,H0ML,HUML,HVML
1135	INTEGER, OPTIONAL, INTENT(IN) :: omlcall
1136	REAL, OPTIONAL, INTENT(IN) :: oml_hml0
1137	LOGICAL, INTENT(IN) :: start_of_simulation
1138
1139	!-- calculate pbl time step
1140
1141	STEPBL = nint(BLDT*60./DT)
1142	STEPBL = max(STEPBL,1)
1143
1144
1145	!-- initialize surface layer scheme
1146
1147	sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics)
1148
1149	CASE (SFCLAYSCHEME)
1150	CALL sfclayinit( allowed_to_read )
1151	isfc = 1
1152	CASE (PXSFCSCHEME)
1153	CALL pxsfclayinit( allowed_to_read )
1154	isfc = 1
1155	CASE (MYJSFCSCHEME)
1156	CALL myjsfcinit(LOWLYR,UST, &
1157	#if ( NMM_CORE == 1 )
1158	Z0, &
1159	#else
1160	ZNT, &
1161	#endif
1162	XLAND,XICE, &
1163	IVGTYP,restart, &
1164	allowed_to_read , &
1165	ids, ide, jds, jde, kds, kde, &
1166	ims, ime, jms, jme, kms, kme, &
1167	its, ite, jts, jte, kts, kte )
1168	isfc = 2
1169
1170	CASE (GFSSFCSCHEME)
1171	CALL myjsfcinit(LOWLYR,UST, &
1172	#if ( NMM_CORE == 1 )
1173	Z0, &
1174	#else
1175	ZNT, &
1176	#endif
1177	XLAND,XICE, &
1178	IVGTYP,restart, &
1179	allowed_to_read , &
1180	ids, ide, jds, jde, kds, kde, &
1181	ims, ime, jms, jme, kms, kme, &
1182	its, ite, jts, jte, kts, kte )
1183	isfc = 1
1184
1185	CASE DEFAULT
1186
1187	END SELECT sfclay_select
1188
1189
1190	!-- initialize surface scheme
1191
1192	sfc_select: SELECT CASE(config_flags%sf_surface_physics)
1193
1194	CASE (SLABSCHEME)
1195
1196	CALL slabinit(TSK,TMN, &
1197	TSLB,ZS,DZS,num_soil_layers, &
1198	allowed_to_read ,start_of_simulation ,&
1199	ids, ide, jds, jde, kds, kde, &
1200	ims, ime, jms, jme, kms, kme, &
1201	its, ite, jts, jte, kts, kte, &
1202	oml_hml0, omlcall, &
1203	tml, t0ml, hml, h0ml, huml, hvml )
1204
1205	#if (NMM_CORE == 1)
1206	CASE (NMMLSMSCHEME)
1207	CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, &
1208	SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW, &
1209	ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP, &
1210	TMN, &
1211	num_soil_layers, &
1212	allowed_to_read , &
1213	ids,ide, jds,jde, kds,kde, &
1214	ims,ime, jms,jme, kms,kme, &
1215	its,ite, jts,jte, kts,kte )
1216	#endif
1217	CASE (LSMSCHEME)
1218	CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, &
1219	SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, &
1220	ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
1221	FNDSOILW, FNDSNOWH, &
1222	num_soil_layers, restart, &
1223	allowed_to_read , &
1224	ids,ide, jds,jde, kds,kde, &
1225	ims,ime, jms,jme, kms,kme, &
1226	its,ite, jts,jte, kts,kte )
1227
1228	!URBAN
1229	IF(UCMCALL.eq.1) THEN
1230
1231	IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
1232
1233	CALL urban_param_init(DZR,DZB,DZG,num_soil_layers & !urban
1234	)
1235	! num_roof_layers,num_wall_layers,road_soil_layers) !urban
1236	CALL urban_var_init(TSK,TSLB,TMN,IVGTYP, & !urban
1237	ims,ime,jms,jme,num_soil_layers, & !urban
1238	! num_roof_layers,num_wall_layers,num_road_layers, & !urban
1239	restart, & !urban
1240	XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !urban
1241	TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !urban
1242	TRL_URB3D,TBL_URB3D,TGL_URB3D, & !urban
1243	SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D, & ! urban
1244	FRC_URB2D, UTYPE_URB2D) !urban
1245	ELSE
1246	CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
1247	ENDIF
1248	ENDIF
1249
1250
1251	CASE (RUCLSMSCHEME)
1252	! if(isfc .ne. 2)CALL wrf_error_fatal &
1253	! ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' )
1254	CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail, &
1255	num_soil_layers, restart, &
1256	allowed_to_read , &
1257	ids,ide, jds,jde, kds,kde, &
1258	ims,ime, jms,jme, kms,kme, &
1259	its,ite, jts,jte, kts,kte )
1260
1261	CASE (PXLSMSCHEME)
1262	CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, &
1263	SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, &
1264	ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
1265	FNDSOILW, FNDSNOWH, &
1266	num_soil_layers, restart, &
1267	allowed_to_read , &
1268	ids,ide, jds,jde, kds,kde, &
1269	ims,ime, jms,jme, kms,kme, &
1270	its,ite, jts,jte, kts,kte )
1271
1272	CASE DEFAULT
1273
1274	END SELECT sfc_select
1275
1276
1277	!-- initialize pbl scheme
1278
1279	pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
1280
1281	CASE (YSUSCHEME)
1282	if(isfc .ne. 1)CALL wrf_error_fatal &
1283	( 'module_physics_init: use sfclay scheme for this pbl option' )
1284	CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
1285	RQCBLTEN,RQIBLTEN,P_QI, &
1286	PARAM_FIRST_SCALAR, &
1287	restart, &
1288	allowed_to_read , &
1289	ids, ide, jds, jde, kds, kde, &
1290	ims, ime, jms, jme, kms, kme, &
1291	its, ite, jts, jte, kts, kte )
1292	CASE (MRFSCHEME)
1293	if(isfc .ne. 1)CALL wrf_error_fatal &
1294	( 'module_physics_init: use sfclay scheme for this pbl option' )
1295	CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
1296	RQCBLTEN,RQIBLTEN,P_QI, &
1297	PARAM_FIRST_SCALAR, &
1298	restart, &
1299	allowed_to_read , &
1300	ids, ide, jds, jde, kds, kde, &
1301	ims, ime, jms, jme, kms, kme, &
1302	its, ite, jts, jte, kts, kte )
1303	CASE (ACMPBLSCHEME)
1304	if(isfc .ne. 1)CALL wrf_error_fatal &
1305	( 'module_physics_init: use sfclay scheme for this pbl option' )
1306	CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
1307	RQCBLTEN,RQIBLTEN,P_QI, &
1308	PARAM_FIRST_SCALAR, &
1309	restart, &
1310	allowed_to_read , &
1311	ids, ide, jds, jde, kds, kde, &
1312	ims, ime, jms, jme, kms, kme, &
1313	its, ite, jts, jte, kts, kte )
1314	CASE (GFSSCHEME)
1315	if(isfc .ne. 1)CALL wrf_error_fatal &
1316	( 'module_physics_init: use sfclay scheme for this pbl option' )
1317	CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
1318	RQCBLTEN,RQIBLTEN,P_QI, &
1319	PARAM_FIRST_SCALAR, &
1320	restart, &
1321	allowed_to_read , &
1322	ids, ide, jds, jde, kds, kde, &
1323	ims, ime, jms, jme, kms, kme, &
1324	its, ite, jts, jte, kts, kte )
1325	CASE (MYJPBLSCHEME)
1326	if(isfc .ne. 2)CALL wrf_error_fatal &
1327	( 'module_physics_init: use myjsfc scheme for this pbl option' )
1328	CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
1329	TKE_MYJ,EXCH_H,restart, &
1330	allowed_to_read , &
1331	ids, ide, jds, jde, kds, kde, &
1332	ims, ime, jms, jme, kms, kme, &
1333	its, ite, jts, jte, kts, kte )
1334	CASE DEFAULT
1335
1336	END SELECT pbl_select
1337
1338	END SUBROUTINE bl_init
1339
1340	!==================================================================
1341	SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, &
1342	RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, &
1343	RAINCV,W0AVG,config_flags,restart, &
1344	CLDEFI,LOWLYR,MASS_FLUX, &
1345	RTHFTEN, RQVFTEN, &
1346	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
1347	APR_CAPMA,APR_CAPME,APR_CAPMI, &
1348	cugd_tten,cugd_ttens,cugd_qvten, &
1349	cugd_qvtens,cugd_qcten, &
1350	allowed_to_read, start_of_simulation, &
1351	ids, ide, jds, jde, kds, kde, &
1352	ims, ime, jms, jme, kms, kme, &
1353	its, ite, jts, jte, kts, kte )
1354	!------------------------------------------------------------------
1355	USE module_cu_kf
1356	USE module_cu_kfeta
1357	USE MODULE_CU_BMJ
1358	USE module_cu_gd, ONLY : GDINIT
1359	USE module_cu_g3, ONLY : G3INIT
1360	USE module_cu_sas
1361	!------------------------------------------------------------------
1362	IMPLICIT NONE
1363	!------------------------------------------------------------------
1364	TYPE (grid_config_rec_type) :: config_flags
1365	LOGICAL , INTENT(IN) :: restart
1366
1367
1368	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1369	ims, ime, jms, jme, kms, kme, &
1370	its, ite, jts, jte, kts, kte
1371
1372	REAL , INTENT(IN) :: DT, CUDT
1373	LOGICAL , INTENT(IN) :: start_of_simulation
1374	LOGICAL , INTENT(IN) :: allowed_to_read
1375	INTEGER , INTENT(INOUT) :: STEPCU
1376
1377	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: &
1378	RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN
1379	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) :: &
1380	cugd_tten,cugd_ttens,cugd_qvten, &
1381	cugd_qvtens,cugd_qcten
1382
1383	REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
1384
1385	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
1386	RTHFTEN, RQVFTEN
1387
1388	REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV
1389
1390	REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI
1391
1392	REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
1393
1394	REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX, &
1395	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
1396	APR_CAPMA,APR_CAPME,APR_CAPMI
1397
1398	INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
1399
1400	! LOCAL VAR
1401
1402	INTEGER :: i,j,itf,jtf
1403
1404	!--------------------------------------------------------------------
1405
1406	!-- calculate cumulus parameterization time step
1407
1408	itf=min0(ite,ide-1)
1409	jtf=min0(jte,jde-1)
1410	!
1411	STEPCU = nint(CUDT*60./DT)
1412	STEPCU = max(STEPCU,1)
1413
1414	!-- initialization
1415
1416	IF(start_of_simulation)THEN
1417	DO j=jts,jtf
1418	DO i=its,itf
1419	RAINC(i,j)=0.
1420	RAINCV(i,j)=0.
1421	ENDDO
1422	ENDDO
1423	ENDIF
1424
1425	cps_select: SELECT CASE(config_flags%cu_physics)
1426
1427	CASE (KFSCHEME)
1428	CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
1429	RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, &
1430	PARAM_FIRST_SCALAR,restart, &
1431	allowed_to_read , &
1432	ids, ide, jds, jde, kds, kde, &
1433	ims, ime, jms, jme, kms, kme, &
1434	its, ite, jts, jte, kts, kte )
1435
1436	CASE (BMJSCHEME)
1437	CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
1438	CLDEFI,LOWLYR,cp,r_d,restart, &
1439	allowed_to_read , &
1440	ids, ide, jds, jde, kds, kde, &
1441	ims, ime, jms, jme, kms, kme, &
1442	its, ite, jts, jte, kts, kte )
1443
1444	CASE (KFETASCHEME)
1445	CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, &
1446	RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, &
1447	SVP1,SVP2,SVP3,SVPT0, &
1448	PARAM_FIRST_SCALAR,restart, &
1449	allowed_to_read , &
1450	ids, ide, jds, jde, kds, kde, &
1451	ims, ime, jms, jme, kms, kme, &
1452	its, ite, jts, jte, kts, kte )
1453	CASE (GDSCHEME)
1454	CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, &
1455	MASS_FLUX,cp,restart, &
1456	P_QC,P_QI,PARAM_FIRST_SCALAR, &
1457	RTHFTEN, RQVFTEN, &
1458	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
1459	APR_CAPMA,APR_CAPME,APR_CAPMI, &
1460	allowed_to_read , &
1461	ids, ide, jds, jde, kds, kde, &
1462	ims, ime, jms, jme, kms, kme, &
1463	its, ite, jts, jte, kts, kte )
1464	#if ( EM_CORE == 1 )
1465	CASE (G3SCHEME)
1466	CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, &
1467	MASS_FLUX,cp,restart, &
1468	P_QC,P_QI,PARAM_FIRST_SCALAR, &
1469	RTHFTEN, RQVFTEN, &
1470	APR_GR,APR_W,APR_MC,APR_ST,APR_AS, &
1471	APR_CAPMA,APR_CAPME,APR_CAPMI, &
1472	cugd_tten,cugd_ttens,cugd_qvten, &
1473	cugd_qvtens,cugd_qcten, &
1474	allowed_to_read , &
1475	ids, ide, jds, jde, kds, kde, &
1476	ims, ime, jms, jme, kms, kme, &
1477	its, ite, jts, jte, kts, kte )
1478	#endif
1479	CASE (SASSCHEME)
1480	CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, &
1481	restart,P_QC,P_QI,PARAM_FIRST_SCALAR, &
1482	allowed_to_read , &
1483	ids, ide, jds, jde, kds, kde, &
1484	ims, ime, jms, jme, kms, kme, &
1485	its, ite, jts, jte, kts, kte )
1486
1487	CASE DEFAULT
1488
1489	END SELECT cps_select
1490
1491	END SUBROUTINE cu_init
1492
1493	!==================================================================
1494	SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain, &
1495	adv_moist_cond, &
1496	MPDT, DT, DX, DY, LOWLYR, & ! for eta mp
1497	F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ! for eta mp
1498	mp_restart_state,tbpvs_state,tbpvs0_state, & ! eta mp
1499	allowed_to_read, start_of_simulation, &
1500	ids, ide, jds, jde, kds, kde, &
1501	ims, ime, jms, jme, kms, kme, &
1502	its, ite, jts, jte, kts, kte )
1503	!------------------------------------------------------------------
1504	USE module_mp_wsm3
1505	USE module_mp_wsm5
1506	USE module_mp_wsm6
1507	USE module_mp_etanew
1508	USE module_mp_thompson
1509	USE module_mp_morr_two_moment
1510	!------------------------------------------------------------------
1511	IMPLICIT NONE
1512	!------------------------------------------------------------------
1513	! Arguments
1514	TYPE (grid_config_rec_type) :: config_flags
1515	LOGICAL , INTENT(IN) :: restart
1516	LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond
1517	REAL , INTENT(IN) :: MPDT, DT, DX, DY
1518	LOGICAL , INTENT(IN) :: start_of_simulation
1519
1520	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1521	ims, ime, jms, jme, kms, kme, &
1522	its, ite, jts, jte, kts, kte
1523
1524	INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT) :: LOWLYR
1525	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC
1526	REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
1527	F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
1528	REAL , DIMENSION(:) ,INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state
1529	LOGICAL , INTENT(IN) :: allowed_to_read
1530
1531	! Local
1532	INTEGER :: i, j, itf, jtf
1533
1534	warm_rain = .false.
1535	adv_moist_cond = .true.
1536	itf=min0(ite,ide-1)
1537	jtf=min0(jte,jde-1)
1538
1539	IF(start_of_simulation)THEN
1540	DO j=jts,jtf
1541	DO i=its,itf
1542	RAINNC(i,j) = 0.
1543	ENDDO
1544	ENDDO
1545	ENDIF
1546
1547	mp_select: SELECT CASE(config_flags%mp_physics)
1548
1549	CASE (KESSLERSCHEME)
1550	warm_rain = .true.
1551	CASE (WSM3SCHEME)
1552	CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
1553	CASE (WSM5SCHEME)
1554	CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
1555	CASE (WSM6SCHEME)
1556	CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
1557	CASE (ETAMPNEW)
1558	adv_moist_cond = .false.
1559	CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart, &
1560	F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, &
1561	mp_restart_state,tbpvs_state,tbpvs0_state,&
1562	allowed_to_read, &
1563	ids, ide, jds, jde, kds, kde, &
1564	ims, ime, jms, jme, kms, kme, &
1565	its, ite, jts, jte, kts, kte )
1566	CASE (THOMPSON)
1567	CALL thompson_init
1568	CASE (MORR_TWO_MOMENT)
1569	CALL morr_two_moment_init
1570
1571	CASE DEFAULT
1572
1573	END SELECT mp_select
1574
1575	END SUBROUTINE mp_init
1576
1577	#if ( EM_CORE == 1 )
1578	!==========================================================
1579	SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, &
1580	RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, &
1581	config_flags,restart, &
1582	allowed_to_read , &
1583	ids, ide, jds, jde, kds, kde, &
1584	ims, ime, jms, jme, kms, kme, &
1585	its, ite, jts, jte, kts, kte )
1586
1587
1588	!--------------------------------------------------------------------
1589	USE module_fdda_psufddagd
1590	!--------------------------------------------------------------------
1591	IMPLICIT NONE
1592	!--------------------------------------------------------------------
1593	TYPE (grid_config_rec_type) :: config_flags
1594	LOGICAL , INTENT(IN) :: restart
1595
1596	INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
1597	ims, ime, jms, jme, kms, kme, &
1598	its, ite, jts, jte, kts, kte
1599
1600	REAL , INTENT(IN) :: DT, FGDT
1601	INTEGER , INTENT(IN) :: id
1602	INTEGER , INTENT(INOUT) :: STEPFG
1603	REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
1604	RUNDGDTEN, &
1605	RVNDGDTEN, &
1606	RTHNDGDTEN, &
1607	RQVNDGDTEN
1608	REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN
1609
1610	LOGICAL, INTENT(IN) :: allowed_to_read
1611	!--------------------------------------------------------------------
1612
1613	!-- calculate pbl time step
1614
1615	STEPFG = nint(FGDT*60./DT)
1616	STEPFG = max(STEPFG,1)
1617
1618
1619	!-- initialize fdda scheme
1620
1621	fdda_select: SELECT CASE(config_flags%grid_fdda)
1622
1623	CASE (PSUFDDAGD)
1624	CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
1625	config_flags%run_hours, &
1626	config_flags%if_no_pbl_nudging_uv, &
1627	config_flags%if_no_pbl_nudging_t, &
1628	config_flags%if_no_pbl_nudging_q, &
1629	config_flags%if_zfac_uv, &
1630	config_flags%k_zfac_uv, &
1631	config_flags%if_zfac_t, &
1632	config_flags%k_zfac_t, &
1633	config_flags%if_zfac_q, &
1634	config_flags%k_zfac_q, &
1635	config_flags%guv, &
1636	config_flags%gt, config_flags%gq, &
1637	config_flags%if_ramping, config_flags%dtramp_min, &
1638	config_flags%gfdda_end_h, &
1639	restart, allowed_to_read, &
1640	ids, ide, jds, jde, kds, kde, &
1641	ims, ime, jms, jme, kms, kme, &
1642	its, ite, jts, jte, kts, kte )
1643	CASE DEFAULT
1644
1645	END SELECT fdda_select
1646
1647	END SUBROUTINE fg_init
1648
1649	!-------------------------------------------------------------------
1650	SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid, &
1651	idynin, dtramp, fdaend, restart, &
1652	obs_twindo_cg, obs_twindo, itimestep, &
1653	cen_lat, cen_lon, stand_lon, &
1654	true_lat1, true_lat2, map_proj, &
1655	xlat, xlong, &
1656	s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, &
1657	fdob, ipf_init, &
1658	ids, ide, jds, jde, kds, kde, &
1659	ims, ime, jms, jme, kms, kme, &
1660	its, ite, jts, jte, kts, kte )
1661
1662	!--------------------------------------------------------------------
1663	USE module_domain
1664	USE module_fddaobs_rtfdda
1665	USE module_llxy
1666	!--------------------------------------------------------------------
1667	IMPLICIT NONE
1668	!--------------------------------------------------------------------
1669	INTEGER , INTENT(IN) :: maxdom
1670	INTEGER , INTENT(IN) :: obs_nudge_opt(maxdom)
1671	INTEGER , INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
1672	ims,ime, jms,jme, kms,kme, &
1673	its,ite, jts,jte, kts,kte
1674	INTEGER , INTENT(IN) :: inest
1675	INTEGER , INTENT(IN) :: parid(maxdom)
1676	INTEGER , INTENT(IN) :: idynin ! flag for dynamic initialization
1677	REAL , INTENT(IN) :: dtramp ! time period for ramping (idynin)
1678	REAL , INTENT(IN) :: fdaend(maxdom) ! nudging end time for domain (min)
1679	LOGICAL , INTENT(IN) :: restart
1680	REAL , INTENT(IN) :: obs_twindo_cg ! twindo on course grid
1681	REAL , INTENT(IN) :: obs_twindo
1682	INTEGER , INTENT(IN) :: itimestep
1683	REAL , INTENT(IN) :: cen_lat ! domain center latitude
1684	REAL , INTENT(IN) :: cen_lon ! domain center longitude
1685	REAL , INTENT(IN) :: stand_lon ! domain longitude
1686	REAL , INTENT(IN) :: true_lat1 ! domain standard parallel
1687	REAL , INTENT(IN) :: true_lat2 ! domain second standard parallel
1688	INTEGER , INTENT(IN) :: map_proj ! map projection
1689	REAL, DIMENSION( ims:ime, jms:jme ), &
1690	INTENT(IN ) :: xlat, xlong ! lat/long locations on mass point grid
1691	INTEGER, intent(in) :: s_sn_cg ! starting north-south coarse-grid index
1692	INTEGER, intent(in) :: e_sn_cg ! ending north-south coarse-grid index
1693	INTEGER, intent(in) :: s_we_cg ! starting west-east coarse-grid index
1694	INTEGER, intent(in) :: e_we_cg ! ending west-east coarse-grid index
1695
1696	TYPE(fdob_type), INTENT(INOUT) :: fdob
1697
1698	INTEGER :: e_sn ! ending north-south grid index
1699	LOGICAL :: ipf_init ! print warnings detected at initialzn
1700	!--------------------------------------------------------------------
1701	!-- initialize fdda obs-nudging scheme
1702
1703	IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN
1704
1705	e_sn = jde
1706	CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid, &
1707	idynin, dtramp, fdaend, restart, &
1708	obs_twindo_cg, &
1709	obs_twindo, itimestep, &
1710	cen_lat, cen_lon, stand_lon, &
1711	true_lat1, true_lat2, map_proj, &
1712	xlat, xlong, &
1713	e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, &
1714	fdob, ipf_init, &
1715	ids,ide, jds,jde, kds,kde, &
1716	ims,ime, jms,jme, kms,kme, &
1717	its,ite, jts,jte, kts,kte)
1718
1719	END SUBROUTINE fdob_init
1720	#endif
1721
1722	!--------------------------------------------------------------------
1723	SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, &
1724	allowed_to_read , &
1725	kds,kde,kms,kme,kts,kte)
1726	IMPLICIT NONE
1727	! Arguments
1728	INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte
1729	REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh
1730	REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh
1731	REAL , INTENT(IN) :: p_top
1732	REAL , INTENT(OUT) :: pptop
1733	TYPE (grid_config_rec_type) :: config_flags
1734	LOGICAL , INTENT(IN) :: allowed_to_read
1735	! Local
1736	REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP
1737	INTEGER K
1738
1739	IF(zf(kde/2) .GT. 1.0)THEN
1740	! Height levels assumed (zeta coordinate)
1741	! Convert to sigma using standard atmosphere for pressure-height relation
1742	! constants for standard atmosphere definition
1743	r=287.05
1744	g=9.80665
1745	ts=288.15
1746	gamma=-6.5/1000.
1747	ps=1013.25
1748	ztrop=11000.
1749	tstrat=ts+gamma*ztrop
1750	ptrop=ps(tstrat/ts)(-g/(gammar))
1751
1752	do k=kde,kds,-1
1753	! full levels
1754	z=zf(k)
1755	if(z.le.ztrop)then
1756	t=ts+gamma*z
1757	p=ps(t/ts)(-g/(gammar))
1758	else
1759	t=tstrat
1760	p=ptropexp(-g(z-ztrop)/(r*tstrat))
1761	endif
1762	if(k.eq.kde)then
1763	ztop=zf(k)
1764	ptop=p
1765	endif
1766	sf(k)=(p-ptop)/(ps-ptop)
1767	! half levels
1768	if(k.ne.kds)then
1769	z=0.5*(zf(k)+zf(k-1))
1770	if(z.le.ztrop)then
1771	t=ts+gamma*z
1772	p=ps(t/ts)(-g/(gammar))
1773	else
1774	t=tstrat
1775	p=ptropexp(-g(z-ztrop)/(r*tstrat))
1776	endif
1777	sh(k-1)=(p-ptop)/(ps-ptop)
1778	endif
1779	enddo
1780	pptop=ptop/10.
1781	ELSE
1782	! Levels are already sigma/eta
1783	do k=kde,kds,-1
1784	! sf(k)=zf(kde-k+kds)
1785	! if(k .ne. kde)sh(k)=zh(kde-1-k+kds)
1786	sf(k)=zf(k)
1787	if(k .ne. kde)sh(k)=zh(k)
1788	enddo
1789	pptop=p_top/1000.
1790
1791	ENDIF
1792
1793	END SUBROUTINE z2sigma
1794
1795	END MODULE module_physics_init

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

Download in other formats:

Original Format