- Timestamp:
- Jul 24, 2024, 2:54:37 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_flux2.F90
r5111 r5116 70 70 fm(:, :) = 0. 71 71 72 if (prt_level>=10) then73 write(lunout1, *) 'Dans thermcell_flux 0'74 write(lunout1, *) 'flux base ', f(igout)75 write(lunout1, *) 'lmax ', lmax(igout)76 write(lunout1, *) 'lalim ', lalim(igout)77 write(lunout1, *) 'ig= ', igout78 write(lunout1, *) ' l E* A* D* '79 write(lunout1, '(i4,3e15.5)') (l, entr_star(igout, l), alim_star(igout, l), detr_star(igout, l) &72 if (prt_level>=10) THEN 73 WRITE(lunout1, *) 'Dans thermcell_flux 0' 74 WRITE(lunout1, *) 'flux base ', f(igout) 75 WRITE(lunout1, *) 'lmax ', lmax(igout) 76 WRITE(lunout1, *) 'lalim ', lalim(igout) 77 WRITE(lunout1, *) 'ig= ', igout 78 WRITE(lunout1, *) ' l E* A* D* ' 79 WRITE(lunout1, '(i4,3e15.5)') (l, entr_star(igout, l), alim_star(igout, l), detr_star(igout, l) & 80 80 , l = 1, lmax(igout)) 81 81 endif … … 90 90 check_debug = .false..or.prt_level>=10 91 91 92 if (check_debug) then92 if (check_debug) THEN 93 93 do l = 1, nlay 94 94 do ig = 1, ngrid 95 if (l<=lmax(ig)) then96 if (entr_star(ig, l)>1.) then95 if (l<=lmax(ig)) THEN 96 if (entr_star(ig, l)>1.) THEN 97 97 PRINT*, 'WARNING thermcell_flux 1 ig,l,lmax(ig)', ig, l, lmax(ig) 98 98 PRINT*, 'entr_star(ig,l)', entr_star(ig, l) … … 101 101 endif 102 102 else 103 if (abs(entr_star(ig, l)) + abs(alim_star(ig, l)) + abs(detr_star(ig, l))>0.) then103 if (abs(entr_star(ig, l)) + abs(alim_star(ig, l)) + abs(detr_star(ig, l))>0.) THEN 104 104 PRINT*, 'cas 1 : ig,l,lmax(ig)', ig, l, lmax(ig) 105 105 PRINT*, 'entr_star(ig,l)', entr_star(ig, l) … … 124 124 enddo 125 125 126 if (prt_level>=10) then127 write(lunout1, *) 'Dans thermcell_flux 1'128 write(lunout1, *) 'flux base ', f(igout)129 write(lunout1, *) 'lmax ', lmax(igout)130 write(lunout1, *) 'lalim ', lalim(igout)131 write(lunout1, *) 'ig= ', igout132 write(lunout1, *) ' l E D W2'133 write(lunout1, '(i4,3e15.5)') (l, entr(igout, l), detr(igout, l) &126 if (prt_level>=10) THEN 127 WRITE(lunout1, *) 'Dans thermcell_flux 1' 128 WRITE(lunout1, *) 'flux base ', f(igout) 129 WRITE(lunout1, *) 'lmax ', lmax(igout) 130 WRITE(lunout1, *) 'lalim ', lalim(igout) 131 WRITE(lunout1, *) 'ig= ', igout 132 WRITE(lunout1, *) ' l E D W2' 133 WRITE(lunout1, '(i4,3e15.5)') (l, entr(igout, l), detr(igout, l) & 134 134 , zw2(igout, l + 1), l = 1, lmax(igout)) 135 135 endif … … 138 138 do l = 1, nlay 139 139 do ig = 1, ngrid 140 if (l<lmax(ig)) then140 if (l<lmax(ig)) THEN 141 141 fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l) 142 elseif(l==lmax(ig)) then142 elseif(l==lmax(ig)) THEN 143 143 fm(ig, l + 1) = 0. 144 144 detr(ig, l) = fm(ig, l) + entr(ig, l) … … 157 157 do l = 1, nlay 158 158 do ig = 1, ngrid 159 if (detr(ig, l)>fm(ig, l)) then159 if (detr(ig, l)>fm(ig, l)) THEN 160 160 ncorecfm8 = ncorecfm8 + 1 161 161 ! igout=ig … … 182 182 183 183 do ig = 1, ngrid 184 if (l<lmax(ig)) then184 if (l<lmax(ig)) THEN 185 185 fm(ig, l + 1) = fm(ig, l) + entr(ig, l) - detr(ig, l) 186 elseif(l==lmax(ig)) then186 elseif(l==lmax(ig)) THEN 187 187 fm(ig, l + 1) = 0. 188 188 detr(ig, l) = fm(ig, l) + entr(ig, l) … … 199 199 ! do l=1,nlay 200 200 do ig = 1, ngrid 201 if (fm(ig, l + 1)<0.) then201 if (fm(ig, l + 1)<0.) THEN 202 202 ! PRINT*,'fm1<0',l+1,lmax(ig),fm(ig,l+1) 203 203 ncorecfm1 = ncorecfm1 + 1 … … 209 209 210 210 if (prt_level>=10) & 211 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &211 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 212 212 entr(igout, l), detr(igout, l), fm(igout, l + 1) 213 213 … … 215 215 !Test sur fraca croissant 216 216 !------------------------------------------------------------------------- 217 if (iflag_thermals_optflux==0) then217 if (iflag_thermals_optflux==0) THEN 218 218 ! do l=1,nlay 219 219 do ig = 1, ngrid 220 220 if (l>=lalim(ig).and.l<=lmax(ig) & 221 .and.(zw2(ig, l + 1)>1.e-10).and.(zw2(ig, l)>1.e-10)) then221 .and.(zw2(ig, l + 1)>1.e-10).and.(zw2(ig, l)>1.e-10)) THEN 222 222 ! zzz est le flux en l+1 a frac constant 223 223 zzz = fm(ig, l) * rhobarz(ig, l + 1) * zw2(ig, l + 1) & 224 224 / (rhobarz(ig, l) * zw2(ig, l)) 225 if (fm(ig, l + 1)>zzz) then225 if (fm(ig, l + 1)>zzz) THEN 226 226 detr(ig, l) = detr(ig, l) + fm(ig, l + 1) - zzz 227 227 fm(ig, l + 1) = zzz … … 234 234 235 235 if (prt_level>=10) & 236 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &236 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 237 237 entr(igout, l), detr(igout, l), fm(igout, l + 1) 238 238 … … 241 241 !test sur flux de masse croissant 242 242 !------------------------------------------------------------------------- 243 if (iflag_thermals_optflux==0) then243 if (iflag_thermals_optflux==0) THEN 244 244 ! do l=1,nlay 245 245 do ig = 1, ngrid 246 if ((fm(ig, l + 1)>fm(ig, l)).and.(l>lalim(ig))) then246 if ((fm(ig, l + 1)>fm(ig, l)).and.(l>lalim(ig))) THEN 247 247 f_old = fm(ig, l + 1) 248 248 fm(ig, l + 1) = fm(ig, l) … … 255 255 256 256 if (prt_level>=10) & 257 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &257 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 258 258 entr(igout, l), detr(igout, l), fm(igout, l + 1) 259 259 … … 263 263 !------------------------------------------------------------------------- 264 264 265 if(1==1) then 266 265 IF(1==1) THEN 267 266 ! do l=1,nlay 268 267 269 268 labort_physic = .FALSE. 270 269 do ig = 1, ngrid 271 if (entr(ig, l)<0.) then270 if (entr(ig, l)<0.) THEN 272 271 labort_physic = .TRUE. 273 272 igout = ig … … 276 275 enddo 277 276 278 if (labort_physic) then277 if (labort_physic) THEN 279 278 PRINT*, 'N1 ig,l,entr', igout, lout, entr(igout, lout) 280 279 abort_message = 'entr negatif' … … 283 282 284 283 do ig = 1, ngrid 285 if (detr(ig, l)>fm(ig, l)) then284 if (detr(ig, l)>fm(ig, l)) THEN 286 285 ncorecfm6 = ncorecfm6 + 1 287 286 detr(ig, l) = fm(ig, l) … … 291 290 ! detrainement est plus fort que le flux de masse, on stope le thermique. 292 291 !test:on commente 293 ! if (l.gt.lalim(ig)) then292 ! if (l.gt.lalim(ig)) THEN 294 293 ! lmax(ig)=l 295 294 ! fm(ig,l+1)=0. … … 300 299 endif 301 300 302 if(l>lmax(ig)) then301 IF(l>lmax(ig)) THEN 303 302 detr(ig, l) = 0. 304 303 fm(ig, l + 1) = 0. … … 309 308 labort_physic = .FALSE. 310 309 do ig = 1, ngrid 311 if (entr(ig, l)<0.) then310 if (entr(ig, l)<0.) THEN 312 311 labort_physic = .TRUE. 313 312 igout = ig 314 313 endif 315 314 enddo 316 if (labort_physic) then315 if (labort_physic) THEN 317 316 ig = igout 318 317 PRINT*, 'ig,l,lmax(ig)', ig, l, lmax(ig) … … 328 327 329 328 if (prt_level>=10) & 330 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &329 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 331 330 entr(igout, l), detr(igout, l), fm(igout, l + 1) 332 331 … … 337 336 ! do l=1,nlay 338 337 do ig = 1, ngrid 339 if (fm(ig, l + 1)<0.) then338 if (fm(ig, l + 1)<0.) THEN 340 339 detr(ig, l) = detr(ig, l) + fm(ig, l + 1) 341 340 fm(ig, l + 1) = 0. … … 346 345 labort_physic = .FALSE. 347 346 do ig = 1, ngrid 348 if (detr(ig, l)<0.) then347 if (detr(ig, l)<0.) THEN 349 348 labort_physic = .TRUE. 350 349 igout = ig 351 350 endif 352 351 enddo 353 if (labort_physic) then352 if (labort_physic) THEN 354 353 ig = igout 355 354 PRINT*, 'cas 2 : ig,l,lmax(ig)', ig, l, lmax(ig) … … 362 361 363 362 if (prt_level>=10) & 364 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &363 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 365 364 entr(igout, l), detr(igout, l), fm(igout, l + 1) 366 365 … … 386 385 ! do l=1,nlay 387 386 do ig = 1, ngrid 388 if (zw2(ig, l + 1)>1.e-10) then387 if (zw2(ig, l + 1)>1.e-10) THEN 389 388 zfm = rhobarz(ig, l + 1) * zw2(ig, l + 1) * alphamax 390 if (fm(ig, l + 1) > zfm) then389 if (fm(ig, l + 1) > zfm) THEN 391 390 f_old = fm(ig, l + 1) 392 391 fm(ig, l + 1) = zfm … … 402 401 403 402 if (prt_level>=10) & 404 write(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, &403 WRITE(lunout1, '(i4,4e14.4)') l, masse(igout, l) / ptimestep, & 405 404 entr(igout, l), detr(igout, l), fm(igout, l + 1) 406 405 … … 418 417 !----------------------------------------------------------------------- 419 418 420 if (1==1) then419 if (1==1) THEN 421 420 labort_physic = .FALSE. 422 421 do l = 1, nlay - 1 … … 426 425 eee = entr(ig, l) - masse(ig, l) * fomass_max / ptimestep 427 426 ddd = detr(ig, l) - eee 428 if (eee>0.) then427 if (eee>0.) THEN 429 428 ncorecfm3 = ncorecfm3 + 1 430 429 entr(ig, l) = entr(ig, l) - eee 431 if (ddd>0.) then430 if (ddd>0.) THEN 432 431 ! l'entrainement est trop fort mais l'exces peut etre compense par une 433 432 ! diminution du detrainement) … … 436 435 ! l'entrainement est trop fort mais l'exces doit etre compense en partie 437 436 ! par un entrainement plus fort dans la couche superieure 438 if(l==lmax(ig)) then437 IF(l==lmax(ig)) THEN 439 438 detr(ig, l) = fm(ig, l) + entr(ig, l) 440 439 else 441 if(l>=lmax(ig).and.0==1) then440 IF(l>=lmax(ig).and.0==1) THEN 442 441 igout = ig 443 442 lout = l … … 453 452 enddo 454 453 enddo 455 if (labort_physic) then454 if (labort_physic) THEN 456 455 ig = igout 457 456 l = lout … … 488 487 489 488 !IM 090508 beg 490 ! if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) then 491 489 ! if (ncorecfm1+ncorecfm2+ncorecfm3+ncorecfm4+ncorecfm5+ncorecalpha > 0 ) THEN 492 490 ! PRINT*,'PB thermcell : on a du coriger ',ncorecfm1,'x fm1',& 493 491 ! & ncorecfm2,'x fm2',ncorecfm3,'x fm3 et', &
Note: See TracChangeset
for help on using the changeset viewer.
