[814] | 1 | SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho, & |
---|
| 2 | & zlev,lalim,alim_star,zmax_sec,wmax_sec,zmax,wmax,f,f0,lev_out) |
---|
| 3 | |
---|
| 4 | !------------------------------------------------------------------------- |
---|
| 5 | !thermcell_closure: fermeture, determination de f |
---|
| 6 | !------------------------------------------------------------------------- |
---|
| 7 | IMPLICIT NONE |
---|
| 8 | |
---|
| 9 | INTEGER ngrid,nlay |
---|
| 10 | INTEGER ig,k |
---|
| 11 | REAL r_aspect,ptimestep |
---|
| 12 | integer lev_out ! niveau pour les print |
---|
| 13 | |
---|
| 14 | INTEGER lalim(ngrid) |
---|
| 15 | REAL alim_star(ngrid,nlay) |
---|
| 16 | REAL rho(ngrid,nlay) |
---|
| 17 | REAL zlev(ngrid,nlay) |
---|
| 18 | REAL zmax(ngrid),zmax_sec(ngrid) |
---|
| 19 | REAL wmax(ngrid),wmax_sec(ngrid) |
---|
| 20 | |
---|
| 21 | REAL alim_star2(ngrid) |
---|
| 22 | |
---|
| 23 | REAL f(ngrid) |
---|
| 24 | REAL f0(ngrid) |
---|
| 25 | |
---|
| 26 | do ig=1,ngrid |
---|
| 27 | alim_star2(ig)=0. |
---|
| 28 | enddo |
---|
| 29 | do ig=1,ngrid |
---|
| 30 | if (alim_star(ig,1).LT.1.e-10) then |
---|
| 31 | f(ig)=0. |
---|
| 32 | else |
---|
| 33 | do k=1,lalim(ig) |
---|
| 34 | alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2 & |
---|
| 35 | & /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))) |
---|
| 36 | enddo |
---|
| 37 | if ((zmax_sec(ig).gt.1.e-10).and.(1.eq.1)) then |
---|
| 38 | f(ig)=wmax_sec(ig)/(max(500.,zmax_sec(ig))*r_aspect & |
---|
| 39 | & *alim_star2(ig)) |
---|
| 40 | f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/ & |
---|
| 41 | & zmax_sec(ig))*wmax_sec(ig)) |
---|
| 42 | else |
---|
| 43 | f(ig)=wmax(ig)/(max(500.,zmax(ig))*r_aspect*alim_star2(ig)) |
---|
| 44 | f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/ & |
---|
| 45 | & zmax(ig))*wmax(ig)) |
---|
| 46 | endif |
---|
| 47 | endif |
---|
| 48 | f0(ig)=f(ig) |
---|
| 49 | enddo |
---|
| 50 | if (lev_out.ge.1) print*,'apres fermeture' |
---|
| 51 | |
---|
| 52 | ! |
---|
| 53 | return |
---|
| 54 | end |
---|