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 |