Sources/phylmd/cvltr.f

module cvltr_m

  IMPLICIT NONE 

contains

  SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)

    ! From LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17

    USE dimphy, ONLY: klev, klon
    USE suphec_m, ONLY: rg

    !=====================================================================
    ! Objet : convection des traceurs / KE
    ! Auteurs: M-A Filiberti and J-Y Grandpeix
    !=====================================================================
    !
    !
    REAL, intent(in):: pdtime
    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) 
    REAL dx(klon,klev)     ! tendance de traceur  (bas en haut)
    real, intent(in):: da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
    REAL, intent(in):: upd(klon,klev)      ! saturated updraft mass flux
    REAL, intent(in):: dnd(klon,klev)      ! saturated downdraft mass flux
    !
    !--variables locales      
    real zed(klon,klev),zmd(klon,klev,klev)
    real za(klon,klev,klev)
    real zmfd(klon,klev),zmfa(klon,klev)
    real zmfp(klon,klev),zmfu(klon,klev)
    integer i,k,j 
    ! test conservation
    !      real conserv
    ! =========================================
    ! calcul des tendances liees au downdraft
    ! =========================================
    zed(:,:)=0.
    zmfd(:,:)=0.
    zmfa(:,:)=0.
    zmfu(:,:)=0.
    zmfp(:,:)=0.
    zmd(:,:,:)=0.
    za(:,:,:)=0.
    ! entrainement
    do k=1,klev-1
       do i=1,klon
          zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
       end do
    end do
    !
    ! calcul de la matrice d echange
    ! matrice de distribution de la masse entrainee en k
    !
    do k=1,klev
       do i=1,klon
          zmd(i,k,k)=zed(i,k)
       end do
    end do
    do k=2,klev
       do j=k-1,1,-1
          do i=1,klon
             if(mp(i,j+1).ne.0) then
                zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+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
    !
    ! rajout du terme lie a l ascendance induite
    !
    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
    !
    ! tendances
    !            
    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
    !
    ! =========================================
    ! calcul des tendances liees aux flux satures
    ! =========================================
    do j=1,klev
       do i=1,klon
          zmfa(i,j)=da(i,j)*(x(i,1)-x(i,j))
       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
       end do
    end do
    do j=1,klev-1
       do i=1,klon
          zmfu(i,j)=max(0.,upd(i,j+1)+dnd(i,j+1))*(x(i,j+1)-x(i,j))
       end do
    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))
       end do
    end do

    ! =========================================
    !--calcul final des tendances
    ! =========================================
    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))
          !          print*,'dx',k,dx(i,k)
       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

  end SUBROUTINE cvltr

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