!        Generated by TAPENADE     (INRIA, Tropics team)
!  Tapenade 3.7 (r4786) - 21 Feb 2013 15:53
!
!  Differentiation of pbl_driver in reverse (adjoint) mode (with options r8):
!   gradient     of useful results: v_phy rublten dusfcg z dvsfcg
!                pi_phy rqvblten dtauy3d rvblten qv_curr t_phy
!                rqcblten rthblten u_phy rqiblten dtaux3d p8w mut
!   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:incr rublten:in-out dusfcg:in-out
!                z:incr dvsfcg:in-out pi_phy:incr rqvblten:in-out
!                dtauy3d:in-out rvblten:in-out qv_curr:incr t_phy:incr
!                rqcblten:in-out rthblten:in-out u_phy:incr rqiblten:in-out
!                dtaux3d:in-out p8w:incr mut:incr
!WRF:MEDIATION_LAYER:PHYSICS
!
MODULE a_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 A_PBL_DRIVER(itimestep, dt, u_frame, v_frame, bldt, curr_secs&
&  , adapt_step_flag, bldtacttime, rublten, rubltenb, rvblten, rvbltenb, &
&  rthblten, rthbltenb, tsk, xland, znt, ht, ust, pblh, hfx, qfx, grdflx&
&  , u_phy, u_phyb, v_phy, v_phyb, th_phy, rho, p_phy, pi_phy, pi_phyb, &
&  p8w, p8wb, t_phy, t_phyb, dz8w, z, zb, 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, &
&  mutb, 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, dtaux3db, dtauy3d, dtauy3db, dusfcg, &
&  dusfcgb, dvsfcg, dvsfcgb, var2d, oc12d, oa1, oa2, oa3, oa4, ol1, ol2, &
&  ol3, ol4, sina,cosa, qv_curr, qv_currb, qc_curr, qr_curr, qi_curr, qs_curr, &
&  qg_curr, rqvblten, rqvbltenb, rqcblten, rqcbltenb, rqiblten, rqibltenb&
&  , 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 module_bl_gwdo
   USE module_bl_surface_drag
   USE a_module_bl_gwdo
   USE a_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) :: pi_phyb, p8wb, t_phyb, &
&  u_phyb, v_phyb, zb
!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) :: rubltenb
  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 :: qv_currb, &
&  rqvbltenb, rqcbltenb, rqibltenb
  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 :: mutb
!
  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 :: dtaux3db, &
&  dtauy3db
!
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: dusfcg, &
&  dvsfcg
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL :: dusfcgb, dvsfcgb
!
  REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: var2d, &
&  oc12d, oa1, oa2, oa3, oa4, ol1, ol2, ol3, ol4, sina, cosa
! 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_phytmpb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmp
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_phytmpb
  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
!------------------------------------------------------------------
!
!!!!!!!if using BEP set flag_bep to true
  INTEGER :: branch
  INTEGER :: ad_to
  INTEGER :: ad_to0
  INTEGER :: ad_from
  INTEGER :: ad_to1
  INTEGER :: ad_from0
  INTEGER :: ad_to2
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rvbltenb
  REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthbltenb
  INTEGER :: min3
  INTEGER :: min2
  INTEGER :: min1
  flag_qi = .false.
  IF (PRESENT(f_qi)) flag_qi = f_qi
  IF (bl_pbl_physics .NE. 0) THEN
! 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) run_param = .true.
    IF (run_param) THEN
!---- 
! CALCULATE CONSTANT
! 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
          dtbl = bldt*60
        ELSE
          dtbl = dt*stepbl
        END IF
      ELSE
        dtbl = dt*stepbl
      END IF
! SAVE OLD VALUES
!$OMP PARALLEL DO   &
!$OMP PRIVATE ( ij,i,j,k )
      DO ij=1,num_tiles
        ad_from0 = j_start(ij)
        DO j=ad_from0,j_end(ij)
          ad_from = i_start(ij)
          DO i=ad_from,i_end(ij)
! REVERSE ORDER IN THE VERTICAL DIRECTION
! testing change later
            DO k=kts,kte
              v_phytmp(i, k, j) = v_phy(i, k, j) + v_frame
              u_phytmp(i, k, j) = u_phy(i, k, j) + u_frame
            END DO
