libf/phylmd/concvl.f90

SUBROUTINE concvl(iflag_con, 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, qcondc, wd, pmflxr, pmflxs,&
     da, phi, mp)

  ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
  ! Objet: schema de convection de Emanuel (1991) interface

  USE dimens_m
  USE dimphy
  USE yomcst
  USE yoethf
  USE fcttre

  IMPLICIT NONE

  ! 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

  INTEGER ntrac
  PARAMETER (ntrac=nqmx-2)

  INTEGER, INTENT (IN) :: iflag_con

  REAL, INTENT (IN) :: dtime
  REAL, INTENT (IN) :: paprs(klon, klev+1)
  REAL, INTENT (IN) :: pplay(klon, klev)
  REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
  REAL, INTENT (IN):: tra(klon, klev, ntrac)
  INTEGER ntra
  REAL work1(klon, klev), work2(klon, klev)
  REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)

  REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
       klev)
  REAL d_tra(klon, klev, ntrac)
  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)
  REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
  INTEGER iflag(klon)
  REAL pbase(klon), bbase(klon)
  REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
  REAL dplcldt(klon), dplcldr(klon)
  REAL qcondc(klon, klev)
  REAL wd(klon)

  REAL zx_t, zdelta, zx_qs, zcor

  INTEGER i, k, itra
  REAL qs(klon, klev)
  REAL cbmf(klon)
  SAVE cbmf
  INTEGER ifrst
  SAVE ifrst
  DATA ifrst/0/

  !-----------------------------------------------------------------

  snow(:) = 0

  IF (ifrst==0) THEN
     ifrst = 1
     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
        pmflxs(i, k) = 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


  IF (iflag_con==4) THEN
     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
  ELSE
     ! iflag_con=3 (modif de puristes qui fait la diffce pour la
     ! convergence numerique)
     DO k = 1, klev
        DO i = 1, klon
           zx_t = t(i, k)
           zdelta = max(0., sign(1., rtt-zx_t))
           zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
           zx_qs = min(0.5, zx_qs)
           zcor = 1./(1.-retv*zx_qs)
           zx_qs = zx_qs*zcor
           qs(i, k) = zx_qs
        END DO
     END DO
  END IF

  ! Main driver for convection:
  !             iflag_con = 3  -> equivalent to convect3
  !             iflag_con = 4  -> equivalent to convect1/2

  CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
       tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
       pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
       dnwdbis, qcondc, wd, cape, da, phi, mp)

  DO i = 1, klon
     rain(i) = rain(i)/86400.
  END DO

  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
  END DO
  DO itra = 1, ntra
     DO k = 1, klev
        DO i = 1, klon
           d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
        END DO
     END DO
  END DO
  ! les traceurs ne sont pas mis dans cette version de convect4:
  IF (iflag_con==4) THEN
     DO itra = 1, ntra
        DO k = 1, klev
           DO i = 1, klon
              d_tra(i, k, itra) = 0.
           END DO
        END DO
     END DO
  END IF

