source: trunk/mesoscale/LMD_LES_MARS/modif_mars/module_physics_init.F @ 126

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

LMD_MM_MARS et LMD_LES_MARS:

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

NB: verifie sur LMD_MM_MARS
NB: a confirmer sur LMD_LES_MARS

Routines modifiees:


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

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