| 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 |