!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of pbl_driver in forward (tangent) mode (with options r8):
!   variations   of useful results: rublten dusfcg dvsfcg rqvblten
!                dtauy3d rvblten rqcblten rthblten rqiblten dtaux3d
!   with respect to varying inputs: v_phy rublten dusfcg z dvsfcg
!                pi_phy rqvblten dtauy3d rvblten qv_curr t_phy
!                rqcblten rthblten u_phy rqiblten dtaux3d p8w mut
!   RW status of diff variables: v_phy:in rublten:in-out dusfcg:in-out
!                z:in dvsfcg:in-out pi_phy:in rqvblten:in-out dtauy3d:in-out
!                rvblten:in-out qv_curr:in t_phy:in rqcblten:in-out
!                rthblten:in-out u_phy:in rqiblten:in-out dtaux3d:in-out
!                p8w:in mut:in
!WRF:MEDIATION_LAYER:PHYSICS
!
MODULE g_module_pbl_driver
CONTAINS
!------------------------------------------------------------------
! paj
! OPTIONAL for TEMF scheme
! MYNN
!ACF for QKE advection
!ACF-end
! Optional
! Optional gravity-wave drag
!  Optional moisture tracers
!  Optional moisture tracer flags
! variables added for BEP
! variables  for GBM PBL
! Wind Turbine Parameterizations
! variables required for camuwpbl scheme
! variables required for camuwpbl scheme (optional)
! for grims shallow convection with ysupbl
SUBROUTINE G_PBL_DRIVER(itimestep, dt, u_frame, v_frame, bldt, curr_secs&
&  , adapt_step_flag, bldtacttime, rublten, rubltend, rvblten, rvbltend, &
&  rthblten, rthbltend, tsk, xland, znt, ht, ust, pblh, hfx, qfx, grdflx&
&  , u_phy, u_phyd, v_phy, v_phyd, th_phy, rho, p_phy, pi_phy, pi_phyd, &
&  p8w, p8wd, t_phy, t_phyd, dz8w, z, zd, exch_h, exch_m, akhs, akms, &
&  thz0, qz0, uz0, vz0, qsfc, f, lowlyr, u10, v10, t2, psim, psih, fm, &
&  fhh, gz1oz0, wspd, br, chklowq, bl_pbl_physics, ra_lw_physics, dx, &
&  stepbl, warm_rain, kpbl, mixht, ct, lh, snow, xice, znu, znw, mut, &
&  mutd, p_top, ctopo, ctopo2, te_temf, km_temf, kh_temf, shf_temf, &
&  qf_temf, uw_temf, vw_temf, hd_temf, lcl_temf, hct_temf, wupd_temf, &
&  mf_temf, thup_temf, qtup_temf, qlup_temf, exch_temf, cf3d_temf, &
&  cfm_temf, flhc, flqc, qke, qke_adv, bl_mynn_tkeadvect, tsq, qsq, cov, &
&  rmol, ch, qcg, grav_settling, el_mynn, dqke, qwt, qshear, qbuoy, qdiss&
&  , bl_mynn_tkebudget, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme&
&  , kms, kme, i_start, i_end, j_start, j_end, kts, kte, num_tiles, hol, &
&  mol, regime, gwd_opt, dtaux3d, dtaux3dd, dtauy3d, dtauy3dd, dusfcg, &
&  dusfcgd, dvsfcg, dvsfcgd, var2d, oc12d, oa1, oa2, oa3, oa4, ol1, ol2, &
&  ol3, ol4, qv_curr, qv_currd, qc_curr, qr_curr, qi_curr, qs_curr, &
&  qg_curr, rqvblten, rqvbltend, rqcblten, rqcbltend, rqiblten, rqibltend&
&  , rqrblten, rqsblten, rqgblten, f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, &
&  frc_urb2d, a_u_bep, a_v_bep, a_t_bep, a_q_bep, b_u_bep, b_v_bep, &
&  b_t_bep, b_q_bep, sf_bep, vl_bep, sf_sfclay_physics, sf_urban_physics&
&  , tke_pbl, el_pbl, wu_tur, wv_tur, wt_tur, wq_tur, exch_tke&
&  , a_e_bep, b_e_bep, dlg_bep, dl_u_bep, mfshconv, massflux_edkf, &
&  entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, rc_up, u_up, v_up&
&  , frac_up, rc_mf, phb, xlat_u, xlong_u, xlat_v, xlong_v, id, z_at_w, &
&  cldfra_old_mp, cldfra, rthratenlw, tauresx2d, tauresy2d, tpert2d, &
&  qpert2d, wpert2d, wsedl3d, turbtype3d, smaw3d, fnm, fnp, qnc_curr, &
&  f_qnc, qni_curr, f_qni, rqniblten, wstar, delta)

   USE module_state_description, ONLY :                            &
                   YSUSCHEME,MRFSCHEME,GFSSCHEME,MYJPBLSCHEME,ACMPBLSCHEME,&
                   QNSEPBLSCHEME,MYNNPBLSCHEME2,MYNNPBLSCHEME3,BOULACSCHEME,&
                   CAMUWPBLSCHEME,BEPSCHEME,BEP_BEMSCHEME,MYJSFCSCHEME, &
                   SURFDRAGSCHEME, TEMFPBLSCHEME, &
                   p_qi,param_first_scalar

   USE module_model_constants
