source: LMDZ4/trunk/libf/phytherm/cvltr.F @ 1098

Last change on this file since 1098 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: 3.7 KB
Line 
1c
2c $Header$
3c
4      SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,pplay,x,upd,dnd,dx)
5      USE dimphy
6      IMPLICIT NONE
7c=====================================================================
8c Objet : convection des traceurs / KE
9c Auteurs: M-A Filiberti and J-Y Grandpeix
10c=====================================================================
11c
12cym#include "dimensions.h"
13cym#include "dimphy.h"
14#include "YOMCST.h"
15#include "YOECUMF.h"
16c
17      REAL pdtime
18      REAL paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
19      REAL pplay(klon,klev)  ! pression pour le milieu de chaque couche
20      REAL x(klon,klev)        ! q de traceur (bas en haut)
21      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
22      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
23      REAL upd(klon,klev)      ! saturated updraft mass flux
24      REAL dnd(klon,klev)      ! saturated downdraft mass flux
25c
26c--variables locales     
27      real zed(klon,klev),zmd(klon,klev,klev)
28      real za(klon,klev,klev)
29      real zmfd(klon,klev),zmfa(klon,klev)
30      real zmfp(klon,klev),zmfu(klon,klev)
31      integer i,k,j
32c test conservation
33c      real conserv
34c =========================================
35c calcul des tendances liees au downdraft
36c =========================================
37      zed(:,:)=0.
38      zmfd(:,:)=0.
39      zmfa(:,:)=0.
40      zmfu(:,:)=0.
41      zmfp(:,:)=0.
42      zmd(:,:,:)=0.
43      za(:,:,:)=0.
44c entrainement
45      do k=1,klev-1
46        do i=1,klon
47          zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
48        end do
49      end do
50c
51c calcul de la matrice d echange
52c matrice de distribution de la masse entrainee en k
53c
54      do k=1,klev
55        do i=1,klon
56          zmd(i,k,k)=zed(i,k)
57        end do
58      end do
59      do k=2,klev
60        do j=k-1,1,-1
61          do i=1,klon
62          if(mp(i,j+1).ne.0) then
63          zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
64          endif
65          end do
66        end do
67      end do
68      do k=1,klev
69        do j=1,klev-1
70          do i=1,klon
71          za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
72          end do
73        end do
74      end do
75c
76c rajout du terme lie a l ascendance induite
77c
78        do j=2,klev
79         do i=1,klon
80          za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
81         end do
82        end do
83C
84c tendances
85c           
86      do k=1,klev
87        do j=1,klev
88          do i=1,klon
89          zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))
90          end do
91        end do
92      end do
93c
94c =========================================
95c calcul des tendances liees aux flux satures
96c =========================================
97      do j=1,klev
98        do i=1,klon
99          zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))
100        end do
101      end do
102      do k=1,klev
103        do j=1,klev
104          do i=1,klon
105          zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j))
106          end do
107        end do
108      end do
109      do j=1,klev-1
110        do i=1,klon
111          zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))
112        end do
113      end do
114      do j=2,klev
115        do i=1,klon
116          zmfu(i,j)=zmfu(i,j)
117     .             +min(0.,upd(i,j)+dnd(i,j))*(x(i,j)-x(i,j-1))
118        end do
119      end do
120
121c =========================================
122c--calcul final des tendances
123c =========================================
124      do k=1, klev
125        do i=1, klon
126          dx(i,k)=(zmfd(i,k)+zmfu(i,k)
127     .      +zmfa(i,k)+zmfp(i,k))*pdtime
128     .      *RG/(paprs(i,k)-paprs(i,k+1))
129c          print*,'dx',k,dx(i,k)
130        enddo
131      enddo
132c
133c test de conservation du traceur
134c      conserv=0.
135c      do k=1, klev
136c        do i=1, klon
137c         conserv=conserv+dx(i,k)*
138c     .     (paprs(i,k)-paprs(i,k+1))/RG
139C
140c        enddo
141c      enddo
142c      print *,'conserv',conserv
143     
144      return
145      end
Note: See TracBrowser for help on using the repository browser.