source: LMDZ4/trunk/libf/phytherm/thermcell_dv2.F90 @ 1053

Last change on this file since 1053 was 814, checked in by Laurent Fairhead, 17 years ago

Rajout de la physique utilisant les thermiques FH
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.0 KB
Line 
1      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
2     &    ,fraca,larga  &
3     &    ,u,v,du,dv,ua,va,lev_out)
4      implicit none
5
6!=======================================================================
7!
8!   Calcul du transport verticale dans la couche limite en presence
9!   de "thermiques" explicitement representes
10!   calcul du dq/dt une fois qu'on connait les ascendances
11!
12!=======================================================================
13
14
15      integer ngrid,nlay
16
17      real ptimestep
18      real masse(ngrid,nlay),fm(ngrid,nlay+1)
19      real fraca(ngrid,nlay+1)
20      real larga(ngrid)
21      real entr(ngrid,nlay)
22      real u(ngrid,nlay)
23      real ua(ngrid,nlay)
24      real du(ngrid,nlay)
25      real v(ngrid,nlay)
26      real va(ngrid,nlay)
27      real dv(ngrid,nlay)
28      integer lev_out                           ! niveau pour les print
29
30      real qa(ngrid,nlay),detr(ngrid,nlay),zf,zf2
31      real wvd(ngrid,nlay+1),wud(ngrid,nlay+1)
32      real gamma0,gamma(ngrid,nlay+1)
33      real ue(ngrid,nlay),ve(ngrid,nlay)
34      real dua,dva
35      integer iter
36
37      integer ig,k
38
39!   calcul du detrainement
40
41      do k=1,nlay
42         do ig=1,ngrid
43            detr(ig,k)=fm(ig,k)-fm(ig,k+1)+entr(ig,k)
44         enddo
45      enddo
46
47!   calcul de la valeur dans les ascendances
48      do ig=1,ngrid
49         ua(ig,1)=u(ig,1)
50         va(ig,1)=v(ig,1)
51         ue(ig,1)=u(ig,1)
52         ve(ig,1)=v(ig,1)
53      enddo
54
55      do k=2,nlay
56         do ig=1,ngrid
57            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
58     &         1.e-5*masse(ig,k)) then
59!   On itère sur la valeur du coeff de freinage.
60!              gamma0=rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))
61               gamma0=masse(ig,k)  &
62     &         *sqrt( 0.5*(fraca(ig,k+1)+fraca(ig,k)) )  &
63     &         *0.5/larga(ig)  &
64     &         *1.
65!    s         *0.5
66!              gamma0=0.
67               zf=0.5*(fraca(ig,k)+fraca(ig,k+1))
68               zf=0.
69               zf2=1./(1.-zf)
70!   la première fois on multiplie le coefficient de freinage
71!   par le module du vent dans la couche en dessous.
72               dua=ua(ig,k-1)-u(ig,k-1)
73               dva=va(ig,k-1)-v(ig,k-1)
74               do iter=1,5
75!   On choisit une relaxation lineaire.
76                  gamma(ig,k)=gamma0
77!   On choisit une relaxation quadratique.
78                  gamma(ig,k)=gamma0*sqrt(dua**2+dva**2)
79                  ua(ig,k)=(fm(ig,k)*ua(ig,k-1)  &
80     &               +(zf2*entr(ig,k)+gamma(ig,k))*u(ig,k))  &
81     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
82     &                 +gamma(ig,k))
83                  va(ig,k)=(fm(ig,k)*va(ig,k-1)  &
84     &               +(zf2*entr(ig,k)+gamma(ig,k))*v(ig,k))  &
85     &               /(fm(ig,k+1)+detr(ig,k)+entr(ig,k)*zf*zf2  &
86     &                 +gamma(ig,k))
87!                 print*,k,ua(ig,k),va(ig,k),u(ig,k),v(ig,k),dua,dva
88                  dua=ua(ig,k)-u(ig,k)
89                  dva=va(ig,k)-v(ig,k)
90                  ue(ig,k)=(u(ig,k)-zf*ua(ig,k))*zf2
91                  ve(ig,k)=(v(ig,k)-zf*va(ig,k))*zf2
92               enddo
93            else
94               ua(ig,k)=u(ig,k)
95               va(ig,k)=v(ig,k)
96               ue(ig,k)=u(ig,k)
97               ve(ig,k)=v(ig,k)
98               gamma(ig,k)=0.
99            endif
100         enddo
101      enddo
102
103      do k=2,nlay
104         do ig=1,ngrid
105            wud(ig,k)=fm(ig,k)*ue(ig,k)
106            wvd(ig,k)=fm(ig,k)*ve(ig,k)
107         enddo
108      enddo
109      do ig=1,ngrid
110         wud(ig,1)=0.
111         wud(ig,nlay+1)=0.
112         wvd(ig,1)=0.
113         wvd(ig,nlay+1)=0.
114      enddo
115
116      do k=1,nlay
117         do ig=1,ngrid
118            du(ig,k)=((detr(ig,k)+gamma(ig,k))*ua(ig,k)  &
119     &               -(entr(ig,k)+gamma(ig,k))*ue(ig,k)  &
120     &               -wud(ig,k)+wud(ig,k+1))  &
121     &               /masse(ig,k)
122            dv(ig,k)=((detr(ig,k)+gamma(ig,k))*va(ig,k)  &
123     &               -(entr(ig,k)+gamma(ig,k))*ve(ig,k)  &
124     &               -wvd(ig,k)+wvd(ig,k+1))  &
125     &               /masse(ig,k)
126         enddo
127      enddo
128
129      return
130      end
Note: See TracBrowser for help on using the repository browser.