/[lmdze]/trunk/phylmd/cvltr.f90
ViewVC logotype

Diff of /trunk/phylmd/cvltr.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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

Legend:
Removed from v.38  
changed lines
  Added in v.212

  ViewVC Help
Powered by ViewVC 1.1.21