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