END SUBROUTINE concvl
1	guez	17	SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&
2			ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&
3			ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&
4			dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&
5			da, phi, mp)
6	guez	3
7	guez	17	! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
8	guez	13	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
9			! Objet: schema de convection de Emanuel (1991) interface
10	guez	3
11	guez	13	USE dimens_m
12			USE dimphy
13			USE yomcst
14			USE yoethf
15			USE fcttre
16
17			IMPLICIT NONE
18
19			! Arguments:
20			! dtime--input-R-pas d'integration (s)
21			! s-------input-R-la valeur "s" pour chaque couche
22			! sigs----input-R-la valeur "sigma" de chaque couche
23			! sig-----input-R-la valeur de "sigma" pour chaque niveau
24			! psolpa--input-R-la pression au sol (en Pa)
25			! pskapa--input-R-exponentiel kappa de psolpa
26			! h-------input-R-enthalpie potentielle (CpT/P*kappa)
27			! q-------input-R-vapeur d'eau (en kg/kg)
28
29			! work*: input et output: deux variables de travail,
30			! on peut les mettre a 0 au debut
31			! ALE-----input-R-energie disponible pour soulevement
32
33			! d_h-----output-R-increment de l'enthalpie potentielle (h)
34			! d_q-----output-R-increment de la vapeur d'eau
35			! rain----output-R-la pluie (mm/s)
36			! snow----output-R-la neige (mm/s)
37			! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
38			! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
39			! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
40			! Cape----output-R-CAPE (J/kg)
41			! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
42			! adiabatiquement a partir du niveau 1 (K)
43	guez	17	! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
44			! Pa)
45			! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
46			! la glace
47	guez	13
48			INTEGER ntrac
49			PARAMETER (ntrac=nqmx-2)
50
51			INTEGER, INTENT (IN) :: iflag_con
52
53			REAL, INTENT (IN) :: dtime
54	guez	17	REAL, INTENT (IN) :: paprs(klon, klev+1)
55			REAL, INTENT (IN) :: pplay(klon, klev)
56			REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
57			REAL, INTENT (IN):: tra(klon, klev, ntrac)
58	guez	13	INTEGER ntra
59	guez	17	REAL work1(klon, klev), work2(klon, klev)
60			REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
61	guez	13
62	guez	17	REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
63			klev)
64			REAL d_tra(klon, klev, ntrac)
65	guez	13	REAL rain(klon), snow(klon)
66
67			INTEGER kbas(klon), ktop(klon)
68	guez	17	REAL em_ph(klon, klev+1), em_p(klon, klev)
69			REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
70			REAL ma(klon, klev), cape(klon), tvp(klon, klev)
71			REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
72	guez	13	INTEGER iflag(klon)
73			REAL pbase(klon), bbase(klon)
74	guez	17	REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
75	guez	13	REAL dplcldt(klon), dplcldr(klon)
76	guez	17	REAL qcondc(klon, klev)
77	guez	13	REAL wd(klon)
78
79			REAL zx_t, zdelta, zx_qs, zcor
80
81			INTEGER i, k, itra
82	guez	17	REAL qs(klon, klev)
83	guez	13	REAL cbmf(klon)
84			SAVE cbmf
85			INTEGER ifrst
86			SAVE ifrst
87			DATA ifrst/0/
88
89			!-----------------------------------------------------------------
90
91			snow(:) = 0
92
93			IF (ifrst==0) THEN
94			ifrst = 1
95			DO i = 1, klon
96			cbmf(i) = 0.
97			END DO
98			END IF
99
100			DO k = 1, klev + 1
101			DO i = 1, klon
102	guez	17	em_ph(i, k) = paprs(i, k)/100.0
103			pmflxs(i, k) = 0.
104	guez	13	END DO
105			END DO
106
107			DO k = 1, klev
108			DO i = 1, klon
109	guez	17	em_p(i, k) = pplay(i, k)/100.0
110	guez	13	END DO
111			END DO
112
113
114			IF (iflag_con==4) THEN
115			DO k = 1, klev
116	guez	3	DO i = 1, klon
117	guez	17	zx_t = t(i, k)
118			zdelta = max(0., sign(1., rtt-zx_t))
119			zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
120	guez	13	zcor = 1./(1.-retv*zx_qs)
121	guez	17	qs(i, k) = zx_qs*zcor
122	guez	13	END DO
123			END DO
124			ELSE
125			! iflag_con=3 (modif de puristes qui fait la diffce pour la
126			! convergence numerique)
127			DO k = 1, klev
128	guez	3	DO i = 1, klon
129	guez	17	zx_t = t(i, k)
130			zdelta = max(0., sign(1., rtt-zx_t))
131			zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
132			zx_qs = min(0.5, zx_qs)
133	guez	13	zcor = 1./(1.-retv*zx_qs)
134			zx_qs = zx_qs*zcor
135	guez	17	qs(i, k) = zx_qs
136	guez	13	END DO
137			END DO
138			END IF
139	guez	3
140	guez	13	! Main driver for convection:
141			! iflag_con = 3 -> equivalent to convect3
142			! iflag_con = 4 -> equivalent to convect1/2
143	guez	3
144	guez	17	CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
145			tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
146			pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
147			dnwdbis, qcondc, wd, cape, da, phi, mp)
148	guez	3
149	guez	13	DO i = 1, klon
150			rain(i) = rain(i)/86400.
151			END DO
152	guez	3
153	guez	13	DO k = 1, klev
154			DO i = 1, klon
155	guez	17	d_t(i, k) = dtime*d_t(i, k)
156			d_q(i, k) = dtime*d_q(i, k)
157			d_u(i, k) = dtime*d_u(i, k)
158			d_v(i, k) = dtime*d_v(i, k)
159	guez	13	END DO
160			END DO
161			DO itra = 1, ntra
162			DO k = 1, klev
163	guez	3	DO i = 1, klon
164	guez	17	d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
165	guez	13	END DO
166			END DO
167			END DO
168			! les traceurs ne sont pas mis dans cette version de convect4:
169			IF (iflag_con==4) THEN
170			DO itra = 1, ntra
171	guez	3	DO k = 1, klev
172	guez	13	DO i = 1, klon
173	guez	17	d_tra(i, k, itra) = 0.
174	guez	13	END DO
175			END DO
176			END DO
177			END IF
178
179			END SUBROUTINE concvl