source: LMDZ4/trunk/libf/phylmd/thermcell_init.F90 @ 996

Last change on this file since 996 was 972, checked in by lmdzadmin, 16 years ago

Version thermique FH/CRio
Ajout tests cas physiques non pris en comptes et ajout/enleve prints
Nouvelle routine thermcell_flux2.F90
IM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.6 KB
Line 
1      SUBROUTINE thermcell_init(ngrid,nlay,ztv,zlay,zlev,  &
2     &                  lalim,lmin,alim_star,alim_star_tot,lev_out)
3
4!----------------------------------------------------------------------
5!thermcell_init: calcul du profil d alimentation du thermique
6!----------------------------------------------------------------------
7      IMPLICIT NONE
8#include "iniprint.h"
9
10      INTEGER l,ig
11!arguments d entree
12      INTEGER ngrid,nlay
13      REAL ztv(ngrid,nlay)
14      REAL zlay(ngrid,nlay)
15      REAL zlev(ngrid,nlay+1)
16!arguments de sortie
17      INTEGER lalim(ngrid)
18      INTEGER lmin(ngrid)
19      REAL alim_star(ngrid,nlay)
20      REAL alim_star_tot(ngrid)
21      integer lev_out                           ! niveau pour les print
22     
23      REAL zzalim(ngrid)
24!CR: ponderation entrainement des couches instables
25!def des alim_star tels que alim=f*alim_star     
26
27      do l=1,nlay
28         do ig=1,ngrid
29            alim_star(ig,l)=0.
30         enddo
31      enddo
32! determination de la longueur de la couche d entrainement
33      do ig=1,ngrid
34         lalim(ig)=1
35      enddo
36
37!on ne considere que les premieres couches instables
38      do l=nlay-2,1,-1
39         do ig=1,ngrid
40            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
41     &          ztv(ig,l+1).le.ztv(ig,l+2)) then
42               lalim(ig)=l+1
43            endif
44          enddo
45      enddo
46
47! determination du lmin: couche d ou provient le thermique
48
49      do ig=1,ngrid
50! FH initialisation de lmin a nlay plutot que 1.
51!        lmin(ig)=nlay
52         lmin(ig)=1
53      enddo
54      do l=nlay,2,-1
55         do ig=1,ngrid
56            if (ztv(ig,l-1).gt.ztv(ig,l)) then
57               lmin(ig)=l-1
58            endif
59         enddo
60      enddo
61!
62      zzalim(:)=0.
63      do l=1,nlay-1
64         do ig=1,ngrid
65             if (l<lalim(ig)) then
66                zzalim(ig)=zzalim(ig)+zlay(ig,l)*(ztv(ig,l)-ztv(ig,l+1))
67             endif
68          enddo
69      enddo
70      do ig=1,ngrid
71          if (lalim(ig)>1) then
72             zzalim(ig)=zlay(ig,1)+zzalim(ig)/(ztv(ig,1)-ztv(ig,lalim(ig)))
73          else
74             zzalim(ig)=zlay(ig,1)
75          endif
76      enddo
77
78      if(prt_level.GE.10) print*,'ZZALIM LALIM ',zzalim,lalim,zlay(1,lalim(1))
79
80! definition de l'entrainement des couches
81      if (1.eq.1) then
82      do l=1,nlay-1
83         do ig=1,ngrid
84            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
85     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
86!def possibles pour alim_star: zdthetadz, dthetadz, zdtheta
87             alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
88     &                       *sqrt(zlev(ig,l+1))
89            endif
90         enddo
91      enddo
92      else
93      do l=1,nlay-1
94         do ig=1,ngrid
95            if (ztv(ig,l).gt.ztv(ig,l+1).and.  &
96     &          l.ge.lmin(ig).and.l.lt.lalim(ig)) then
97             alim_star(ig,l)=max(3.*zzalim(ig)-zlay(ig,l),0.) &
98     &        *(zlev(ig,l+1)-zlev(ig,l))
99            endif
100         enddo
101      enddo
102      endif
103     
104! pas de thermique si couche 1 stable
105      do ig=1,ngrid
106!CRnouveau test
107        if (alim_star(ig,1).lt.1.e-10) then
108            do l=1,nlay
109                alim_star(ig,l)=0.
110            enddo
111            lmin(ig)=1
112         endif
113      enddo
114! calcul de l alimentation totale
115      do ig=1,ngrid
116         alim_star_tot(ig)=0.
117      enddo
118      do l=1,nlay
119         do ig=1,ngrid
120            alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
121         enddo
122      enddo
123!
124! Calcul entrainement normalise
125      do l=1,nlay
126         do ig=1,ngrid
127            if (alim_star_tot(ig).gt.1.e-10) then
128               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
129            endif
130         enddo
131      enddo
132       
133      return
134      end 
Note: See TracBrowser for help on using the repository browser.