! *** add new modules of schemes here

   USE g_module_bl_gwdo
   USE g_module_bl_surface_drag

  IMPLICIT NONE
!======================================================================
! Grid structure in physics part of WRF
!----------------------------------------------------------------------
! The horizontal velocities used in the physics are unstaggered
! relative to temperature/moisture variables. All predicted
! variables are carried at half levels except w, which is at full
! levels. Some arrays with names (*8w) are at w (full) levels.
!
!----------------------------------------------------------------------
! In WRF, kms (smallest number) is the bottom level and kme (largest
! number) is the top level.  In your scheme, if 1 is at the top level,
! then you have to reverse the order in the k direction.
!
!         kme      -   half level (no data at this level)
!         kme    ----- full level
!         kme-1    -   half level
!         kme-1  ----- full level
!         .
!         .
!         .
!         kms+2    -   half level
!         kms+2  ----- full level
!         kms+1    -   half level
!         kms+1  ----- full level
!         kms      -   half level
!         kms    ----- full level
!
!======================================================================
! Definitions
!-----------
! Rho_d      dry density (kg/m^3)
! Theta_m    moist potential temperature (K)
! Qv         water vapor mixing ratio (kg/kg)
! Qc         cloud water mixing ratio (kg/kg)
! Qr         rain water mixing ratio (kg/kg)
! Qi         cloud ice mixing ratio (kg/kg)
! Qs         snow mixing ratio (kg/kg)
! QNC        cloud Liq number concentration (#/kg) !For CAMUWPBL scheme
! QNI        cloud ice number concentration (#/kg) !For CAMUWPBL scheme
!-----------------------------------------------------------------
!-- RUBLTEN       U tendency due to
!                 PBL parameterization (m/s^2)
!-- RVBLTEN       V tendency due to
!                 PBL parameterization (m/s^2)
!-- RTHBLTEN      Theta tendency due to
!                 PBL parameterization (K/s)
!-- RQVBLTEN      Qv tendency due to
!                 PBL parameterization (kg/kg/s)
!-- RQCBLTEN      Qc tendency due to
!                 PBL parameterization (kg/kg/s)
!-- RQIBLTEN      Qi tendency due to
!                 PBL parameterization (kg/kg/s)
!-- RQNIBLTEN     Qni tendency due to
!                 PBL parameterization (#/kg/s) !For CAMUWPBL scheme
!-- id            WRF grid id  (optional, only needed by turbine drag schemes)
!-- itimestep     number of time steps
!-- GLW           downward long wave flux at ground surface (W/m^2)
!-- GSW           downward short wave flux at ground surface (W/m^2)
!-- EMISS         surface emissivity (between 0 and 1)
!-- TSK           surface temperature (K)
!-- TMN           soil temperature at lower boundary (K)
!-- XLAND         land mask (1 for land, 2 for water)
!-- ZNT           roughness length (m)
!-- MAVAIL        surface moisture availability (between 0 and 1)
!-- UST           u* in similarity theory (m/s)
!-- MOL           T* (similarity theory) (K)
!-- HOL           PBL height over Monin-Obukhov length
!-- PBLH          PBL height (m)
!-- CAPG          heat capacity for soil (J/K/m^3)
!-- THC           thermal inertia (Cal/cm/K/s^0.5)
!-- SNOWC         flag indicating snow coverage (1 for snow cover)
!-- HFX           upward heat flux at the surface (W/m^2)
!-- QFX           upward moisture flux at the surface (kg/m^2/s)
!-- REGIME        flag indicating PBL regime (stable, unstable, etc.)
!-- exch_m        exchange coefficient for momentum, m^2/s
!-- exch_h        exchange coefficient for heat, K m/s
!-- exch_tke      exchange coeff. for TKE [enhanced], m^2/s (gbmpbl scheme)
!-- rthraten      tendency from radiation, used in GBM PBL scheme
!-- akhs          sfc exchange coefficient of heat/moisture from MYJ
!-- akms          sfc exchange coefficient of momentum from MYJ
!-- tke_pbl       turbulence kinetic energy from PBL schemes (m^2/s^2)
!-- el_pbl        length scale from PBL schemes (m)
!-- wu_tur        turbulent flux of momentum (x) (m^2/s^2)
!-- wv_tur        turbulent flux of momentum (y) (m^2/s^2)
!-- wt_tur        turbulent flux of potential temperature  (K m/s)
!-- wq_tur        turbulent flux of water vapor  (- m/s)
!-- te_temf       Total energy from TEMF BL scheme
!-- km_temf       Exchange coefficient for momentum from TEMF BL scheme
!-- kh_temf       Exchange coefficient for heat from TEMF BL scheme
!-- shf_temf      Sensible heat flux from TEMF BL scheme
!-- qf_temf       Water vapor flux from TEMF BL scheme
!-- uw_temf       Momentum flux in U direction from TEMF BL scheme
!-- vw_temf       Momentum flux in V direction from TEMF BL scheme
!-- wupd_temf     Updraft velocity from TEMF BL scheme
!-- mf_temf       Mass flux from TEMF BL scheme
!-- thup_temf     Updraft thetal from TEMF BL scheme
!-- qtup_temf     Updraft qt from TEMF BL scheme
!-- qlup_temf     Updraft ql from TEMF BL scheme
!-- cf3d_temf     3D cloud fraction from TEMF PBL
!-- cfm_temf      Column cloud fraction from TEMF PBL
!-- exch_temf     Surface exchange coefficient (as for moisture) from TEMF surface layer scheme
!-- flhc          Surface exchange coefficient for heat (for TEMF)
!-- flqc          Surface exchange coefficient for moisture (for TEMF)
!-- thz0          potential temperature at roughness length (K)
!-- uz0           u wind component at roughness length (m/s)
!-- vz0           v wind component at roughness length (m/s)
!-- qsfc          specific humidity at lower boundary (kg/kg)
!-- th2           diagnostic 2-m theta from surface layer and lsm
!-- t2            diagnostic 2-m temperature from surface layer and lsm
!-- q2            diagnostic 2-m mixing ratio from surface layer and lsm
!-- lowlyr        index of lowest model layer above ground
!-- rr            dry air density (kg/m^3)
!-- u_phy         u-velocity interpolated to theta points (m/s)
!-- v_phy         v-velocity interpolated to theta points (m/s)
!-- th_phy        potential temperature (K)
!-- p_phy         pressure (Pa)
!-- pi_phy        exner function (dimensionless)
!-- p8w           pressure at full levels (Pa)
!-- t_phy         temperature (K)
!-- dz8w          dz between full levels (m)
!-- z             height above sea level (m)
!-- DX            horizontal space interval (m)
!-- DT            time step (second)
!-- n_moist       number of moisture species
!-- PSFC          pressure at the surface (Pa)
!-- TSLB
!-- ZS
!-- DZS
!-- num_soil_layers number of soil layer
!-- IFSNOW      ifsnow=1 for snow-cover effects
!-- z_at_w      Height above sea level at layer interfaces (m)
!-- cldfra      Cloud fraction [unitless]
!-- cldfra_old_mp      Cloud fraction [unitless]
!-- rthratenlw  Tendency for LW ( K/s)
!-- tauresx2d   X-COMP OF RESIDUAL STRESS(m^2/s^2)
!-- tauresy2d   Y-COMP OF RESIDUAL STRESS(m^2/s^2)
!-- tpert2d     Convective temperature excess (K)
!-- qpert2d     Convective humidity excess (kg/kg)
!-- wpert2d     Turbulent velocity excess (m/s)
!-- wsedl3d     Sedimentation velocity of stratiform liquid cloud droplet (m/s)
!-- turbtype3d  Turbulent interface types [ no unit ]
!-- smaw3d      Normalized Galperin instability function for momentum  ( 0<= <=4.964 and 1 at neutral ) [no units]
!
!-- P_QV          species index for water vapor
!-- P_QC          species index for cloud water
!-- P_QR          species index for rain water
!-- P_QI          species index for cloud ice
!-- P_QNC         species index for cloud liq number concentration !For CAMUWPBL scheme
!-- P_QNI         species index for cloud ice number concentration !For CAMUWPBL scheme
!-- P_QS          species index for snow
!-- P_QG          species index for graupel
!-- ids           start index for i in domain
!-- ide           end index for i in domain
!-- jds           start index for j in domain
!-- jde           end index for j in domain
!-- kds           start index for k in domain
!-- kde           end index for k in domain
!-- ims           start index for i in memory
!-- ime           end index for i in memory
!-- jms           start index for j in memory
!-- jme           end index for j in memory
!-- kms           start index for k in memory
!-- kme           end index for k in memory
!-- jts           start index for j in tile
!-- jte           end index for j in tile
!-- kts           start index for k in tile
!-- kte           end index for k in tile
!
!******************************************************************
!------------------------------------------------------------------
!
  INTEGER, INTENT(IN) :: bl_pbl_physics, ra_lw_physics, &
&  sf_sfclay_physics, sf_urban_physics
  INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
&  jme, kms, kme, kts, kte, num_tiles
  INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, &
&  j_end
  INTEGER, INTENT(IN) :: itimestep, stepbl
  INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: lowlyr
!
  LOGICAL, INTENT(IN) :: warm_rain
!BSINGH:01/31/2013: Added for CAMUWPBL
  REAL, DIMENSION(kms:kme), OPTIONAL, INTENT(IN) :: znu, znw
!
  REAL, INTENT(IN) :: dt, dx
  REAL, INTENT(IN), OPTIONAL :: bldt
  REAL, INTENT(IN), OPTIONAL :: curr_secs
  LOGICAL, INTENT(IN), OPTIONAL :: adapt_step_flag
  REAL, INTENT(INOUT), OPTIONAL :: bldtacttime
! Optional for Wind Turbine Parameterizations
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
&  phb
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: xlat_u, &
&  xlong_u, xlat_v, xlong_v
!
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: p_phy, &
&  pi_phy, p8w, rho, t_phy, u_phy, v_phy, dz8w, z, th_phy
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: pi_phyd, &
&  p8wd, t_phyd, u_phyd, v_phyd, zd
!1D variables required for CAMUWPBL scheme
  REAL, DIMENSION(kms:kme), INTENT(IN), OPTIONAL :: fnm, fnp
!3D Variables for camuwpbl scheme
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: &
&  z_at_w, cldfra_old_mp, cldfra, rthratenlw, wsedl3d
!2D Variables required by camuwpbl scheme
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: &
&  tauresx2d, tauresy2d, tpert2d, qpert2d, wpert2d
!3D Variables for camuwpbl scheme - out
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL :: &
&  turbtype3d, smaw3d
!
! for grims shallow convection with ysupbl
!
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: wstar
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: delta
!
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xland, ht, psim, psih&
&  , fm, fhh, gz1oz0, br, f, chklowq
!
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: tsk, ust, pblh, &
&  hfx, qfx, znt, qsfc, akhs, akms, mixht, qz0, thz0, uz0, vz0, ct, &
&  grdflx, u10, v10, t2, wspd
!
! for GBM PBL scheme
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
&  rvblten, rthblten, exch_h, exch_m, tke_pbl
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rubltend&
&  , rvbltend, rthbltend
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: wu_tur, &
&  wv_tur, wt_tur, wq_tur
!
!MYNN
!,k_m,k_h,k_q &
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  tsq, qsq, cov, qke, el_mynn, dqke, qwt, qshear, qbuoy, qdiss
  INTEGER, OPTIONAL, INTENT(IN) :: bl_mynn_tkebudget, grav_settling
!ACF-QKE advection start
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  qke_adv
  LOGICAL, OPTIONAL, INTENT(IN) :: bl_mynn_tkeadvect
!ACF-QKE advection end
! for GBM PBL scheme
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  exch_tke
  INTEGER, OPTIONAL :: id
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: qcg, rmol, &
&  ch
!
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT) :: el_pbl
  REAL, INTENT(IN) :: u_frame, v_frame
!
  INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: kpbl
  REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xice, snow, lh
! Bep changes: variable added for urban
! URBAN Landuse fraction
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
&  frc_urb2d
! Implicit component for the momemtum in X-direction
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  a_u_bep
! Implicit component for the momemtum in Y-direction
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  a_v_bep
! Implicit component for the Pot. Temp.
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  a_t_bep
! Implicit component for Moisture
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  a_q_bep
! Implicit component for the TKE
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  a_e_bep
! Explicit component for the momemtum in X-direction
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  b_u_bep
! Explicit component for the momemtum in Y-direction
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  b_v_bep
! Explicit component for the Pot. Temp.
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  b_t_bep
! Explicit component for Moisture
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  b_q_bep
! Explicit component for the TKE
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  b_e_bep
! Height above ground (L_ground in formula (24) of the BLM paper).
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  dlg_bep
! Length scale (lb in formula (22) ofthe BLM paper).
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  dl_u_bep
! urban surface and volumes
! surfaces
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  sf_bep
! volumes
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  vl_bep
! Bep changes end
!  New variables for TEMF scheme
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  te_temf
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
&  km_temf, kh_temf, shf_temf, qf_temf, uw_temf, vw_temf, wupd_temf, &
&  mf_temf, thup_temf, qtup_temf, qlup_temf, cf3d_temf
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: flhc, &
&  flqc
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: hd_temf, &
&  lcl_temf, hct_temf, cfm_temf
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: &
&  exch_temf
!
!
! Optional
!
!
! Flags relating to the optional tendency arrays declared above
! Models that carry the optional tendencies will provdide the
! optional arguments at compile time; these flags all the model
! to determine at run-time whether a particular tracer is in
! use or not.
!
!used in CAMUWPBL
!used in CAMUWPBL
  LOGICAL, INTENT(IN), OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, &
&  f_qnc, f_qni
! optional moisture tracers
! 2 time levels; if only one then use CURR
!used in CAMUWPBL
!rqniblten  used in CAMUWPBL
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  qv_curr, qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qnc_curr, &
&  qni_curr, rqvblten, rqcblten, rqrblten, rqiblten, rqsblten, rqgblten, &
&  rqniblten
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  qv_currd, rqvbltend, rqcbltend, rqibltend
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: hol, mol&
&  , regime
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: mut
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: mutd
!
  INTEGER, OPTIONAL, INTENT(IN) :: gwd_opt
  REAL, OPTIONAL, INTENT(IN) :: p_top
!
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  dtaux3d, dtauy3d
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::&
&  dtaux3dd, dtauy3dd
!
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: dusfcg, &
&  dvsfcg
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: dusfcgd&
&  , dvsfcgd
!
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: var2d, &
&  oc12d, oa1, oa2, oa3, oa4, ol1, ol2, ol3, ol4
! paj
!mchen
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: ctopo, &
&  ctopo2
! Variables and Diagnostic for QNSE and EDKF JP
  INTEGER, INTENT(IN) :: mfshconv
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: &
&  massflux_edkf, entr_edkf, detr_edkf, thl_up, thv_up, rt_up, rv_up, &
&  rc_up, u_up, v_up, frac_up, rc_mf
!  LOCAL  VAR
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: v_phytmp
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: v_phytmpd
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmp
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmpd
  REAL, DIMENSION(ims:ime, jms:jme) :: tskold, ustold, zntold, zol, psfc
! make these allocatable depending on the setting of idiff
! Typically, we try to avoide allocating and deallocating local storage like this
! so as not to fragment the stack. But at this point, the idiff = 1 case is disabled
! (set to 0 for all cases) and has to be set manually by users who want to work with
! it.  When it becomes a more standard option, this should be redone, either defining
! these as state with package clauses to turn them on and off and passing them in,
! or pass in an integer flag that can be used to dimension the arrays to 1:1:1 as
! local variables.  JM 20100316
! Implicit component for the momemtum in X-direction
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_u
! Implicit component for the momemtum in Y-direction
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_v
! Implicit component for the Pot. Temp.
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_t
! Implicit component for the water vapor
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: a_q
! Explicit component for the momemtum in X-direction
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_u
! Explicit component for the momemtum in Y-direction
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_v
! Explicit component for the Pot. Temp.
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_t
! Explicit component for the water vapor
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: b_q
! surfaces
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: sf
! volumes
  REAL, DIMENSION(:, :, :), ALLOCATABLE :: vl
  REAL :: dtmin, dtbl
!
  INTEGER :: initflag
!
  INTEGER :: i, j, k, nk, jj, ij, its, ite, jts, jte
  LOGICAL :: radiation
  LOGICAL :: flag_bep
  LOGICAL :: flag_myjsfc
!flag_qnc,flag_qnc are used in camuwpbl scheme
  LOGICAL :: flag_qv, flag_qc, flag_qr, flag_qi, flag_qs, flag_qg, &
&  flag_qnc, flag_qni
  CHARACTER(len=256) :: message
  REAL :: next_bl_time
  LOGICAL :: run_param, doing_adapt_dt, decided
  LOGICAL :: do_adapt
  INTEGER :: iu_bep, iurb, idiff
  REAL :: seamask, thsk, zzz, unew, vnew, tnew, qnew, umom, vmom
  REAL :: z0, z1, z2, w1, w2
  INTEGER :: min3
  INTEGER :: min2
  INTEGER :: min1
!------------------------------------------------------------------
!
!!!!!!!if using BEP set flag_bep to true
  SELECT CASE  (sf_urban_physics)
  CASE (bepscheme)
    flag_bep = .true.
  CASE (bep_bemscheme)
    flag_bep = .true.
  CASE DEFAULT
    flag_bep = .false.
  END SELECT
  SELECT CASE  (sf_sfclay_physics)
  CASE (myjsfcscheme)
    flag_myjsfc = .true.
  CASE DEFAULT
    flag_myjsfc = .false.
  END SELECT
!
  flag_qv = .false.
  IF (PRESENT(f_qv)) flag_qv = f_qv
  flag_qc = .false.
  IF (PRESENT(f_qc)) flag_qc = f_qc
  flag_qr = .false.
  IF (PRESENT(f_qr)) flag_qr = f_qr
  flag_qi = .false.
  IF (PRESENT(f_qi)) flag_qi = f_qi
  flag_qs = .false.
  IF (PRESENT(f_qs)) flag_qs = f_qs
  flag_qg = .false.
  IF (PRESENT(f_qg)) flag_qg = f_qg
  flag_qnc = .false.
!Used in CAMUWPBL
  IF (PRESENT(f_qnc)) flag_qnc = f_qnc
  flag_qni = .false.
!Used in CAMUWPBL
  IF (PRESENT(f_qni)) flag_qni = f_qni
  IF (bl_pbl_physics .EQ. 0) THEN
    RETURN
  ELSE
! RAINBL in mm (Accumulation between PBL calls)
!
    doing_adapt_dt = .false.
    IF (PRESENT(adapt_step_flag)) THEN
      IF (adapt_step_flag) THEN
        doing_adapt_dt = .true.
        IF (bldtacttime .EQ. 0.) bldtacttime = curr_secs + bldt*60.
      END IF
    END IF
!  Do we run through this scheme or not?
!    Test 1:  If this is the initial model time, then yes.
!                ITIMESTEP=1
!    Test 2:  If the user asked for the pbl to be run every time step, then yes.
!                BLDT=0 or STEPBL=1
!    Test 3:  If not adaptive dt, and this is on the requested pbl frequency, then yes.
!                MOD(ITIMESTEP,STEPBL)=0
!    Test 4:  If using adaptive dt and the current time is past the last requested activate pbl time, then yes.
!                CURR_SECS >= BLDTACTTIME
!  If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
!  to TRUE.  The decided flag says that one of these tests was able to say "yes", run the scheme.
!  We only proceed to other tests if the previous tests all have left decided as FALSE.
!  If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
!  pbl run.
    run_param = .false.
    decided = .false.
    IF (.NOT.decided .AND. itimestep .EQ. 1) THEN
      run_param = .true.
      decided = .true.
    END IF
    IF (PRESENT(bldt)) THEN
      IF (.NOT.decided .AND. (bldt .EQ. 0. .OR. stepbl .EQ. 1)) THEN
        run_param = .true.
        decided = .true.
      END IF
    ELSE IF (.NOT.decided .AND. stepbl .EQ. 1) THEN
      run_param = .true.
      decided = .true.
    END IF
    IF (.NOT.decided .AND. (.NOT.doing_adapt_dt) .AND. MOD(itimestep, &
&        stepbl) .EQ. 0) THEN
      run_param = .true.
      decided = .true.
    END IF
    IF (.NOT.decided .AND. doing_adapt_dt .AND. curr_secs .GE. &
&        bldtacttime) THEN
      run_param = .true.
      decided = .true.
      bldtacttime = curr_secs + bldt*60
    END IF
    IF (run_param) THEN
      radiation = .false.
      IF (ra_lw_physics .GT. 0) radiation = .true.
!----
! CALCULATE CONSTANT
      dtmin = dt/60.
! PBL schemes need PBL time step for updates
      IF (PRESENT(adapt_step_flag)) THEN
        IF (adapt_step_flag) THEN
          do_adapt = .true.
        ELSE
          do_adapt = .false.
        END IF
      ELSE
        do_adapt = .false.
      END IF
      IF (PRESENT(bldt)) THEN
        IF (bldt .EQ. 0) THEN
          dtbl = dt
        ELSE IF (do_adapt) THEN
          IF (curr_secs .LT. 2.*dt) THEN
            CALL WRF_MESSAGE(&
&          'WARNING: When using an adaptive time-step the boundary layer'&
&                       //&
&       ' time-step should be 0 (i.e., equivalent to model time-step).  '&
&                      )
            CALL WRF_MESSAGE(&
&            'In order to proceed, for boundary layer calculations, the '&
&                       //'boundary layer time-step'//&
&                       ' will be rounded to the nearest minute,')
            CALL WRF_MESSAGE('possibly resulting in innacurate results.'&
&                      )
          END IF
          dtbl = bldt*60
        ELSE
          dtbl = dt*stepbl
        END IF
      ELSE
        dtbl = dt*stepbl
      END IF
      idiff = 0
      u_phytmpd = 0.0_8
      v_phytmpd = 0.0_8
! SAVE OLD VALUES
!$OMP PARALLEL DO   &
!$OMP PRIVATE ( ij,i,j,k )
      DO ij=1,num_tiles
        DO j=j_start(ij),j_end(ij)
          DO i=i_start(ij),i_end(ij)
            tskold(i, j) = tsk(i, j)
            ustold(i, j) = ust(i, j)
            zntold(i, j) = znt(i, j)
! REVERSE ORDER IN THE VERTICAL DIRECTION
! testing change later
            DO k=kts,kte
              v_phytmpd(i, k, j) = v_phyd(i, k, j)
              v_phytmp(i, k, j) = v_phy(i, k, j) + v_frame
              u_phytmpd(i, k, j) = u_phyd(i, k, j)
              u_phytmp(i, k, j) = u_phy(i, k, j) + u_frame
            END DO
! PSFC : in Pa
            psfc(i, j) = p8w(i, kms, j)
            IF (kte + 1 .GT. kde) THEN
              min1 = kde
            ELSE
              min1 = kte + 1
            END IF
            DO k=kts,min1
              rthbltend(i, k, j) = 0.0_8
              rthblten(i, k, j) = 0.
              rubltend(i, k, j) = 0.0_8
              rublten(i, k, j) = 0.
              rvbltend(i, k, j) = 0.0_8
              rvblten(i, k, j) = 0.
              IF (PRESENT(rqcblten)) THEN
                rqcbltend(i, k, j) = 0.0_8
                rqcblten(i, k, j) = 0.
              END IF
              IF (PRESENT(rqvblten)) THEN
                rqvbltend(i, k, j) = 0.0_8
                rqvblten(i, k, j) = 0.
              END IF
            END DO
            IF (flag_qi .AND. PRESENT(rqiblten)) THEN
              IF (kte + 1 .GT. kde) THEN
                min2 = kde
              ELSE
                min2 = kte + 1
              END IF
              DO k=kts,min2
                rqibltend(i, k, j) = 0.0_8
                rqiblten(i, k, j) = 0.
              END DO
            END IF
!Following if condition is added for CAMUWPBL scheme
            IF (flag_qni .AND. PRESENT(rqniblten)) THEN
              IF (kte + 1 .GT. kde) THEN
                min3 = kde
              ELSE
                min3 = kte + 1
              END IF
              DO k=kts,min3
                rqniblten(i, k, j) = 0.
              END DO
            END IF
          END DO
        END DO
      END DO
!$OMP END PARALLEL DO
!
!$OMP PARALLEL DO   &
!$OMP PRIVATE ( ij, i,j,k, its, ite, jts, jte, z0, z1, z2, w1, w2, message, initflag )
      DO ij=1,num_tiles
        its = i_start(ij)
        ite = i_end(ij)
        jts = j_start(ij)
        jte = j_end(ij)
        SELECT CASE  (bl_pbl_physics)
        CASE (surfdragscheme)
          CALL WRF_DEBUG(100, 'in G_SURFDRAG scheme')
          CALL G_SURFACE_DRAG(rublten=rublten, rubltend=rubltend, &
&                        rvblten=rvblten, rvbltend=rvbltend, u_phy=u_phy&
&                        , u_phyd=u_phyd, v_phy=v_phy, v_phyd=v_phyd, &
&                        xland=xland, z=z, zd=zd, ht=ht, kpbl2d=kpbl, ids&
&                        =ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=&
&                        kde, ims=ims, ime=ime, jms=jms, jme=jme, kms=kms&
&                        , kme=kme, its=its, ite=ite, jts=jts, jte=jte, &
&                        kts=kts, kte=kte)
        CASE DEFAULT
          WRITE(message, *) &
&          'The pbl option does not exist: bl_pbl_physics = ', &
&          bl_pbl_physics
          CALL WRF_ERROR_FATAL(message)
        END SELECT
        IF (PRESENT(dtaux3d)) THEN
          IF (gwd_opt .EQ. 1) CALL G_GWDO(u3d=u_phytmp, u3dd=u_phytmpd, &
&                                    v3d=v_phytmp, v3dd=v_phytmpd, t3d=&
&                                    t_phy, t3dd=t_phyd, qv3d=qv_curr, &
&                                    qv3dd=qv_currd, p3d=p_phy, p3di=p8w&
&                                    , p3did=p8wd, pi3d=pi_phy, pi3dd=&
&                                    pi_phyd, z=z, zd=zd, rublten=rublten&
&                                    , rubltend=rubltend, rvblten=rvblten&
&                                    , rvbltend=rvbltend, dtaux3d=dtaux3d&
&                                    , dtaux3dd=dtaux3dd, dtauy3d=dtauy3d&
&                                    , dtauy3dd=dtauy3dd, dusfcg=dusfcg, &
&                                    dusfcgd=dusfcgd, dvsfcg=dvsfcg, &
&                                    dvsfcgd=dvsfcgd, var2d=var2d, oc12d=&
&                                    oc12d, oa2d1=oa1, oa2d2=oa2, oa2d3=&
&                                    oa3, oa2d4=oa4, ol2d1=ol1, ol2d2=ol2&
&                                    , ol2d3=ol3, ol2d4=ol4, znu=znu, znw&
&                                    =znw, p_top=&
&                                    p_top, cp=cp, g=g, rd=r_d, rv=r_v, &
&                                    ep1=ep_1, pi=3.141592653, dt=dtbl, &
&                                    dx=dx, kpbl2d=kpbl, itimestep=&
&                                    itimestep, ids=ids, ide=ide, jds=jds&
&                                    , jde=jde, kds=kds, kde=kde, ims=ims&
&                                    , ime=ime, jms=jms, jme=jme, kms=kms&
&                                    , kme=kme, its=its, ite=ite, jts=jts&
&                                    , jte=jte, kts=kts, kte=kte)
        END IF
      END DO
    END IF
  END IF
END SUBROUTINE G_PBL_DRIVER

END MODULE g_module_pbl_driver