wrftladj/module_physics_init_tl.F

   1 !        Generated by TAPENADE     (INRIA, Tropics team)
   2 !  Tapenade 3.6 (r4343) - 10 Feb 2012 10:52
   3 !
   4 !WRF:MODEL_LAYER:INITIALIZATION
   5 !
   6 !  This MODULE holds the routines which are used to perform model start-up operations
   7 !  for the individual domains.  This is the stage after inputting wrfinput and before
   8 !  calling 'integrate'.
   9 !  This MODULE CONTAINS the following routines:
  10 MODULE G_MODULE_PHYSICS_INIT
  11
  12    USE module_state_description
  13    USE module_model_constants
  14    USE module_configure, ONLY : grid_config_rec_type
  15    USE module_physics_init, ONLY : landuse_init
  16
  17 CONTAINS
  18 !  Differentiation of phy_init in forward (tangent) mode:
  19 !   variations   of useful results: rublten raincv rqccuten rthcuten
  20 !                rainnc rainc rqvblten w0avg snownc rvblten
  21 !                graupelnc rthblten graupelncv snowncv rqvcuten
  22 !                rainncv
  23 !   with respect to varying inputs: rublten raincv rqccuten rthcuten
  24 !                rainnc rainc rqvblten w0avg snownc rvblten
  25 !                graupelnc rthblten graupelncv snowncv rqvcuten
  26 !                rainncv
  27 !   RW status of diff variables: rublten:in-out raincv:in-out rqccuten:in-out
  28 !                rthcuten:in-out rainnc:in-out rainc:in-out rqvblten:in-out
  29 !                w0avg:in-out snownc:in-out rvblten:in-out
  30 !                graupelnc:in-out rthblten:in-out graupelncv:in-out
  31 !                snowncv:in-out rqvcuten:in-out rainncv:in-out
  32 !=================================================================
  33 !EMBCK new
  34 ! temporary
  35 !                        num_roof_layers,num_wall_layers,        &
  36 !                        num_road_layers,                        &
  37 ! WA 12/21/09
  38 ! WA 9/27/10
  39 ! WA 2/22/11
  40   SUBROUTINE G_PHY_INIT(id, config_flags, dt, restart, zfull, zhalf, &
  41 &    p_top, tsk, radt, bldt, cudt, mpdt, rucuten, rvcuten, rthcuten&
  42 &    , rthcutend, rqvcuten, rqvcutend, rqrcuten, rqccuten, rqccutend, &
  43 &    rqscuten, rqicuten, rushten, rvshten, rthshten, rqvshten, rqrshten, &
  44 &    rqcshten, rqsshten, rqishten, rqgshten, rublten, rubltend, rvblten, &
  45 &    rvbltend, rthblten, rthbltend, rqvblten, rqvbltend, rqcblten, &
  46 &    rqiblten, rthraten, rthratenlw, rthratensw, stepbl, stepra, stepcu, &
  47 &    w0avg, w0avgd, rainnc, rainncd, rainc, raincd, raincv, raincvd, &
  48 &    rainncv, rainncvd, snownc, snowncd, snowncv, snowncvd, graupelnc, &
  49 &    graupelncd, graupelncv, graupelncvd, nca, swrad_scat, cldefi, lowlyr&
  50 &    , mass_flux, rthften, rqvften, cldfra, cldfra_old, glw, gsw, emiss, &
  51 &    embck, lu_index, landuse_isice, landuse_lucats, landuse_luseas, &
  52 &    landuse_isn, lu_state, xlat, xlong, albedo, albbck, gmt, julyr, &
  53 &    julday, levsiz, n_ozmixm, n_aerosolc, paerlev, alevsiz, no_src_types, tmn, xland, znt, z0, &
  54 &    ust, mol, pblh, tke_pbl, exch_h, thc, snowc, mavail, hfx, qfx, &
  55 &    rainbl, tslb, zs, dzs, num_soil_layers, warm_rain, adv_moist_cond, &
  56 &    apr_gr, apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme, &
  57 &    apr_capmi, xice, xicem, vegfra, snow, canwat, smstav, smstot, &
  58 &    sfcrunoff, udrunoff, grdflx, acsnow, acsnom, ivgtyp, isltyp, sfcevp&
  59 &    , smois, sh2o, snowh, smfr3d, snoalb, dx, dy, f_ice_phy, f_rain_phy&
  60 &    , f_rimef_phy, mp_restart_state, tbpvs_state, tbpvs0_state, &
  61 &    allowed_to_read, moved, start_of_simulation, lagday, ids, ide, jds, &
  62 &    jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
  63 &    , kte, num_urban_ndm,urban_map_zrd,urban_map_zwd,urban_map_gd,urban_map_zd,&
  64 &    urban_map_zdf,urban_map_bd,urban_map_wd,urban_map_gbd,urban_map_fbd, &
  65 &    NUM_URBAN_HI, raincv_a, raincv_b, gd_cloud, gd_cloud2, &
  66 &    gd_cloud_a, gd_cloud2_a, gd_cloud_b, gd_cloud2_b, ozmixm, pin, &
  67 &    m_ps_1, m_ps_2, m_hybi, aerosolc_1, aerosolc_2, rundgdten, rvndgdten&
  68 &    , rthndgdten, rphndgdten, rqvndgdten, rmundgdten, fgdt, stepfg, &
  69 &    cugd_tten, cugd_ttens, cugd_qvten, cugd_qvtens, cugd_qcten, isnowxy&
  70 &    , zsnsoxy, tsnoxy, snicexy, snliqxy, tvxy, tgxy, canicexy, canliqxy&
  71 &    , eahxy, tahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, qrainxy,&
  72 &    wslakexy, zwtxy, waxy, wtxy, lfmassxy, rtmassxy, stmassxy, woodxy, &
  73 &    stblcpxy, fastcpxy, xsaixy, t2mvxy, t2mbxy, chstarxy, dzr, dzb, dzg&
  74 &    , tr_urb2d, tb_urb2d, tg_urb2d, tc_urb2d, qc_urb2d, xxxr_urb2d, &
  75 &    xxxb_urb2d, xxxg_urb2d, xxxc_urb2d, trl_urb3d, tbl_urb3d, tgl_urb3d&
  76 &    , sh_urb2d, lh_urb2d, g_urb2d, rn_urb2d, ts_urb2d, frc_urb2d, &
  77 &    utype_urb2d, trb_urb4d, tw1_urb4d, tw2_urb4d, tgb_urb4d, tlev_urb3d&
  78 &    , qlev_urb3d, tw1lev_urb3d, tw2lev_urb3d, tglev_urb3d, tflev_urb3d, &
  79 &    sf_ac_urb3d, lf_ac_urb3d, cm_ac_urb3d, sfvent_urb3d, lfvent_urb3d, &
  80 &    sfwin1_urb3d, sfwin2_urb3d, sfw1_urb3d, sfw2_urb3d, sfr_urb3d, &
  81 &    sfg_urb3d, a_u_bep, a_v_bep, a_t_bep, a_q_bep, a_e_bep, b_u_bep, &
  82 &    b_v_bep, b_t_bep, b_q_bep, b_e_bep, dlg_bep, dl_u_bep, sf_bep, &
  83 &    vl_bep, tml, t0ml, hml, h0ml, huml, hvml, tmoml, itimestep, fdob, &
  84 &    t00, p00, tlp, tyr, tyra, tdly, tlag, nyear, nday, tmn_update, achfx&
  85 &    , aclhf, acgrdflx, te_temf, cf3d_temf, wm_temf, massflux_edkf, &
  86 &    entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, rc_up, u_up, &
  87 &    v_up, frac_up)
  88
  89     USE module_domain
  90     USE module_wrf_error
  91
  92     IMPLICIT NONE
  93 !-----------------------------------------------------------------
  94 !-----------------------------------------------------------------
  95     TYPE(GRID_CONFIG_REC_TYPE) :: config_flags
  96     INTEGER, INTENT(IN) :: id
  97     INTEGER, INTENT(IN), OPTIONAL :: tmn_update
  98     LOGICAL, INTENT(OUT) :: warm_rain, adv_moist_cond
  99 !   LOGICAL , INTENT (IN)       :: FNDSOILW, FNDSNOWH
 100     LOGICAL, PARAMETER :: fndsoilw=.true., fndsnowh=.true.
 101     INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
 102 &    jme, kms, kme, its, ite, jts, jte, kts, kte
 103     INTEGER, INTENT(IN) :: num_soil_layers
 104     INTEGER, INTENT(IN) :: lagday
 105     INTEGER, INTENT(OUT), OPTIONAL :: nyear
 106     REAL, INTENT(OUT), OPTIONAL :: nday
 107     LOGICAL, INTENT(IN) :: start_of_simulation
 108     REAL, INTENT(IN) :: dt, p_top, dx, dy
 109     LOGICAL, INTENT(IN) :: restart
 110     REAL, INTENT(IN) :: radt, bldt, cudt, mpdt
 111     REAL, INTENT(IN) :: swrad_scat
 112     REAL, DIMENSION(kms:kme), INTENT(IN) :: zfull, zhalf
 113     REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: tsk, xlat, xlong
 114     INTEGER, INTENT(IN) :: levsiz, n_ozmixm
 115     INTEGER, INTENT(IN) :: paerlev, n_aerosolc
 116     INTEGER, INTENT(IN   )    ::   alevsiz, no_src_types
 117     REAL, DIMENSION(ims:ime, levsiz, jms:jme, n_ozmixm), OPTIONAL, &
 118 &    INTENT(INOUT) :: ozmixm
 119     REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: pin
 120     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1&
 121 &    , m_ps_2
 122     REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi
 123     REAL, DIMENSION(ims:ime, paerlev, jms:jme, n_aerosolc), OPTIONAL, &
 124 &    INTENT(INOUT) :: aerosolc_1, aerosolc_2
 125     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), INTENT(INOUT) ::&
 126 &    smois, sh2o, tslb
 127     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), INTENT(OUT) :: &
 128 &    smfr3d
 129     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: snow, snowc, &
 130 &    snowh, canwat, smstav, smstot, sfcrunoff, udrunoff, sfcevp, grdflx, &
 131 &    acsnow, xice, xicem, vegfra, acsnom
 132     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: achfx&
 133 &    , aclhf, acgrdflx
 134     INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: ivgtyp, &
 135 &    isltyp
 136 ! rad
 137     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthraten&
 138 &    , rthratenlw, rthratensw, cldfra
 139     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
 140 &    cldfra_old
 141 !EMBCK new
 142     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: gsw, albedo, &
 143 &    albbck, glw, emiss, embck
 144     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: snoalb
 145     REAL, INTENT(IN) :: gmt
 146     INTEGER, INTENT(OUT) :: stepra, stepbl, stepcu
 147     INTEGER, INTENT(IN) :: julyr, julday
 148 ! cps
 149     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten, &
 150 &    rvcuten, rthcuten, rqvcuten, rqrcuten, rqccuten, rqscuten, rqicuten&
 151 &    , rushten, rvshten, rthshten, rqvshten, rqrshten, rqcshten, rqsshten&
 152 &    , rqishten, rqgshten
 153     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcutend&
 154 &    , rqvcutend, rqccutend
 155     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: w0avg
 156     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: w0avgd
 157     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: mass_flux, apr_gr&
 158 &    , apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme, apr_capmi
 159     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthften, &
 160 &    rqvften
 161     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: rainnc, rainc, &
 162 &    raincv, rainncv, snownc, snowncv, graupelnc, graupelncv
 163     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: rainncd, raincd, &
 164 &    raincvd, rainncvd, snowncd, snowncvd, graupelncd, graupelncvd
 165     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: cldefi, nca
 166     INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: lowlyr
 167 !pbl
 168 ! soil layer
 169     REAL, DIMENSION(num_soil_layers), INTENT(INOUT) :: zs, dzs
 170     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
 171 &    rvblten, rthblten, rqvblten, rqcblten, rqiblten, exch_h, tke_pbl
 172     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rubltend&
 173 &    , rvbltend, rthbltend, rqvbltend
 174     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL ::&
 175 &    massflux_edkf, entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, &
 176 &    rc_up, u_up, v_up, frac_up
 177     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) ::&
 178 &    cugd_tten, cugd_ttens, cugd_qvten, cugd_qvtens, cugd_qcten
 179     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: xland, znt, z0, &
 180 &    ust, mol, lu_index, pblh, thc, mavail, hfx, qfx, rainbl
 181     INTEGER, INTENT(INOUT) :: landuse_isice, landuse_lucats
 182     INTEGER, INTENT(INOUT) :: landuse_luseas, landuse_isn
 183     REAL, DIMENSION(:), INTENT(INOUT) :: lu_state
 184     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: tmn
 185     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: tyr
 186     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: tyra
 187     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: tdly
 188     REAL, DIMENSION(ims:ime, lagday, jms:jme), INTENT(INOUT), OPTIONAL &
 189 &    :: tlag
 190     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 191 &    :: gd_cloud, gd_cloud2, gd_cloud_a, gd_cloud2_a, gd_cloud_b, &
 192 &    gd_cloud2_b
 193     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincv_a, &
 194 &    raincv_b
 195 !Noah-MP
 196     INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL :: isnowxy
 197     REAL, DIMENSION(ims:ime, -2:num_soil_layers, jms:jme), OPTIONAL :: &
 198 &    zsnsoxy
 199     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: tsnoxy
 200     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: snicexy
 201     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: snliqxy
 202     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tvxy
 203     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tgxy
 204     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: canicexy
 205     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: canliqxy
 206     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: eahxy
 207     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tahxy
 208     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: cmxy
 209     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: chxy
 210     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: fwetxy
 211     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: sneqvoxy
 212     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: alboldxy
 213     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: qsnowxy
 214     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: qrainxy
 215     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: wslakexy
 216     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: zwtxy
 217     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: waxy
 218     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: wtxy
 219     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: lfmassxy
 220     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: rtmassxy
 221     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: stmassxy
 222     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: woodxy
 223     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: stblcpxy
 224     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: fastcpxy
 225     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: xsaixy
 226     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: t2mvxy
 227     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: t2mbxy
 228     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: chstarxy
 229 !mp
 230     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: f_ice_phy&
 231 &    , f_rain_phy, f_rimef_phy
 232     REAL, DIMENSION(:), INTENT(INOUT) :: mp_restart_state, tbpvs_state, &
 233 &    tbpvs0_state
 234     LOGICAL, INTENT(IN) :: allowed_to_read, moved
 235 ! ocean mixed layer
 236     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: tml, &
 237 &    t0ml, hml, h0ml, huml, hvml, tmoml
 238 !fdda
 239     REAL, OPTIONAL, INTENT(IN) :: fgdt
 240     INTEGER, OPTIONAL, INTENT(OUT) :: stepfg
 241     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) ::&
 242 &    rundgdten, rvndgdten, rthndgdten, rphndgdten, rqvndgdten
 243     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: &
 244 &    rmundgdten
 245 !URBAN
 246 !   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR   !urban
 247 !   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB   !urban
 248 !   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG   !urban
 249 !urban
 250     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzr
 251 !urban
 252     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzb
 253 !urban
 254     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzg
 255 !urban
 256     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 257 &    tr_urb2d
 258 !urban
 259     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 260 &    tb_urb2d
 261 !urban
 262     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 263 &    tg_urb2d
 264 !urban
 265     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 266 &    tc_urb2d
 267 !urban
 268     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 269 &    qc_urb2d
 270 !urban
 271     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 272 &    xxxr_urb2d
 273 !urban
 274     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 275 &    xxxb_urb2d
 276 !urban
 277     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 278 &    xxxg_urb2d
 279 !urban
 280     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 281 &    xxxc_urb2d
 282 !   REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D !urban
 283 !   REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D !urban
 284 !   REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D !urban
 285 !urban
 286     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 287 &    INTENT(INOUT) :: trl_urb3d
 288 !urban
 289     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 290 &    INTENT(INOUT) :: tbl_urb3d
 291 !urban
 292     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 293 &    INTENT(INOUT) :: tgl_urb3d
 294 !urban
 295     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 296 &    sh_urb2d
 297 !urban
 298     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 299 &    lh_urb2d
 300 !urban
 301     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 302 &    g_urb2d
 303 !urban
 304     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 305 &    rn_urb2d
 306 !urban
 307     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 308 &    ts_urb2d
 309 !urban
 310     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 311 &    frc_urb2d
 312 !urban
 313     INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 314 &    utype_urb2d
 315     INTEGER, INTENT(IN) :: num_urban_ndm
 316     INTEGER, INTENT(IN) :: urban_map_zrd
 317     INTEGER, INTENT(IN) :: urban_map_zwd
 318     INTEGER, INTENT(IN) :: urban_map_gd
 319     INTEGER, INTENT(IN) :: urban_map_zd
 320     INTEGER, INTENT(IN) :: urban_map_zdf
 321     INTEGER, INTENT(IN) :: urban_map_bd
 322     INTEGER, INTENT(IN) :: urban_map_wd
 323     INTEGER, INTENT(IN) :: urban_map_gbd
 324     INTEGER, INTENT(IN) :: urban_map_fbd
 325     INTEGER, INTENT(IN) :: num_urban_hi
 326 ! multi-layer UCM
 327     REAL, DIMENSION(ims:ime, urban_map_zrd, jms:jme), OPTIONAL, &
 328 &    INTENT(INOUT) :: trb_urb4d
 329 ! multi-layer UCM
 330     REAL, DIMENSION(ims:ime, urban_map_zwd, jms:jme), OPTIONAL, &
 331 &    INTENT(INOUT) :: tw1_urb4d
 332 ! multi-layer UCM
 333     REAL, DIMENSION(ims:ime, urban_map_zwd, jms:jme), OPTIONAL, &
 334 &    INTENT(INOUT) :: tw2_urb4d
 335 ! multi-layer UCM
 336     REAL, DIMENSION(ims:ime, urban_map_gd, jms:jme), OPTIONAL, &
 337 &    INTENT(INOUT) :: tgb_urb4d
 338 ! multi-layer UCM
 339     REAL, DIMENSION(ims:ime, urban_map_bd, jms:jme), OPTIONAL, &
 340 &    INTENT(INOUT) :: tlev_urb3d
 341 ! multi-layer UCM
 342     REAL, DIMENSION(ims:ime, urban_map_bd, jms:jme), OPTIONAL, &
 343 &    INTENT(INOUT) :: qlev_urb3d
 344 ! multi-layer UCM
 345     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 346 &    INTENT(INOUT) :: tw1lev_urb3d
 347 ! multi-layer UCM
 348     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 349 &    INTENT(INOUT) :: tw2lev_urb3d
 350 ! multi-layer UCM
 351     REAL, DIMENSION(ims:ime, urban_map_gbd, jms:jme), OPTIONAL, &
 352 &    INTENT(INOUT) :: tglev_urb3d
 353 ! multi-layer UCM
 354     REAL, DIMENSION(ims:ime, urban_map_fbd, jms:jme), OPTIONAL, &
 355 &    INTENT(INOUT) :: tflev_urb3d
 356 !multi-layer UCM
 357     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 358 &    lf_ac_urb3d
 359 !multi-layer UCM
 360     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 361 &    sf_ac_urb3d
 362 !multi-layer UCM
 363     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 364 &    cm_ac_urb3d
 365 !multi-layer UCM
 366     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 367 &    sfvent_urb3d
 368 !multi-layer UCM
 369     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 370 &    lfvent_urb3d
 371 ! multi-layer UCM
 372     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 373 &    INTENT(INOUT) :: sfwin1_urb3d
 374 ! multi-layer UCM
 375     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 376 &    INTENT(INOUT) :: sfwin2_urb3d
 377 ! multi-layer UCM
 378     REAL, DIMENSION(ims:ime, num_urban_ndm, jms:jme), OPTIONAL, &
 379 &    INTENT(INOUT) :: sfg_urb3d
 380 ! multi-layer UCM
 381     REAL, DIMENSION(ims:ime, urban_map_zdf, jms:jme), OPTIONAL, &
 382 &    INTENT(INOUT) :: sfr_urb3d
 383 ! multi-layer UCM
 384     REAL, DIMENSION(ims:ime, urban_map_zd, jms:jme), OPTIONAL, &
 385 &    INTENT(INOUT) :: sfw1_urb3d
 386 ! multi-layer UCM
 387     REAL, DIMENSION(ims:ime, urban_map_zd, jms:jme), OPTIONAL, &
 388 &    INTENT(INOUT) :: sfw2_urb3d
 389     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 390 &    :: a_u_bep
 391     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 392 &    :: a_v_bep
 393     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 394 &    :: a_t_bep
 395     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 396 &    :: a_q_bep
 397     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 398 &    :: a_e_bep
 399     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 400 &    :: b_u_bep
 401     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 402 &    :: b_v_bep
 403     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 404 &    :: b_t_bep
 405     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 406 &    :: b_q_bep
 407     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 408 &    :: b_e_bep
 409     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 410 &    :: vl_bep
 411     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 412 &    :: dlg_bep
 413     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 414 &    :: sf_bep
 415     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 416 &    :: dl_u_bep
 417 !obs fdda
 418     INTEGER, OPTIONAL, INTENT(IN) :: itimestep
 419     TYPE(FDOB_TYPE), OPTIONAL, INTENT(INOUT) :: fdob
 420 ! for obs-nudging base-state calcn
 421     REAL, OPTIONAL, INTENT(IN) :: p00, t00, tlp
 422 ! WA 12/21/09
 423     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) ::&
 424 &    te_temf, cf3d_temf
 425 ! WA 2/22/11
 426     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: wm_temf
 427 ! Local data
 428     REAL :: alblnd, zzlnd, zzwtr, thinld, xmava, cen_lat, pptop
 429     REAL, DIMENSION(kms:kme) :: sfull, shalf
 430     REAL :: obs_twindo_cg, obs_twindo
 431     CHARACTER(len=256) :: mminlu_loc
 432     CHARACTER(len=512) :: message
 433     INTEGER :: iswater
 434     INTEGER :: isice
 435     INTEGER :: isurban
 436     INTEGER :: sf_urban_physics
 437     INTEGER :: sf_ocean_physics
 438     REAL :: oml_hml0
 439     LOGICAL :: usemonalb
 440     LOGICAL :: rdmaxalb
 441     INTEGER :: mfshconv
 442     INTEGER :: i, j, k, itf, jtf, ktf, n
 443     INTEGER :: myproc
 444     INTRINSIC MIN0
 445     INTRINSIC TRIM
 446     INTRINSIC PRESENT
 447 !-----------------------------------------------------------------
 448     sf_urban_physics = config_flags%sf_urban_physics
 449     usemonalb = config_flags%usemonalb
 450     rdmaxalb = config_flags%rdmaxalb
 451     mfshconv = config_flags%mfshconv
 452     obs_twindo_cg = model_config_rec%obs_twindo(1)
 453     obs_twindo = config_flags%obs_twindo
 454     oml_hml0 = config_flags%oml_hml0
 455     sf_ocean_physics=config_flags%sf_ocean_physics
 456 !-- should be from the namelist
 457     sfull = 0.
 458     shalf = 0.
 459     CALL WRF_DEBUG(100, 'top of phy_init')
 460     WRITE(wrf_err_message, *) 'phy_init:  start_of_simulation = ', &
 461 &    start_of_simulation
 462     CALL WRF_DEBUG(100, TRIM(wrf_err_message))
 463     IF (ite .GT. ide - 1) THEN
 464       itf = ide - 1
 465     ELSE
 466       itf = ite
 467     END IF
 468     IF (jte .GT. jde - 1) THEN
 469       jtf = jde - 1
 470     ELSE
 471       jtf = jte
 472     END IF
 473     IF (kte .GT. kde - 1) THEN
 474       ktf = kde - 1
 475     ELSE
 476       ktf = kte
 477     END IF
 478     zzlnd = 0.1
 479     zzwtr = 0.0001
 480     thinld = 0.04
 481     alblnd = 0.2
 482     xmava = 0.3
 483     CALL NL_GET_CEN_LAT(id, cen_lat)
 484     CALL WRF_DEBUG(100, &
 485 &             'calling nl_get_iswater, nl_get_isice, nl_get_mminlu_loc')
 486     CALL NL_GET_ISWATER(id, iswater)
 487     CALL NL_GET_ISICE(id, isice)
 488     CALL NL_GET_ISURBAN(id, isurban)
 489     CALL NL_GET_MMINLU(1, mminlu_loc)
 490     CALL WRF_DEBUG(100, &
 491 &             'after nl_get_iswater, nl_get_isice, nl_get_mminlu_loc')
 492 !-- temporary fix by ww
 493     landuse_isice = isice
 494     IF (.NOT.restart) THEN
 495 !-- initialize common variables
 496       IF (.NOT.moved) THEN
 497         DO j=jts,jtf
 498           DO i=its,itf
 499             xland(i, j) = 1.
 500             gsw(i, j) = 0.
 501             glw(i, j) = 0.
 502 !-- initialize ust to a small value
 503             ust(i, j) = 0.0001
 504             mol(i, j) = 0.0
 505             pblh(i, j) = 0.0
 506             hfx(i, j) = 0.
 507             qfx(i, j) = 0.
 508             rainbl(i, j) = 0.
 509             rainncvd(i, j) = 0.0
 510             rainncv(i, j) = 0.
 511             snowncvd(i, j) = 0.0
 512             snowncv(i, j) = 0.
 513             graupelncvd(i, j) = 0.0
 514             graupelncv(i, j) = 0.
 515             acsnow(i, j) = 0.
 516 !wig, 17-May-2006: Added for idealized chem. runs
 517             DO k=kms,kme
 518               exch_h(i, k, j) = 0.
 519             END DO
 520           END DO
 521         END DO
 522       END IF
 523 !
 524       IF (PRESENT(tmn_update)) THEN
 525         IF (tmn_update .EQ. 1) THEN
 526           nyear = 1
 527           nday = 0.
 528           DO j=jts,jtf
 529             DO i=its,itf
 530               tyr(i, j) = tmn(i, j)
 531               tyra(i, j) = 0.0
 532               tdly(i, j) = 0.0
 533               DO n=1,lagday
 534                 tlag(i, n, j) = tmn(i, j)
 535               END DO
 536             END DO
 537           END DO
 538         END IF
 539       END IF
 540 !
 541 !
 542       DO j=jts,jtf
 543         DO i=its,itf
 544           IF (xland(i, j) .LT. 1.5) THEN
 545             IF (mminlu_loc .EQ. '    ') albbck(i, j) = alblnd
 546             embck(i, j) = 0.85
 547             albedo(i, j) = albbck(i, j)
 548             emiss(i, j) = embck(i, j)
 549             thc(i, j) = thinld
 550             znt(i, j) = zzlnd
 551             z0(i, j) = zzlnd
 552             mavail(i, j) = xmava
 553           ELSE
 554             IF (mminlu_loc .EQ. '    ') albbck(i, j) = 0.08
 555             albedo(i, j) = albbck(i, j)
 556             embck(i, j) = 0.98
 557             emiss(i, j) = embck(i, j)
 558             thc(i, j) = thinld
 559             znt(i, j) = zzwtr
 560             z0(i, j) = zzwtr
 561             mavail(i, j) = 1.0
 562           END IF
 563         END DO
 564       END DO
 565       IF (config_flags%cu_diag .EQ. 1) THEN
 566         DO j=jts,jtf
 567           DO k=kts,ktf
 568             DO i=its,itf
 569               gd_cloud(i, k, j) = 0.
 570               gd_cloud2(i, k, j) = 0.
 571               gd_cloud_a(i, k, j) = 0.
 572               gd_cloud2_a(i, k, j) = 0.
 573             END DO
 574           END DO
 575         END DO
 576       END IF
 577       DO j=jts,jtf
 578         DO i=its,itf
 579           raincv_a(i, j) = 0.
 580           raincv_b(i, j) = 0.
 581         END DO
 582       END DO
 583       CALL WRF_DEBUG(200, &
 584 &               'module_start: phy_init: Before call to landuse_init')
 585       IF (mminlu_loc .NE. '    ') CALL LANDUSE_INIT(lu_index, snowc, &
 586 &                                              albedo, albbck, snoalb, &
 587 &                                              mavail, emiss, embck, znt&
 588 &                                              , z0, thc, xland, xice, &
 589 &                                              xicem, julday, cen_lat, &
 590 &                                              iswater, TRIM(mminlu_loc)&
 591 &                                              , landuse_isice, &
 592 &                                              landuse_lucats, &
 593 &                                              landuse_luseas, &
 594 &                                              landuse_isn, config_flags%&
 595 &                                              fractional_seaice, &
 596 &                                              lu_state, allowed_to_read&
 597 &                                              , usemonalb, ids, ide, jds&
 598 &                                              , jde, kds, kde, ims, ime&
 599 &                                              , jms, jme, kms, kme, its&
 600 &                                              , ite, jts, jte, kts, kte)
 601 !-- initialize surface properties
 602     END IF
 603 !-- initialize physics
 604 !-- ra: radiation
 605 !-- bl: pbl
 606 !-- cu: cumulus
 607 !-- mp: microphysics
 608     CALL WRF_DEBUG(200, 'module_start: phy_init: Before call to bl_init'&
 609 &            )
 610 ! WA
 611 !Optional urban
 612 !Optional urban
 613 !Optional urban
 614 !Optional urban
 615 !Optional urban
 616 !Optional urban
 617 !Optional multi-layer urban
 618 !Optional multi-layer urban
 619 !Optional multi-layer urban
 620 !Optional multi-layer urban
 621 !Optional multi-layer urban
 622 !Optional multi-layer urban
 623 !Optional multi-layer urban
 624 !Optional multi-layer urban
 625 !Optional multi-layer urban
 626 !Optional multi-layer urban
 627 !Optional multi-layer urban
 628 !Optional multi-layer urban
 629 !Optional multi-layer urban
 630 !Optional multi-layer urban
 631 !Optional oml
 632     CALL BL_INIT_D(stepbl, bldt, dt, rublten, rubltend, rvblten, &
 633 &             rvbltend, rthblten, rthbltend, rqvblten, rqvbltend, &
 634 &             rqcblten, rqiblten, tsk, tmn, config_flags, restart, &
 635 &             ust, lowlyr, tslb, zs, dzs, num_soil_layers, tke_pbl, &
 636 &             mfshconv, massflux_edkf, entr_edkf, detr_edkf, thl_up, &
 637 &             thv_up, rt_up, rv_up, rc_up, u_up, v_up, frac_up, exch_h, &
 638 &             vegfra, snow, snowc, canwat, smstav, smstot, sfcrunoff, &
 639 &             udrunoff, acsnow, acsnom, ivgtyp, isltyp, isurban, smois, &
 640 &             smfr3d, mavail, snowh, sh2o, snoalb, fndsoilw, fndsnowh, &
 641 &             rdmaxalb, znt, xland, xice, sfcevp, grdflx, TRIM(mminlu_loc&
 642 &             ), isnowxy, zsnsoxy, tsnoxy, snicexy, snliqxy, tvxy, tgxy, &
 643 &             canicexy, canliqxy, eahxy, tahxy, cmxy, chxy, fwetxy, &
 644 &             sneqvoxy, alboldxy, qsnowxy, qrainxy, wslakexy, zwtxy, waxy, wtxy, &
 645 &             lfmassxy, rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, &
 646 &             xsaixy, t2mvxy, t2mbxy, chstarxy, allowed_to_read, &
 647 &             start_of_simulation, te_temf, cf3d_temf, wm_temf, dzr, dzb&
 648 &             , dzg, tr_urb2d, tb_urb2d, tg_urb2d, tc_urb2d, qc_urb2d, &
 649 &             xxxr_urb2d, xxxb_urb2d, xxxg_urb2d, xxxc_urb2d, trl_urb3d, &
 650 &             tbl_urb3d, tgl_urb3d, sh_urb2d, lh_urb2d, g_urb2d, rn_urb2d&
 651 &             , ts_urb2d, frc_urb2d, utype_urb2d, sf_urban_physics, &
 652 &             num_urban_ndm, urban_map_zrd, urban_map_zwd, urban_map_gd,&
 653 &             urban_map_zd, urban_map_zdf, urban_map_bd, urban_map_wd, urban_map_gbd,&
 654 &             urban_map_fbd, trb_urb4d, tw1_urb4d, tw2_urb4d, &
 655 &             tgb_urb4d, tlev_urb3d, qlev_urb3d, tw1lev_urb3d, &
 656 &             tw2lev_urb3d, tglev_urb3d, tflev_urb3d, sf_ac_urb3d, &
 657 &             lf_ac_urb3d, cm_ac_urb3d, sfvent_urb3d, lfvent_urb3d, &
 658 &             sfwin1_urb3d, sfwin2_urb3d, sfw1_urb3d, sfw2_urb3d, &
 659 &             sfr_urb3d, sfg_urb3d, a_u_bep, a_v_bep, a_t_bep, a_q_bep, &
 660 &             a_e_bep, b_u_bep, b_v_bep, b_t_bep, b_q_bep, b_e_bep, &
 661 &             dlg_bep, dl_u_bep, sf_bep, vl_bep, ids, ide, jds, jde, kds&
 662 &             , kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
 663 &             kts, kte, achfx, aclhf, acgrdflx, oml_hml0, sf_ocean_physics, tml, &
 664 &             t0ml, hml, h0ml, huml, hvml, tmoml)
 665 !Optional oml
 666     CALL WRF_DEBUG(200, 'module_start: phy_init: Before call to cu_init'&
 667 &            )
 668     CALL CU_INIT_D(dx, stepcu, cudt, dt, rucuten, rvcuten, rthcuten, &
 669 &             rthcutend, rqvcuten, rqvcutend, rqrcuten, rqccuten, &
 670 &             rqccutend, rqscuten, rqicuten, nca, rainc, raincd, raincv, &
 671 &             raincvd, w0avg, w0avgd, config_flags, restart, cldefi, &
 672 &             lowlyr, mass_flux, rthften, rqvften, apr_gr, apr_w, apr_mc&
 673 &             , apr_st, apr_as, apr_capma, apr_capme, apr_capmi, &
 674 &             cugd_tten, cugd_ttens, cugd_qvten, cugd_qvtens, cugd_qcten&
 675 &             , allowed_to_read, start_of_simulation, ids, ide, jds, jde&
 676 &             , kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
 677 &             jte, kts, kte)
 678     CALL WRF_DEBUG(200, 'module_start: phy_init: Before call to mp_init'&
 679 &            )
 680     CALL MP_INIT_D(rainnc, rainncd, snownc, snowncd, graupelnc, &
 681 &             graupelncd, config_flags, restart, warm_rain, &
 682 &             adv_moist_cond, mpdt, dt, dx, dy, lowlyr, f_ice_phy, &
 683 &             f_rain_phy, f_rimef_phy, mp_restart_state, tbpvs_state, &
 684 &             tbpvs0_state, allowed_to_read, start_of_simulation, ids, &
 685 &             ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its&
 686 &             , ite, jts, jte, kts, kte)
 687   END SUBROUTINE G_PHY_INIT
 688 !=================================================================
 689 !  Differentiation of bl_init in forward (tangent) mode:
 690 !   variations   of useful results: rublten rqvblten rvblten
 691 !                rthblten
 692 !   with respect to varying inputs: rublten rqvblten rvblten
 693 !                rthblten
 694 !=====================================================================
 695 ! WA
 696 !                num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban
 697 !Optional urban
 698 !Optional urban
 699 !Optional urban
 700 !Optional urban
 701 !Optional urban
 702 !Optional urban
 703 !Optional multi-layer urban
 704 !Optional multi-layer urban
 705 !Optional multi-layer urban
 706 !Optional multi-layer urban
 707 !Optional multi-layer urban
 708 !Optional multi-layer urban
 709 !Optional multi-layer urban
 710 !Optional multi-layer urban
 711 !Optional multi-layer urban
 712 !Optional multi-layer urban
 713 !Optional multi-layer urban
 714 !Optional multi-layer urban
 715 !Optional multi-layer urban
 716 !Optional multi-layer urban
 717 !Optional oml
 718   SUBROUTINE BL_INIT_D(stepbl, bldt, dt, rublten, rubltend, rvblten, &
 719 &    rvbltend, rthblten, rthbltend, rqvblten, rqvbltend, rqcblten, &
 720 &    rqiblten, tsk, tmn, config_flags, restart, ust, lowlyr, tslb, &
 721 &    zs, dzs, num_soil_layers, tke_pbl, mfshconv, massflux_edkf, &
 722 &    entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, rc_up, u_up, &
 723 &    v_up, frac_up, exch_h, vegfra, snow, snowc, canwat, smstav, smstot, &
 724 &    sfcrunoff, udrunoff, acsnow, acsnom, ivgtyp, isltyp, isurban, smois&
 725 &    , smfr3d, mavail, snowh, sh2o, snoalb, fndsoilw, fndsnowh, rdmaxalb&
 726 &    , znt, xland, xice, sfcevp, grdflx, mminlu, isnowxy, zsnsoxy, tsnoxy&
 727 &    , snicexy, snliqxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, &
 728 &    cmxy, chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, qrainxy, wslakexy, zwtxy,&
 729 &    waxy, wtxy, lfmassxy, rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy&
 730 &    , xsaixy, t2mvxy, t2mbxy, chstarxy, allowed_to_read, &
 731 &    start_of_simulation, te_temf, cf3d_temf, wm_temf, dzr, dzb, dzg, &
 732 &    tr_urb2d, tb_urb2d, tg_urb2d, tc_urb2d, qc_urb2d, xxxr_urb2d, &
 733 &    xxxb_urb2d, xxxg_urb2d, xxxc_urb2d, trl_urb3d, tbl_urb3d, tgl_urb3d&
 734 &    , sh_urb2d, lh_urb2d, g_urb2d, rn_urb2d, ts_urb2d, frc_urb2d, &
 735 &    utype_urb2d, sf_urban_physics, num_urban_ndm, urban_map_zrd,&
 736 &    urban_map_zwd, urban_map_gd, urban_map_zd, urban_map_zdf, urban_map_bd,&
 737 &    urban_map_wd, urban_map_gbd, urban_map_fbd, trb_urb4d, &
 738 &    tw1_urb4d, tw2_urb4d, tgb_urb4d, tlev_urb3d, qlev_urb3d, &
 739 &    tw1lev_urb3d, tw2lev_urb3d, tglev_urb3d, tflev_urb3d, sf_ac_urb3d, &
 740 &    lf_ac_urb3d, cm_ac_urb3d, sfvent_urb3d, lfvent_urb3d, sfwin1_urb3d, &
 741 &    sfwin2_urb3d, sfw1_urb3d, sfw2_urb3d, sfr_urb3d, sfg_urb3d, a_u_bep&
 742 &    , a_v_bep, a_t_bep, a_q_bep, a_e_bep, b_u_bep, b_v_bep, b_t_bep, &
 743 &    b_q_bep, b_e_bep, dlg_bep, dl_u_bep, sf_bep, vl_bep, ids, ide, jds, &
 744 &    jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts&
 745 &    , kte, achfx, aclhf, acgrdflx, oml_hml0, sf_ocean_physics, tml, t0ml, hml, &
 746 &    h0ml, huml, hvml, tmoml)
 747
 748     USE module_sf_sfclay
 749     USE g_module_bl_surface_drag, ONLY : surface_drag_init_d
 750
 751     IMPLICIT NONE
 752 !Optional oml
 753 !--------------------------------------------------------------------
 754 !--------------------------------------------------------------------
 755     TYPE(GRID_CONFIG_REC_TYPE) :: config_flags
 756     LOGICAL, INTENT(IN) :: restart
 757     LOGICAL, INTENT(IN) :: fndsoilw, fndsnowh
 758     LOGICAL, INTENT(IN) :: rdmaxalb
 759     INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
 760 &    jme, kms, kme, its, ite, jts, jte, kts, kte
 761     INTEGER, INTENT(IN) :: num_soil_layers
 762     INTEGER, INTENT(IN) :: sf_urban_physics
 763     REAL, INTENT(IN) :: dt, bldt
 764     INTEGER, INTENT(INOUT) :: stepbl
 765     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), INTENT(OUT) :: &
 766 &    smfr3d
 767     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), INTENT(INOUT) ::&
 768 &    smois, sh2o, tslb
 769     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: snow, snowh, &
 770 &    snowc, snoalb, canwat, mavail, smstav, smstot, sfcrunoff, udrunoff, &
 771 &    acsnow, vegfra, acsnom, sfcevp, grdflx, ust, znt, xland, xice
 772     INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: ivgtyp, &
 773 &    isltyp, lowlyr
 774     REAL, DIMENSION(num_soil_layers), INTENT(INOUT) :: zs, dzs
 775     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
 776 &    rvblten, exch_h, rthblten, rqvblten, rqcblten, rqiblten, tke_pbl
 777     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rubltend&
 778 &    , rvbltend, rthbltend, rqvbltend
 779     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL ::&
 780 &    massflux_edkf, entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, &
 781 &    rc_up, u_up, v_up, frac_up
 782 ! WRF JP
 783     INTEGER, INTENT(IN) :: mfshconv
 784     REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: tsk
 785     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: tmn
 786     CHARACTER(len=*), INTENT(IN) :: mminlu
 787     LOGICAL, INTENT(IN) :: allowed_to_read
 788     INTEGER, INTENT(IN) :: isurban
 789     INTEGER :: isn, isfc
 790     INTEGER :: k
 791 !WA
 792     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) ::&
 793 &    te_temf, cf3d_temf
 794     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: wm_temf
 795 !Noah-MP
 796     INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL :: isnowxy
 797     REAL, DIMENSION(ims:ime, -2:num_soil_layers, jms:jme), OPTIONAL :: &
 798 &    zsnsoxy
 799     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: tsnoxy
 800     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: snicexy
 801     REAL, DIMENSION(ims:ime, -2:0, jms:jme), OPTIONAL :: snliqxy
 802     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tvxy
 803     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tgxy
 804     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: canicexy
 805     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: canliqxy
 806     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: eahxy
 807     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: tahxy
 808     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: cmxy
 809     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: chxy
 810     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: fwetxy
 811     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: sneqvoxy
 812     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: alboldxy
 813     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: qsnowxy
 814     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: qrainxy
 815     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: wslakexy
 816     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: zwtxy
 817     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: waxy
 818     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: wtxy
 819     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: lfmassxy
 820     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: rtmassxy
 821     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: stmassxy
 822     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: woodxy
 823     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: stblcpxy
 824     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: fastcpxy
 825     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: xsaixy
 826     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: t2mvxy
 827     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: t2mbxy
 828     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: chstarxy
 829 !URBAN
 830 !   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR  !Optional urban
 831 !   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB  !Optional urban
 832 !   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG  !Optional urban
 833 !Optional urban
 834     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzr
 835 !Optional urban
 836     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzb
 837 !Optional urban
 838     REAL, DIMENSION(num_soil_layers), OPTIONAL, INTENT(INOUT) :: dzg
 839 !Optional urban
 840     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 841 &    tr_urb2d
 842 !Optional urban
 843     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 844 &    tb_urb2d
 845 !Optional urban
 846     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 847 &    tg_urb2d
 848 !Optional urban
 849     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 850 &    tc_urb2d
 851 !Optional urban
 852     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 853 &    qc_urb2d
 854 !Optional urban
 855     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 856 &    xxxr_urb2d
 857 !Optional urban
 858     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 859 &    xxxb_urb2d
 860 !Optional urban
 861     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 862 &    xxxg_urb2d
 863 !Optional urban
 864     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 865 &    xxxc_urb2d
 866 !Optional urban
 867     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 868 &    sh_urb2d
 869 !Optional urban
 870     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 871 &    lh_urb2d
 872 !Optional urban
 873     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 874 &    g_urb2d
 875 !Optional urban
 876     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 877 &    rn_urb2d
 878 !Optional urban
 879     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 880 &    ts_urb2d
 881 !Optional urban
 882     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 883 &    frc_urb2d
 884 !Optional urban
 885     INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 886 &    utype_urb2d
 887 !    REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
 888 !    REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
 889 !    REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
 890 !Optional urban
 891     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 892 &    INTENT(INOUT) :: trl_urb3d
 893 !Optional urban
 894     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 895 &    INTENT(INOUT) :: tbl_urb3d
 896 !Optional urban
 897     REAL, DIMENSION(ims:ime, num_soil_layers, jms:jme), OPTIONAL, &
 898 &    INTENT(INOUT) :: tgl_urb3d
 899     INTEGER, INTENT(IN) :: num_urban_ndm
 900     INTEGER, INTENT(IN) :: urban_map_zrd
 901     INTEGER, INTENT(IN) :: urban_map_zwd
 902     INTEGER, INTENT(IN) :: urban_map_gd
 903     INTEGER, INTENT(IN) :: urban_map_zd
 904     INTEGER, INTENT(IN) :: urban_map_zdf
 905     INTEGER, INTENT(IN) :: urban_map_bd
 906     INTEGER, INTENT(IN) :: urban_map_wd
 907     INTEGER, INTENT(IN) :: urban_map_gbd
 908     INTEGER, INTENT(IN) :: urban_map_fbd
 909 !Optional UCM
 910     REAL, DIMENSION(ims:ime, urban_map_zrd, jms:jme), OPTIONAL, &
 911 &    INTENT(INOUT) :: trb_urb4d
 912 !Optional UCM
 913     REAL, DIMENSION(ims:ime, urban_map_zwd, jms:jme), OPTIONAL, &
 914 &    INTENT(INOUT) :: tw1_urb4d
 915 !Optional UCM
 916     REAL, DIMENSION(ims:ime, urban_map_zwd, jms:jme), OPTIONAL, &
 917 &    INTENT(INOUT) :: tw2_urb4d
 918 !Optional UCM
 919     REAL, DIMENSION(ims:ime, urban_map_gd, jms:jme), OPTIONAL, &
 920 &    INTENT(INOUT) :: tgb_urb4d
 921 !Optional UCM
 922     REAL, DIMENSION(ims:ime, urban_map_bd, jms:jme), OPTIONAL, &
 923 &    INTENT(INOUT) :: tlev_urb3d
 924 !Optional UCM
 925     REAL, DIMENSION(ims:ime, urban_map_bd, jms:jme), OPTIONAL, &
 926 &    INTENT(INOUT) :: qlev_urb3d
 927 ! multi-layer UCM
 928     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 929 &    INTENT(INOUT) :: tw1lev_urb3d
 930 ! multi-layer UCM
 931     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 932 &    INTENT(INOUT) :: tw2lev_urb3d
 933 ! multi-layer UCM
 934     REAL, DIMENSION(ims:ime, urban_map_gbd, jms:jme), OPTIONAL, &
 935 &    INTENT(INOUT) :: tglev_urb3d
 936 ! multi-layer UCM
 937     REAL, DIMENSION(ims:ime, urban_map_fbd, jms:jme), OPTIONAL, &
 938 &    INTENT(INOUT) :: tflev_urb3d
 939 !multi-layer UCM
 940     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 941 &    lf_ac_urb3d
 942 !multi-layer UCM
 943     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 944 &    sf_ac_urb3d
 945 !multi-layer UCM
 946     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 947 &    cm_ac_urb3d
 948 !multi-layer UCM
 949     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 950 &    sfvent_urb3d
 951 !multi-layer UCM
 952     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
 953 &    lfvent_urb3d
 954 ! multi-layer UCM
 955     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 956 &    INTENT(INOUT) :: sfwin1_urb3d
 957 ! multi-layer UCM
 958     REAL, DIMENSION(ims:ime, urban_map_wd, jms:jme), OPTIONAL, &
 959 &    INTENT(INOUT) :: sfwin2_urb3d
 960 !Optional UCM
 961     REAL, DIMENSION(ims:ime, urban_map_zd, jms:jme), OPTIONAL, &
 962 &    INTENT(INOUT) :: sfw1_urb3d
 963 !Optional UCM
 964     REAL, DIMENSION(ims:ime, urban_map_zd, jms:jme), OPTIONAL, &
 965 &    INTENT(INOUT) :: sfw2_urb3d
 966 !Optional UCM
 967     REAL, DIMENSION(ims:ime, urban_map_zdf, jms:jme), OPTIONAL, &
 968 &    INTENT(INOUT) :: sfr_urb3d
 969 !Optional UCM
 970     REAL, DIMENSION(ims:ime, num_urban_ndm, jms:jme), OPTIONAL, &
 971 &    INTENT(INOUT) :: sfg_urb3d
 972     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 973 &    :: a_u_bep
 974     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 975 &    :: a_v_bep
 976     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 977 &    :: a_t_bep
 978     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 979 &    :: a_q_bep
 980     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 981 &    :: a_e_bep
 982     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 983 &    :: b_u_bep
 984     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 985 &    :: b_v_bep
 986     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 987 &    :: b_t_bep
 988     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 989 &    :: b_q_bep
 990     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 991 &    :: b_e_bep
 992     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 993 &    :: vl_bep
 994     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 995 &    :: dlg_bep
 996     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 997 &    :: sf_bep
 998     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
 999 &    :: dl_u_bep
