phylmd/Conflx/conflx.f

module conflx_m

  IMPLICIT none

contains

  SUBROUTINE conflx (dtime, pres_h, pres_f, t, q, con_t, con_q, qhfl, w, &
       d_t, d_q, rain, snow, mfu, mfd, pen_u, pde_u, pen_d, pde_d, kcbot, &
       kctop, kdtop, pmflxr, pmflxs)

    ! From LMDZ4/libf/phylmd/conflx.F, version 1.1.1.1 2004/05/19 12:53:08

    ! Author: Z. X. Li (LMD/CNRS)
    ! Date: 1994/10/14

    ! Objet: schéma en flux de masse pour la convection (schéma de
    ! Tiedtke avec quelques modifications mineures)

    ! Décembre 1997 : prise en compte des modifications introduites
    ! par Olivier Boucher et Alexandre Armengaud pour le mélange et le
    ! lessivage des traceurs passifs.

    use flxmain_m, only: flxmain
    USE dimphy, ONLY: klev, klon
    USE suphec_m, ONLY: rd, retv, rtt
    USE yoethf_m, ONLY: r2es
    USE fcttre, ONLY: foeew

    REAL, intent(in):: dtime ! pas d'integration (s)
    REAL, intent(in):: pres_h(:, :) ! (klon, klev+1) pression half-level (Pa)
    REAL, intent(in):: pres_f(:, :) ! (klon, klev) pression full-level (Pa)
    REAL, intent(in):: t(:, :) ! (klon, klev) temperature (K)
    REAL, intent(in):: q(:, :) ! (klon, klev) humidité spécifique (no dimension)

    REAL, intent(in):: con_t(:, :)
    ! (klon, klev) convergence de temperature (K/s)

    REAL, intent(in):: con_q(:, :) 
    ! (klon, klev) convergence de l'eau vapeur (g/g/s)

    REAL, intent(in):: qhfl(:) ! (klon) evaporation (negative vers haut) mm/s
    REAL, intent(in):: w(:, :) ! (klon, klev) vitesse verticale (Pa/s)

    REAL, intent(out):: d_t(:, :) ! (klon, klev) incrementation de temperature
    REAL, intent(out):: d_q(:, :) ! (klon, klev) incrementation d'humidite
    REAL, intent(out):: rain(:) ! (klon) pluie (mm/s)
    REAL, intent(out):: snow(:) ! (klon) neige (mm/s)

    REAL, intent(out):: mfu(:, :) ! (klon, klev)
    ! flux de masse (kg/m2/s) panache ascendant

    REAL, intent(out):: mfd(:, :) ! (klon, klev)
    ! flux de masse (kg/m2/s) panache descendant

    REAL, intent(out):: pen_u(:, :) ! (klon, klev)
    REAL, intent(out):: pde_u(:, :) ! (klon, klev)
    REAL, intent(out):: pen_d(:, :) ! (klon, klev)
    REAL, intent(out):: pde_d(:, :) ! (klon, klev)
    INTEGER, intent(out):: kcbot(:) ! (klon) niveau du bas de la convection
    INTEGER, intent(out):: kctop(:) ! (klon) niveau du haut de la convection
    INTEGER, intent(out):: kdtop(:) ! (klon) niveau du haut des downdrafts
    REAL, intent(out):: pmflxr(:, :) ! (klon, klev+1)
    REAL, intent(out):: pmflxs(:, :) ! (klon, klev+1)

    ! Local:

    REAL qsen(klon, klev)
    REAL pvervel(klon, klev)
    LOGICAL land(klon)

    REAL d_t_bis(klon, klev)
    REAL d_q_bis(klon, klev)
    REAL paprs(klon, klev+1)
    REAL paprsf(klon, klev)
    REAL zgeom(klon, klev)
    REAL zcvgq(klon, klev)
    REAL zcvgt(klon, klev)

    REAL zen_u(klon, klev)
    REAL zen_d(klon, klev)
    REAL zde_u(klon, klev)
    REAL zde_d(klon, klev)
    REAL zmflxr(klon, klev+1)
    REAL zmflxs(klon, klev+1)

    INTEGER i, k
    REAL zqsat

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

    ! initialiser les variables de sortie (pour securite)
    DO i = 1, klon
       rain(i) = 0.0
       snow(i) = 0.0
       kcbot(i) = 0
       kctop(i) = 0
       kdtop(i) = 0
    ENDDO
    DO k = 1, klev
       DO i = 1, klon
          d_t(i, k) = 0.0
          d_q(i, k) = 0.0
          pen_u(i, k) = 0.0
          pde_u(i, k) = 0.0
          pen_d(i, k) = 0.0
          pde_d(i, k) = 0.0
          zen_u(i, k) = 0.0
          zde_u(i, k) = 0.0
          zen_d(i, k) = 0.0
          zde_d(i, k) = 0.0
       ENDDO
    ENDDO
    DO k = 1, klev+1
       DO i = 1, klon
          zmflxr(i, k) = 0.0
          zmflxs(i, k) = 0.0
       ENDDO
    ENDDO

    ! calculer la nature du sol (pour l'instant, ocean partout)
    DO i = 1, klon
       land(i) = .FALSE.
    ENDDO

    ! preparer les variables d'entree (attention: l'ordre des niveaux
    ! verticaux augmente du haut vers le bas)
    DO k = 1, klev
       DO i = 1, klon
          paprsf(i, k) = pres_f(i, klev-k+1)
          paprs(i, k) = pres_h(i, klev+1-k+1)
          pvervel(i, k) = w(i, klev+1-k)
          zcvgt(i, k) = con_t(i, klev-k+1)
          zcvgq(i, k) = con_q(i, klev-k+1)

          zqsat = MIN(0.5, R2ES * FOEEW(t(i, k), &
               merge(0., 1., rtt < t(i, k))) / paprsf(i, k))
          qsen(i, k) = zqsat / (1. - RETV * zqsat)
       ENDDO
    ENDDO
    DO i = 1, klon
       paprs(i, klev+1) = pres_h(i, 1)
       zgeom(i, klev) = RD * t(i, klev) &
            / (0.5*(paprs(i, klev+1)+paprsf(i, klev))) &
            * (paprs(i, klev+1)-paprsf(i, klev))
    ENDDO
    DO k = klev-1, 1, -1
       DO i = 1, klon
          zgeom(i, k) = zgeom(i, k+1) &
               + RD * 0.5*(t(i, k+1)+t(i, k)) / paprs(i, k+1) &
               * (paprsf(i, k+1)-paprsf(i, k))
       ENDDO
    ENDDO

    ! Appeler la routine principale :
    CALL flxmain(dtime, t, q, qsen, qhfl, paprsf, paprs, zgeom, land, &
         zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, mfu, mfd, &
         zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)

    ! De la même façon que l'on effectue le réindiçage pour la
    ! température t et le champ q, on réindice les flux nécessaires à
    ! la convection des traceurs.
    DO k = 1, klev
       DO i = 1, klon
          d_q(i, klev+1-k) = dtime*d_q_bis(i, k)
          d_t(i, klev+1-k) = dtime*d_t_bis(i, k)
       ENDDO
    ENDDO

    mfu = eoshift(mfu, shift=1, dim=2)
    mfd = eoshift(mfd, shift=1, dim=2)
    pen_d(:, 1)= 0.
    pde_d(:, 1)= 0.

    DO k = 1, klev
       DO i = 1, klon
          pen_u(i, klev+1-k)= zen_u(i, k)
          pde_u(i, klev+1-k)= zde_u(i, k)
       ENDDO
    ENDDO

    DO k = 1, klev-1
       DO i = 1, klon
          pen_d(i, klev+1-k)= -zen_d(i, k+1)
          pde_d(i, klev+1-k)= -zde_d(i, k+1)
       ENDDO
    ENDDO

    DO k = 1, klev+1
       DO i = 1, klon
          pmflxr(i, klev+2-k)= zmflxr(i, k)
          pmflxs(i, klev+2-k)= zmflxs(i, k)
       ENDDO
    ENDDO

  END SUBROUTINE conflx

