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