! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53 ! ! Differentiation of cumulus_driver in forward (tangent) mode (with options r8): ! variations of useful results: raincv rthcuten pratec rqvcuten ! with respect to varying inputs: th raincv p t rthcuten z pratec ! qv_curr rqvcuten rho dz8w ! RW status of diff variables: th:in raincv:in-out p:in t:in ! rthcuten:in-out z:in pratec:in-out qv_curr:in ! rqvcuten:in-out rho:in dz8w:in !WRF:MEDIATION_LAYER:PHYSICS ! MODULE g_module_cumulus_driver CONTAINS ! Order dependent args for domain, mem, and tile dims ! Order independent args (use VAR= in call) ! --Prognostic ! --Other arguments !Balwinder.Singh@pnnl.gov: Used for CAM's wet scavenging ! Package selection variables ! Optional moisture tracers ! Optional arguments for GD scheme ! Optional output arguments for CAMZM scheme ! Optional arguments for SAS scheme !Kwon for SAS2010 shallow convection ! Optional arguments for NSAS scheme ! Optional moisture and other tendencies ! Optional variables for tiedtke scheme - add by ZCX&YQW ! Optional moisture tracer flags ! Optional trigger function activation variable SUBROUTINE G_CUMULUS_DRIVER(grid, ids, ide, jds, jde, kds, kde, ims, ime& & , jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, i_start, i_end, & & j_start, j_end, kts, kte, num_tiles, u, v, th, thd, t, td, w, p, pd, & & pi, rho, rhod, itimestep, dt, dx, cudt, curr_secs, adapt_step_flag, & & cudtacttime, rainc, raincv, raincvd, pratec, pratecd, nca, z, zd, & & z_at_w, dz8w, dz8wd, mavail, pblh, p8w, psfc, tsk, tke_pbl, ust, & & forcet, forceq, w0avg, stepcu, gsw, cldefi, lowlyr, xland, cu_act_flag& & , warm_rain, hfx, qfx, cldfra, cldfra_mp_all, tpert2d, htop, hbot, & & kpbl, ht, ensdim, maxiens, maxens, maxens2, maxens3, periodic_x, & & periodic_y, evapcdp3d, icwmrdp3d, rprddp3d, & & cu_physics, bl_pbl_physics, sf_sfclay_physics, qv_curr, qv_currd, & & qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qv_prev, qc_prev, qr_prev& & , qi_prev, qs_prev, qg_prev, apr_gr, apr_w, apr_mc, apr_st, apr_as, & & apr_capma, apr_capme, apr_capmi, edt_out, clos_choice, mass_flux, & & xf_ens, pr_ens, cugd_avedx, imomentum, ishallow, cugd_tten, cugd_qvten& & , cugd_qcten, cugd_ttens, cugd_qvtens, gd_cloud, gd_cloud2, cape, zmmu& & , zmmd, zmdt, zmdq, dlf, rliq, pconvb, pconvt, evaptzm, fzsntzm, & & evsntzm, evapqzm, zmflxprc, zmflxsnw, zmntprpd, zmntsnpd, zmeiheat, & & cmfmc, cmfmcdzm, preccdzm, precz, zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu& & , zmvpgd, zmicuu, zmicud, zmicvu, zmicvd, zmdice, zmdliq, dp3d, du3d, & & ed3d, eu3d, md3d, mu3d, dsubcld2d, ideep2d, jt2d, maxg2d, lengath2d, & & k22_shallow, kbcon_shallow, ktop_shallow, xmb_shallow, ktop_deep, & & pgcon, sas_mass_flux, shalconv, shal_pgcon, hpbl2d, evap2d, heat2d, & & mp_physics, rqvcuten, rqvcutend, rqccuten, rqrcuten, rqicuten, & & rqscuten, rqgcuten, rqcncuten, rqincuten, rqvblten, rqvften, rucuten, & & rvcuten, rthcuten, rthcutend, rthraten, rthblten, rthften, mommix, & & store_rand, znu, f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, cfu1, cfd1, dfu1& & , efu1, dfd1, efd1, f_flux, kfeta_trigger) USE module_model_constants USE module_state_description, ONLY: KFSCHEME,BMJSCHEME & ,KFETASCHEME,GDSCHEME & ,G3SCHEME,GFSCHEME & ,P_QC,P_QI,Param_FIRST_SCALAR & ,CAMZMSCHEME, SASSCHEME & ,OSASSCHEME & ,NSASSCHEME, DUCUSCHEME & , CAMMGMPSCHEME & ,TIEDTKESCHEME ! *** add new modules of schemes here #ifdef DM_PARALLEL USE module_dm , ONLY : ntasks_x,ntasks_y,local_communicator,mytask,ntasks #endif USE module_domain , ONLY: domain USE g_module_cu_du , ONLY : DUCU_D USE module_wrf_error , ONLY : wrf_err_message 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) !----------------------------------------------------------------- !-- DT time step (second) !-- CUDT cumulus time step (minute) !-- curr_secs current forecast time (seconds) !-- itimestep number of time step (integer) !-- DX horizontal space interval (m) !-- rr dry air density (kg/m^3) ! !-- RUCUTEN Zonal wind tendency due to ! cumulus scheme precipitation (m/s/s) !-- RVCUTEN Meridional wind tendency due to ! cumulus scheme precipitation (m/s/s) !-- RTHCUTEN Theta tendency due to ! cumulus scheme precipitation (K/s) !-- RQVCUTEN Qv tendency due to ! cumulus scheme precipitation (kg/kg/s) !-- RQRCUTEN Qr tendency due to ! cumulus scheme precipitation (kg/kg/s) !-- RQCCUTEN Qc tendency due to ! cumulus scheme precipitation (kg/kg/s) !-- RQSCUTEN Qs tendency due to ! cumulus scheme precipitation (kg/kg/s) !-- RQICUTEN Qi tendency due to ! cumulus scheme precipitation (kg/kg/s) ! !-- RAINC accumulated total cumulus scheme precipitation (mm) !-- RAINCV time-step cumulus scheme precipitation (mm) !-- PRATEC precipitiation rate from cumulus scheme (mm/s) !-- NCA counter of the cloud relaxation ! time in KF cumulus scheme (integer) !-- 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) !-- t_phy temperature (K) !-- tsk skin temperature (K) !-- tke_pbl turbulent kinetic energy from PBL scheme (m2/s2) !-- ust u* in similarity theory (m/s) !-- w vertical velocity (m/s) !-- moist moisture array (4D - last index is species) (kg/kg) !-- z height above sea level at middle of layers (m) !-- z_at_w height above sea level at layer interfaces (m) !-- dz8w dz between full levels (m) !-- pblh planetary boundary layer height (m) !-- mavail soil moisture availability !-- p8w pressure at full levels (Pa) !-- psfc surface pressure (Pa) !-- p_phy pressure (Pa) !-- pi_phy exner function (dimensionless) ! points (dimensionless) !-- hfx upward heat flux at surface (W/m2) !-- qfx upward moisture flux at surface (kg/m2/s) !-- RTHRATEN radiative temp forcing for Grell-Devenyi scheme !-- RTHBLTEN PBL temp forcing for Grell-Devenyi scheme !-- RQVBLTEN PBL moisture forcing for Grell-Devenyi scheme !-- RTHFTEN !-- RQVFTEN !-- MASS_FLUX !-- XF_ENS !-- PR_ENS !-- warm_rain !-- cldfra cloud fraction !-- cldfra_mp_all cloud fraction !-- CU_ACT_FLAG !-- W0AVG average vertical velocity, (for KF scheme) (m/s) !-- kfeta_trigger namelist for KF trigger (=1, default; =2, moisture-advection-dependent trigger) !-- rho density (kg/m^3) !-- CLDEFI precipitation efficiency (for BMJ scheme) (dimensionless) !-- STEPCU # of fundamental timesteps between convection calls !-- XLAND land-sea mask (1.0 for land; 2.0 for water) !-- LOWLYR index of lowest model layer above the ground !-- XLV0 latent heat of vaporization constant ! used in temperature dependent formula (J/kg) !-- XLV1 latent heat of vaporization constant ! used in temperature dependent formula (J/kg/K) !-- XLS0 latent heat of sublimation constant ! used in temperature dependent formula (J/kg) !-- XLS1 latent heat of sublimation constant ! used in temperature dependent formula (J/kg/K) !-- R_d gas constant for dry air ( 287. J/kg/K) !-- R_v gas constant for water vapor (461 J/k/kg) !-- Cp specific heat at constant pressure (1004 J/k/kg) !-- rvovrd R_v divided by R_d (dimensionless) !-- G acceleration due to gravity (m/s^2) !-- EP_1 constant for virtual temperature ! (R_v/R_d - 1) (dimensionless) !-- pi_phy the exner function, (p/p0)**(R/Cp) (none unit) !-- evapcdp3d Evaporation of deep convective precipitation (kg/kg/s) !-- icwmrdp3d Deep Convection in-cloud water mixing ratio (kg/m2) !-- rprddp3d dq/dt due to deep convective rainout (kg/kg/s) !-- 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 !-- i_start start indices for i in tile !-- i_end end indices for i in tile !-- j_start start indices for j in tile !-- j_end end indices for j in tile !-- kts start index for k in tile !-- kte end index for k in tile !-- num_tiles number of tiles !-- HBOT index of lowest model layer with convection !-- HTOP index of highest model layer with convection !-- LBOT index of lowest model layer with convection !-- LTOP index of highest model layer with convection !-- KPBL layer index of the PBL !-- periodic_x T/F this is using periodic lateral boundaries in the X direction !-- periodic_y T/F this is using periodic lateral boundaries in the Y-direction ! !====================================================================== INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, & & jme, kms, kme, kts, kte, itimestep, num_tiles LOGICAL :: periodic_x, periodic_y TYPE(DOMAIN), INTENT(INOUT) :: grid INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, & & j_end INTEGER, INTENT(IN) :: ensdim, maxiens, maxens, maxens2, maxens3 INTEGER, OPTIONAL, INTENT(IN) :: cugd_avedx, clos_choice, & & bl_pbl_physics, sf_sfclay_physics INTEGER, INTENT(IN) :: cu_physics INTEGER, INTENT(IN) :: stepcu LOGICAL, INTENT(IN) :: warm_rain !BSINGH:01/31/2013: Added for CAMZM REAL, INTENT(IN), OPTIONAL :: pgcon, shal_pgcon, sas_mass_flux INTEGER, INTENT(IN), OPTIONAL :: shalconv INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: lowlyr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: z, dz8w, p8w& & , p, pi, u, v, th, t, rho, w REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: zd, dz8wd, & & pd, thd, td, rhod REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(OUT), OPTIONAL :: & & evapcdp3d, icwmrdp3d, rprddp3d REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: & & z_at_w, cldfra, cldfra_mp_all, tke_pbl REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: w0avg REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: gsw, ht, xland REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainc, raincv, nca& & , htop, hbot, cldefi REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincvd REAL, DIMENSION(kms:kme), OPTIONAL, INTENT(IN) :: znu REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: pratec, & & mavail, pblh, psfc, tsk, tpert2d, ust, hfx, qfx REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: pratecd REAL, DIMENSION(ims:ime, jms:jme) :: tmppratec REAL, DIMENSION(ims:ime, jms:jme) :: tmppratecd INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: kpbl LOGICAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: cu_act_flag INTEGER, INTENT(IN), OPTIONAL :: kfeta_trigger REAL, INTENT(IN) :: dt, dx INTEGER, INTENT(IN), OPTIONAL :: ips, ipe, jps, jpe, kps, kpe, & & imomentum, ishallow REAL, INTENT(IN), OPTIONAL :: cudt REAL, INTENT(IN), OPTIONAL :: curr_secs LOGICAL, INTENT(IN), OPTIONAL :: adapt_step_flag REAL, INTENT(INOUT), OPTIONAL :: cudtacttime REAL :: cudt_pass, curr_secs_pass, cudtacttime_pass LOGICAL :: adapt_step_flag_pass INTEGER, INTENT(IN), OPTIONAL :: mp_physics REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: store_rand ! REAL, OPTIONAL, INTENT(INOUT) :: mommix !Kwon for sas2010 shallow convection REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: hpbl2d, & & evap2d, heat2d ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten, & & rvcuten ! ! optional arguments ! INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: & & k22_shallow, kbcon_shallow, ktop_shallow, ideep2d, jt2d, maxg2d, & & lengath2d INTEGER, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(OUT) :: & & ktop_deep ! optional moisture tracers ! 2 time levels; if only one then use CURR ! optional moisture and other tendencies REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & qv_curr, qc_curr, qr_curr, qi_curr, qs_curr, qg_curr, qv_prev, qc_prev& & , qr_prev, qi_prev, qs_prev, qg_prev, rqvcuten, rqccuten, rqrcuten, & & rqicuten, rqscuten, rqgcuten, rqcncuten, rqincuten, rqvblten, rqvften& & , rthraten, rthblten, cugd_tten, cugd_qvten, cugd_qcten, cugd_ttens, & & cugd_qvtens, forcet, forceq, rthften, rthcuten REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & qv_currd, rqvcutend, rthcutend REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT) :: apr_gr, & & apr_w, apr_mc, apr_st, apr_as, apr_capma, apr_capme, apr_capmi, & & edt_out, xmb_shallow, mass_flux, cape, pconvb, pconvt, preccdzm, precz& & , rliq, dsubcld2d REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & gd_cloud, gd_cloud2, zmmd, zmmu, zmdt, zmdq, dlf, evaptzm, fzsntzm, & & evsntzm, evapqzm, zmflxprc, zmflxsnw, zmntprpd, zmntsnpd, zmeiheat, & & cmfmc, cmfmcdzm, zmmtu, zmmtv, zmupgu, zmupgd, zmvpgu, zmvpgd, zmicuu& & , zmicud, zmicvu, zmicvd, zmdice, zmdliq, dp3d, du3d, ed3d, eu3d, md3d& & , mu3d REAL, DIMENSION(ims:ime, jms:jme, ensdim), OPTIONAL, INTENT(INOUT) :: & & xf_ens, pr_ens REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & cfu1, cfd1, dfu1, efu1, dfd1, efd1 ! ! 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. ! LOGICAL, INTENT(IN), OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg LOGICAL, INTENT(IN), OPTIONAL :: f_flux ! LOCAL VAR INTEGER :: i, j, k, its, ite, jts, jte, ij, trigger_kf LOGICAL :: l_flux LOGICAL :: decided, run_param, doing_adapt_dt !----------------------------------------------------------------- l_flux = .false. IF (PRESENT(f_flux)) l_flux = f_flux IF (.NOT.PRESENT(curr_secs)) THEN curr_secs_pass = -1 ELSE curr_secs_pass = curr_secs END IF IF (.NOT.PRESENT(cudt)) THEN cudt_pass = -1 cudtacttime_pass = -1 ELSE cudt_pass = cudt cudtacttime_pass = cudtacttime END IF IF (.NOT.PRESENT(adapt_step_flag)) THEN adapt_step_flag_pass = .false. ELSE adapt_step_flag_pass = adapt_step_flag END IF ! Initialize tmppratec to pratec IF (PRESENT(pratec)) THEN tmppratecd(:, :) = pratecd(:, :) tmppratec(:, :) = pratec(:, :) ELSE tmppratec(:, :) = 0. tmppratecd = 0.0_8 END IF IF (.NOT.PRESENT(kfeta_trigger)) THEN trigger_kf = 1 ELSE trigger_kf = kfeta_trigger END IF IF (cu_physics .EQ. 0) THEN RETURN ELSE ! Initialization for adaptive time step. IF (adapt_step_flag_pass) THEN doing_adapt_dt = .true. IF (cudtacttime_pass .EQ. 0.) cudtacttime_pass = curr_secs_pass + & & cudt_pass*60. ELSE doing_adapt_dt = .false. 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 cumulus to be run every time step, then yes. ! CUDT=0 or STEPCU=1 ! Test 3: If not adaptive dt, and this is on the requested cumulus frequency, then yes. ! MOD(ITIMESTEP,STEPCU)=0 ! Test 4: If using adaptive dt and the current time is past the last requested activate cumulus time, then yes. ! CURR_SECS >= CUDTACTTIME ! 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 ! cumulus run. decided = .false. run_param = .false. IF (.NOT.decided .AND. itimestep .EQ. 1) THEN run_param = .true. decided = .true. END IF IF (.NOT.decided .AND. (cudt_pass .EQ. 0. .OR. stepcu .EQ. 1)) THEN run_param = .true. decided = .true. END IF IF (.NOT.decided .AND. (.NOT.doing_adapt_dt) .AND. MOD(itimestep, & & stepcu) .EQ. 0) THEN run_param = .true. decided = .true. END IF IF (.NOT.decided .AND. doing_adapt_dt .AND. curr_secs_pass .GE. & & cudtacttime_pass) THEN run_param = .true. decided = .true. cudtacttime_pass = curr_secs_pass + cudt_pass*60 END IF IF (run_param) THEN ! DON'T JUDGE TIME STEP HERE, SINCE KF NEEDS ACCUMULATED W FIELD. ! DO IT INSIDE THE INDIVIDUAL CUMULUS SCHEME ! SET START AND END POINTS FOR TILES !$OMP PARALLEL DO & !$OMP PRIVATE ( ij ,its,ite,jts,jte, i,j,k) DO ij=1,num_tiles its = i_start(ij) ite = i_end(ij) jts = j_start(ij) jte = j_end(ij) SELECT CASE (cu_physics) CASE (ducuscheme) CALL WRF_DEBUG(100, 'in ducu') ! order independent arguments ! ! ! ! ! or XLV=xlv1 ! ! ! RD, RV ! only EP2 needed ! ! ! ! ! from other scheme ! ! ! ! ! optionals CALL DUCU_D(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, dt=dt, ktau=itimestep, dx=dx, rho=rho, rhod=rhod, & & raincv=raincv, raincvd=raincvd, nca=nca, pratec=& & tmppratec, pratecd=tmppratecd, u=u, v=v, th=th, thd=thd& & , t=t, td=td, w=w, dz8w=dz8w, dz8wd=dz8wd, z=z, zd=zd, & & pcps=p, pcpsd=pd, pi=pi, w0avg=w0avg, cp=cp, rd=r_d, rv=& & r_v, g=g, xlv=xlv0, ep2=ep_2, svp1=svp1, svp2=svp2, svp3& & =svp3, svpt0=svpt0, stepcu=stepcu, cu_act_flag=& & cu_act_flag, warm_rain=warm_rain, cutop=htop, cubot=hbot& & , qv=qv_curr, qvd=qv_currd, rthcuten=rthcuten, rthcutend& & =rthcutend, rqvcuten=rqvcuten, rqvcutend=rqvcutend) CASE DEFAULT ! WRITE(wrf_err_message, *) & & 'The cumulus option does not exist: cu_physics = ', cu_physics CALL WRF_ERROR_FATAL(wrf_err_message) END SELECT END DO !$OMP END PARALLEL DO ! Copy pratec back to output array, if necessary. IF (PRESENT(pratec)) THEN pratecd(:, :) = tmppratecd(:, :) pratec(:, :) = tmppratec(:, :) END IF ! Copy cudtacttime back if necessary IF (PRESENT(cudtacttime)) cudtacttime = cudtacttime_pass CALL WRF_DEBUG(200, 'returning from cumulus_driver') ELSE !print *,'calling CU scheme' !print *,'NOT calling CU scheme' RETURN END IF END IF END SUBROUTINE G_CUMULUS_DRIVER END MODULE g_module_cumulus_driver