Changeset 4396
- Timestamp:
- Jan 24, 2023, 2:16:46 PM (22 months ago)
- Location:
- LMDZ6/trunk/libf/phylmd
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/thermcell_down.F90
r4383 r4396 1 SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac )1 SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac,dtrac) 2 2 3 3 !----------------------------------------------------------------- … … 25 25 real,intent(in), dimension(ngrid,nlay) :: ddn ! detrainment from downdrafts * dz [same unit as flux] 26 26 real,intent(in), dimension(ngrid,nlay) :: masse ! mass of layers = rho dz 27 real,intent(in out), dimension(ngrid,nlay) :: trac ! tracer27 real,intent(in), dimension(ngrid,nlay) :: trac ! tracer 28 28 integer, intent(in), dimension(ngrid) :: lmax ! max level index at which downdraft are present 29 real,intent(out),dimension(ngrid,nlay) ::dtrac ! tendance du traceur 29 30 30 31 … … 32 33 33 34 real, dimension(ngrid,nlay+1) :: fup,fdn,fthu,fthd,fthe,fthtot 34 real, dimension(ngrid,nlay) :: tracu,tracd ,dtrac35 real, dimension(ngrid,nlay) :: tracu,tracd 35 36 real :: www 36 37 integer ig,ilay … … 68 69 do ilay=1,nlay,1 69 70 do ig=1,ngrid 70 if (ilay.l e.lmax(ig) .and. lmax(ig)>1) then71 if (ilay.lt.lmax(ig) .and. lmax(ig)>1) then 71 72 fup(ig,ilay+1)=fup(ig,ilay)+eup(ig,ilay)-dup(ig,ilay) 72 73 if (ilay == 1 ) then … … 83 84 enddo 84 85 enddo 85 !Boucle pour calculer le flux up86 !Boucle pour calculer le flux du traceur flux updraft, flux downdraft, flux compensatoire 86 87 do ilay=2,nlay,1 87 88 do ig=1,ngrid … … 95 96 endif 96 97 fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay) 98 !! si on voulait le prendre en compte on 99 !fthe(ig,ilay)=-(fup(ig,ilay)-fdn(ig,ilay))*trac(ig,ilay-1) 97 100 fthtot(ig,ilay)=fthu(ig,ilay)+fthd(ig,ilay)+fthe(ig,ilay) 98 101 enddo … … 101 104 do ilay=1,nlay,1 102 105 do ig=1,ngrid 103 dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))*( ptimestep/masse(ig,ilay))106 dtrac(ig,ilay)=(fthtot(ig,ilay)-fthtot(ig,ilay+1))*(1./masse(ig,ilay)) 104 107 ! trac(ig,ilay)=trac(ig,ilay) + (fthtot(ig,ilay)-fthtot(ig,ilay+1))*(ptimestep/masse(ig,ilay)) 105 108 enddo 106 109 enddo 107 if (1==0) then108 do ilay=1,nlay,1109 do ig=1,ngrid110 trac(ig,ilay)=trac(ig,ilay) + (fup(ig,ilay)*tracu(ig,ilay-1)-fup(ig,ilay+1)*tracu(ig,ilay) + &111 & (fup(ig,ilay+1)+fdn(ig,ilay+1))*trac(ig,ilay+1) - (fup(ig,ilay)+fdn(ig,ilay))*trac(ig,ilay) + &112 & fdn(ig,ilay+1)*tracd(ig,ilay+1)-fdn(ig,ilay)*tracd(ig,ilay))*(ptimestep/masse(ig,ilay))113 enddo114 enddo115 endif116 110 ! Il reste a coder : 117 111 ! d(rho trac)/dt = - d/dz(rho w'trac') -
LMDZ6/trunk/libf/phylmd/thermcell_main.F90
r4381 r4396 479 479 endif 480 480 481 !------------------------------------------------------------------ 482 ! Calcul de la fraction de l'ascendance 483 !------------------------------------------------------------------ 484 do ig=1,ngrid 485 fraca(ig,1)=0. 486 fraca(ig,nlay+1)=0. 487 enddo 488 do l=2,nlay 489 do ig=1,ngrid 490 if (zw2(ig,l).gt.1.e-10) then 491 fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l)) 492 else 493 fraca(ig,l)=0. 494 endif 495 enddo 496 enddo 497 481 498 !c------------------------------------------------------------------ 482 499 ! calcul du transport vertical … … 485 502 print*,'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA' 486 503 print*,'WARNING !!! routine thermcell_down en cours de developpement' 487 CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,0.5*detr0,0.5*entr0,masse,zthl) 488 ENDIF 504 ! on veut transporter la temperature potentielle, l'eau totale, qté de mouvement 505 CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,0.5*detr0,0.5*entr0,masse,zthl,zdthladj) 506 CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,0.5*detr0,0.5*entr0,masse,po,pdoadj) 507 CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,0.5*detr0,0.5*entr0,masse,zu,pduadj) 508 CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,0.5*detr0,0.5*entr0,masse,zv,pdvadj) 509 ELSE 489 510 !-------------------------------------------------------------- 490 511 491 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, &492 & zthl,zdthladj,zta,lev_out)493 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, &494 & po,pdoadj,zoa,lev_out)512 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & 513 & zthl,zdthladj,zta,lev_out) 514 call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & 515 & po,pdoadj,zoa,lev_out) 495 516 496 517 #ifdef ISO … … 534 555 535 556 536 537 !------------------------------------------------------------------538 ! Calcul de la fraction de l'ascendance539 !------------------------------------------------------------------540 do ig=1,ngrid541 fraca(ig,1)=0.542 fraca(ig,nlay+1)=0.543 enddo544 do l=2,nlay545 do ig=1,ngrid546 if (zw2(ig,l).gt.1.e-10) then547 fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))548 else549 fraca(ig,l)=0.550 endif551 enddo552 enddo553 554 557 !------------------------------------------------------------------ 555 558 ! calcul du transport vertical du moment horizontal … … 576 579 577 580 endif 581 ENDIF 578 582 579 583 ! print*,'13 OK convect8'
Note: See TracChangeset
for help on using the changeset viewer.