! Generated by TAPENADE (INRIA, Tropics team) ! Tapenade 3.7 (r4786) - 21 Feb 2013 15:53 ! ! Differentiation of microphysics_driver in forward (tangent) mode (with options r8): ! variations of useful results: th rainnc qv_curr rainncv ! with respect to varying inputs: th p rainnc pi_phy qv_curr ! rainncv rho dz8w ! RW status of diff variables: th:in-out p:in rainnc:in-out pi_phy:in ! qv_curr:in-out rainncv:in-out rho:in dz8w:in !WRF:MEDIATION_LAYER:PHYSICS ! *** add new modules of schemes here ! MODULE g_module_microphysics_driver CONTAINS !====================== !Variables required for CAMMGMP Scheme !====================== ! for etampnew or etampold ! for mp_gsfcgce ! ,ccntype & ! for mp_milbrandt2mom ! HM, 9/22/09, add for refl ! YLIN ! Added the RI_CURR array to the call SUBROUTINE G_MICROPHYSICS_DRIVER(th, thd, rho, rhod, pi_phy, pi_phyd, p& & , pd, ht, dz8w, dz8wd, p8w, dt, dx, dy, mp_physics, spec_zone, & & specified, channel_switch, warm_rain, t8w, chem_opt, progn, cldfra, & & cldfra_old, exch_h, nsource, qlsink, precr, preci, precs, precg, xland& & , snowh, itimestep, f_ice_phy, f_rain_phy, f_rimef_phy, lowlyr, sr, id& & , 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, naer, dlf, dlf2, t_phy, p_hyd, p8w_hyd, tke_pbl, z_at_w, & & qfx, rliq, turbtype3d, smaw3d, wsedl3d, cldfra_old_mp, cldfra_mp, & & cldfra_mp_all, cldfrai, cldfral, cldfra_conv, alt, accum_mode, & & aitken_mode, coarse_mode, icwmrsh3d, icwmrdp3d, shfrc3d, cmfmc3d, & & cmfmc2_3d, config_flags, fnm, fnp, rh_old_mp, lcd_old_mp, qv_curr, & & qv_currd, qc_curr, qc_currd, qr_curr, qr_currd, qi_curr, qs_curr, qg_curr, qndrop_curr, & & qni_curr, qh_curr, qnh_curr, qzr_curr, qzi_curr, qzs_curr, qzg_curr, & & qzh_curr, qns_curr, qnr_curr, qng_curr, qnn_curr, qnc_curr, qvolg_curr, qvolh_curr & & , f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, f_qndrop, f_qni, f_qns, f_qnr, & & f_qng, f_qnc, f_qnn, f_qh, f_qnh, f_qzr, f_qzi, f_qzs, f_qzg, f_qzh, & & f_qvolg, f_qvolh, qrcuten, qscuten, qicuten, qt_curr, f_qt, & & mp_restart_state, tbpvs_state, tbpvs0_state, hail, ice2, w, z, rainnc& & , rainncd, rainncv, rainncvd, snownc, snowncv, hailnc, hailncv, & & graupelnc, graupelncv, refl_10cm, ri_curr, diagflag, do_radar_ref) ! Framework USE module_state_description, ONLY : & KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME & ,WSM6SCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT & ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG & ,NSSL_1MOM,NSSL_1MOMLFO & ! ,NSSL_3MOM & ,MILBRANDT2MOM, LSCONDSCHEME, MKESSLERSCHEME, CAMMGMPSCHEME !,MILBRANDT3MOM ! Model Layer USE module_model_constants USE module_wrf_error USE module_configure, only: grid_config_rec_type ! *** add new modules of schemes here USE g_module_mp_nconvp ! added by Zhuxiao USE g_module_mp_mkessler ! For checking model timestep is history time (for radar reflectivity) USE module_utility, ONLY: WRFU_Clock, WRFU_Alarm USE module_domain, ONLY : HISTORY_ALARM, Is_alarm_tstep IMPLICIT NONE ! ,NSSL_3MOM & !,MILBRANDT3MOM ! Model Layer ! *** add new modules of schemes here ! USE module_mp_nconvp ! added by Zhuxiao ! For checking model timestep is history time (for radar reflectivity) !====================================================================== ! 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) ! Qg graupel mixing ratio (kg/kg) ! Qh hail mixing ratio (kg/kg) ! Qndrop droplet number mixing ratio (#/kg) ! Qni cloud ice number concentration (#/kg) ! Qns snow number concentration (#/kg) ! Qnr rain number concentration (#/kg) ! Qng graupel number concentration (#/kg) ! Qnh hail number concentration (#/kg) ! Qzr rain reflectivity (m6/kg) ! Qzi ice reflectivity (m6/kg) ! Qzs snow reflectivity (m6/kg) ! Qzg graupel reflectivity (m6/kg) ! Qzh hail reflectivity (m6/kg) ! Qvolg graupel particle volume (m3/kg) ! Qvolh hail particle volume (m3/kg) ! !---------------------------------------------------------------------- !-- th potential temperature (K) !-- moist_new updated moisture array (kg/kg) !-- moist_old Old moisture array (kg/kg) !-- rho density of air (kg/m^3) !-- pi_phy exner function (dimensionless) !-- p pressure (Pa) !-- RAINNC grid scale precipitation (mm) !-- RAINNCV one time step grid scale precipitation (mm/step) !-- SNOWNC grid scale snow and ice (mm) !-- SNOWNCV one time step grid scale snow and ice (mm/step) !-- GRAUPELNC grid scale graupel (mm) !-- GRAUPELNCV one time step grid scale graupel (mm/step) !-- HAILNC grid scale hail (mm) !-- HAILNCV one time step grid scale hail (mm/step) !-- SR one time step mass ratio of snow to total precip !-- z Height above sea level (m) !-- dt Time step (s) !-- G acceleration due to gravity (m/s^2) !-- CP heat capacity at constant pressure for dry air (J/kg/K) !-- R_d gas constant for dry air (J/kg/K) !-- R_v gas constant for water vapor (J/kg/K) !-- XLS latent heat of sublimation (J/kg) !-- XLV latent heat of vaporization (J/kg) !-- XLF latent heat of melting (J/kg) !-- rhowater water density (kg/m^3) !-- rhosnow snow density (kg/m^3) !-- F_ICE_PHY Fraction of ice. !-- F_RAIN_PHY Fraction of rain. !-- F_RIMEF_PHY Mass ratio of rimed ice (rime factor) !-- t8w temperature at layer interfaces !-- cldfra, cldfra_old, current, previous cloud fraction !-- exch_h vertical diffusivity (m2/s) !-- qlsink Fractional cloud water sink (/s) !-- precr rain precipitation rate at all levels (kg/m2/s) !-- preci ice precipitation rate at all levels (kg/m2/s) !-- precs snow precipitation rate at all levels (kg/m2/s) !-- precg graupel precipitation rate at all levels (kg/m2/s) & !-- 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_QS species index for snow !-- P_QG species index for graupel !-- P_QH species index for hail !-- P_QNDROP species index for cloud drop mixing ratio !-- P_QNR species index for rain number concentration, !-- P_QNI species index for cloud ice number concentration !-- P_QNS species index for snow number concentration, !-- P_QNG species index for graupel number concentration, !-- P_QNH species index for hail number concentration, !-- P_QZR species index for rain reflectivity !-- P_QZI species index for ice reflectivity !-- P_QZS species index for snow reflectivity !-- P_QZG species index for graupel reflectivity !-- P_QZH species index for hail reflectivity !-- P_QVOLG species index for graupel particle volume, !-- P_QVOLH species index for hail particle volume, !-- id grid id number !-- 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 !-- its start index for i in tile !-- ite end index for i in tile !-- 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 !-- num_tiles number of tiles !-- diagflag Logical to tell us when to produce diagnostics for history or restart ! !====================================================================== TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN), OPTIONAL :: config_flags INTEGER, INTENT(IN) :: mp_physics LOGICAL, INTENT(IN) :: specified INTEGER, OPTIONAL, INTENT(IN) :: chem_opt, progn !, ccntype INTEGER, OPTIONAL, INTENT(IN) :: hail, ice2 ! INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde INTEGER, INTENT(IN) :: ims, ime, jms, jme, kms, kme INTEGER, OPTIONAL, INTENT(IN) :: ips, ipe, jps, jpe, kps, kpe INTEGER, INTENT(IN) :: kts, kte INTEGER, INTENT(IN) :: itimestep, num_tiles, spec_zone INTEGER, DIMENSION(num_tiles), INTENT(IN) :: i_start, i_end, j_start, & & j_end LOGICAL, INTENT(IN) :: warm_rain ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: th REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thd ! ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rho, dz8w, & & p8w, pi_phy, p REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rhod, dz8wd& & , pi_phyd, pd !================= !Data for CAMMGMP scheme REAL, INTENT(IN), OPTIONAL :: accum_mode, aitken_mode, coarse_mode !1D variables required for CAMMGMP scheme !Factors for interpolation at "w" grid (interfaces) REAL, DIMENSION(kms:kme), INTENT(IN), OPTIONAL :: fnm, fnp !2D variables required for CAMMGMP scheme !Moisture flux at surface (kg m-2 s-1) !Vertically-integrated reserved cloud condensate(m/s) REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: qfx, rliq !3D variables required for CAMMGMP scheme !Detraining cloud water tendendcy !dq/dt due to export of cloud water into environment by shallow convection(kg/kg/s) !Temprature at the mid points (K) !Hydrostatic pressure(Pa) !Hydrostatic Pressure at level interface (Pa) !Height above sea level at layer interfaces (m) !Turbulence kinetic energy !Turbulent interface types [ no unit ] !Normalized Galperin instability function for momentum ( 0<= <=4.964 and 1 at neutral ) [no units] !inverse density(m3/kg) !Shallow cumulus in-cloud water mixing ratio (kg/m2) !Deep Convection in-cloud water mixing ratio (kg/m2) !Shallow cloud fraction !Deep + Shallow Convective mass flux [ kg /s/m^2 ] !Shallow convective mass flux [ kg/s/m^2 ] REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN), OPTIONAL :: & & dlf, dlf2, t_phy, p_hyd, p8w_hyd, z_at_w, tke_pbl, turbtype3d, smaw3d& & , alt, icwmrsh3d, icwmrdp3d, shfrc3d, cmfmc3d, cmfmc2_3d !In-outs !Old Cloud fraction for CAMMGMP microphysics only !Old RH !Old liquid cloud fraction REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL ::& & cldfra_old_mp, rh_old_mp, lcd_old_mp !In-outs -optional !outs !Sedimentation velocity of stratiform liquid cloud droplet (m/s) !Old Cloud fraction for CAMMGMP microphysics only !Old Cloud fraction for CAMMGMP microphysics only !Old Cloud fraction for CAMMGMP microphysics only !Old Cloud fraction for CAMMGMP microphysics only REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL ::& & wsedl3d, cldfra_mp, cldfra_mp_all, cldfrai, cldfral, cldfra_conv REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: f_ice_phy& & , f_rain_phy, f_rimef_phy !!$#ifdef WRF_CHEM ! REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) :: & !!$#else !!$ REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: & !!$#endif ! cloud water sink (/s) ! rain precipitation rate at all levels (kg/m2/s) ! ice precipitation rate at all levels (kg/m2/s) ! snow precipitation rate at all levels (kg/m2/s) ! graupel precipitation rate at all levels (kg/m2/s) REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: & & qlsink, precr, preci, precs, precg ! REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: xland REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN), OPTIONAL :: snowh REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: sr REAL, INTENT(IN) :: dt, dx, dy INTEGER, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: lowlyr ! ! Optional ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: & & refl_10cm LOGICAL, OPTIONAL, INTENT(IN) :: channel_switch ! aerosol number concentration (/kg) REAL, OPTIONAL, INTENT(INOUT) :: naer REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & w, z, t8w, cldfra, cldfra_old, exch_h, qv_curr, qc_curr, qr_curr, & & qi_curr, qs_curr, qg_curr, qt_curr, qndrop_curr, qni_curr, qh_curr, & & qnh_curr, qns_curr, qnr_curr, qng_curr, qnn_curr, qnc_curr, qzr_curr, & & qzi_curr, qzs_curr, qzg_curr, qzh_curr, qvolg_curr, qvolh_curr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & qv_currd, qc_currd, qr_currd REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(IN) :: & & qrcuten, qscuten, qicuten ! YLIN ! Added RI_CURR similar to microphysics fields above REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT) ::& & ri_curr REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT) :: & & nsource ! REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: rainnc, & & rainncv, snownc, snowncv, graupelnc, graupelncv, hailnc, hailncv REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT), OPTIONAL :: rainncd& & , rainncvd INTEGER, OPTIONAL, INTENT(IN) :: id REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN) :: ht REAL, DIMENSION(:), OPTIONAL, INTENT(INOUT) :: mp_restart_state, & & tbpvs_state, tbpvs0_state ! LOGICAL, OPTIONAL :: f_qv, f_qc, f_qr, f_qi, f_qs, f_qg, f_qndrop, & & f_qni, f_qt, f_qns, f_qnr, f_qng, f_qnn, f_qnc, f_qh, f_qnh, f_qzr, & & f_qzi, f_qzs, f_qzg, f_qzh, f_qvolg, f_qvolh LOGICAL, OPTIONAL, INTENT(IN) :: diagflag INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref ! LOCAL VAR INTEGER :: i, j, k, its, ite, jts, jte, ij, sz, n LOGICAL :: channel REAL :: z0, z1, z2, w1, w2 !--------------------------------------------------------------------- ! check for microphysics type. We need a clean way to ! specify these things! !--------------------------------------------------------------------- channel = .false. IF (PRESENT(channel_switch)) channel = channel_switch IF (mp_physics .EQ. 0) THEN RETURN ELSE IF (specified) THEN sz = spec_zone ELSE sz = 0 END IF !$OMP PARALLEL DO & !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n ) DO ij=1,num_tiles IF (channel) THEN IF (i_start(ij) .LT. ids) THEN its = ids ELSE its = i_start(ij) END IF IF (i_end(ij) .GT. ide - 1) THEN ite = ide - 1 ELSE ite = i_end(ij) END IF ELSE IF (i_start(ij) .LT. ids + sz) THEN its = ids + sz ELSE its = i_start(ij) END IF IF (i_end(ij) .GT. ide - 1 - sz) THEN ite = ide - 1 - sz ELSE ite = i_end(ij) END IF END IF IF (j_start(ij) .LT. jds + sz) THEN jts = jds + sz ELSE jts = j_start(ij) END IF IF (j_end(ij) .GT. jde - 1 - sz) THEN jte = jde - 1 - sz ELSE jte = j_end(ij) END IF ! 2009-06009 rce - zero all these for safety IF (PRESENT(qlsink)) qlsink(its:ite, kts:kte, jts:jte) = 0. IF (PRESENT(precr)) precr(its:ite, kts:kte, jts:jte) = 0. IF (PRESENT(preci)) preci(its:ite, kts:kte, jts:jte) = 0. IF (PRESENT(precs)) precs(its:ite, kts:kte, jts:jte) = 0. IF (PRESENT(precg)) precg(its:ite, kts:kte, jts:jte) = 0. SELECT CASE (mp_physics) CASE (MKESSLERSCHEME) CALL wrf_debug ( 100 , 'microphysics_driver: calling g_mkessler' ) IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND. & PRESENT( QR_CURR ) .AND. & PRESENT( RAINNC ) .AND. PRESENT ( RAINNCV ) .AND. & PRESENT( Z )) THEN CALL g_mkessler( & T=th,TD=thd & ,QV=qv_curr,QVD=qv_currd & ,QC=qc_curr,QCD=qc_currd & ,QR=qr_curr,QRD=qr_currd & ,P=p,PD=pd & ,RHO=rho, RHOD=rhod, PII=pi_phy,PIID=pi_phyd, DT_IN=dt, Z=z & ,XLV=xlv, CP=cp & ,EP2=ep_2,SVP1=svp1,SVP2=svp2 & ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater & ,DZ8W=dz8w & ,RAINNC=rainnc,RAINNCV=rainncv & ,RAINNCD=rainncd,RAINNCVD=rainncvd & ,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 & ) ELSE CALL wrf_error_fatal ( 'arguments not present for calling g_mkessler' ) ENDIF CASE (lscondscheme) ! Added by Zhuxiao, lscond (simplified Large-scale condensation scheme by Jimy ) CALL WRF_DEBUG(100, 'microphysics_driver: calling lscond') IF (PRESENT(qv_curr) .AND. PRESENT(rainnc) .AND. PRESENT(rainncv& & )) THEN ! added CALL LSCOND_D(th=th, thd=thd, p=p, pd=pd, qv=qv_curr, qvd=& & qv_currd, rho=rho, rhod=rhod, pii=pi_phy, piid=pi_phyd& & , r_v=r_v, xlv=xlv, cp=cp, ep2=ep_2, svp1=svp1, svp2=& & svp2, svp3=svp3, svpt0=svpt0, dz8w=dz8w, dz8wd=dz8wd, & & rainnc=rainnc, rainncd=rainncd, rainncv=rainncv, & & rainncvd=rainncvd, 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) ELSE CALL WRF_ERROR_FATAL(& & 'arguments not present for calling lscond') END IF CASE DEFAULT WRITE(wrf_err_message, *) & & 'The microphysics option does not exist: mp_physics = ', & & mp_physics CALL WRF_ERROR_FATAL(wrf_err_message) END SELECT END DO !$OMP END PARALLEL DO CALL WRF_DEBUG(200, 'microphysics_driver: returning from') RETURN END IF END SUBROUTINE G_MICROPHYSICS_DRIVER END MODULE g_module_microphysics_driver