source: LMDZ4/branches/V3_test/libf/phylmd/conemav.F

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