libf/phylmd/cvltr.f

c
c $Header: /home/cvsroot/LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17 lmdzadmin Exp $
c
      SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)
      use dimens_m
      use dimphy
      use SUPHEC_M
            use yoecumf 
      IMPLICIT NONE 
c=====================================================================
c Objet : convection des traceurs / KE
c Auteurs: M-A Filiberti and J-Y Grandpeix
c=====================================================================
c
c
      REAL, intent(in):: pdtime
      REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
      REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut) 
      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
      REAL upd(klon,klev)      ! saturated updraft mass flux
      REAL dnd(klon,klev)      ! saturated downdraft mass flux
c
c--variables locales      
      real zed(klon,klev),zmd(klon,klev,klev)
      real za(klon,klev,klev)
      real zmfd(klon,klev),zmfa(klon,klev)
      real zmfp(klon,klev),zmfu(klon,klev)
      integer i,k,j 
c test conservation
c      real conserv
c =========================================
c calcul des tendances liees au downdraft
c =========================================
      zed(:,:)=0.
      zmfd(:,:)=0.
      zmfa(:,:)=0.
      zmfu(:,:)=0.
      zmfp(:,:)=0.
      zmd(:,:,:)=0.
      za(:,:,:)=0.
c entrainement
      do k=1,klev-1
        do i=1,klon
          zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
        end do
      end do
c
c calcul de la matrice d echange
c matrice de distribution de la masse entrainee en k
c
      do k=1,klev
        do i=1,klon
          zmd(i,k,k)=zed(i,k)
        end do
      end do
      do k=2,klev
        do j=k-1,1,-1
          do i=1,klon
          if(mp(i,j+1).ne.0) then
          zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
          endif
          end do
        end do
      end do
      do k=1,klev
        do j=1,klev-1
          do i=1,klon
          za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
          end do
        end do
      end do
c
c rajout du terme lie a l ascendance induite
c
        do j=2,klev
         do i=1,klon
          za(i,j,j-1)=za(i,j,j-1)+mp(i,j)
         end do
        end do
C
c tendances
c            
      do k=1,klev
        do j=1,klev
          do i=1,klon
          zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))
          end do
        end do
      end do
c
c =========================================
c calcul des tendances liees aux flux satures
c =========================================
      do j=1,klev
        do i=1,klon
          zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))
        end do
      end do
      do k=1,klev
        do j=1,klev
          do i=1,klon
          zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j))
          end do
        end do
      end do
      do j=1,klev-1
        do i=1,klon
          zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))
        end do
      end do
      do j=2,klev
        do i=1,klon
          zmfu(i,j)=zmfu(i,j)
     .             +min(0.,upd(i,j)+dnd(i,j))*(x(i,j)-x(i,j-1))
        end do
      end do

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