Sources/phylmd/cvltr.f

SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)

  ! From LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17

  USE dimphy, ONLY: klev, klon
  USE suphec_m, ONLY: rg

  IMPLICIT NONE 
  !=====================================================================
  ! Objet : convection des traceurs / KE
  ! Auteurs: M-A Filiberti and J-Y Grandpeix
  !=====================================================================
  !
  !
  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, intent(in):: upd(klon,klev)      ! saturated updraft mass flux
  REAL, intent(in):: dnd(klon,klev)      ! saturated downdraft mass flux
  !
  !--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 
  ! test conservation
  !      real conserv
  ! =========================================
  ! calcul des tendances liees au downdraft
  ! =========================================
  zed(:,:)=0.
  zmfd(:,:)=0.
  zmfa(:,:)=0.
  zmfu(:,:)=0.
  zmfp(:,:)=0.
  zmd(:,:,:)=0.
  za(:,:,:)=0.
  ! 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
  !
  ! calcul de la matrice d echange
  ! matrice de distribution de la masse entrainee en k
  !
  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
  !
  ! rajout du terme lie a l ascendance induite
  !
  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
  !
  ! tendances
  !            
  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
  !
  ! =========================================
  ! calcul des tendances liees aux flux satures
  ! =========================================
  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

  ! =========================================
  !--calcul final des tendances
  ! =========================================
  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))
        !          print*,'dx',k,dx(i,k)
     enddo
  enddo
  !
  ! test de conservation du traceur
  !      conserv=0.
  !      do k=1, klev
  !        do i=1, klon
  !         conserv=conserv+dx(i,k)*
  !     .     (paprs(i,k)-paprs(i,k+1))/RG
  !
  !        enddo
  !      enddo
  !      print *,'conserv',conserv

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