!$gpum horizontal klon ngrid
MODULE lmdz_lscp_subgridvarq
   PRIVATE

   LOGICAL, SAVE :: first = .TRUE.  ! first call to ratqs_main
   !$OMP THREADPRIVATE(first)

   REAL, SAVE :: resolmax_glo
   !$OMP THREADPRIVATE(resolmax_glo)

   PUBLIC ratqs_main_first, ratqs_main

CONTAINS

!================================================================
   SUBROUTINE ratqs_main_first(klon, cell_area)
      USE mod_phys_lmdz_para
      IMPLICIT NONE
      INTEGER, INTENT(in) :: klon
      REAL, DIMENSION(klon), INTENT(in) :: cell_area
      REAL :: resolmax

      IF (first) THEN
         resolmax = sqrt(maxval(cell_area))
         CALL reduce_max(resolmax, resolmax_glo)
         CALL bcast(resolmax_glo)
         first = .FALSE.
      END IF

   END SUBROUTINE ratqs_main_first

!=======================================================================
   SUBROUTINE ratqs_main(klon, klev, nbsrf, is_ter, is_lic, pdtphys, &
                         pctsrf, s_pblh, zstd, wake_s, wake_deltaq, &
                         paprs, pplay, t_seri, q_seri, &
                         qtc_cv, sigt_cv, detrain_cv, fm_cv, fqd, fqcomp, &
                         sigd, qsat, &
                         fm_therm, entr_therm, detr_therm, cell_area, &
                         ratqsc, ratqs, ratqs_inter_, sigma_qtherm)

      USE lmdz_lscp_ini, ONLY: prt_level, lunout, iflag_ratqs, iflag_cld_th
      USE lmdz_lscp_ini, ONLY: ratqsbas, ratqshaut
      USE lmdz_lscp_ini, ONLY: tau_ratqs, ratqsp0, ratqsdp

      implicit none

!========================================================================
! Computation of ratqs, the width of the subrid scale water distribution
! (normalized by the mean value of specific humidity)
! that is, sigma=ratqs*qmean
! Various options controled by flags iflag_cld_th and iflag_ratqs
! This routine consists in 2 steps.
! First the "stratiform" ratqs (ratqss, corresponding to stratiform clouds)
! is computed
! Then the total ratqs is calculated either taken equal to ratqss or
! calculated as a combination of ratqss and
! that corresponding to deep convective clouds ratqsc
! (input of the routine, from the deep convection part).
! contact: Frederic Hourdin, frederic.hourdin@lmd.ipsl.fr
!
! References:
!           Hourdin et al. 2013, doi:10.1007/s00382-012-1343-y
!           Madeleine et al. 2020, doi:10.1029/2020MS002046
!========================================================================

! Declarations
!--------------

