source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_dtke.F90 @ 1643

Last change on this file since 1643 was 1312, checked in by Laurent Fairhead, 15 years ago

Routines was forgotten in the commits for the TKE transport in the new thermals


Oubli lors de la soumission sur le transport de la TKE dans les thermiques

File size: 2.9 KB
Line 
1      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
2     &           rg,pplev,tke)
3      implicit none
4
5#include "iniprint.h"
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      integer ngrid,nlay,nsrf
15
16      real ptimestep
17      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
18      real entr0(ngrid,nlay),rg
19      real tke(ngrid,nlay,nsrf)
20      real detr0(ngrid,nlay)
21
22
23      real masse(ngrid,nlay),fm(ngrid,nlay+1)
24      real entr(ngrid,nlay)
25      real q(ngrid,nlay)
26      integer lev_out                           ! niveau pour les print
27
28      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
29
30      real zzm
31
32      integer ig,k
33      integer isrf
34
35
36      lev_out=0
37
38
39      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
40
41!   calcul du detrainement
42      do k=1,nlay
43         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
44         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
45      enddo
46
47
48! Decalage vertical des entrainements et detrainements.
49      masse(:,1)=0.5*masse0(:,1)
50      entr(:,1)=0.5*entr0(:,1)
51      detr(:,1)=0.5*detr0(:,1)
52      fm(:,1)=0.
53      do k=1,nlay-1
54         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
55         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
56         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
57         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
58      enddo
59      fm(:,nlay+1)=0.
60
61!   calcul de la valeur dans les ascendances
62      do ig=1,ngrid
63         qa(ig,1)=q(ig,1)
64      enddo
65
66
67
68do isrf=1,nsrf
69
70   q(:,:)=tke(:,:,isrf)
71
72    if (1==1) then
73      do k=2,nlay
74         do ig=1,ngrid
75            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
76     &         1.e-5*masse(ig,k)) then
77         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
78     &         /(fm(ig,k+1)+detr(ig,k))
79            else
80               qa(ig,k)=q(ig,k)
81            endif
82            if (qa(ig,k).lt.0.) then
83!               print*,'qa<0!!!'
84            endif
85            if (q(ig,k).lt.0.) then
86!               print*,'q<0!!!'
87            endif
88         enddo
89      enddo
90
91! Calcul du flux subsident
92
93      do k=2,nlay
94         do ig=1,ngrid
95            wqd(ig,k)=fm(ig,k)*q(ig,k)
96            if (wqd(ig,k).lt.0.) then
97!               print*,'wqd<0!!!'
98            endif
99         enddo
100      enddo
101      do ig=1,ngrid
102         wqd(ig,1)=0.
103         wqd(ig,nlay+1)=0.
104      enddo
105     
106
107! Calcul des tendances
108      do k=1,nlay
109         do ig=1,ngrid
110            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
111     &               -wqd(ig,k)+wqd(ig,k+1))  &
112     &               *ptimestep/masse(ig,k)
113         enddo
114      enddo
115
116 endif
117
118   tke(:,:,isrf)=q(:,:)
119
120enddo
121
122      return
123      end
Note: See TracBrowser for help on using the repository browser.