end module conflx_m
1	guez	62	module conflx_m
2	guez	3
3	guez	62	IMPLICIT none
4	guez	3
5	guez	62	contains
6	guez	3
7	guez	70	SUBROUTINE conflx (dtime, pres_h, pres_f, t, q, con_t, con_q, qhfl, w, &
8	guez	71	d_t, d_q, rain, snow, mfu, mfd, pen_u, pde_u, pen_d, pde_d, kcbot, &
9	guez	62	kctop, kdtop, pmflxr, pmflxs)
10	guez	3
11	guez	62	! From LMDZ4/libf/phylmd/conflx.F, version 1.1.1.1 2004/05/19 12:53:08
12	guez	3
13	guez	62	! Author: Z. X. Li (LMD/CNRS)
14	guez	70	! Date: 1994/10/14
15	guez	52
16	guez	70	! Objet: schéma en flux de masse pour la convection (schéma de
17	guez	62	! Tiedtke avec quelques modifications mineures)
18	guez	52
19	guez	62	! Décembre 1997 : prise en compte des modifications introduites
20	guez	70	! par Olivier Boucher et Alexandre Armengaud pour le mélange et le
21	guez	62	! lessivage des traceurs passifs.
22
23			use flxmain_m, only: flxmain
24			USE dimphy, ONLY: klev, klon
25			USE suphec_m, ONLY: rd, retv, rtt
26			USE yoethf_m, ONLY: r2es
27			USE fcttre, ONLY: foeew
28
29	guez	70	REAL, intent(in):: dtime ! pas d'integration (s)
30			REAL, intent(in):: pres_h(:, :) ! (klon, klev+1) pression half-level (Pa)
31			REAL, intent(in):: pres_f(:, :) ! (klon, klev) pression full-level (Pa)
32			REAL, intent(in):: t(:, :) ! (klon, klev) temperature (K)
33	guez	71	REAL, intent(in):: q(:, :) ! (klon, klev) humidité spécifique (no dimension)
34	guez	62
35	guez	70	REAL, intent(in):: con_t(:, :)
36			! (klon, klev) convergence de temperature (K/s)
37	guez	62
38	guez	70	REAL, intent(in):: con_q(:, :)
39			! (klon, klev) convergence de l'eau vapeur (g/g/s)
40
41			REAL, intent(in):: qhfl(:) ! (klon) evaporation (negative vers haut) mm/s
42			REAL, intent(in):: w(:, :) ! (klon, klev) vitesse verticale (Pa/s)
43
44			REAL, intent(out):: d_t(:, :) ! (klon, klev) incrementation de temperature
45			REAL, intent(out):: d_q(:, :) ! (klon, klev) incrementation d'humidite
46			REAL, intent(out):: rain(:) ! (klon) pluie (mm/s)
47			REAL, intent(out):: snow(:) ! (klon) neige (mm/s)
48
49	guez	71	REAL, intent(out):: mfu(:, :) ! (klon, klev)
50			! flux de masse (kg/m2/s) panache ascendant
51	guez	70
52	guez	71	REAL, intent(out):: mfd(:, :) ! (klon, klev)
53			! flux de masse (kg/m2/s) panache descendant
54	guez	62
55	guez	70	REAL, intent(out):: pen_u(:, :) ! (klon, klev)
56			REAL, intent(out):: pde_u(:, :) ! (klon, klev)
57			REAL, intent(out):: pen_d(:, :) ! (klon, klev)
58			REAL, intent(out):: pde_d(:, :) ! (klon, klev)
59			INTEGER, intent(out):: kcbot(:) ! (klon) niveau du bas de la convection
60			INTEGER, intent(out):: kctop(:) ! (klon) niveau du haut de la convection
61			INTEGER, intent(out):: kdtop(:) ! (klon) niveau du haut des downdrafts
62			REAL, intent(out):: pmflxr(:, :) ! (klon, klev+1)
63			REAL, intent(out):: pmflxs(:, :) ! (klon, klev+1)
64	guez	62
65			! Local:
66
67	guez	71	REAL qsen(klon, klev)
68	guez	62	REAL pvervel(klon, klev)
69			LOGICAL land(klon)
70
71			REAL d_t_bis(klon, klev)
72			REAL d_q_bis(klon, klev)
73			REAL paprs(klon, klev+1)
74			REAL paprsf(klon, klev)
75			REAL zgeom(klon, klev)
76			REAL zcvgq(klon, klev)
77			REAL zcvgt(klon, klev)
78
79			REAL zen_u(klon, klev)
80			REAL zen_d(klon, klev)
81			REAL zde_u(klon, klev)
82			REAL zde_d(klon, klev)
83			REAL zmflxr(klon, klev+1)
84			REAL zmflxs(klon, klev+1)
85
86			INTEGER i, k
87	guez	70	REAL zqsat
88	guez	62
89			!--------------------------------------------------------------------
90
91			! initialiser les variables de sortie (pour securite)
92			DO i = 1, klon
93			rain(i) = 0.0
94			snow(i) = 0.0
95			kcbot(i) = 0
96			kctop(i) = 0
97			kdtop(i) = 0
98			ENDDO
99			DO k = 1, klev
100			DO i = 1, klon
101			d_t(i, k) = 0.0
102			d_q(i, k) = 0.0
103			pen_u(i, k) = 0.0
104			pde_u(i, k) = 0.0
105			pen_d(i, k) = 0.0
106			pde_d(i, k) = 0.0
107			zen_u(i, k) = 0.0
108			zde_u(i, k) = 0.0
109			zen_d(i, k) = 0.0
110			zde_d(i, k) = 0.0
111			ENDDO
112			ENDDO
113			DO k = 1, klev+1
114			DO i = 1, klon
115			zmflxr(i, k) = 0.0
116			zmflxs(i, k) = 0.0
117			ENDDO
118			ENDDO
119
120			! calculer la nature du sol (pour l'instant, ocean partout)
121			DO i = 1, klon
122			land(i) = .FALSE.
123			ENDDO
124
125			! preparer les variables d'entree (attention: l'ordre des niveaux
126			! verticaux augmente du haut vers le bas)
127			DO k = 1, klev
128			DO i = 1, klon
129			paprsf(i, k) = pres_f(i, klev-k+1)
130			paprs(i, k) = pres_h(i, klev+1-k+1)
131			pvervel(i, k) = w(i, klev+1-k)
132			zcvgt(i, k) = con_t(i, klev-k+1)
133			zcvgq(i, k) = con_q(i, klev-k+1)
134
135	guez	70	zqsat = MIN(0.5, R2ES * FOEEW(t(i, k), &
136			merge(0., 1., rtt < t(i, k))) / paprsf(i, k))
137	guez	71	qsen(i, k) = zqsat / (1. - RETV * zqsat)
138	guez	62	ENDDO
139			ENDDO
140			DO i = 1, klon
141			paprs(i, klev+1) = pres_h(i, 1)
142	guez	70	zgeom(i, klev) = RD * t(i, klev) &
143	guez	62	/ (0.5*(paprs(i, klev+1)+paprsf(i, klev))) &
144			* (paprs(i, klev+1)-paprsf(i, klev))
145			ENDDO
146			DO k = klev-1, 1, -1
147			DO i = 1, klon
148			zgeom(i, k) = zgeom(i, k+1) &
149	guez	70	+ RD * 0.5*(t(i, k+1)+t(i, k)) / paprs(i, k+1) &
150	guez	62	* (paprsf(i, k+1)-paprsf(i, k))
151			ENDDO
152			ENDDO
153
154	guez	70	! Appeler la routine principale :
155	guez	71	CALL flxmain(dtime, t, q, qsen, qhfl, paprsf, paprs, zgeom, land, &
156			zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, mfu, mfd, &
157	guez	62	zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
158
159			! De la même façon que l'on effectue le réindiçage pour la
160			! température t et le champ q, on réindice les flux nécessaires à
161			! la convection des traceurs.
162			DO k = 1, klev
163			DO i = 1, klon
164			d_q(i, klev+1-k) = dtime*d_q_bis(i, k)
165			d_t(i, klev+1-k) = dtime*d_t_bis(i, k)
166			ENDDO
167			ENDDO
168
169	guez	71	mfu = eoshift(mfu, shift=1, dim=2)
170			mfd = eoshift(mfd, shift=1, dim=2)
171			pen_d(:, 1)= 0.
172			pde_d(:, 1)= 0.
173	guez	62
174			DO k = 1, klev
175			DO i = 1, klon
176	guez	70	pen_u(i, klev+1-k)= zen_u(i, k)
177			pde_u(i, klev+1-k)= zde_u(i, k)
178	guez	62	ENDDO
179			ENDDO
180
181			DO k = 1, klev-1
182			DO i = 1, klon
183			pen_d(i, klev+1-k)= -zen_d(i, k+1)
184			pde_d(i, klev+1-k)= -zde_d(i, k+1)
185			ENDDO
186			ENDDO
187
188			DO k = 1, klev+1
189			DO i = 1, klon
190			pmflxr(i, klev+2-k)= zmflxr(i, k)
191			pmflxs(i, klev+2-k)= zmflxs(i, k)
192			ENDDO
193			ENDDO
194
195			END SUBROUTINE conflx
196
197			end module conflx_m