| 1 | ! | 
|---|
| 2 | ! $Header$ | 
|---|
| 3 | ! | 
|---|
| 4 |       SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlay,zlev,  & | 
|---|
| 5 |      &                  lalim,lmin,alim_star,alim_star_tot,lev_out) | 
|---|
| 6 |  | 
|---|
| 7 | !---------------------------------------------------------------------- | 
|---|
| 8 | !thermcell_init: calcul du profil d alimentation du thermique | 
|---|
| 9 | !---------------------------------------------------------------------- | 
|---|
| 10 |       IMPLICIT NONE | 
|---|
| 11 | #include "iniprint.h" | 
|---|
| 12 | #include "thermcell.h" | 
|---|
| 13 |  | 
|---|
| 14 |       INTEGER l,ig | 
|---|
| 15 | !arguments d entree | 
|---|
| 16 |       INTEGER ngrid,nlay | 
|---|
| 17 |       REAL ztv(ngrid,nlay) | 
|---|
| 18 |       REAL zlay(ngrid,nlay) | 
|---|
| 19 |       REAL zlev(ngrid,nlay+1) | 
|---|
| 20 | !arguments de sortie | 
|---|
| 21 |       INTEGER lalim(ngrid) | 
|---|
| 22 |       INTEGER lmin(ngrid) | 
|---|
| 23 |       REAL alim_star(ngrid,nlay) | 
|---|
| 24 |       REAL alim_star_tot(ngrid) | 
|---|
| 25 |       integer lev_out                           ! niveau pour les print | 
|---|
| 26 |        | 
|---|
| 27 |       REAL zzalim(ngrid) | 
|---|
| 28 | !CR: ponderation entrainement des couches instables | 
|---|
| 29 | !def des alim_star tels que alim=f*alim_star       | 
|---|
| 30 |  | 
|---|
| 31 |  | 
|---|
| 32 |       write(lunout,*)'THERM INIT V20C ' | 
|---|
| 33 |  | 
|---|
| 34 |       alim_star_tot(:)=0. | 
|---|
| 35 |       alim_star(:,:)=0. | 
|---|
| 36 |       lmin(:)=1 | 
|---|
| 37 |       lalim(:)=1 | 
|---|
| 38 |  | 
|---|
| 39 |       do l=1,nlay-1 | 
|---|
| 40 |          do ig=1,ngrid | 
|---|
| 41 |             if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then | 
|---|
| 42 |                alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  & | 
|---|
| 43 |      &                       *sqrt(zlev(ig,l+1))  | 
|---|
| 44 |                lalim(:)=l+1 | 
|---|
| 45 |                alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l) | 
|---|
| 46 |             endif | 
|---|
| 47 |          enddo | 
|---|
| 48 |       enddo | 
|---|
| 49 |       do l=1,nlay | 
|---|
| 50 |          do ig=1,ngrid  | 
|---|
| 51 |             if (alim_star_tot(ig) > 1.e-10 ) then | 
|---|
| 52 |                alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig) | 
|---|
| 53 |             endif | 
|---|
| 54 |          enddo | 
|---|
| 55 |       enddo | 
|---|
| 56 |       alim_star_tot(:)=1. | 
|---|
| 57 |  | 
|---|
| 58 |       return | 
|---|
| 59 |       end   | 
|---|