source: trunk/LMDZ.GENERIC/libf/phystd/thermcell_env.F90 @ 3566

!
!
!
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