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	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	SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)
5	use dimens_m
6	use dimphy
7	use SUPHEC_M
8	use yoecumf
9	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	REAL, intent(in):: pdtime
17	REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
18	REAL, intent(in):: x(klon,klev) ! q de traceur (bas en haut)
19	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