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