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