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