Context Navigation

module_physics_init.F @ 3567

Last change on this file since 3567 was 94, checked in by aslmd, 14 years ago

LMD_MM_MARS et LMD_LES_MARS:

routines physique terrestres commentees dans WRF
pour accelerer la compilation des sources dans le cas martien
--> la premiere compilation est toujours un peu longue, mais les recompilations sont desormais plus rapides
--> les executables sont plus legers (passe de 15-20 Mo a 5-10 Mo)
--> bien que les .F soient presents, la plupart des routines de phys/ ne sont plus compilees
--> regle le bug avec certaines routines dans le cas de g95

NB: verifie sur LMD_MM_MARS
NB: a confirmer sur LMD_LES_MARS

Routines modifiees:

M 93 mesoscale/LMD_LES_MARS/modif_mars/module_first_rk_step_part2.F
M 93 mesoscale/LMD_LES_MARS/modif_mars/solve_em.F
A 0 mesoscale/LMD_LES_MARS/modif_mars/module_physics_init.F
M 93 mesoscale/LMD_LES_MARS/modif_mars/module_physics_addtendc.F
A 0 mesoscale/LMD_LES_MARS/modif_mars/Makefile_dyn_em
M 93 mesoscale/LMD_LES_MARS/modif_mars/Makefile
M 93 mesoscale/LMD_LES_MARS/modif_mars/module_first_rk_step_part1.F
M 93 mesoscale/LMD_LES_MARS/LMD_LES_MARS_install
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/Makefile
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/dyn_em/solve_em.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/Makefile
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_lmd_driver.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_physics_init.F
M 93 mesoscale/LMD_MM_MARS/SRC/WRFV2/phys/module_physics_addtendc.F

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

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

Download in other formats:

Original Format