source: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_dtke.F90 @ 5140

Last change on this file since 5140 was 5119, checked in by abarral, 12 months ago

enforce PRIVATE by default in several modules, expose PUBLIC as needed
move eigen.f90 to obsolete/
(lint) aslong the way
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.0 KB
Line 
1MODULE lmdz_thermcell_dtke
2CONTAINS
3
4      SUBROUTINE thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
5             rg,pplev,tke)
6      USE lmdz_print_control, ONLY: prt_level
7      IMPLICIT NONE
8
9!=======================================================================
10
11!   Calcul du transport verticale dans la couche limite en presence
12!   de "thermiques" explicitement representes
13!   calcul du dq/dt une fois qu'on connait les ascendances
14
15!=======================================================================
16
17      INTEGER, INTENT(IN) :: ngrid,nlay,nsrf
18      REAL, INTENT(IN) :: ptimestep
19      REAL, DIMENSION(ngrid,nlay), INTENT(IN) :: entr0
20      REAL, DIMENSION(ngrid,nlay+1), INTENT(IN) :: fm0,pplev
21      REAL, INTENT(IN) :: rg
22      REAL, INTENT(INOUT) :: tke(ngrid,nlay+1,nsrf)
23
24      REAL, DIMENSION(ngrid,nlay) :: masse0,detr0, masse,entr,detr
25      REAL, DIMENSION(ngrid,nlay+1) :: fm,wqd,q,qa
26      INTEGER lev_out                           ! niveau pour les print
27
28
29      REAL :: zzm
30
31      INTEGER ig,k
32      INTEGER isrf
33
34
35      lev_out=0
36
37!PRINT*,'thermcell_dtke'
38
39      IF (prt_level>=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
62
63DO isrf=1,nsrf
64
65   q(:,:)=tke(:,:,isrf)
66!   calcul de la valeur dans les ascendances
67      do ig=1,ngrid
68         qa(ig,1)=q(ig,1)
69      enddo
70
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>  &
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)<0.) THEN
83!               PRINT*,'qa<0!!!'
84            endif
85            IF (q(ig,k)<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)<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 END IF
117
118   tke(:,:,isrf)=q(:,:)
119
120END DO
121
122      RETURN
123      END
124END MODULE lmdz_thermcell_dtke
Note: See TracBrowser for help on using the repository browser.