Sources/phylmd/cvltr.f

module cvltr_m

  IMPLICIT NONE 

contains

  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

    !=====================================================================
    ! 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, intent(in):: 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

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