My Project
Main Page
Data Types List
Files
File List
File Members
All
Classes
Files
Functions
Variables
Macros
thermcell_dtke.F90
Go to the documentation of this file.
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
68
do
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
120
enddo
121
122
return
123
end
libf
phylmd
thermcell_dtke.F90
Generated on Fri Jun 28 2013 15:59:55 for My Project by
1.8.1.2
1.8.1.2 
