Changeset 852 for LMDZ4/trunk/libf/phytherm/thermcell_main.F90
- Timestamp:
- Oct 11, 2007, 3:43:42 PM (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phytherm/thermcell_main.F90
r814 r852 1 ! 2 ! $Header$ 3 ! 1 4 SUBROUTINE thermcell_main(ngrid,nlay,ptimestep & 2 5 & ,pplay,pplev,pphi,debut & … … 55 58 ! ------ 56 59 57 integer,save :: igout=871 60 ! integer,save :: igout=4259 61 integer,save :: igout=2928 58 62 integer,save :: lunout=6 59 integer,save :: lev_out= 063 integer,save :: lev_out=10 60 64 61 65 INTEGER ig,k,l,ll … … 129 133 real zlevinter(klon) 130 134 logical debut 135 real seuil 131 136 132 137 ! … … 142 147 ! --------------- 143 148 ! 149 150 seuil=0.25 151 144 152 if (lev_out.ge.1) print*,'thermcell_main V4' 145 153 … … 228 236 229 237 !------------------------------------------------------------------ 230 ! Calcul de w2, carre de w a partir de la cape 231 ! 232 ! Indicages: 233 ! l'ascendance provenant du niveau k traverse l'interface l avec 234 ! une vitesse wa(k,l). 235 ! 236 ! -------------------- 237 ! 238 ! + + + + + + + + + + 239 ! 240 ! wa(k,l) ---- -------------------- l 241 ! /\ 242 ! /||\ + + + + + + + + + + 243 ! || 244 ! || -------------------- 245 ! || 246 ! || + + + + + + + + + + 247 ! || 248 ! || -------------------- 249 ! ||__ 250 ! |___ + + + + + + + + + + k 251 ! 252 ! -------------------- 253 ! 254 ! 255 ! 238 ! 239 ! /|\ 240 ! -------- | F_k+1 ------- 241 ! ----> D_k 242 ! /|\ <---- E_k , A_k 243 ! -------- | F_k --------- 244 ! ----> D_k-1 245 ! <---- E_k-1 , A_k-1 246 ! 247 ! 248 ! 249 ! 250 ! 251 ! --------------------------- 252 ! 253 ! ----- F_lmax+1=0 ---------- \ 254 ! lmax (zmax) | 255 ! --------------------------- | 256 ! | 257 ! --------------------------- | 258 ! | 259 ! --------------------------- | 260 ! | 261 ! --------------------------- | 262 ! | 263 ! --------------------------- | 264 ! | E 265 ! --------------------------- | D 266 ! | 267 ! --------------------------- | 268 ! | 269 ! --------------------------- \ | 270 ! lalim | | 271 ! --------------------------- | | 272 ! | | 273 ! --------------------------- | | 274 ! | A | 275 ! --------------------------- | | 276 ! | | 277 ! --------------------------- | | 278 ! lmin (=1 pour le moment) | | 279 ! ----- F_lmin=0 ------------ / / 280 ! 281 ! --------------------------- 282 ! ////////////////////////// 283 ! 284 ! 285 !============================================================================= 286 ! Calculs initiaux ne faisant pas intervenir les changements de phase 287 !============================================================================= 288 256 289 !------------------------------------------------------------------ 257 !definition du profil d alimentation a partir de la flottabilite: 258 !alim_star, alim_star_tot, lalim et lmin 290 ! 1. alim_star est le profil vertical de l'alimentation à la base du 291 ! panache thermique, calculé à partir de la flotabilité de l'air sec 292 ! 2. lmin et lalim sont les indices inferieurs et superieurs de alim_star 259 293 !------------------------------------------------------------------ 260 294 ! … … 262 296 CALL thermcell_init(ngrid,nlay,ztv,zlev, & 263 297 & lalim,lmin,alim_star,alim_star_tot,lev_out) 298 299 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lmin ') 300 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_init lalim ') 301 264 302 265 303 if (lev_out.ge.1) print*,'thermcell_main apres thermcell_init' … … 268 306 write(lunout,*) 'lmin ',lmin(igout) 269 307 write(lunout,*) 'lalim ',lalim(igout) 308 write(lunout,*) ' ig l alim_star thetav' 309 write(lunout,'(i6,i4,2e15.5)') (igout,l,alim_star(igout,l) & 310 & ,ztv(igout,l),l=1,lalim(igout)+4) 270 311 endif 271 312 272 !----------------------------------------------------------------------------------- 273 !calcul des caracteristiques du thermique sec pour le calcul de detr et la fermeture 274 !----------------------------------------------------------------------------------- 313 !----------------------------------------------------------------------------- 314 ! 3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un 315 ! panache sec conservatif (e=d=0) alimente selon alim_star 316 ! Il s'agit d'un calcul de type CAPE 317 ! zmax_sec est utilisé pour déterminer la géométrie du thermique. 318 !------------------------------------------------------------------------------ 275 319 ! 276 320 CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & 277 321 & lalim,lmin,zmax_sec,wmax_sec,lev_out) 278 322 323 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') 324 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') 325 279 326 if (lev_out.ge.1) print*,'thermcell_main apres thermcell_dry' 327 if (lev_out.ge.10) then 328 write(lunout,*) 'Dans thermcell_main 1b' 329 write(lunout,*) 'lmin ',lmin(igout) 330 write(lunout,*) 'lalim ',lalim(igout) 331 write(lunout,*) ' ig l alim_star entr_star detr_star f_star ' 332 write(lunout,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) & 333 & ,l=1,lalim(igout)+4) 334 endif 280 335 281 336 … … 289 344 & lalim,zmax_sec,f0,detr_star,entr_star,f_star,ztva, & 290 345 & ztla,zqla,zqta,zha,zw2,zqsatth,lmix,linter,lev_out) 346 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') 347 call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') 291 348 292 349 if (lev_out.ge.1) print*,'thermcell_main apres thermcell_plume' … … 297 354 write(lunout,*) ' ig l alim_star entr_star detr_star f_star ' 298 355 write(lunout,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) & 299 & ,f_star(igout,l+1),l=1, lmax(igout))356 & ,f_star(igout,l+1),l=1,nint(linter(igout))+5) 300 357 endif 301 358 … … 307 364 & zlev,lmax,zmax,zmax0,zmix,wmax,lev_out) 308 365 366 367 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') 368 call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') 369 call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') 370 call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') 371 309 372 if (lev_out.ge.1) print*,'thermcell_main apres thermcell_height' 310 373 … … 322 385 !------------------------------------------------------------------------------- 323 386 324 CALL thermcell_flux (ngrid,nlay,ptimestep,masse, &387 CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, & 325 388 & lalim,lmax,alim_star, & 326 389 & entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, & … … 328 391 329 392 if (lev_out.ge.1) print*,'thermcell_main apres thermcell_flux' 393 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') 394 call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') 330 395 331 396 !c------------------------------------------------------------------ … … 391 456 enddo 392 457 458 print*,'14a OK convect8' 393 459 ! calcul du niveau de condensation 394 460 ! initialisation … … 410 476 enddo 411 477 enddo 478 print*,'14b OK convect8' 412 479 do k=nlay,1,-1 413 480 do ig=1,ngrid … … 418 485 enddo 419 486 enddo 487 print*,'14c OK convect8' 420 488 !calcul des moments 421 489 !initialisation … … 429 497 enddo 430 498 enddo 499 print*,'14d OK convect8' 431 500 do l=1,nlay 432 501 do ig=1,ngrid … … 440 509 q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 441 510 !test: on calcul q2/po=ratqsc 442 ratqscth(ig,l)=sqrt( q2(ig,l))/(po(ig,l)*1000.)511 ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.)) 443 512 enddo 444 513 enddo 445 514 !calcul du ratqscdiff 515 print*,'14e OK convect8' 446 516 var=0. 447 517 vardiff=0. … … 452 522 enddo 453 523 enddo 524 print*,'14f OK convect8' 454 525 do ig=1,ngrid 455 526 do l=1,lalim(ig) … … 462 533 enddo 463 534 enddo 535 print*,'14g OK convect8' 464 536 do l=1,nlay 465 537 do ig=1,ngrid … … 496 568 497 569 !----------------------------------------------------------------------------- 570 571 subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment) 572 573 integer klon,klev 574 real pplev(klon,klev+1),pplay(klon,klev) 575 real ztv(klon,klev) 576 real po(klon,klev) 577 real ztva(klon,klev) 578 real zqla(klon,klev) 579 real f_star(klon,klev) 580 real zw2(klon,klev) 581 integer long(klon) 582 real seuil 583 character*21 comment 584 585 print*,'TEST ',comment 586 ! test sur la hauteur des thermiques ... 587 do i=1,klon 588 if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then 589 print*,'WARNING ',comment,' au point ',i,' K= ',long(i) 590 print*,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F* W2' 591 do k=1,klev 592 write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k) 593 enddo 594 ! stop 595 endif 596 enddo 597 598 599 return 600 end 601
Note: See TracChangeset
for help on using the changeset viewer.