GCC Code Coverage Report


Directory: ./
File: phys/thermcell_flux2.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 97 161 60.2%
Branches: 102 140 72.9%

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