! PSFC : in Pa
            IF (kte + 1 .GT. kde) THEN
              min1 = kde
            ELSE
              min1 = kte + 1
            END IF
            DO k=kts,min1
              rublten(i, k, j) = 0.
              rvblten(i, k, j) = 0.
              IF (PRESENT(rqcblten)) THEN
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHCONTROL1B(1)
              END IF
              IF (PRESENT(rqvblten)) THEN
                CALL PUSHCONTROL1B(0)
              ELSE
                CALL PUSHCONTROL1B(1)
              END IF
            END DO
            CALL PUSHINTEGER4(k - 1)
            IF (flag_qi .AND. PRESENT(rqiblten)) THEN
              IF (kte + 1 .GT. kde) THEN
                min2 = kde
              ELSE
                min2 = kte + 1
              END IF
              k = min2 + 1
              CALL PUSHINTEGER4(k - 1)
              CALL PUSHCONTROL1B(0)
            ELSE
              CALL PUSHCONTROL1B(1)
            END IF
          END DO
          CALL PUSHINTEGER4(i - 1)
          CALL PUSHINTEGER4(ad_from)
        END DO
        CALL PUSHINTEGER4(j - 1)
        CALL PUSHINTEGER4(ad_from0)
      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
        CALL PUSHINTEGER4(its)
        its = i_start(ij)
        CALL PUSHINTEGER4(ite)
        ite = i_end(ij)
        CALL PUSHINTEGER4(jts)
        jts = j_start(ij)
        CALL PUSHINTEGER4(jte)
        jte = j_end(ij)
        SELECT CASE  (bl_pbl_physics) 
        CASE (surfdragscheme) 
          CALL PUSHINTEGER4ARRAY(kpbl, (ime-ims+1)*(jme-jms+1))
          CALL SURFACE_DRAG(rublten=rublten, rvblten=rvblten, u_phy=&
&                      u_phy, v_phy=v_phy, z=z, xland=xland, 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)
          CALL PUSHCONTROL1B(0)
        CASE DEFAULT
          CALL PUSHCONTROL1B(1)
        END SELECT
        IF (PRESENT(dtaux3d)) THEN
          IF (gwd_opt .EQ. 1) THEN
            CALL GWDO(u3d=u_phytmp, v3d=v_phytmp, t3d=t_phy, qv3d=&
&                qv_curr, p3d=p_phy, p3di=p8w, pi3d=pi_phy, z=z, rublten=&
&                rublten, rvblten=rvblten, dtaux3d=dtaux3d, dtauy3d=&
&                dtauy3d, dusfcg=dusfcg, dvsfcg=dvsfcg, var2d=var2d, &
&                oc12d=oc12d, oa2d1=oa1, oa2d2=oa2, oa2d3=oa3, oa2d4=oa4&
&                , ol2d1=ol1, ol2d2=ol2, ol2d3=ol3, ol2d4=ol4, &
&                SINA=sina,COSA=cosa, 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)
            CALL PUSHCONTROL2B(2)
          ELSE
            CALL PUSHCONTROL2B(1)
          END IF
        ELSE
          CALL PUSHCONTROL2B(0)
        END IF
      END DO
      u_phytmpb = 0.0_8
      v_phytmpb = 0.0_8
      DO ij=num_tiles,1,-1
        CALL POPCONTROL2B(branch)
        IF (branch .NE. 0) THEN
          IF (branch .NE. 1) THEN
            ite = i_end(ij)
            its = i_start(ij)
            jte = j_end(ij)
            jts = j_start(ij)
            CALL GWDO_B(u3d=u_phytmp, u3db=u_phytmpb, v3d=v_phytmp, v3db&
&                  =v_phytmpb, t3d=t_phy, t3db=t_phyb, qv3d=qv_curr, &
&                  qv3db=qv_currb, p3d=p_phy, p3di=p8w, p3dib=p8wb, pi3d=&
&                  pi_phy, pi3db=pi_phyb, z=z, zb=zb, rublten=rublten, &
&                  rubltenb=rubltenb, rvblten=rvblten, rvbltenb=rvbltenb&
&                  , dtaux3d=dtaux3d, dtaux3db=dtaux3db, dtauy3d=dtauy3d&
&                  , dtauy3db=dtauy3db, dusfcg=dusfcg, dusfcgb=dusfcgb, &
&                  dvsfcg=dvsfcg, dvsfcgb=dvsfcgb, 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 IF
        CALL POPCONTROL1B(branch)
        IF (branch .EQ. 0) THEN
          CALL POPINTEGER4ARRAY(kpbl, (ime-ims+1)*(jme-jms+1))
          CALL SURFACE_DRAG_B(rublten=rublten, rubltenb=rubltenb, &
&                        rvblten=rvblten, rvbltenb=rvbltenb, u_phy=u_phy&
&                        , u_phyb=u_phyb, v_phy=v_phy, v_phyb=v_phyb, &
&                        xland=xland, z=z, zb=zb, 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)
        END IF
        CALL POPINTEGER4(jte)
        CALL POPINTEGER4(jts)
        CALL POPINTEGER4(ite)
        CALL POPINTEGER4(its)
      END DO
      DO ij=num_tiles,1,-1
        CALL POPINTEGER4(ad_from0)
        CALL POPINTEGER4(ad_to2)
        DO j=ad_to2,ad_from0,-1
          CALL POPINTEGER4(ad_from)
          CALL POPINTEGER4(ad_to1)
          DO i=ad_to1,ad_from,-1
            CALL POPCONTROL1B(branch)
            IF (branch .EQ. 0) THEN
              CALL POPINTEGER4(ad_to0)
              DO k=ad_to0,kts,-1
                rqibltenb(i, k, j) = 0.0_8
              END DO
            END IF
            CALL POPINTEGER4(ad_to)
            DO k=ad_to,kts,-1
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) rqvbltenb(i, k, j) = 0.0_8
              CALL POPCONTROL1B(branch)
              IF (branch .EQ. 0) rqcbltenb(i, k, j) = 0.0_8
              rvbltenb(i, k, j) = 0.0_8
              rubltenb(i, k, j) = 0.0_8
              rthbltenb(i, k, j) = 0.0_8
            END DO
            DO k=kte,kts,-1
              u_phyb(i, k, j) = u_phyb(i, k, j) + u_phytmpb(i, k, j)
              u_phytmpb(i, k, j) = 0.0_8
              v_phyb(i, k, j) = v_phyb(i, k, j) + v_phytmpb(i, k, j)
              v_phytmpb(i, k, j) = 0.0_8
            END DO
          END DO
        END DO
      END DO
    END IF
  END IF
END SUBROUTINE A_PBL_DRIVER

END MODULE a_module_pbl_driver
