/[lmdze]/trunk/Sources/phylmd/cvltr.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/cvltr.f

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

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 212 by guez, Thu Jan 12 12:31:31 2017 UTC
# Line 1  Line 1 
1  module cvltr_m  module cvltr_m
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5  contains  contains
6    
7    SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)    SUBROUTINE cvltr(pdtime, da, phi, mp, paprs, x, upd, dnd, dx)
8    
9      ! From LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17      ! From LMDZ4/libf/phylmd/cvltr.F, version 1.1 2005/04/15 12:36:17
10    
11      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
12      USE suphec_m, ONLY: rg      USE suphec_m, ONLY: rg
13    
14      !=====================================================================      ! Objet : convection des traceurs / Kerry Emanuel
15      ! Objet : convection des traceurs / KE      ! Authors: M.-A. Filiberti and J.-Y. Grandpeix
16      ! Auteurs: M-A Filiberti and J-Y Grandpeix  
     !=====================================================================  
     !  
     !  
17      REAL, intent(in):: pdtime      REAL, intent(in):: pdtime
18      REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)      real, intent(in):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
19      REAL, intent(in):: x(klon,klev)        ! q de traceur (bas en haut)      REAL, intent(in):: paprs(klon, klev + 1) ! pression aux 1/2 couches
20      REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)      REAL, intent(in):: x(klon, klev) ! q de traceur (bas en haut)
21      real, intent(in):: da(klon,klev),phi(klon,klev,klev),mp(klon,klev)      REAL, intent(in):: upd(klon, klev) ! saturated updraft mass flux
22      REAL, intent(in):: upd(klon,klev)      ! saturated updraft mass flux      REAL, intent(in):: dnd(klon, klev) ! saturated downdraft mass flux
23      REAL, intent(in):: dnd(klon,klev)      ! saturated downdraft mass flux      REAL, intent(out):: dx(klon, klev) ! tendance de traceur (bas en haut)
24      !  
25      !--variables locales            ! Local:
26      real zed(klon,klev),zmd(klon,klev,klev)      real zed(klon, klev), zmd(klon, klev, klev)
27      real za(klon,klev,klev)      real za(klon, klev, klev)
28      real zmfd(klon,klev),zmfa(klon,klev)      real zmfd(klon, klev), zmfa(klon, klev)
29      real zmfp(klon,klev),zmfu(klon,klev)      real zmfp(klon, klev), zmfu(klon, klev)
30      integer i,k,j      integer i, k, j
31      ! test conservation  
32      !      real conserv      !------------------------------------------------------------
33      ! =========================================  
34      ! calcul des tendances liees au downdraft      ! calcul des tendances liees au downdraft
35      ! =========================================  
36      zed(:,:)=0.      zed = 0.
37      zmfd(:,:)=0.      zmfd = 0.
38      zmfa(:,:)=0.      zmfa = 0.
39      zmfu(:,:)=0.      zmfu = 0.
40      zmfp(:,:)=0.      zmfp = 0.
41      zmd(:,:,:)=0.      zmd = 0.
42      za(:,:,:)=0.      za = 0.
43      ! entrainement      ! entrainement
44      do k=1,klev-1      do k = 1, klev - 1
45         do i=1,klon         do i = 1, klon
46            zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))            zed(i, k) = max(0., mp(i, k) - mp(i, k + 1))
47         end do         end do
48      end do      end do
49      !  
50      ! calcul de la matrice d echange      ! calcul de la matrice d echange
51      ! matrice de distribution de la masse entrainee en k      ! matrice de distribution de la masse entrainee en k
52      !  
53      do k=1,klev      do k = 1, klev
54         do i=1,klon         do i = 1, klon
55            zmd(i,k,k)=zed(i,k)            zmd(i, k, k) = zed(i, k)
56         end do         end do
57      end do      end do
58      do k=2,klev      do k = 2, klev
59         do j=k-1,1,-1         do j = k - 1, 1, - 1
60            do i=1,klon            do i = 1, klon
61               if(mp(i,j+1).ne.0) then               if(mp(i, j + 1) /= 0) then
62                  zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))                  zmd(i, j, k) = zmd(i, j + 1, k) * min(1., mp(i, j)/mp(i, j + 1))
63               endif               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      !  
75      ! rajout du terme lie a l ascendance induite      ! rajout du terme lie a l'ascendance induite
76      !  
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      !  
83      ! tendances      ! tendances
84      !              
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      !  
     ! =========================================  
93      ! calcul des tendances liees aux flux satures      ! calcul des tendances liees aux flux satures
94      ! =========================================  
95      do j=1,klev      do j = 1, klev
96         do i=1,klon         do i = 1, klon
97            zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))            zmfa(i, j) = da(i, j) * (x(i, 1) - x(i, j))
98         end do         end do
99      end do      end do
100      do k=1,klev      do k = 1, klev
101         do j=1,klev         do j = 1, klev
102            do i=1,klon            do i = 1, klon
103               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))
     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))  
111         end do         end do
112      end do      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        ! calcul final des tendances
121    
122      ! =========================================      do k = 1, klev
123      !--calcul final des tendances         do i = 1, klon
124      ! =========================================            dx(i, k) = (zmfd(i, k) + zmfu(i, k) &
125      do k=1, klev                 + zmfa(i, k) + zmfp(i, k)) * pdtime &
126         do i=1, klon                 * RG/(paprs(i, k) - paprs(i, k + 1))
           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)  
127         enddo         enddo
128      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  
129    
130    end SUBROUTINE cvltr    end SUBROUTINE cvltr
131    

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

  ViewVC Help
Powered by ViewVC 1.1.21