phylmd/Conflx/conflx.f

module conflx_m

  IMPLICIT none

contains

  SUBROUTINE conflx (dtime, pres_h, pres_f, t, q, con_t, con_q, pqhfl, w, &
       d_t, d_q, rain, snow, pmfu, pmfd, 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 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 mélange et
    ! 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

    ! Entree:
    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 q(klon, klev)     ! humidite specifique (g/g)
    REAL w(klon, klev)     ! vitesse verticale (Pa/s)
    REAL con_t(klon, klev) ! convergence de temperature (K/s)
    REAL con_q(klon, klev) ! convergence de l'eau vapeur (g/g/s)
    REAL pqhfl(klon)      ! evaporation (negative vers haut) mm/s

    ! Sortie:
    REAL d_t(klon, klev)   ! incrementation de temperature
    REAL d_q(klon, klev)   ! incrementation d'humidite

    REAL, intent(out):: pmfu(:, :) ! (klon, klev)
    ! flux masse (kg/m2/s) panache ascendant
    
    REAL, intent(out):: pmfd(:, :) ! (klon, klev)
    ! flux masse (kg/m2/s) panache descendant

    REAL pen_u(klon, klev)
    REAL pen_d(klon, klev)
    REAL pde_u(klon, klev)
    REAL pde_d(klon, klev)
    REAL rain(klon)       ! pluie (mm/s)
    REAL snow(klon)       ! neige (mm/s)
    REAL pmflxr(klon, klev+1)
    REAL pmflxs(klon, klev+1)
    INTEGER kcbot(klon)  ! niveau du bas de la convection
    INTEGER kctop(klon)  ! niveau du haut de la convection
    INTEGER kdtop(klon)  ! niveau du haut des downdrafts

    ! Local:

    REAL pt(klon, klev)
    REAL pq(klon, klev)
    REAL pqs(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 zmfu(klon, klev)
    REAL zmfd(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 zdelta, 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
          pmfu(i, k) = 0.0
          pmfd(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
          zmfu(i, k) = 0.0
          zmfd(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
          pt(i, k) = t(i, klev-k+1)
          pq(i, k) = q(i, klev-k+1)
          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)

          zdelta=MAX(0., SIGN(1., RTT-pt(i, k)))
          zqsat=R2ES*FOEEW ( pt(i, k), zdelta ) / paprsf(i, k)
          zqsat=MIN(0.5, zqsat)
          zqsat=zqsat/(1.-RETV  *zqsat)
          pqs(i, k) = zqsat
       ENDDO
    ENDDO
    DO i = 1, klon
       paprs(i, klev+1) = pres_h(i, 1)
       zgeom(i, klev) = RD * pt(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*(pt(i, k+1)+pt(i, k)) / paprs(i, k+1) &
               * (paprsf(i, k+1)-paprsf(i, k))
       ENDDO
    ENDDO

    ! appeler la routine principale

    CALL flxmain(dtime, pt, pq, pqs, pqhfl, paprsf, paprs, zgeom, land, &
         zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, zmfu, zmfd, &
         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

    DO i = 1, klon
       pmfu(i, 1)= 0.
       pmfd(i, 1)= 0.
       pen_d(i, 1)= 0.
       pde_d(i, 1)= 0.
    ENDDO

    DO k = 2, klev
       DO i = 1, klon
          pmfu(i, klev+2-k)= zmfu(i, k)
          pmfd(i, klev+2-k)= zmfd(i, k)
       ENDDO
    ENDDO

    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, pqhfl, w, &
8	d_t, d_q, rain, snow, pmfu, pmfd, 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 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 mélange et
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	! Entree:
30	REAL, intent(in):: dtime ! pas d'integration (s)
31	REAL, intent(in):: pres_h(klon, klev+1) ! pression half-level (Pa)
32	REAL, intent(in):: pres_f(klon, klev)! pression full-level (Pa)
33	REAL, intent(in):: t(klon, klev) ! temperature (K)
34	REAL q(klon, klev) ! humidite specifique (g/g)
35	REAL w(klon, klev) ! vitesse verticale (Pa/s)
36	REAL con_t(klon, klev) ! convergence de temperature (K/s)
37	REAL con_q(klon, klev) ! convergence de l'eau vapeur (g/g/s)
38	REAL pqhfl(klon) ! evaporation (negative vers haut) mm/s
39
40	! Sortie:
41	REAL d_t(klon, klev) ! incrementation de temperature
42	REAL d_q(klon, klev) ! incrementation d'humidite
43
44	REAL, intent(out):: pmfu(:, :) ! (klon, klev)
45	! flux masse (kg/m2/s) panache ascendant
46
47	REAL, intent(out):: pmfd(:, :) ! (klon, klev)
48	! flux masse (kg/m2/s) panache descendant
49
50	REAL pen_u(klon, klev)
51	REAL pen_d(klon, klev)
52	REAL pde_u(klon, klev)
53	REAL pde_d(klon, klev)
54	REAL rain(klon) ! pluie (mm/s)
55	REAL snow(klon) ! neige (mm/s)
56	REAL pmflxr(klon, klev+1)
57	REAL pmflxs(klon, klev+1)
58	INTEGER kcbot(klon) ! niveau du bas de la convection
59	INTEGER kctop(klon) ! niveau du haut de la convection
60	INTEGER kdtop(klon) ! niveau du haut des downdrafts
61
62	! Local:
63
64	REAL pt(klon, klev)
65	REAL pq(klon, klev)
66	REAL pqs(klon, klev)
67	REAL pvervel(klon, klev)
68	LOGICAL land(klon)
69
70	REAL d_t_bis(klon, klev)
71	REAL d_q_bis(klon, klev)
72	REAL paprs(klon, klev+1)
73	REAL paprsf(klon, klev)
74	REAL zgeom(klon, klev)
75	REAL zcvgq(klon, klev)
76	REAL zcvgt(klon, klev)
77
78	REAL zmfu(klon, klev)
79	REAL zmfd(klon, klev)
80	REAL zen_u(klon, klev)
81	REAL zen_d(klon, klev)
82	REAL zde_u(klon, klev)
83	REAL zde_d(klon, klev)
84	REAL zmflxr(klon, klev+1)
85	REAL zmflxs(klon, klev+1)
86
87	INTEGER i, k
88	REAL zdelta, zqsat
89
90	!--------------------------------------------------------------------
91
92	! initialiser les variables de sortie (pour securite)
93	DO i = 1, klon
94	rain(i) = 0.0
95	snow(i) = 0.0
96	kcbot(i) = 0
97	kctop(i) = 0
98	kdtop(i) = 0
99	ENDDO
100	DO k = 1, klev
101	DO i = 1, klon
102	d_t(i, k) = 0.0
103	d_q(i, k) = 0.0
104	pmfu(i, k) = 0.0
105	pmfd(i, k) = 0.0
106	pen_u(i, k) = 0.0
107	pde_u(i, k) = 0.0
108	pen_d(i, k) = 0.0
109	pde_d(i, k) = 0.0
110	zmfu(i, k) = 0.0
111	zmfd(i, k) = 0.0
112	zen_u(i, k) = 0.0
113	zde_u(i, k) = 0.0
114	zen_d(i, k) = 0.0
115	zde_d(i, k) = 0.0
116	ENDDO
117	ENDDO
118	DO k = 1, klev+1
119	DO i = 1, klon
120	zmflxr(i, k) = 0.0
121	zmflxs(i, k) = 0.0
122	ENDDO
123	ENDDO
124
125	! calculer la nature du sol (pour l'instant, ocean partout)
126	DO i = 1, klon
127	land(i) = .FALSE.
128	ENDDO
129
130	! preparer les variables d'entree (attention: l'ordre des niveaux
131	! verticaux augmente du haut vers le bas)
132	DO k = 1, klev
133	DO i = 1, klon
134	pt(i, k) = t(i, klev-k+1)
135	pq(i, k) = q(i, klev-k+1)
136	paprsf(i, k) = pres_f(i, klev-k+1)
137	paprs(i, k) = pres_h(i, klev+1-k+1)
138	pvervel(i, k) = w(i, klev+1-k)
139	zcvgt(i, k) = con_t(i, klev-k+1)
140	zcvgq(i, k) = con_q(i, klev-k+1)
141
142	zdelta=MAX(0., SIGN(1., RTT-pt(i, k)))
143	zqsat=R2ES*FOEEW ( pt(i, k), zdelta ) / paprsf(i, k)
144	zqsat=MIN(0.5, zqsat)
145	zqsat=zqsat/(1.-RETV *zqsat)
146	pqs(i, k) = zqsat
147	ENDDO
148	ENDDO
149	DO i = 1, klon
150	paprs(i, klev+1) = pres_h(i, 1)
151	zgeom(i, klev) = RD * pt(i, klev) &
152	/ (0.5*(paprs(i, klev+1)+paprsf(i, klev))) &
153	* (paprs(i, klev+1)-paprsf(i, klev))
154	ENDDO
155	DO k = klev-1, 1, -1
156	DO i = 1, klon
157	zgeom(i, k) = zgeom(i, k+1) &
158	+ RD * 0.5*(pt(i, k+1)+pt(i, k)) / paprs(i, k+1) &
159	* (paprsf(i, k+1)-paprsf(i, k))
160	ENDDO
161	ENDDO
162
163	! appeler la routine principale
164
165	CALL flxmain(dtime, pt, pq, pqs, pqhfl, paprsf, paprs, zgeom, land, &
166	zcvgt, zcvgq, pvervel, rain, snow, kcbot, kctop, kdtop, zmfu, zmfd, &
167	zen_u, zde_u, zen_d, zde_d, d_t_bis, d_q_bis, zmflxr, zmflxs)
168
169	! De la même façon que l'on effectue le réindiçage pour la
170	! température t et le champ q, on réindice les flux nécessaires à
171	! la convection des traceurs.
172	DO k = 1, klev
173	DO i = 1, klon
174	d_q(i, klev+1-k) = dtime*d_q_bis(i, k)
175	d_t(i, klev+1-k) = dtime*d_t_bis(i, k)
176	ENDDO
177	ENDDO
178
179	DO i = 1, klon
180	pmfu(i, 1)= 0.
181	pmfd(i, 1)= 0.
182	pen_d(i, 1)= 0.
183	pde_d(i, 1)= 0.
184	ENDDO
185
186	DO k = 2, klev
187	DO i = 1, klon
188	pmfu(i, klev+2-k)= zmfu(i, k)
189	pmfd(i, klev+2-k)= zmfd(i, k)
190	ENDDO
191	ENDDO
192
193	DO k = 1, klev
194	DO i = 1, klon
195	pen_u(i, klev+1-k)= zen_u(i, k)
196	pde_u(i, klev+1-k)= zde_u(i, k)
197	ENDDO
198	ENDDO
199
200	DO k = 1, klev-1
201	DO i = 1, klon
202	pen_d(i, klev+1-k)= -zen_d(i, k+1)
203	pde_d(i, klev+1-k)= -zde_d(i, k+1)
204	ENDDO
205	ENDDO
206
207	DO k = 1, klev+1
208	DO i = 1, klon
209	pmflxr(i, klev+2-k)= zmflxr(i, k)
210	pmflxs(i, klev+2-k)= zmflxs(i, k)
211	ENDDO
212	ENDDO
213
214	END SUBROUTINE conflx
215
216	end module conflx_m