phylmd/Conflx/conflx.f90

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,v 1.1.1.1 2004/05/19 12:53:08

  use dimens_m
  use dimphy
  use SUPHEC_M
  use yoethf_m
  use fcttre

  IMPLICIT none
  !======================================================================
  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19941014
  ! Objet: Schema flux de masse pour la convection
  !        (schema de Tiedtke avec qqs modifications mineures)
  ! Dec.97: Prise en compte des modifications introduites par
  !         Olivier Boucher et Alexandre Armengaud pour melange
  !         et lessivage des traceurs passifs.
  !======================================================================
  ! 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 pmfu(klon,klev)  ! flux masse (kg/m2/s) panache ascendant
  REAL 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)
  !AA
  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)
  !AA

  !
  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)
  !
  !AA--------------------------------------------------------
  !AA rem : De la meme facon que l'on effectue le reindicage
  !AA       pour la temperature t et le champ q
  !AA       on reindice les flux necessaires a la convection
  !AA       des traceurs
  !AA--------------------------------------------------------
  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
1	SUBROUTINE conflx (dtime,pres_h,pres_f, &
2	t, q, con_t, con_q, pqhfl, w, &
3	d_t, d_q, rain, snow, &
4	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
5	kcbot, kctop, kdtop, pmflxr, pmflxs)
6
7	! From LMDZ4/libf/phylmd/conflx.F,v 1.1.1.1 2004/05/19 12:53:08
8
9	use dimens_m
10	use dimphy
11	use SUPHEC_M
12	use yoethf_m
13	use fcttre
14
15	IMPLICIT none
16	!======================================================================
17	! Auteur(s): Z.X. Li (LMD/CNRS) date: 19941014
18	! Objet: Schema flux de masse pour la convection
19	! (schema de Tiedtke avec qqs modifications mineures)
20	! Dec.97: Prise en compte des modifications introduites par
21	! Olivier Boucher et Alexandre Armengaud pour melange
22	! et lessivage des traceurs passifs.
23	!======================================================================
24	! Entree:
25	REAL, intent(in):: dtime ! pas d'integration (s)
26	REAL, intent(in):: pres_h(klon,klev+1) ! pression half-level (Pa)
27	REAL, intent(in):: pres_f(klon,klev)! pression full-level (Pa)
28	REAL, intent(in):: t(klon,klev) ! temperature (K)
29	REAL q(klon,klev) ! humidite specifique (g/g)
30	REAL w(klon,klev) ! vitesse verticale (Pa/s)
31	REAL con_t(klon,klev) ! convergence de temperature (K/s)
32	REAL con_q(klon,klev) ! convergence de l'eau vapeur (g/g/s)
33	REAL pqhfl(klon) ! evaporation (negative vers haut) mm/s
34	! Sortie:
35	REAL d_t(klon,klev) ! incrementation de temperature
36	REAL d_q(klon,klev) ! incrementation d'humidite
37	REAL pmfu(klon,klev) ! flux masse (kg/m2/s) panache ascendant
38	REAL pmfd(klon,klev) ! flux masse (kg/m2/s) panache descendant
39	REAL pen_u(klon,klev)
40	REAL pen_d(klon,klev)
41	REAL pde_u(klon,klev)
42	REAL pde_d(klon,klev)
43	REAL rain(klon) ! pluie (mm/s)
44	REAL snow(klon) ! neige (mm/s)
45	REAL pmflxr(klon,klev+1)
46	REAL pmflxs(klon,klev+1)
47	INTEGER kcbot(klon) ! niveau du bas de la convection
48	INTEGER kctop(klon) ! niveau du haut de la convection
49	INTEGER kdtop(klon) ! niveau du haut des downdrafts
50	! Local:
51	REAL pt(klon,klev)
52	REAL pq(klon,klev)
53	REAL pqs(klon,klev)
54	REAL pvervel(klon,klev)
55	LOGICAL land(klon)
56	!
57	REAL d_t_bis(klon,klev)
58	REAL d_q_bis(klon,klev)
59	REAL paprs(klon,klev+1)
60	REAL paprsf(klon,klev)
61	REAL zgeom(klon,klev)
62	REAL zcvgq(klon,klev)
63	REAL zcvgt(klon,klev)
64	!AA
65	REAL zmfu(klon,klev)
66	REAL zmfd(klon,klev)
67	REAL zen_u(klon,klev)
68	REAL zen_d(klon,klev)
69	REAL zde_u(klon,klev)
70	REAL zde_d(klon,klev)
71	REAL zmflxr(klon,klev+1)
72	REAL zmflxs(klon,klev+1)
73	!AA
74
75	!
76	INTEGER i, k
77	REAL zdelta, zqsat
78	!
79	!
80	! initialiser les variables de sortie (pour securite)
81	DO i = 1, klon
82	rain(i) = 0.0
83	snow(i) = 0.0
84	kcbot(i) = 0
85	kctop(i) = 0
86	kdtop(i) = 0
87	ENDDO
88	DO k = 1, klev
89	DO i = 1, klon
90	d_t(i,k) = 0.0
91	d_q(i,k) = 0.0
92	pmfu(i,k) = 0.0
93	pmfd(i,k) = 0.0
94	pen_u(i,k) = 0.0
95	pde_u(i,k) = 0.0
96	pen_d(i,k) = 0.0
97	pde_d(i,k) = 0.0
98	zmfu(i,k) = 0.0
99	zmfd(i,k) = 0.0
100	zen_u(i,k) = 0.0
101	zde_u(i,k) = 0.0
102	zen_d(i,k) = 0.0
103	zde_d(i,k) = 0.0
104	ENDDO
105	ENDDO
106	DO k = 1, klev+1
107	DO i = 1, klon
108	zmflxr(i,k) = 0.0
109	zmflxs(i,k) = 0.0
110	ENDDO
111	ENDDO
112	!
113	! calculer la nature du sol (pour l'instant, ocean partout)
114	DO i = 1, klon
115	land(i) = .FALSE.
116	ENDDO
117	!
118	! preparer les variables d'entree (attention: l'ordre des niveaux
119	! verticaux augmente du haut vers le bas)
120	DO k = 1, klev
121	DO i = 1, klon
122	pt(i,k) = t(i,klev-k+1)
123	pq(i,k) = q(i,klev-k+1)
124	paprsf(i,k) = pres_f(i,klev-k+1)
125	paprs(i,k) = pres_h(i,klev+1-k+1)
126	pvervel(i,k) = w(i,klev+1-k)
127	zcvgt(i,k) = con_t(i,klev-k+1)
128	zcvgq(i,k) = con_q(i,klev-k+1)
129	!
130	zdelta=MAX(0.,SIGN(1.,RTT-pt(i,k)))
131	zqsat=R2ES*FOEEW ( pt(i,k), zdelta ) / paprsf(i,k)
132	zqsat=MIN(0.5,zqsat)
133	zqsat=zqsat/(1.-RETV *zqsat)
134	pqs(i,k) = zqsat
135	ENDDO
136	ENDDO
137	DO i = 1, klon
138	paprs(i,klev+1) = pres_h(i,1)
139	zgeom(i,klev) = RD * pt(i,klev) &
140	/ (0.5*(paprs(i,klev+1)+paprsf(i,klev))) &
141	* (paprs(i,klev+1)-paprsf(i,klev))
142	ENDDO
143	DO k = klev-1, 1, -1
144	DO i = 1, klon
145	zgeom(i,k) = zgeom(i,k+1) &
146	+ RD * 0.5*(pt(i,k+1)+pt(i,k)) / paprs(i,k+1) &
147	* (paprsf(i,k+1)-paprsf(i,k))
148	ENDDO
149	ENDDO
150	!
151	! appeler la routine principale
152	!
153	CALL flxmain(dtime, pt, pq, pqs, pqhfl, &
154	paprsf, paprs, zgeom, land, zcvgt, zcvgq, pvervel, &
155	rain, snow, kcbot, kctop, kdtop, &
156	zmfu, zmfd, zen_u, zde_u, zen_d, zde_d, &
157	d_t_bis, d_q_bis, zmflxr, zmflxs)
158	!
159	!AA--------------------------------------------------------
160	!AA rem : De la meme facon que l'on effectue le reindicage
161	!AA pour la temperature t et le champ q
162	!AA on reindice les flux necessaires a la convection
163	!AA des traceurs
164	!AA--------------------------------------------------------
165	DO k = 1, klev
166	DO i = 1, klon
167	d_q(i,klev+1-k) = dtime*d_q_bis(i,k)
168	d_t(i,klev+1-k) = dtime*d_t_bis(i,k)
169	ENDDO
170	ENDDO
171	!
172	DO i = 1, klon
173	pmfu(i,1)= 0.
174	pmfd(i,1)= 0.
175	pen_d(i,1)= 0.
176	pde_d(i,1)= 0.
177	ENDDO
178
179	DO k = 2, klev
180	DO i = 1, klon
181	pmfu(i,klev+2-k)= zmfu(i,k)
182	pmfd(i,klev+2-k)= zmfd(i,k)
183	ENDDO
184	ENDDO
185	!
186	DO k = 1, klev
187	DO i = 1, klon
188	pen_u(i,klev+1-k)= zen_u(i,k)
189	pde_u(i,klev+1-k)= zde_u(i,k)
190	ENDDO
191	ENDDO
192	!
193	DO k = 1, klev-1
194	DO i = 1, klon
195	pen_d(i,klev+1-k)= -zen_d(i,k+1)
196	pde_d(i,klev+1-k)= -zde_d(i,k+1)
197	ENDDO
198	ENDDO
199
200	DO k = 1, klev+1
201	DO i = 1, klon
202	pmflxr(i,klev+2-k)= zmflxr(i,k)
203	pmflxs(i,klev+2-k)= zmflxs(i,k)
204	ENDDO
205	ENDDO
206
207	END SUBROUTINE conflx