source: LMDZ6/branches/cirrus/libf/phylmd/cvltr_noscav.F90 @ 5407

Last change on this file since 5407 was 4770, checked in by lguez, 12 months ago

Bug fix: correct intent of dx in cvltr_noscav

intent(out) means that the whole array becomes undefined on entry of
the procedure. Here we only define dx(:, :, it) and we want to keep
the values of dx for other tracers.

File size: 5.3 KB
Line 
1!
2! $Id $
3!
4SUBROUTINE cvltr_noscav(it,pdtime,da, phi, mp,wght_cvfd,paprs,pplay,x,upd,dnd,dx)
5  USE dimphy
6  USE infotrac_phy, ONLY : nbtr
7  IMPLICIT NONE
8!=====================================================================
9! Objet : convection des traceurs / KE
10! Auteurs: M-A Filiberti and J-Y Grandpeix
11!=====================================================================
12  include "YOMCST.h"
13  include "YOECUMF.h"
14
15! Entree
16  REAL,INTENT(IN)                           :: pdtime
17  INTEGER, INTENT(IN)                       :: it
18  REAL,DIMENSION(klon,klev),INTENT(IN)      :: da
19  REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi
20  REAL,DIMENSION(klon,klev),INTENT(IN)      :: mp
21  REAL,DIMENSION(klon,klev),INTENT(IN)      :: wght_cvfd  ! weights of the layers feeding convection
22  REAL,DIMENSION(klon,klev+1),INTENT(IN)    :: paprs ! pression aux 1/2 couches (bas en haut)
23  REAL,DIMENSION(klon,klev),INTENT(IN)      :: pplay ! pression pour le milieu de chaque couche
24  REAL,DIMENSION(klon,klev,nbtr),INTENT(IN)      :: x     ! q de traceur (bas en haut)
25  REAL,DIMENSION(klon,klev),INTENT(IN)      :: upd   ! saturated updraft mass flux
26  REAL,DIMENSION(klon,klev),INTENT(IN)      :: dnd   ! saturated downdraft mass flux
27
28! Sortie
29  REAL,DIMENSION(klon,klev,nbtr),INTENT(inOUT) :: dx ! tendance de traceur  (bas en haut)
30
31! Variables locales     
32! REAL,DIMENSION(klon,klev)       :: zed
33  REAL,DIMENSION(klon,klev,klev)  :: zmd
34  REAL,DIMENSION(klon,klev,klev)  :: za
35  REAL,DIMENSION(klon,klev)       :: zmfd,zmfa
36  REAL,DIMENSION(klon,klev)       :: zmfp,zmfu
37  REAL,DIMENSION(klon,nbtr)       :: qfeed     ! tracer concentration feeding convection
38  REAL,DIMENSION(klon,klev)       :: deltap
39  INTEGER                         :: i,k,j
40  REAL                            :: pdtimeRG
41  REAL                            :: smallest_mp
42  real conserv
43  real smfd
44  real smfu
45  real smfa
46  real smfp
47! =========================================
48! calcul des tendances liees au downdraft
49! =========================================
50!
51  smallest_mp = tiny(mp(1,1))
52!cdir collapse
53  qfeed(:,it) = 0.
54  DO j=1,klev
55  DO i=1,klon
56!   zed(i,j)=0.
57    zmfd(i,j)=0.
58    zmfa(i,j)=0.
59    zmfu(i,j)=0.
60    zmfp(i,j)=0.
61  END DO
62  END DO
63!cdir collapse
64  DO k=1,klev
65  DO j=1,klev
66  DO i=1,klon
67    zmd(i,j,k)=0.
68    za (i,j,k)=0.
69  END DO
70  END DO
71  END DO
72! entrainement
73! DO k=1,klev-1
74!    DO i=1,klon
75!       zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
76!    END DO
77! END DO
78
79! calcul de la matrice d echange
80! matrice de distribution de la masse entrainee en k
81
82  DO k=1,klev-1
83     DO i=1,klon
84        zmd(i,k,k)=max(0.,mp(i,k)-mp(i,k+1))
85     END DO
86  END DO
87  DO k=2,klev
88     DO j=k-1,1,-1
89        DO i=1,klon
90!!           if(mp(i,j+1).ne.0) then
91!!              zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
92!!           ENDif
93           zmd(i,j,k)=zmd(i,j+1,k)*mp(i,j)/max(mp(i,j),mp(i,j+1),smallest_mp)
94        END DO
95     END DO
96  END DO
97  DO k=1,klev
98     DO j=1,klev-1
99        DO i=1,klon
100           za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
101        END DO
102     END DO
103  END DO
104!
105! rajout du terme lie a l ascendance induite
106!
107  DO j=2,klev
108     DO i=1,klon
109        za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
110     END DO
111  END DO
112!
113! tendances
114!           
115  DO k=1,klev
116     DO j=1,klev
117        DO i=1,klon
118           zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k,it)-x(i,j,it))
119        END DO
120     END DO
121  END DO
122!
123! =========================================
124! calcul des tendances liees aux flux satures
125! =========================================
126!RL
127!  Feeding concentrations
128  DO j=1,klev
129     DO i=1,klon
130        qfeed(i,it)=qfeed(i,it)+wght_cvfd(i,j)*x(i,j,it)
131     END DO
132  END DO
133!RL
134!
135  DO j=1,klev
136     DO i=1,klon
137!RL
138!!        zmfa(i,j,it)=da(i,j)*(x(i,1,it)-x(i,j,it))                     ! da
139        zmfa(i,j)=da(i,j)*(qfeed(i,it)-x(i,j,it))                     ! da
140!RL
141     END DO
142  END DO
143!
144!!  print *,'it, qfeed(1,it), x(1,1,it) ', it, qfeed(1,it), x(1,1,it)  !jyg
145!!  print *,'wght_cvfd ', (j, wght_cvfd(1,j), j=1,5)                     !jyg
146!
147  DO k=1,klev
148     DO j=1,klev
149        DO i=1,klon
150           zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k,it)-x(i,j,it))
151        END DO
152     END DO
153  END DO
154  DO j=1,klev-1
155     DO i=1,klon
156        zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1,it)-x(i,j,it))
157     END DO
158  END DO
159  DO j=2,klev
160     DO i=1,klon
161        zmfu(i,j)=zmfu(i,j)+min(0.,upd(i,j)+dnd(i,j))*(x(i,j,it)-x(i,j-1,it))
162     END DO
163  END DO
164
165! =========================================
166! calcul final des tendances
167! =========================================
168  DO k=1, klev
169     DO i=1, klon
170        deltap(i,k)=paprs(i,k)-paprs(i,k+1)
171     ENDDO
172  ENDDO
173  pdtimeRG=pdtime*RG
174!cdir collapse
175  DO k=1, klev
176     DO i=1, klon
177        dx(i,k,it)=(zmfd(i,k)+zmfu(i,k)       &
178                +zmfa(i,k)+zmfp(i,k))*pdtimeRG/deltap(i,k)
179     ENDDO
180  ENDDO
181
182!! test de conservation du traceur
183      conserv=0.
184      smfd = 0.
185      smfu = 0.
186      smfa = 0.
187      smfp = 0.
188      DO k=1, klev
189        DO i=1, klon
190         conserv=conserv+dx(i,k,it)*   &
191          deltap(i,k)/RG
192         smfd = smfd + zmfd(i,k)*pdtime
193         smfu = smfu + zmfu(i,k)*pdtime
194         smfa = smfa + zmfa(i,k)*pdtime
195         smfp = smfp + zmfp(i,k)*pdtime
196        ENDDO
197      ENDDO
198!!      print *,'it',it,'cvltr_noscav conserv, smfd, smfu, smfa, smfp ',conserv,  &
199!!               smfd, smfu, smfa, smfp
200     
201END SUBROUTINE cvltr_noscav
Note: See TracBrowser for help on using the repository browser.