wrfv2_fire/phys/module_physics_init.F

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