1000     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: achfx&
1001 &    , aclhf, acgrdflx
1002 ! Optional OML variables
1003     REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: tml, &
1004 &    t0ml, hml, h0ml, huml, hvml, tmoml
1005     INTEGER, OPTIONAL, INTENT(IN) :: sf_ocean_physics
1006     REAL, OPTIONAL, INTENT(IN) :: oml_hml0
1007     LOGICAL, INTENT(IN) :: start_of_simulation
1008     INTEGER :: i, j
1009 !local mynn
1010     INTEGER :: mynn_closure_level
1011     INTRINSIC MAX
1012     INTRINSIC PRESENT
1013     INTRINSIC NINT
1014 !-- calculate pbl time step
1015     stepbl = NINT(bldt*60./dt)
1016     IF (stepbl .LT. 1) THEN
1017       stepbl = 1
1018     ELSE
1019       stepbl = stepbl
1020     END IF
1021 !-- initialization
1022     IF (PRESENT(achfx)) THEN
1023       IF (.NOT.restart) THEN
1024         DO j=jts,jte
1025           DO i=its,ite
1026             achfx(i, j) = 0.
1027             aclhf(i, j) = 0.
1028             acgrdflx(i, j) = 0.
1029             sfcevp(i, j) = 0.
1030           END DO
1031         END DO
1032       END IF
1033     END IF
1034 !-- initialize surface layer scheme
1035     SELECT CASE  (config_flags%sf_sfclay_physics)
1036     CASE (sfclayscheme)
1037       CALL SFCLAYINIT(allowed_to_read)
1038       isfc = 1
1039     CASE DEFAULT
1040 !mynn
1041 !-- initialize pbl scheme
1042       SELECT CASE  (config_flags%bl_pbl_physics)
1043       CASE (surfdragscheme)
1044         CALL SURFACE_DRAG_INIT_D(rublten, rubltend, rvblten, rvbltend, &
1045 &                           rthblten, rthbltend, rqvblten, rqvbltend, &
1046 &                           restart, ids, ide, jds, jde, kds, kde, ims, &
1047 &                           ime, jms, jme, kms, kme, its, ite, jts, jte, &
1048 &                           kts, kte)
1049       END SELECT
1050     END SELECT
1051   END SUBROUTINE BL_INIT_D
1052 !=====================================================================
1053 !  Differentiation of cu_init in forward (tangent) mode:
1054 !   variations   of useful results: raincv rqccuten rthcuten rainc
1055 !                w0avg rqvcuten
1056 !   with respect to varying inputs: raincv rqccuten rthcuten rainc
1057 !                w0avg rqvcuten
1058 !==================================================================
1059   SUBROUTINE CU_INIT_D(dx, stepcu, cudt, dt, rucuten, rvcuten, rthcuten, &
1060 &    rthcutend, rqvcuten, rqvcutend, rqrcuten, rqccuten, rqccutend, &
1061 &    rqscuten, rqicuten, nca, rainc, raincd, raincv, raincvd, w0avg, &
1062 &    w0avgd, config_flags, restart, cldefi, lowlyr, mass_flux, rthften, &
1063 &    rqvften, apr_gr, apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme&
1064 &    , apr_capmi, cugd_tten, cugd_ttens, cugd_qvten, cugd_qvtens, &
1065 &    cugd_qcten, allowed_to_read, start_of_simulation, ids, ide, jds, jde&
1066 &    , kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, &
1067 &    kte)
1068
1069     USE g_module_cu_du, ONLY : ducuinit_d
1070
1071     IMPLICIT NONE
1072 !------------------------------------------------------------------
1073 !------------------------------------------------------------------
1074     TYPE(GRID_CONFIG_REC_TYPE) :: config_flags
1075     LOGICAL, INTENT(IN) :: restart
1076     INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
1077 &    jme, kms, kme, its, ite, jts, jte, kts, kte
1078     REAL, INTENT(IN) :: dt, cudt, dx
1079     LOGICAL, INTENT(IN) :: start_of_simulation
1080     LOGICAL, INTENT(IN) :: allowed_to_read
1081     INTEGER, INTENT(INOUT) :: stepcu
1082     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten&
1083 &    , rvcuten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, &
1084 &    rqscuten
1085     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
1086 &    rthcutend, rqvcutend, rqccutend
1087     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) &
1088 &    :: cugd_tten, cugd_ttens, cugd_qvten, cugd_qvtens, cugd_qcten
1089     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: w0avg
1090     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: w0avgd
1091     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthften, &
1092 &    rqvften
1093     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: rainc, raincv
1094     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: raincd, raincvd
1095     REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: cldefi
1096     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: nca
1097     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mass_flux, &
1098 &    apr_gr, apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme, &
1099 &    apr_capmi
1100     INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: lowlyr
1101 ! LOCAL VAR
1102     INTEGER :: i, j, itf, jtf
1103     INTRINSIC MIN0
1104     INTRINSIC MAX
1105     INTRINSIC NINT
1106     IF (ite .GT. ide - 1) THEN
1107       itf = ide - 1
1108     ELSE
1109       itf = ite
1110     END IF
1111     IF (jte .GT. jde - 1) THEN
1112       jtf = jde - 1
1113     ELSE
1114       jtf = jte
1115     END IF
1116 !
1117     stepcu = NINT(cudt*60./dt)
1118     IF (stepcu .LT. 1) THEN
1119       stepcu = 1
1120     ELSE
1121       stepcu = stepcu
1122     END IF
1123 !-- initialization
1124     IF (start_of_simulation) THEN
1125       DO j=jts,jtf
1126         DO i=its,itf
1127           raincd(i, j) = 0.0
1128           rainc(i, j) = 0.
1129           raincvd(i, j) = 0.0
1130           raincv(i, j) = 0.
1131         END DO
1132       END DO
1133     END IF
1134 !-- deep convection and hybrid deep-shallow convection schemes
1135     SELECT CASE  (config_flags%cu_physics)
1136     CASE (ducuscheme)
1137       CALL DUCUINIT_D(rthcuten, rthcutend, rqvcuten, rqvcutend, rqccuten&
1138 &                , rqccutend, rqrcuten, rqicuten, rqscuten, nca, w0avg, &
1139 &                w0avgd, p_qc, p_qr, svp1, svp2, svp3, svpt0, &
1140 &                param_first_scalar, restart, allowed_to_read, ids, ide, &
1141 &                jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, &
1142 &                ite, jts, jte, kts, kte)
1143     END SELECT
1144   END SUBROUTINE CU_INIT_D
1145 !==================================================================
1146 !  Differentiation of mp_init in forward (tangent) mode:
1147 !   variations   of useful results: rainnc snownc graupelnc
1148 !   with respect to varying inputs: rainnc snownc graupelnc
1149 !==================================================================
1150 ! for eta mp
1151 ! for eta mp
1152 ! eta mp
1153   SUBROUTINE MP_INIT_D(rainnc, rainncd, snownc, snowncd, graupelnc, &
1154 &    graupelncd, config_flags, restart, warm_rain, adv_moist_cond, mpdt, &
1155 &    dt, dx, dy, lowlyr, f_ice_phy, f_rain_phy, f_rimef_phy, &
1156 &    mp_restart_state, tbpvs_state, tbpvs0_state, allowed_to_read, &
1157 &    start_of_simulation, ids, ide, jds, jde, kds, kde, ims, ime, jms, &
1158 &    jme, kms, kme, its, ite, jts, jte, kts, kte)
1159     IMPLICIT NONE
1160 !------------------------------------------------------------------
1161 ! Arguments
1162     TYPE(GRID_CONFIG_REC_TYPE) :: config_flags
1163     LOGICAL, INTENT(IN) :: restart
1164     LOGICAL, INTENT(OUT) :: warm_rain, adv_moist_cond
1165     REAL, INTENT(IN) :: mpdt, dt, dx, dy
1166     LOGICAL, INTENT(IN) :: start_of_simulation
1167     INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
1168 &    jme, kms, kme, its, ite, jts, jte, kts, kte
1169     INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: lowlyr
1170     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainnc, snownc, &
1171 &    graupelnc
1172     REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainncd, snowncd&
1173 &    , graupelncd
1174     REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: &
1175 &    f_ice_phy, f_rain_phy, f_rimef_phy
1176     REAL, DIMENSION(:), INTENT(INOUT) :: mp_restart_state, tbpvs_state, &
1177 &    tbpvs0_state
1178     LOGICAL, INTENT(IN) :: allowed_to_read
1179 ! Local
1180     INTEGER :: i, j, itf, jtf
1181     INTRINSIC MIN0
1182     warm_rain = .false.
1183     adv_moist_cond = .true.
1184     IF (ite .GT. ide - 1) THEN
1185       itf = ide - 1
1186     ELSE
1187       itf = ite
1188     END IF
1189     IF (jte .GT. jde - 1) THEN
1190       jtf = jde - 1
1191     ELSE
1192       jtf = jte
1193     END IF
1194     IF (start_of_simulation) THEN
1195       DO j=jts,jtf
1196         DO i=its,itf
1197           rainncd(i, j) = 0.0
1198           rainnc(i, j) = 0.
1199           snowncd(i, j) = 0.0
1200           snownc(i, j) = 0.
1201           graupelncd(i, j) = 0.0
1202           graupelnc(i, j) = 0.
1203         END DO
1204       END DO
1205     END IF
1206     SELECT CASE  (config_flags%mp_physics)
1207
1208     END SELECT
1209   END SUBROUTINE MP_INIT_D
1210 !==================================================================
1211   SUBROUTINE Z2SIGMA(zf, zh, sf, sh, p_top, pptop, config_flags, &
1212 &    allowed_to_read, kds, kde, kms, kme, kts, kte)
1213     IMPLICIT NONE
1214 ! Arguments
1215     INTEGER, INTENT(IN) :: kds, kde, kms, kme, kts, kte
1216     REAL, DIMENSION(kms:kme), INTENT(IN) :: zf, zh
1217     REAL, DIMENSION(kms:kme), INTENT(OUT) :: sf, sh
1218     REAL, INTENT(IN) :: p_top
1219     REAL, INTENT(OUT) :: pptop
1220     TYPE(GRID_CONFIG_REC_TYPE) :: config_flags
1221     LOGICAL, INTENT(IN) :: allowed_to_read
1222 ! Local
1223     REAL :: r, g, ts, gamma, ps, ztrop, tstrat, ptrop, z, t, p, ztop, &
1224 &    ptop
1225     INTEGER :: k
1226     REAL :: pwx1
1227     REAL :: pwy1
1228     REAL :: pwr1
1229     REAL :: arg1
1230     INTRINSIC EXP
1231     IF (zf(kde/2) .GT. 1.0) THEN
1232 ! Height levels assumed (zeta coordinate)
1233 ! Convert to sigma using standard atmosphere for pressure-height relation
1234 ! constants for standard atmosphere definition
1235       r = 287.05
1236       g = 9.80665
1237       ts = 288.15
1238       gamma = -(6.5/1000.)
1239       ps = 1013.25
1240       ztrop = 11000.
1241       tstrat = ts + gamma*ztrop
1242       pwx1 = tstrat/ts
1243       pwy1 = -(g/(gamma*r))
1244       pwr1 = pwx1**pwy1
1245       ptrop = ps*pwr1
1246       DO k=kde,kds,-1
1247 ! full levels
1248         z = zf(k)
1249         IF (z .LE. ztrop) THEN
1250           t = ts + gamma*z
1251           pwx1 = t/ts
1252           pwy1 = -(g/(gamma*r))
1253           pwr1 = pwx1**pwy1
1254           p = ps*pwr1
1255         ELSE
1256           t = tstrat
1257           arg1 = -(g*(z-ztrop)/(r*tstrat))
1258           p = ptrop*EXP(arg1)
1259         END IF
1260         IF (k .EQ. kde) THEN
1261           ztop = zf(k)
1262           ptop = p
1263         END IF
1264         sf(k) = (p-ptop)/(ps-ptop)
1265 ! half levels
1266         IF (k .NE. kds) THEN
1267           z = 0.5*(zf(k)+zf(k-1))
1268           IF (z .LE. ztrop) THEN
1269             t = ts + gamma*z
1270             pwx1 = t/ts
1271             pwy1 = -(g/(gamma*r))
1272             pwr1 = pwx1**pwy1
1273             p = ps*pwr1
1274           ELSE
1275             t = tstrat
1276             arg1 = -(g*(z-ztrop)/(r*tstrat))
1277             p = ptrop*EXP(arg1)
1278           END IF
1279           sh(k-1) = (p-ptop)/(ps-ptop)
1280         END IF
1281       END DO
1282       pptop = ptop/10.
1283     ELSE
1284 !  Levels are already sigma/eta
1285       DO k=kde,kds,-1
1286 !        sf(k)=zf(kde-k+kds)
1287 !        if(k .ne. kde)sh(k)=zh(kde-1-k+kds)
1288         sf(k) = zf(k)
1289         IF (k .NE. kde) sh(k) = zh(k)
1290       END DO
1291       pptop = p_top/1000.
1292     END IF
1293   END SUBROUTINE Z2SIGMA
1294 END MODULE G_MODULE_PHYSICS_INIT