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