! ! ! SUBROUTINE thermcell_env(ngrid,nlay,nq,pq,pt,pu,pv,pplay,pplev, & zqt,zql,zt,ztv,zhl,zu,zv,zpopsk,zqs) !=============================================================================== ! Purpose: calcul des caracteristiques de l'environnement necessaires au calcul ! des proprietes dans le thermique. ! ! Modif 2019/04 (AB alexandre.boissinot@lmd.jussieu.fr) ! ! Nota Bene ! ql means "non-gaseous water mass mixing ratio" (liquid and solid) ! qv means "vapor mass mixing ratio" ! qt means "total water mass mixing ratio" ! TP means "potential temperature" ! TRPV means "virtual potential temperature with latent heat release" ! TPV means "virtual potential temperature" ! TR means "temperature with latent heat release" !=============================================================================== USE print_control_mod, ONLY: prt_level USE thermcell_mod, ONLY: RKAPPA USE watercommon_h, ONLY: RLvCp, RETV, Psat_water USE tracer_h, ONLY: igcm_h2o_vap, igcm_h2o_ice USE callkeys_mod, ONLY: water, generic_condensation USE comcstfi_mod, ONLY: r, cpp, mugaz USE generic_cloud_common_h, ONLY: Psat_generic, epsi_generic, RLVTT_generic USE generic_tracer_index_mod, ONLY: generic_tracer_index IMPLICIT NONE !=============================================================================== ! Declaration !=============================================================================== ! Inputs: ! ------- INTEGER, INTENT(in) :: ngrid INTEGER, INTENT(in) :: nlay INTEGER, INTENT(in) :: nq REAL, INTENT(in) :: pq(ngrid,nlay,nq) ! Large scale water REAL, INTENT(in) :: pt(ngrid,nlay) ! Large scale temperature REAL, INTENT(in) :: pu(ngrid,nlay) ! Large scale zonal wind REAL, INTENT(in) :: pv(ngrid,nlay) ! Large scale meridional wind REAL, INTENT(in) :: pplay(ngrid,nlay) ! Layers pressure REAL, INTENT(in) :: pplev(ngrid,nlay+1) ! Levels pressure REAL, INTENT(in) :: zpopsk(ngrid,nlay) ! Exner function ! Outputs: ! -------- REAL, INTENT(out) :: zt(ngrid,nlay) ! T environment REAL, INTENT(out) :: ztv(ngrid,nlay) ! TRPV environment REAL, INTENT(out) :: zhl(ngrid,nlay) ! TP environment REAL, INTENT(out) :: zu(ngrid,nlay) ! u environment REAL, INTENT(out) :: zv(ngrid,nlay) ! v environment REAL, INTENT(out) :: zqt(ngrid,nlay) ! qt environment REAL, INTENT(out) :: zql(ngrid,nlay) ! ql environment REAL, INTENT(out) :: zqs(ngrid,nlay) ! qsat environment ! Local: ! ------ INTEGER ig, k, iq REAL psat ! Dummy argument for Psat_water() !ALS24 declaration for generic tracer INTEGER :: igcm_generic_vap, igcm_generic_ice! index of the vap and ice of generic_tracer LOGICAL :: call_ice_vap_generic ! to call only one time the ice/vap pair of a tracer REAL, SAVE :: metallicity ! metallicity of planet --- is not used here, but necessary to call function Psat_generic !$OMP THREADPRIVATE(metallicity) REAL :: RETV_generic, RV_generic, RLvCp_generic !=============================================================================== ! Initialization !=============================================================================== zu(:,:) = pu(:,:) zv(:,:) = pv(:,:) zhl(:,:) = pt(:,:) / zpopsk(:,:) zqt(:,:) = 0. zql(:,:) = 0. metallicity=0.0 ! default value --- is not used here but necessary to call function Psat_generic !=============================================================================== ! Condensation and latent heat release !=============================================================================== IF (water) THEN zqt(:,:) = pq(:,:,igcm_h2o_vap) DO k=1,nlay DO ig=1,ngrid CALL Psat_water(pt(ig,k), pplev(ig,k), psat, zqs(ig,k)) ENDDO ENDDO DO k=1,nlay DO ig=1,ngrid zql(ig,k) = max(0.,pq(ig,k,igcm_h2o_vap) - zqs(ig,k)) zt(ig,k) = pt(ig,k) + RLvCp * zql(ig,k) ztv(ig,k) = zt(ig,k) / zpopsk(ig,k) & & * (1. + RETV * (zqt(ig,k)-zql(ig,k)) - zql(ig,k)) ENDDO ENDDO ELSEIF (generic_condensation .AND. .NOT. water ) THEN DO iq=1,nq CALL generic_tracer_index(nq,iq,igcm_generic_vap,igcm_generic_ice,call_ice_vap_generic) IF (call_ice_vap_generic) THEN ! to call only one time the ice/vap pair of a tracer zqt(:,:) = pq(:,:,igcm_generic_vap) DO k = 1,nlay DO ig=1,ngrid CALL Psat_generic(pt(ig,k),pplev(ig,k),metallicity,psat,zqs(ig,k)) ENDDO ENDDO RV_generic = (8.314511*1000.)/(epsi_generic*mugaz) RETV_generic = RV_generic/r-1. RLvCp_generic = RLVTT_generic/cpp DO k = 1,nlay DO ig=1,ngrid zql(ig,k) = max(0.,pq(ig,k,igcm_generic_vap) - zqs(ig,k)) zt(ig,k) = pt(ig,k) + RLvCp_generic * zql(ig,k) ztv(ig,k) = zt(ig,k) / zpopsk(ig,k) & & * (1. + RETV_generic * (zqt(ig,k)-zql(ig,k)) - zql(ig,k)) ENDDO ENDDO ENDIF !call_ice_vap_generic ENDDO!nq ELSE zt(:,:) = pt(:,:) ztv(:,:) = pt(:,:) / zpopsk(:,:) ENDIF RETURN END