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

Last change on this file since 5128 was 5119, checked in by abarral, 5 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.