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 securité):
    rain = 0.
    snow = 0.
    kcbot = 0
    kctop = 0
    kdtop = 0
    d_t = 0.
    d_q = 0.

    zen_u = 0.
    zde_u = 0.
    zen_d = 0.
    zde_d = 0.
    zmflxr = 0.
    zmflxs = 0.

    ! Calculer la nature du sol (pour l'instant, océan partout):
    land = .FALSE.

    ! Préparer les variables d'entrée (attention: l'indice 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), 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	module conflx_m
2
3	IMPLICIT none
4
5	contains
6
7	SUBROUTINE conflx(dtime, pres_h, pres_f, t, q, con_t, con_q, qhfl, w, &
8	d_t, d_q, rain, snow, mfu, mfd, pen_u, pde_u, pen_d, pde_d, kcbot, &
9	kctop, kdtop, pmflxr, pmflxs)
10
11	! From LMDZ4/libf/phylmd/conflx.F, version 1.1.1.1 2004/05/19 12:53:08
12
13	! Author: Z. X. Li (LMD/CNRS)
14	! Date: 1994/10/14
15
16	! Objet: schéma en flux de masse pour la convection (schéma de
17	! Tiedtke avec quelques modifications mineures)
18
19	! Décembre 1997 : prise en compte des modifications introduites
20	! par Olivier Boucher et Alexandre Armengaud pour le mélange et le
21	! 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	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	REAL, intent(in):: q(:, :) ! (klon, klev) humidité spécifique (no dimension)
34
35	REAL, intent(in):: con_t(:, :)
36	! (klon, klev) convergence de temperature (K/s)
37
38	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	REAL, intent(out):: mfu(:, :) ! (klon, klev)
50	! flux de masse (kg/m2/s) panache ascendant
51
52	REAL, intent(out):: mfd(:, :) ! (klon, klev)
53	! flux de masse (kg/m2/s) panache descendant
54
55	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
65	! Local:
66
67	REAL qsen(klon, klev)
68	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	REAL zqsat
88
89	!--------------------------------------------------------------------
90
91	! Initialiser les variables de sortie (pour securité):
92	rain = 0.
93	snow = 0.
94	kcbot = 0
95	kctop = 0
96	kdtop = 0
97	d_t = 0.
98	d_q = 0.
99
100	zen_u = 0.
101	zde_u = 0.
102	zen_d = 0.
103	zde_d = 0.
104	zmflxr = 0.
105	zmflxs = 0.
106
107	! Calculer la nature du sol (pour l'instant, océan partout):
108	land = .FALSE.
109
110	! Préparer les variables d'entrée (attention: l'indice des niveaux
111	! verticaux augmente du haut vers le bas) :
112	DO k = 1, klev
113	DO i = 1, klon
114	paprsf(i, k) = pres_f(i, klev-k + 1)
115	paprs(i, k) = pres_h(i, klev + 1-k + 1)
116	pvervel(i, k) = w(i, klev + 1-k)
117	zcvgt(i, k) = con_t(i, klev-k + 1)
118	zcvgq(i, k) = con_q(i, klev-k + 1)
119
120	zqsat = MIN(0.5, R2ES * FOEEW(t(i, k), rtt >= t(i, k)) &
121	/ paprsf(i, k))
122	qsen(i, k) = zqsat / (1. - RETV * zqsat)
123	ENDDO
124	ENDDO
125	DO i = 1, klon
126	paprs(i, klev + 1) = pres_h(i, 1)
127	zgeom(i, klev) = RD * t(i, klev) &
128	/ (0.5*(paprs(i, klev + 1) + paprsf(i, klev))) &
129	* (paprs(i, klev + 1)-paprsf(i, klev))
130	ENDDO
131	DO k = klev-1, 1, -1
132	DO i = 1, klon
133	zgeom(i, k) = zgeom(i, k + 1) &
134	+ RD * 0.5*(t(i, k + 1) + t(i, k)) / paprs(i, k + 1) &
135	* (paprsf(i, k + 1)-paprsf(i, k))
136	ENDDO
137	ENDDO
138
139	! Appeler la routine principale :
140	CALL flxmain(dtime, t, q, qsen, qhfl, paprsf, paprs, zgeom, land, &
141	zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, mfu, mfd, &
142	zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
143
144	! De la même façon que l'on effectue le réindiçage pour la
145	! température t et le champ q, on réindice les flux nécessaires à
146	! la convection des traceurs.
147	DO k = 1, klev
148	DO i = 1, klon
149	d_q(i, klev + 1-k) = dtime*d_q_bis(i, k)
150	d_t(i, klev + 1-k) = dtime*d_t_bis(i, k)
151	ENDDO
152	ENDDO
153
154	mfu = eoshift(mfu, shift=1, dim=2)
155	mfd = eoshift(mfd, shift=1, dim=2)
156	pen_d(:, 1)= 0.
157	pde_d(:, 1)= 0.
158
159	DO k = 1, klev
160	DO i = 1, klon
161	pen_u(i, klev + 1-k)= zen_u(i, k)
162	pde_u(i, klev + 1-k)= zde_u(i, k)
163	ENDDO
164	ENDDO
165
166	DO k = 1, klev-1
167	DO i = 1, klon
168	pen_d(i, klev + 1-k)= -zen_d(i, k + 1)
169	pde_d(i, klev + 1-k)= -zde_d(i, k + 1)
170	ENDDO
171	ENDDO
172
173	DO k = 1, klev + 1
174	DO i = 1, klon
175	pmflxr(i, klev + 2-k)= zmflxr(i, k)
176	pmflxs(i, klev + 2-k)= zmflxs(i, k)
177	ENDDO
178	ENDDO
179
180	END SUBROUTINE conflx
181
182	end module conflx_m