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