source: LMDZ6/branches/contrails/libf/phylmd/cvltr_noscav.f90 @ 5456

Last change on this file since 5456 was 5289, checked in by abarral, 2 months ago

Turn YOECUMF.h into a module
Fix USE in fxy_new_mod_h.f90

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