/[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

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