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