source: LMDZ.3.3/branches/rel-LF/libf/phylmd/concvl.F @ 475

Last change on this file since 475 was 418, checked in by (none), 22 years ago

This commit was manufactured by cvs2svn to create branch 'rel-LF'.

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