1 |
|
|
MODULE lmdz_thermcell_flux2 |
2 |
|
|
! |
3 |
|
|
! $Id: lmdz_thermcell_flux2.F90 4590 2023-06-29 01:03:15Z fhourdin $ |
4 |
|
|
! |
5 |
|
|
CONTAINS |
6 |
|
|
|
7 |
|
288 |
SUBROUTINE thermcell_flux2(ngrid,nlay,ptimestep,masse, & |
8 |
|
|
& lalim,lmax,alim_star, & |
9 |
|
288 |
& entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, & |
10 |
|
|
& detr,zqla,lev_out,lunout1,igout) |
11 |
|
|
!IM 060508 & detr,zqla,zmax,lev_out,lunout,igout) |
12 |
|
|
|
13 |
|
|
|
14 |
|
|
!--------------------------------------------------------------------------- |
15 |
|
|
!thermcell_flux: deduction des flux |
16 |
|
|
!--------------------------------------------------------------------------- |
17 |
|
|
|
18 |
|
|
USE lmdz_thermcell_ini, ONLY : prt_level,iflag_thermals_optflux |
19 |
|
|
IMPLICIT NONE |
20 |
|
|
|
21 |
|
|
! arguments |
22 |
|
|
INTEGER, intent(in) :: ngrid,nlay |
23 |
|
|
REAL, intent(in) :: ptimestep |
24 |
|
|
REAL, intent(in), dimension(ngrid,nlay) :: masse |
25 |
|
|
INTEGER, intent(in), dimension(ngrid) :: lalim,lmax |
26 |
|
|
REAL, intent(in), dimension(ngrid,nlay) :: alim_star,entr_star,detr_star |
27 |
|
|
REAL, intent(in), dimension(ngrid) :: f |
28 |
|
|
REAL, intent(in), dimension(ngrid,nlay) :: rhobarz |
29 |
|
|
REAL, intent(in), dimension(ngrid,nlay+1) :: zw2,zlev |
30 |
|
|
! FH : laisser ca le temps de verifier qu'on a bien fait de commenter les |
31 |
|
|
! lignes faisant apparaitre zqla, zmax ... |
32 |
|
|
! REAL, intent(in), dimension(ngrid) :: zmax(ngrid) |
33 |
|
|
! enlever aussi zqla |
34 |
|
|
REAL, intent(in), dimension(ngrid,nlay) :: zqla ! not used |
35 |
|
|
integer, intent(in) :: lev_out, lunout1 |
36 |
|
|
|
37 |
|
|
REAL,intent(out), dimension(ngrid,nlay) :: entr,detr |
38 |
|
|
REAL,intent(out), dimension(ngrid,nlay+1) :: fm |
39 |
|
|
|
40 |
|
|
! local |
41 |
|
|
INTEGER ig,l |
42 |
|
|
integer igout,lout |
43 |
|
|
REAL zfm |
44 |
|
|
integer ncorecfm1,ncorecfm2,ncorecfm3,ncorecalpha |
45 |
|
|
integer ncorecfm4,ncorecfm5,ncorecfm6,ncorecfm7,ncorecfm8 |
46 |
|
|
|
47 |
|
|
|
48 |
|
|
REAL f_old,ddd0,eee0,ddd,eee,zzz |
49 |
|
|
|
50 |
|
|
REAL,SAVE :: fomass_max=0.5 |
51 |
|
|
REAL,SAVE :: alphamax=0.7 |
52 |
|
|
!$OMP THREADPRIVATE(fomass_max,alphamax) |
53 |
|
|
|
54 |
|
|
logical check_debug,labort_physic |
55 |
|
|
|
56 |
|
|
character (len=20) :: modname='thermcell_flux2' |
57 |
|
|
character (len=80) :: abort_message |
58 |
|
|
|
59 |
|
|
|
60 |
|
|
ncorecfm1=0 |
61 |
|
|
ncorecfm2=0 |
62 |
|
|
ncorecfm3=0 |
63 |
|
|
ncorecfm4=0 |
64 |
|
|
ncorecfm5=0 |
65 |
|
|
ncorecfm6=0 |
66 |
|
|
ncorecfm7=0 |
67 |
|
|
ncorecfm8=0 |
68 |
|
|
ncorecalpha=0 |
69 |
|
|
|
70 |
|
|
!initialisation |
71 |
✓✓✓✓
|
11462688 |
fm(:,:)=0. |
72 |
|
|
|
73 |
✗✓ |
288 |
if (prt_level.ge.10) then |
74 |
|
|
write(lunout1,*) 'Dans thermcell_flux 0' |
75 |
|
|
write(lunout1,*) 'flux base ',f(igout) |
76 |
|
|
write(lunout1,*) 'lmax ',lmax(igout) |
77 |
|
|
write(lunout1,*) 'lalim ',lalim(igout) |
78 |
|
|
write(lunout1,*) 'ig= ',igout |
79 |
|
|
write(lunout1,*) ' l E* A* D* ' |
80 |
|
|
write(lunout1,'(i4,3e15.5)') (l,entr_star(igout,l),alim_star(igout,l),detr_star(igout,l) & |
81 |
|
|
& ,l=1,lmax(igout)) |
82 |
|
|
endif |
83 |
|
|
|
84 |
|
|
|
85 |
|
|
!------------------------------------------------------------------------- |
86 |
|
|
! Verification de la nullite des entrainement et detrainement au dessus |
87 |
|
|
! de lmax(ig) |
88 |
|
|
! Active uniquement si check_debug=.true. ou prt_level>=10 |
89 |
|
|
!------------------------------------------------------------------------- |
90 |
|
|
|
91 |
|
288 |
check_debug=.false..or.prt_level>=10 |
92 |
|
|
|
93 |
✗✓ |
288 |
if (check_debug) then |
94 |
|
|
do l=1,nlay |
95 |
|
|
do ig=1,ngrid |
96 |
|
|
if (l.le.lmax(ig)) then |
97 |
|
|
if (entr_star(ig,l).gt.1.) then |
98 |
|
|
print*,'WARNING thermcell_flux 1 ig,l,lmax(ig)',ig,l,lmax(ig) |
99 |
|
|
print*,'entr_star(ig,l)',entr_star(ig,l) |
100 |
|
|
print*,'alim_star(ig,l)',alim_star(ig,l) |
101 |
|
|
print*,'detr_star(ig,l)',detr_star(ig,l) |
102 |
|
|
endif |
103 |
|
|
else |
104 |
|
|
if (abs(entr_star(ig,l))+abs(alim_star(ig,l))+abs(detr_star(ig,l)).gt.0.) then |
105 |
|
|
print*,'cas 1 : ig,l,lmax(ig)',ig,l,lmax(ig) |
106 |
|
|
print*,'entr_star(ig,l)',entr_star(ig,l) |
107 |
|
|
print*,'alim_star(ig,l)',alim_star(ig,l) |
108 |
|
|
print*,'detr_star(ig,l)',detr_star(ig,l) |
109 |
|
|
abort_message = '' |
110 |
|
|
labort_physic=.true. |
111 |
|
|
CALL abort_physic (modname,abort_message,1) |
112 |
|
|
endif |
113 |
|
|
endif |
114 |
|
|
enddo |
115 |
|
|
enddo |
116 |
|
|
endif |
117 |
|
|
|
118 |
|
|
!------------------------------------------------------------------------- |
119 |
|
|
! Multiplication par le flux de masse issu de la femreture |
120 |
|
|
!------------------------------------------------------------------------- |
121 |
|
|
|
122 |
✓✓ |
11520 |
do l=1,nlay |
123 |
✓✓ |
11175840 |
entr(:,l)=f(:)*(entr_star(:,l)+alim_star(:,l)) |
124 |
✓✓ |
11176128 |
detr(:,l)=f(:)*detr_star(:,l) |
125 |
|
|
enddo |
126 |
|
|
|
127 |
✗✓ |
288 |
if (prt_level.ge.10) then |
128 |
|
|
write(lunout1,*) 'Dans thermcell_flux 1' |
129 |
|
|
write(lunout1,*) 'flux base ',f(igout) |
130 |
|
|
write(lunout1,*) 'lmax ',lmax(igout) |
131 |
|
|
write(lunout1,*) 'lalim ',lalim(igout) |
132 |
|
|
write(lunout1,*) 'ig= ',igout |
133 |
|
|
write(lunout1,*) ' l E D W2' |
134 |
|
|
write(lunout1,'(i4,3e15.5)') (l,entr(igout,l),detr(igout,l) & |
135 |
|
|
& ,zw2(igout,l+1),l=1,lmax(igout)) |
136 |
|
|
endif |
137 |
|
|
|
138 |
✓✓ |
286560 |
fm(:,1)=0. |
139 |
✓✓ |
11520 |
do l=1,nlay |
140 |
✓✓ |
11176128 |
do ig=1,ngrid |
141 |
✓✓ |
11175840 |
if (l.lt.lmax(ig)) then |
142 |
|
742187 |
fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l) |
143 |
✓✓ |
10422421 |
elseif(l.eq.lmax(ig)) then |
144 |
|
286272 |
fm(ig,l+1)=0. |
145 |
|
286272 |
detr(ig,l)=fm(ig,l)+entr(ig,l) |
146 |
|
|
else |
147 |
|
10136149 |
fm(ig,l+1)=0. |
148 |
|
|
endif |
149 |
|
|
enddo |
150 |
|
|
enddo |
151 |
|
|
|
152 |
|
|
|
153 |
|
|
|
154 |
|
|
! Test provisoire : pour comprendre pourquoi on corrige plein de fois |
155 |
|
|
! le cas fm6, on commence par regarder une premiere fois avant les |
156 |
|
|
! autres corrections. |
157 |
|
|
|
158 |
✓✓ |
11520 |
do l=1,nlay |
159 |
✓✓ |
11176128 |
do ig=1,ngrid |
160 |
|
11232 |
if (detr(ig,l).gt.fm(ig,l)) then |
161 |
|
|
ncorecfm8=ncorecfm8+1 |
162 |
|
|
! igout=ig |
163 |
|
|
endif |
164 |
|
|
enddo |
165 |
|
|
enddo |
166 |
|
|
|
167 |
|
|
! if (prt_level.ge.10) & |
168 |
|
|
! & call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, & |
169 |
|
|
! & ptimestep,masse,entr,detr,fm,'2 ') |
170 |
|
|
|
171 |
|
|
|
172 |
|
|
|
173 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
174 |
|
|
! FH Version en cours de test; |
175 |
|
|
! par rapport a thermcell_flux, on fait une grande boucle sur "l" |
176 |
|
|
! et on modifie le flux avec tous les contr�les appliques d'affilee |
177 |
|
|
! pour la meme couche |
178 |
|
|
! Momentanement, on duplique le calcule du flux pour pouvoir comparer |
179 |
|
|
! les flux avant et apres modif |
180 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
181 |
|
|
|
182 |
✓✓ |
11520 |
do l=1,nlay |
183 |
|
|
|
184 |
✓✓ |
11175840 |
do ig=1,ngrid |
185 |
✓✓ |
11175840 |
if (l.lt.lmax(ig)) then |
186 |
|
742187 |
fm(ig,l+1)=fm(ig,l)+entr(ig,l)-detr(ig,l) |
187 |
✓✓ |
10422421 |
elseif(l.eq.lmax(ig)) then |
188 |
|
286272 |
fm(ig,l+1)=0. |
189 |
|
286272 |
detr(ig,l)=fm(ig,l)+entr(ig,l) |
190 |
|
|
else |
191 |
|
10136149 |
fm(ig,l+1)=0. |
192 |
|
|
endif |
193 |
|
|
enddo |
194 |
|
|
|
195 |
|
|
|
196 |
|
|
!------------------------------------------------------------------------- |
197 |
|
|
! Verification de la positivite des flux de masse |
198 |
|
|
!------------------------------------------------------------------------- |
199 |
|
|
|
200 |
|
|
! do l=1,nlay |
201 |
✓✓ |
11175840 |
do ig=1,ngrid |
202 |
✓✓ |
11175840 |
if (fm(ig,l+1).lt.0.) then |
203 |
|
|
! print*,'fm1<0',l+1,lmax(ig),fm(ig,l+1) |
204 |
|
|
ncorecfm1=ncorecfm1+1 |
205 |
|
4534 |
fm(ig,l+1)=fm(ig,l) |
206 |
|
4534 |
detr(ig,l)=entr(ig,l) |
207 |
|
|
endif |
208 |
|
|
enddo |
209 |
|
|
! enddo |
210 |
|
|
|
211 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
212 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
213 |
|
|
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
214 |
|
|
|
215 |
|
|
!------------------------------------------------------------------------- |
216 |
|
|
!Test sur fraca croissant |
217 |
|
|
!------------------------------------------------------------------------- |
218 |
✓✗ |
11232 |
if (iflag_thermals_optflux==0) then |
219 |
|
|
! do l=1,nlay |
220 |
✓✓ |
11175840 |
do ig=1,ngrid |
221 |
|
|
if (l.ge.lalim(ig).and.l.le.lmax(ig) & |
222 |
✓✓✓✓
✓✓✓✗
|
11175840 |
& .and.(zw2(ig,l+1).gt.1.e-10).and.(zw2(ig,l).gt.1.e-10) ) then |
223 |
|
|
! zzz est le flux en l+1 a frac constant |
224 |
|
|
zzz=fm(ig,l)*rhobarz(ig,l+1)*zw2(ig,l+1) & |
225 |
|
400717 |
& /(rhobarz(ig,l)*zw2(ig,l)) |
226 |
✓✓ |
400717 |
if (fm(ig,l+1).gt.zzz) then |
227 |
|
3930 |
detr(ig,l)=detr(ig,l)+fm(ig,l+1)-zzz |
228 |
|
3930 |
fm(ig,l+1)=zzz |
229 |
|
|
ncorecfm4=ncorecfm4+1 |
230 |
|
|
endif |
231 |
|
|
endif |
232 |
|
|
enddo |
233 |
|
|
! enddo |
234 |
|
|
endif |
235 |
|
|
|
236 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
237 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
238 |
|
|
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
239 |
|
|
|
240 |
|
|
|
241 |
|
|
!------------------------------------------------------------------------- |
242 |
|
|
!test sur flux de masse croissant |
243 |
|
|
!------------------------------------------------------------------------- |
244 |
✓✗ |
11232 |
if (iflag_thermals_optflux==0) then |
245 |
|
|
! do l=1,nlay |
246 |
✓✓ |
11175840 |
do ig=1,ngrid |
247 |
✓✓✓✓
|
11175840 |
if ((fm(ig,l+1).gt.fm(ig,l)).and.(l.gt.lalim(ig))) then |
248 |
|
|
f_old=fm(ig,l+1) |
249 |
|
502 |
fm(ig,l+1)=fm(ig,l) |
250 |
|
502 |
detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1) |
251 |
|
|
ncorecfm5=ncorecfm5+1 |
252 |
|
|
endif |
253 |
|
|
enddo |
254 |
|
|
! enddo |
255 |
|
|
endif |
256 |
|
|
|
257 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
258 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
259 |
|
|
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
260 |
|
|
|
261 |
|
|
!fin 1.eq.0 |
262 |
|
|
!------------------------------------------------------------------------- |
263 |
|
|
!detr ne peut pas etre superieur a fm |
264 |
|
|
!------------------------------------------------------------------------- |
265 |
|
|
|
266 |
|
|
if(1.eq.1) then |
267 |
|
|
|
268 |
|
|
! do l=1,nlay |
269 |
|
|
|
270 |
|
|
|
271 |
|
|
|
272 |
|
|
labort_physic=.false. |
273 |
✓✓ |
11175840 |
do ig=1,ngrid |
274 |
✗✓ |
11175840 |
if (entr(ig,l)<0.) then |
275 |
|
|
labort_physic=.true. |
276 |
|
|
igout=ig |
277 |
|
|
lout=l |
278 |
|
|
endif |
279 |
|
|
enddo |
280 |
|
|
|
281 |
✗✓ |
11232 |
if (labort_physic) then |
282 |
|
|
print*,'N1 ig,l,entr',igout,lout,entr(igout,lout) |
283 |
|
|
abort_message = 'entr negatif' |
284 |
|
|
CALL abort_physic (modname,abort_message,1) |
285 |
|
|
endif |
286 |
|
|
|
287 |
✓✓ |
11175840 |
do ig=1,ngrid |
288 |
✓✓ |
11164608 |
if (detr(ig,l).gt.fm(ig,l)) then |
289 |
|
|
ncorecfm6=ncorecfm6+1 |
290 |
|
138283 |
detr(ig,l)=fm(ig,l) |
291 |
|
138283 |
entr(ig,l)=fm(ig,l+1) |
292 |
|
|
|
293 |
|
|
! Dans le cas ou on est au dessus de la couche d'alimentation et que le |
294 |
|
|
! detrainement est plus fort que le flux de masse, on stope le thermique. |
295 |
|
|
!test:on commente |
296 |
|
|
! if (l.gt.lalim(ig)) then |
297 |
|
|
! lmax(ig)=l |
298 |
|
|
! fm(ig,l+1)=0. |
299 |
|
|
! entr(ig,l)=0. |
300 |
|
|
! else |
301 |
|
|
! ncorecfm7=ncorecfm7+1 |
302 |
|
|
! endif |
303 |
|
|
endif |
304 |
|
|
|
305 |
✓✓ |
11175840 |
if(l.gt.lmax(ig)) then |
306 |
|
10136149 |
detr(ig,l)=0. |
307 |
|
10136149 |
fm(ig,l+1)=0. |
308 |
|
10136149 |
entr(ig,l)=0. |
309 |
|
|
endif |
310 |
|
|
enddo |
311 |
|
|
|
312 |
|
|
labort_physic=.false. |
313 |
✓✓ |
11175840 |
do ig=1,ngrid |
314 |
✗✓ |
11175840 |
if (entr(ig,l).lt.0.) then |
315 |
|
|
labort_physic=.true. |
316 |
|
|
igout=ig |
317 |
|
|
endif |
318 |
|
|
enddo |
319 |
✗✓ |
11232 |
if (labort_physic) then |
320 |
|
|
ig=igout |
321 |
|
|
print*,'ig,l,lmax(ig)',ig,l,lmax(ig) |
322 |
|
|
print*,'entr(ig,l)',entr(ig,l) |
323 |
|
|
print*,'fm(ig,l)',fm(ig,l) |
324 |
|
|
abort_message = 'probleme dans thermcell flux' |
325 |
|
|
CALL abort_physic (modname,abort_message,1) |
326 |
|
|
endif |
327 |
|
|
|
328 |
|
|
|
329 |
|
|
! enddo |
330 |
|
|
endif |
331 |
|
|
|
332 |
|
|
|
333 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
334 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
335 |
|
|
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
336 |
|
|
|
337 |
|
|
!------------------------------------------------------------------------- |
338 |
|
|
!fm ne peut pas etre negatif |
339 |
|
|
!------------------------------------------------------------------------- |
340 |
|
|
|
341 |
|
|
! do l=1,nlay |
342 |
✓✓ |
11175840 |
do ig=1,ngrid |
343 |
✗✓ |
11175840 |
if (fm(ig,l+1).lt.0.) then |
344 |
|
|
detr(ig,l)=detr(ig,l)+fm(ig,l+1) |
345 |
|
|
fm(ig,l+1)=0. |
346 |
|
|
ncorecfm2=ncorecfm2+1 |
347 |
|
|
endif |
348 |
|
|
enddo |
349 |
|
|
|
350 |
|
|
labort_physic=.false. |
351 |
✓✓ |
11175840 |
do ig=1,ngrid |
352 |
✗✓ |
11175840 |
if (detr(ig,l).lt.0.) then |
353 |
|
|
labort_physic=.true. |
354 |
|
|
igout=ig |
355 |
|
|
endif |
356 |
|
|
enddo |
357 |
✗✓ |
11232 |
if (labort_physic) then |
358 |
|
|
ig=igout |
359 |
|
|
print*,'cas 2 : ig,l,lmax(ig)',ig,l,lmax(ig) |
360 |
|
|
print*,'detr(ig,l)',detr(ig,l) |
361 |
|
|
print*,'fm(ig,l)',fm(ig,l) |
362 |
|
|
abort_message = 'probleme dans thermcell flux' |
363 |
|
|
CALL abort_physic (modname,abort_message,1) |
364 |
|
|
endif |
365 |
|
|
! enddo |
366 |
|
|
|
367 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
368 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
369 |
|
|
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
370 |
|
|
|
371 |
|
|
!----------------------------------------------------------------------- |
372 |
|
|
!la fraction couverte ne peut pas etre superieure a 1 |
373 |
|
|
!----------------------------------------------------------------------- |
374 |
|
|
|
375 |
|
|
|
376 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
377 |
|
|
! FH Partie a revisiter. |
378 |
|
|
! Il semble qu'etaient codees ici deux optiques dans le cas |
379 |
|
|
! F/ (rho *w) > 1 |
380 |
|
|
! soit limiter la hauteur du thermique en considerant que c'est |
381 |
|
|
! la derniere chouche, soit limiter F a rho w. |
382 |
|
|
! Dans le second cas, il faut en fait limiter a un peu moins |
383 |
|
|
! que ca parce qu'on a des 1 / ( 1 -alpha) un peu plus loin |
384 |
|
|
! dans thermcell_main et qu'il semble de toutes facons deraisonable |
385 |
|
|
! d'avoir des fractions de 1.. |
386 |
|
|
! Ci dessous, et dans l'etat actuel, le premier des deux if est |
387 |
|
|
! sans doute inutile. |
388 |
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
389 |
|
|
|
390 |
|
|
! do l=1,nlay |
391 |
✓✓ |
11175840 |
do ig=1,ngrid |
392 |
✓✓ |
11175840 |
if (zw2(ig,l+1).gt.1.e-10) then |
393 |
|
741355 |
zfm=rhobarz(ig,l+1)*zw2(ig,l+1)*alphamax |
394 |
✓✓ |
741355 |
if ( fm(ig,l+1) .gt. zfm) then |
395 |
|
|
f_old=fm(ig,l+1) |
396 |
|
3447 |
fm(ig,l+1)=zfm |
397 |
|
3447 |
detr(ig,l)=detr(ig,l)+f_old-fm(ig,l+1) |
398 |
|
|
! lmax(ig)=l+1 |
399 |
|
|
! zmax(ig)=zlev(ig,lmax(ig)) |
400 |
|
|
! print*,'alpha>1',l+1,lmax(ig) |
401 |
|
|
ncorecalpha=ncorecalpha+1 |
402 |
|
|
endif |
403 |
|
|
endif |
404 |
|
|
enddo |
405 |
|
|
! enddo |
406 |
|
|
! |
407 |
|
|
|
408 |
|
|
|
409 |
✗✓ |
11232 |
if (prt_level.ge.10) & |
410 |
|
|
& write(lunout1,'(i4,4e14.4)') l,masse(igout,l)/ptimestep, & |
411 |
|
288 |
& entr(igout,l),detr(igout,l),fm(igout,l+1) |
412 |
|
|
|
413 |
|
|
! Fin de la grande boucle sur les niveaux verticaux |
414 |
|
|
enddo |
415 |
|
|
|
416 |
|
|
! if (prt_level.ge.10) & |
417 |
|
|
! & call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, & |
418 |
|
|
! & ptimestep,masse,entr,detr,fm,'8 ') |
419 |
|
|
|
420 |
|
|
|
421 |
|
|
!----------------------------------------------------------------------- |
422 |
|
|
! On fait en sorte que la quantite totale d'air entraine dans le |
423 |
|
|
! panache ne soit pas trop grande comparee a la masse de la maille |
424 |
|
|
!----------------------------------------------------------------------- |
425 |
|
|
|
426 |
|
|
if (1.eq.1) then |
427 |
|
|
labort_physic=.false. |
428 |
✓✓ |
11232 |
do l=1,nlay-1 |
429 |
✓✓ |
10889568 |
do ig=1,ngrid |
430 |
|
10878336 |
eee0=entr(ig,l) |
431 |
|
10878336 |
ddd0=detr(ig,l) |
432 |
|
10878336 |
eee=entr(ig,l)-masse(ig,l)*fomass_max/ptimestep |
433 |
|
10878336 |
ddd=detr(ig,l)-eee |
434 |
✓✓ |
10889280 |
if (eee.gt.0.) then |
435 |
|
|
ncorecfm3=ncorecfm3+1 |
436 |
|
284062 |
entr(ig,l)=entr(ig,l)-eee |
437 |
✓✓ |
284062 |
if ( ddd.gt.0.) then |
438 |
|
|
! l'entrainement est trop fort mais l'exces peut etre compense par une |
439 |
|
|
! diminution du detrainement) |
440 |
|
20963 |
detr(ig,l)=ddd |
441 |
|
|
else |
442 |
|
|
! l'entrainement est trop fort mais l'exces doit etre compense en partie |
443 |
|
|
! par un entrainement plus fort dans la couche superieure |
444 |
✗✓ |
263099 |
if(l.eq.lmax(ig)) then |
445 |
|
|
detr(ig,l)=fm(ig,l)+entr(ig,l) |
446 |
|
|
else |
447 |
|
|
if(l.ge.lmax(ig).and.0.eq.1) then |
448 |
|
|
igout=ig |
449 |
|
|
lout=l |
450 |
|
|
labort_physic=.true. |
451 |
|
|
endif |
452 |
|
263099 |
entr(ig,l+1)=entr(ig,l+1)-ddd |
453 |
|
263099 |
detr(ig,l)=0. |
454 |
|
263099 |
fm(ig,l+1)=fm(ig,l)+entr(ig,l) |
455 |
|
|
detr(ig,l)=0. |
456 |
|
|
endif |
457 |
|
|
endif |
458 |
|
|
endif |
459 |
|
|
enddo |
460 |
|
|
enddo |
461 |
|
|
if (labort_physic) then |
462 |
|
|
ig=igout |
463 |
|
|
l=lout |
464 |
|
|
print*,'ig,l',ig,l |
465 |
|
|
print*,'eee0',eee0 |
466 |
|
|
print*,'ddd0',ddd0 |
467 |
|
|
print*,'eee',eee |
468 |
|
|
print*,'ddd',ddd |
469 |
|
|
print*,'entr',entr(ig,l) |
470 |
|
|
print*,'detr',detr(ig,l) |
471 |
|
|
print*,'masse',masse(ig,l) |
472 |
|
|
print*,'fomass_max',fomass_max |
473 |
|
|
print*,'masse(ig,l)*fomass_max/ptimestep',masse(ig,l)*fomass_max/ptimestep |
474 |
|
|
print*,'ptimestep',ptimestep |
475 |
|
|
print*,'lmax(ig)',lmax(ig) |
476 |
|
|
print*,'fm(ig,l+1)',fm(ig,l+1) |
477 |
|
|
print*,'fm(ig,l)',fm(ig,l) |
478 |
|
|
abort_message = 'probleme dans thermcell_flux' |
479 |
|
|
CALL abort_physic (modname,abort_message,1) |
480 |
|
|
endif |
481 |
|
|
endif |
482 |
|
|
! |
483 |
|
|
! ddd=detr(ig)-entre |
484 |
|
|
!on s assure que tout s annule bien en zmax |
485 |
✓✓ |
286560 |
do ig=1,ngrid |
486 |
|
286272 |
fm(ig,lmax(ig)+1)=0. |
487 |
|
286272 |
entr(ig,lmax(ig))=0. |
488 |
|
286560 |
detr(ig,lmax(ig))=fm(ig,lmax(ig))+entr(ig,lmax(ig)) |
489 |
|
|
enddo |
490 |
|
|
|
491 |
|
|
!----------------------------------------------------------------------- |
492 |
|
|
! Impression du nombre de bidouilles qui ont ete necessaires |
493 |
|
|
!----------------------------------------------------------------------- |
494 |
|
|
|
495 |
|
|
!IM 090508 beg |
496 |
|
|
! if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then |
497 |
|
|
! |
498 |
|
|
! print*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',& |
499 |
|
|
! & ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', & |
500 |
|
|
! & ncorecfm4,'x fm4',ncorecfm5,'x fm5 et', & |
501 |
|
|
! & ncorecfm6,'x fm6', & |
502 |
|
|
! & ncorecfm7,'x fm7', & |
503 |
|
|
! & ncorecfm8,'x fm8', & |
504 |
|
|
! & ncorecalpha,'x alpha' |
505 |
|
|
! endif |
506 |
|
|
!IM 090508 end |
507 |
|
|
|
508 |
|
|
! if (prt_level.ge.10) & |
509 |
|
|
! & call printflux(ngrid,nlay,lunout1,igout,f,lmax,lalim, & |
510 |
|
|
! & ptimestep,masse,entr,detr,fm,'fin') |
511 |
|
|
|
512 |
|
|
|
513 |
|
288 |
RETURN |
514 |
|
|
end |
515 |
|
|
END MODULE lmdz_thermcell_flux2 |