Context Navigation

module_physics_init.F

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

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

Download in other formats:

Original Format