source: LMDZ4/branches/V3_test/libf/phylmd/concvl.F @ 1270

Last change on this file since 1270 was 704, checked in by Laurent Fairhead, 18 years ago

Inclusion des modifs de Y. Meurdesoif pour la version V3
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.8 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,
5     .             work1,work2,d_t,d_q,d_u,d_v,d_tra,
6     .             rain, snow, kbas, ktop,
7     .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,
8     .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,
9     .             qcondc,wd,
10     .             pmflxr,pmflxs,
11     .             da,phi,mp)
12 
13c
14      USE dimphy
15      IMPLICIT none
16c======================================================================
17c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
18c Objet: schema de convection de Emanuel (1991) interface
19c======================================================================
20c Arguments:
21c dtime--input-R-pas d'integration (s)
22c s-------input-R-la valeur "s" pour chaque couche
23c sigs----input-R-la valeur "sigma" de chaque couche
24c sig-----input-R-la valeur de "sigma" pour chaque niveau
25c psolpa--input-R-la pression au sol (en Pa)
26C pskapa--input-R-exponentiel kappa de psolpa
27c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
28c q-------input-R-vapeur d'eau (en kg/kg)
29c
30c work*: input et output: deux variables de travail,
31c                            on peut les mettre a 0 au debut
32c ALE-----input-R-energie disponible pour soulevement
33c
34C d_h-----output-R-increment de l'enthalpie potentielle (h)
35c d_q-----output-R-increment de la vapeur d'eau
36c rain----output-R-la pluie (mm/s)
37c snow----output-R-la neige (mm/s)
38c upwd----output-R-saturated updraft mass flux (kg/m**2/s)
39c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
40c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
41c Cape----output-R-CAPE (J/kg)
42c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
43c                  adiabatiquement a partir du niveau 1 (K)
44c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
45c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
46c======================================================================
47c
48#include "dimensions.h"
49cym#include "dimphy.h"
50c
51      integer NTRAC
52      PARAMETER (NTRAC=nqmx-2)
53c
54       INTEGER iflag_con
55c
56       REAL dtime, paprs(klon,klev+1),pplay(klon,klev)
57       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
58       REAL tra(klon,klev,ntrac)
59       INTEGER ntra
60       REAL work1(klon,klev),work2(klon,klev)
61       REAL pmflxr(klon,klev+1),pmflxs(klon,klev+1)
62c
63       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
64       REAL d_tra(klon,klev,ntrac)
65       REAL rain(klon),snow(klon)
66c
67       INTEGER kbas(klon),ktop(klon)
68       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       INTEGER iflag(klon)
73       REAL rflag(klon)
74       REAL pbase(klon),bbase(klon)
75       REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)
76       REAL dplcldt(klon),dplcldr(klon)
77       REAL qcondc(klon,klev)
78       REAL wd(klon)
79c
80       REAL zx_t,zdelta,zx_qs,zcor
81c
82       INTEGER noff, minorig
83       INTEGER i,k,itra
84       REAL qs(klon,klev)
85cym       REAL cbmf(klon)
86cym       SAVE cbmf
87       REAL,ALLOCATABLE,SAVE :: cbmf(:)
88c$OMP THREADPRIVATE(cbmf)
89       INTEGER ifrst
90       SAVE ifrst
91       DATA ifrst /0/
92c$OMP THREADPRIVATE(ifrst)
93
94#include "YOMCST.h"
95#include "YOETHF.h"
96#include "FCTTRE.h"
97c
98c
99cym
100      snow(:)=0
101     
102      IF (ifrst .EQ. 0) THEN
103         ifrst = 1
104         allocate(cbmf(klon))
105         DO i = 1, klon
106          cbmf(i) = 0.
107         ENDDO
108      ENDIF
109
110      DO k = 1, klev+1
111         DO i=1,klon
112         em_ph(i,k) = paprs(i,k) / 100.0
113         pmflxs(i,k)=0.
114      ENDDO
115      ENDDO
116c
117      DO k = 1, klev
118         DO i=1,klon
119         em_p(i,k) = pplay(i,k) / 100.0
120      ENDDO
121      ENDDO
122
123c
124      if (iflag_con .eq. 4) then
125      DO k = 1, klev
126        DO i = 1, klon
127         zx_t = t(i,k)
128         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
129         zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0)
130         zcor=1./(1.-retv*zx_qs)
131         qs(i,k)=zx_qs*zcor
132        ENDDO
133      ENDDO
134      else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)
135      DO k = 1, klev
136        DO i = 1, klon
137         zx_t = t(i,k)
138         zdelta=MAX(0.,SIGN(1.,rtt-zx_t))
139         zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0
140         zx_qs= MIN(0.5,zx_qs)
141         zcor=1./(1.-retv*zx_qs)
142         zx_qs=zx_qs*zcor
143         qs(i,k)=zx_qs
144        ENDDO
145      ENDDO
146      endif ! iflag_con
147c
148C------------------------------------------------------------------
149
150C Main driver for convection:
151C               iflag_con = 3  -> equivalent to convect3
152C               iflag_con = 4  -> equivalent to convect1/2
153
154      CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,
155     :              t,q,qs,u,v,tra,
156     $              em_p,em_ph,iflag,
157     $              d_t,d_q,d_u,d_v,d_tra,rain,
158     $              pmflxr,cbmf,work1,work2,
159     $              kbas,ktop,
160     $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,
161     $              da,phi,mp)
162
163C------------------------------------------------------------------
164
165      DO i = 1,klon
166        rain(i) = rain(i)/86400.
167        rflag(i)=iflag(i)
168      ENDDO
169
170      DO k = 1, klev
171        DO i = 1, klon
172           d_t(i,k) = dtime*d_t(i,k)
173           d_q(i,k) = dtime*d_q(i,k)
174           d_u(i,k) = dtime*d_u(i,k)
175           d_v(i,k) = dtime*d_v(i,k)
176        ENDDO
177      ENDDO
178       DO itra = 1,ntra
179        DO k = 1, klev
180         DO i = 1, klon
181            d_tra(i,k,itra) =dtime*d_tra(i,k,itra)
182         ENDDO
183        ENDDO
184       ENDDO
185c les traceurs ne sont pas mis dans cette version de convect4:
186      if (iflag_con.eq.4) then
187       DO itra = 1,ntra
188        DO k = 1, klev
189         DO i = 1, klon
190            d_tra(i,k,itra) = 0.
191         ENDDO
192        ENDDO
193       ENDDO
194      endif
195 
196      RETURN
197      END
198 
Note: See TracBrowser for help on using the repository browser.