My Project
 All Classes Files Functions Variables Macros
thermcell_init.F90
Go to the documentation of this file.
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