conemav.F90

Go to the documentation of this file.

! $Id: conemav.F90 2346 2015-08-21 15:13:46Z emillour $

SUBROUTINE conemav(dtime, paprs, pplay, t, q, u, v, tra, ntra, work1, work2, &
    d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, &
    ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, dplcldr)


  USE dimphy
  USE infotrac_phy, ONLY: nbtr
  IMPLICIT NONE
  ! ======================================================================
  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
  ! Objet: schema de convection de Emanuel (1991) interface
  ! ======================================================================
  ! Arguments:
  ! dtime--input-R-pas d'integration (s)
  ! s-------input-R-la valeur "s" pour chaque couche
  ! sigs----input-R-la valeur "sigma" de chaque couche
  ! sig-----input-R-la valeur de "sigma" pour chaque niveau
  ! psolpa--input-R-la pression au sol (en Pa)
  ! pskapa--input-R-exponentiel kappa de psolpa
  ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
  ! q-------input-R-vapeur d'eau (en kg/kg)

  ! work*: input et output: deux variables de travail,
  ! on peut les mettre a 0 au debut
  ! ALE-----input-R-energie disponible pour soulevement

  ! d_h-----output-R-increment de l'enthalpie potentielle (h)
  ! d_q-----output-R-increment de la vapeur d'eau
  ! rain----output-R-la pluie (mm/s)
  ! snow----output-R-la neige (mm/s)
  ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
  ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
  ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
  ! Cape----output-R-CAPE (J/kg)
  ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
  ! adiabatiquement a partir du niveau 1 (K)
  ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
  ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
  ! ======================================================================


  REAL dtime, paprs(klon, klev+1), pplay(klon, klev)
  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
  REAL tra(klon, klev, nbtr)
  INTEGER ntra
  REAL work1(klon, klev), work2(klon, klev)

  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, klev)
  REAL d_tra(klon, klev, nbtr)
  REAL rain(klon), snow(klon)

  INTEGER kbas(klon), ktop(klon)
  REAL em_ph(klon, klev+1), em_p(klon, klev)
  REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
  REAL ma(klon, klev), cape(klon), tvp(klon, klev)
  INTEGER iflag(klon)
  REAL rflag(klon)
  REAL pbase(klon), bbase(klon)
  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
  REAL dplcldt(klon), dplcldr(klon)

  REAL zx_t, zdelta, zx_qs, zcor

  INTEGER noff, minorig
  INTEGER i, k, itra
  REAL qs(klon, klev)
  REAL, ALLOCATABLE, SAVE :: cbmf(:)
  !$OMP THREADPRIVATE(cbmf)
  INTEGER ifrst
  SAVE ifrst
  DATA ifrst/0/
  !$OMP THREADPRIVATE(ifrst)
  include "YOMCST.h"
  include "YOETHF.h"
  include "FCTTRE.h"


  IF (ifrst==0) THEN
    ifrst = 1
    ALLOCATE (cbmf(klon))
    DO i = 1, klon
      cbmf(i) = 0.
    END DO
  END IF

  DO k = 1, klev + 1
    DO i = 1, klon
      em_ph(i, k) = paprs(i, k)/100.0
    END DO
  END DO

  DO k = 1, klev
    DO i = 1, klon
      em_p(i, k) = pplay(i, k)/100.0
    END DO
  END DO


  DO k = 1, klev
    DO i = 1, klon
      zx_t = t(i, k)
      zdelta = max(0., sign(1.,rtt-zx_t))
      zx_qs = min(0.5, r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
      zcor = 1./(1.-retv*zx_qs)
      qs(i, k) = zx_qs*zcor
    END DO
  END DO

  noff = 2
  minorig = 2
  CALL convect1(klon, klev, klev+1, noff, minorig, t, q, qs, u, v, em_p, &
    em_ph, iflag, d_t, d_q, d_u, d_v, rain, cbmf, dtime, ma)

  DO i = 1, klon
    rain(i) = rain(i)/86400.
    rflag(i) = iflag(i)
  END DO
  ! call dump2d(iim,jjm-1,rflag(2:klon-1),'FLAG CONVECTION   ')
  ! if (klon.eq.1) then
  ! print*,'IFLAG ',iflag
  ! else
  ! write(*,'(96i1)') (iflag(i),i=2,klon-1)
  ! endif
  DO k = 1, klev
    DO i = 1, klon
      d_t(i, k) = dtime*d_t(i, k)
      d_q(i, k) = dtime*d_q(i, k)
      d_u(i, k) = dtime*d_u(i, k)
      d_v(i, k) = dtime*d_v(i, k)
    END DO
    DO itra = 1, ntra
      DO i = 1, klon
        d_tra(i, k, itra) = 0.
      END DO
    END DO
  END DO




  RETURN
END SUBROUTINE conemav