! Input
      integer, intent(in) :: klon, klev           ! horizontal and vertical dimensions
      integer, intent(in) :: nbsrf, is_ter, is_lic ! number of subgrid tiles and indices for land and landice
      real, intent(in)     :: pdtphys             ! physics time step [s]
      real, dimension(klon, klev + 1), intent(in) :: paprs ! pressure at layer interfaces [Pa]
      real, dimension(klon, klev), intent(in)   :: pplay ! pressure at middle of layers [Pa]
      real, dimension(klon, klev), intent(in)   :: t_seri ! temperature [K]
      real, dimension(klon, klev), intent(in)   :: q_seri ! specific total water [kg/kg]
      real, dimension(klon, klev), intent(in)   :: qsat   ! saturation specific humidity [kg/kg]
      real, dimension(klon, klev), intent(in)   :: entr_therm ! thermal plume entrainment rate * dz [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: detr_therm ! thermal plume detrainment rate * dz [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: qtc_cv     ! total specific moisture in convective saturated draughts  [kg/kg]
      real, dimension(klon, klev), intent(in)   :: sigt_cv    ! surface fraction of convective saturated draughts [-]
      real, dimension(klon, klev), intent(in)   :: detrain_cv ! deep convection detrainment of specific humidity variance [kg/s/m2*(kg/kg)^2]
      real, dimension(klon, klev), intent(in)   :: fm_cv  ! deep convective mass flux [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: fqd    ! specific humidity tendency due to convective precip [kg/kg/s]
      real, dimension(klon, klev), intent(in)   :: fqcomp ! specific humidity tendency due to convective mixed draughts [kg/ks/s]
      real, dimension(klon), intent(in)        :: sigd ! fractional area covered by unsaturated convective downdrafts [-]

      real, dimension(klon, klev + 1), intent(in) :: fm_therm    ! convective mass flux of thermals [kg/s/m2]
      real, dimension(klon, klev), intent(in)    :: wake_deltaq ! difference in humidity between wakes and environment [kg/kg]
      real, dimension(klon), intent(in)         :: wake_s    ! wake fraction area [-]
      real, dimension(klon), intent(in)        :: cell_area ! grid cell area [m2]
      real, dimension(klon, nbsrf), intent(in)   :: pctsrf    ! fraction of each subgrid tiles [0-1]
      real, dimension(klon), intent(in)         :: s_pblh    ! boundary layer height [m]
      real, dimension(klon), intent(in)         :: zstd      ! sub grid orography standard deviation [m]
      real, dimension(klon, klev), intent(in)   :: ratqsc   ! convective ratqs

! Output
      real, dimension(klon, klev), intent(out) :: ratqs    ! ratqs i.e. factor for subgrid standard deviation of humidit
      real, dimension(klon, klev), intent(out) :: ratqs_inter_  ! interactive ratqs
      real, dimension(klon, klev), intent(out) :: sigma_qtherm  ! standard deviation of humidity in thermals [kg/kg]

! local
      integer                    :: i, k
      real, dimension(klon, klev) :: ratqss
      real                       :: facteur, zfratqs1, zfratqs2
      real, dimension(klon, klev) :: ratqs_oro_
      real                       :: resol, fact

! First step: stratiform clouds ratqs (ratqss) computation
!---------------------------------------------------------
! for all options, the background ratqss is computed as a
! function increasing from a value at the ground surface
! (0 or ratqsbas) and a value for the high atmosphere
! (ratqshaut)

      if (iflag_ratqs .eq. 0) then

         ! iflag_ratqs=0 corresponds to LMDZ4 version of the model
         ! with a linear function of pressure

         do k = 1, klev
            do i = 1, klon
               ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)* &
                              min((paprs(i, 1) - pplay(i, k))/(paprs(i, 1) - 30000.), 1.)
            end do
         end do

         ! for iflag_ratqs = 1 or 2, ratqss is constant above 300 hPa (ratqshaut),
         ! and then linearly varies between  600 and 300 hPa and it is either constant (ratqsbas)
         ! for iflag_ratqs=1 or lineary varies (between ratqsbas and 0 at the surface) for iflag_ratqs=2
         ! iflag_ratqs=2 was the option retained for LMDZ5A (see Hourdin et al. 2013)

      else if (iflag_ratqs .eq. 1) then

         do k = 1, klev
            do i = 1, klon
               if (pplay(i, k) .ge. 60000.) then
                  ratqss(i, k) = ratqsbas
               else if ((pplay(i, k) .ge. 30000.) .and. (pplay(i, k) .lt. 60000.)) then
                  ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)*(60000.-pplay(i, k))/(60000.-30000.)
               else
                  ratqss(i, k) = ratqshaut
               end if
            end do
         end do

      else if (iflag_ratqs .eq. 2) then

         do k = 1, klev
            do i = 1, klon
               if (pplay(i, k) .ge. 60000.) then
                  ratqss(i, k) = ratqsbas*(paprs(i, 1) - pplay(i, k))/(paprs(i, 1) - 60000.)
               else if ((pplay(i, k) .ge. 30000.) .and. (pplay(i, k) .lt. 60000.)) then
                  ratqss(i, k) = ratqsbas + (ratqshaut - ratqsbas)*(60000.-pplay(i, k))/(60000.-30000.)
               else
                  ratqss(i, k) = ratqshaut
               end if
            end do
         end do

         ! quadratic dependency upon pressure

      else if (iflag_ratqs == 3) then
         do k = 1, klev
            ratqss(:, k) = ratqsbas + (ratqshaut - ratqsbas) &
                           *min(((paprs(:, 1) - pplay(:, k))/70000.)**2, 1.)
         end do

         ! atan dependency on pressure, ratqsp0 being the pressure
         ! where the transition occurs and ratqsdp controls
         ! the sharpness of the transition. This is the version used
         ! in LMDZ6A (see Madeleine et al. 2020, fig 2).

      else if (iflag_ratqs == 4) then
         do k = 1, klev
            ratqss(:, k) = ratqsbas + 0.5*(ratqshaut - ratqsbas) &
                           *(tanh((ratqsp0 - pplay(:, k))/ratqsdp) + 1.)
         end do

      else if (iflag_ratqs == 5) then
         ! Dependency of ratqs on model resolution (dependency on sqrt(cell_area)
         ! according to high-tropo aircraft obs, A. Borella PhD)
         do k = 1, klev
            do i = 1, klon
               resol = sqrt(cell_area(i))
               fact = sqrt(resol/resolmax_glo)
               ratqss(i, k) = ratqsbas*fact + 0.5*(ratqshaut - ratqsbas)*fact &
                              *(tanh((ratqsp0 - pplay(i, k))/ratqsdp) + 1.)
            end do
         end do

      else if (iflag_ratqs .GE. 10) then

         ! interactive ratqss calculations that depend on cold pools, orography
         ! This should help getting a more realistic ratqs in the low and mid troposphere
         ! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
         ! in the high troposphere.
         ! work of Louis d'Alecon, PhD

         ! background atan ratqs and initialisations
         do k = 1, klev
            do i = 1, klon
               ratqss(i, k) = ratqsbas + 0.5*(ratqshaut - ratqsbas) &
                              *(tanh((ratqsp0 - pplay(i, k))/ratqsdp) + 1.)
               ratqss(i, k) = max(ratqss(i, k), 0.0)
               ratqs_oro_(i, k) = 0.
               ratqs_inter_(i, k) = 0
            end do
         end do

         if ((iflag_ratqs .EQ. 10) .OR. (iflag_ratqs .EQ. 11)) then
            ! interactive ratqs with several sources
            call ratqs_inter(klon, klev, iflag_ratqs, pdtphys, paprs, &
                             ratqsbas, wake_deltaq, wake_s, q_seri, qtc_cv, sigt_cv, &
                             fm_therm, entr_therm, detr_therm, detrain_cv, fm_cv, fqd, fqcomp, sigd, &
                             ratqs_inter_, sigma_qtherm)
            ratqss = ratqss + ratqs_inter_
         else if (iflag_ratqs .EQ. 12) then
            ! contribution of subgrid orography to ratqs
            call ratqs_oro(klon, klev, nbsrf, is_ter, is_lic, pctsrf, zstd, qsat, t_seri, pplay, paprs, ratqs_oro_)
            ratqss = ratqss + ratqs_oro_
         end if

      end if

!  Second step: total ratqs calculation
!----------------------------------------

      if (iflag_cld_th .eq. 1 .or. iflag_cld_th .eq. 2 .or. iflag_cld_th .eq. 4) then

         ! ratqs are a combination of ratqss et ratqsc

         if (prt_level .ge. 9) write (lunout, *) 'PHYLMD NEW TAU_RATQS ', tau_ratqs

         if (tau_ratqs > 1.e-10) then
            facteur = exp(-pdtphys/tau_ratqs)
         else
            facteur = 0.
         end if
         ratqs(:, :) = ratqsc(:, :)*(1.-facteur) + ratqs(:, :)*facteur
         ratqs(:, :) = max(ratqs(:, :), ratqss(:, :))

      else if (iflag_cld_th <= 6) then

         ! ratqs is taken equal to ratqss
         ratqs(:, :) = ratqss(:, :)

      else

         ! additional exploratory combinations of ratqss and ratqsc
         zfratqs1 = exp(-pdtphys/10800.)
         zfratqs2 = exp(-pdtphys/10800.)
         do k = 1, klev
            do i = 1, klon
               if (ratqsc(i, k) .gt. 1.e-10) then
                  ratqs(i, k) = ratqs(i, k)*zfratqs2 + (iflag_cld_th/100.)*ratqsc(i, k)*(1.-zfratqs2)
               end if
               ratqs(i, k) = min(ratqs(i, k)*zfratqs1 + ratqss(i, k)*(1.-zfratqs1), 0.5)
            end do
         end do
      end if

      return
   END SUBROUTINE ratqs_main

!========================================================================
   SUBROUTINE ratqs_inter(klon, klev, iflag_ratqs, pdtphys, paprs, &
                          ratqsbas, wake_deltaq, wake_s, q_seri, qtc_cv, sigt_cv, &
                          fm_therm, entr_therm, detr_therm, detrain_cv, fm_cv, fqd, fqcomp, sigd, &
                          ratqs_inter_, sigma_qtherm)

      USE lmdz_lscp_ini, ONLY: a_ratqs_cv, tau_var, fac_tau, tau_cumul, a_ratqs_wake, dqimpl
      USE lmdz_lscp_ini, ONLY: RG
      USE lmdz_lscp_ini, ONLY: povariance, var_conv
      USE lmdz_thermcell_dq, ONLY: thermcell_dq

      implicit none

!========================================================================
! This routine computes a ratqsbas value through an interactive method
! that accounts for explicit source terms from convection parameterizations
! L. d'Alencon, 25/02/2021
! contact Frederic Hourdin, frederic.hourdin@lmd.ipsl.fr
!         Catherine Rio, catherine.rio@meteo.fr
!
! References:
!    Klein et al. 2005, doi: 10.1029/2004JD005017
!========================================================================

! Declarations

! Input
      integer, intent(in) :: klon, klev                       ! horizontal and vertical dimensions
      integer, intent(in) :: iflag_ratqs                     ! flag that controls ratqs options
      real, intent(in)    :: pdtphys                         ! physics time step [s]
      real, intent(in)    :: ratqsbas                        ! ratqs value near the surface [-]
      real, dimension(klon, klev + 1), intent(in) :: paprs      ! pressure at layers'interface [Pa]
      real, dimension(klon, klev), intent(in)   :: wake_deltaq ! difference in humidity between wakes and environment [kg/kg]
      real, dimension(klon, klev), intent(in)   :: q_seri     ! total water specific humidity [kg/kg]
      real, dimension(klon), intent(in)        :: wake_s     ! fractional area covered by wakes [-]
      real, dimension(klon, klev + 1), intent(in) :: fm_therm   ! mass flux in thermals [kg/m2/s]
      real, dimension(klon, klev), intent(in)   :: entr_therm ! thermal plume entrainment rate * dz [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: detr_therm ! thermal plume detrainment rate * dz [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: qtc_cv     ! total specific moisture in convective saturated draughts  [kg/kg]
      real, dimension(klon, klev), intent(in)   :: sigt_cv    ! surface fraction of convective saturated draughts [-]
      real, dimension(klon, klev), intent(in)   :: detrain_cv ! deep convection detrainment of specific humidity variance [kg/s/m2*(kg/kg)^2]
      real, dimension(klon, klev), intent(in)   :: fm_cv  ! deep convective mass flux [kg/s/m2]
      real, dimension(klon, klev), intent(in)   :: fqd    ! specific humidity tendency due to convective precip [kg/kg/s]
      real, dimension(klon, klev), intent(in)   :: fqcomp ! specific humidity tendency due to convective mixed draughts [kg/ks/s]
      real, dimension(klon), intent(in)        :: sigd   ! fractional area covered by unsaturated convective downdrafts [-]

! Inout and output
      real, dimension(klon, klev), intent(inout) :: ratqs_inter_
      real, dimension(klon, klev), intent(out)  :: sigma_qtherm

! local
      LOGICAL, PARAMETER :: klein = .false.
      LOGICAL, PARAMETER :: klein_conv = .true.
      REAL, PARAMETER :: taup0 = 70000
      REAL, PARAMETER :: taudp = 500
      integer :: lev_out
      REAL, DIMENSION(klon, klev) :: zmasse, entr0, detr0, detraincv, dqp, detrain_p, q0, qd0, tau_diss
      REAL, DIMENSION(klon, klev + 1) :: fm0
      integer i, k
      real, dimension(klon, klev) :: wake_dq

      real, dimension(klon) :: max_sigd, max_dqconv, max_sigt
      real, dimension(klon, klev) :: zoa, zocarrea, pdocarreadj, pocarre, po, pdoadj, varq_therm
      real, dimension(klon, klev) :: var_moy, var_var, var_desc_th, var_det_conv, var_desc_prec, var_desc_conv

      lev_out = 0.

! Computation of layers' mass
!-----------------------------------------------------------------------

      do k = 1, klev
         zmasse(:, k) = (paprs(:, k) - paprs(:, k + 1))/RG
      end do

! Computation of detrainment term of humidity variance due to thermal plumes
!---------------------------------------------------------------------------

! initialisations

      do k = 1, klev
         do i = 1, klon
            tau_diss(i, k) = tau_var + 0.5*fac_tau*tau_var*(tanh((taup0 - paprs(i, k))/taudp) + 1.)
         end do
      end do

      entr0(:, :) = entr_therm(:, :)
      fm0(:, :) = fm_therm(:, :)
      detr0(:, :) = detr_therm(:, :)

! computation of the square of specific humidity and circulation in thermals
      po(:, :) = q_seri(:, :)
      call thermcell_dq(klon, klev, dqimpl, pdtphys, fm0, entr0, zmasse,  &
     &                   po, pdoadj, zoa, lev_out)
      do k = 1, klev
         do i = 1, klon
            pocarre(i, k) = po(i, k)*po(i, k) + povariance(i, k)
         end do
      end do
      call thermcell_dq(klon, klev, dqimpl, pdtphys, fm0, entr0, zmasse,  &
      &                   pocarre, pdocarreadj, zocarrea, lev_out)

! variance of total specific humidity in thermals
      do k = 1, klev
         do i = 1, klon
            varq_therm(i, k) = zocarrea(i, k) - zoa(i, k)*zoa(i, k)
         end do
      end do

! computation of source terms of variance due to thermals and deep convection (see Klein et al. 2005)
      do k = 1, klev
         do i = 1, klon
            var_moy(i, k) = detr0(i, k)*((zoa(i, k) - po(i, k))**2)/zmasse(i, k)
            var_var(i, k) = detr0(i, k)*(varq_therm(i, k) - povariance(i, k))/zmasse(i, k)
            var_det_conv(i, k) = a_ratqs_cv*(detrain_cv(i, k)/zmasse(i, k))
            if (sigd(i) .ne. 0) then
               var_desc_prec(i, k) = sigd(i)*(1 - sigd(i))*(fqd(i, k)*tau_cumul/sigd(i))**2/tau_cumul
            else
               var_desc_prec(i, k) = 0
            end if
         end do
      end do

      do k = 1, klev - 1
         do i = 1, klon
            var_desc_th(i, k) = fm0(i, k + 1)*povariance(i, k + 1)/zmasse(i, k) - &
                                fm0(i, k)*povariance(i, k)/zmasse(i, k)
            var_desc_conv(i, k) = ((povariance(i, k + 1) - povariance(i, k))*(fm_cv(i, k)/zmasse(i, k)))
         end do
      end do
      var_desc_th(:, klev) = var_desc_th(:, klev - 1)
      var_desc_conv(:, klev) = var_desc_conv(:, klev - 1)

      if (klein) then
         do k = 1, klev - 1
            do i = 1, klon
               qd0(:, :) = 0.0
               if (sigd(i) .ne. 0) then
                  qd0(i, k) = fqd(i, k)*tau_cumul/sigd(i)
               end if
            end do
         end do
         do k = 1, klev - 1
            do i = 1, klon
               povariance(i, k) = (var_moy(i, k) + var_var(i, k) + var_desc_th(i, k) + &
                                   var_det_conv(i, k) + var_desc_prec(i, k) &
                                   + var_desc_conv(i, k))*pdtphys + povariance(i, k)
               povariance(i, k) = povariance(i, k)*exp(-pdtphys/tau_diss(i, k))
            end do
         end do
         povariance(:, klev) = povariance(:, klev - 1)

      else ! direct computation
         qd0(:, :) = 0.0
         q0(:, :) = 0.0
         do k = 1, klev - 1
            do i = 1, klon
               if (sigd(i) .ne. 0) then    ! variance terms through accumulation
                  qd0(i, k) = fqd(i, k)*tau_cumul/sigd(i)
               end if
               if (sigt_cv(i, k) .ne. 0) then
                  q0(i, k) = fqcomp(i, k)*tau_cumul/sigt_cv(i, k)
               end if
            end do
         end do
         do k = 1, klev - 1
            do i = 1, klon
               povariance(i, k) = (pdocarreadj(i, k) - 2.*po(i, k)*pdoadj(i, k) + &
                                   a_ratqs_cv*(sigt_cv(i, k)*(1 - sigt_cv(i, k))*q0(i, k)**2/tau_cumul + var_desc_prec(i, k) + &
                                               var_desc_conv(i, k)))*pdtphys + povariance(i, k)
               povariance(i, k) = povariance(i, k)*exp(-pdtphys/tau_diss(i, k))
            end do
         end do
         povariance(:, klev) = povariance(:, klev - 1)
!         fqd(:,:)=sigt_cv(:,:)*(1-sigt_cv(:,:))*q0(:,:)**2/tau_cumul
      end if

!  Final ratqs_inter_ computation
!-------------------------------------------------------------------------

      do k = 1, klev
         do i = 1, klon
            if (q_seri(i, k) .ge. 1E-7) then
               ratqs_inter_(i, k) = abs(povariance(i, k))**0.5/q_seri(i, k)
               sigma_qtherm(i, k) = abs(varq_therm(i, k))**0.5     ! sigma in thermals
            else
               ratqs_inter_(i, k) = 0.
               sigma_qtherm(i, k) = 0.
            end if
         end do
      end do

      return

   END SUBROUTINE ratqs_inter

!===========================================================================
   SUBROUTINE ratqs_oro(klon, klev, nbsrf, is_ter, is_lic, pctsrf, zstd, qsat, temp, pplay, paprs, ratqs_oro_)

!--------------------------------------------------------------------------
! This routine computes the dependency of ratqs on the relief over lands.
! It considers the variability of q explained by temperature, hence qsat,
! variations due to subgrid relief.
! contact E. Vignon, etienne.vignon@lmd.ipsl.fr
!--------------------------------------------------------------------------

      USE lmdz_lscp_ini, ONLY: RG, RV, RD, RLSTT, RLVTT, RTT

      IMPLICIT NONE

! Declarations
!--------------

! Input

      INTEGER, INTENT(IN) :: klon                       ! number of horizontal grid points
      INTEGER, INTENT(IN) :: klev                       ! number of vertical layers
      INTEGER, INTENT(IN) :: nbsrf                      ! number of subgrid tiles
      INTEGER, INTENT(IN) :: is_ter, is_lic              ! indices for landice and land tiles
      REAL, DIMENSION(klon, nbsrf) :: pctsrf             ! fraction of different tiles [0-1]
      REAL, DIMENSION(klon, klev), INTENT(IN) :: qsat    ! saturation specific humidity [kg/kg]
      REAL, DIMENSION(klon), INTENT(IN) :: zstd         ! sub grid orography standard deviation [m]
      REAL, DIMENSION(klon, klev), INTENT(IN) :: temp    ! air temperature [K]
      REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay   ! air pressure, layer's center [Pa]
      REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! air pressure, lower inteface [Pa]

! Output

      REAL, DIMENSION(klon, klev), INTENT(out) :: ratqs_oro_ ! ratqs profile due to subgrid orography

! Local

      INTEGER :: i, k
      REAL, DIMENSION(klon) :: orogradT, xsi0
      REAL, DIMENSION(klon, klev) :: zlay
      REAL :: Lvs, temp0

! Calculation of the near-surface temperature gradient along the topography
!--------------------------------------------------------------------------

! at the moment, we fix it at a constant value (moist adiab. lapse rate)

      orogradT(:) = -6.5/1000. ! K/m

! Calculation of near-surface surface ratqs
!-------------------------------------------

      DO i = 1, klon
         temp0 = temp(i, 1)
         IF (temp0 .LT. RTT) THEN
            Lvs = RLSTT
         ELSE
            Lvs = RLVTT
         END IF
         xsi0(i) = zstd(i)*ABS(orogradT(i))*Lvs/temp0/temp0/RV
         ratqs_oro_(i, 1) = xsi0(i)
      END DO

! Vertical profile of ratqs assuming an exponential decrease with height
!------------------------------------------------------------------------

! calculation of geop. height AGL
      zlay(:, 1) = RD*temp(:, 1)/(0.5*(paprs(:, 1) + pplay(:, 1))) &
                   *(paprs(:, 1) - pplay(:, 1))/RG

      DO k = 2, klev
         DO i = 1, klon
            zlay(i, k) = zlay(i, k - 1) + RD*0.5*(temp(i, k - 1) + temp(i, k)) &
                         /paprs(i, k)*(pplay(i, k - 1) - pplay(i, k))/RG

            ratqs_oro_(i, k) = MAX(0.0, pctsrf(i, is_ter)*xsi0(i)*exp(-zlay(i, k)/MAX(zstd(i), 1.)))
         END DO
      END DO

   END SUBROUTINE ratqs_oro
!===========================================================================

END MODULE lmdz_lscp_subgridvarq
