! 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& & , tke_budget, 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,MYNNPBLSCHEME,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) :: tke_budget, 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