libf/phylmd/cvltr.f90

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

  IMPLICIT NONE 
  !=====================================================================
  ! 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 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
1	SUBROUTINE cvltr(pdtime,da, phi, mp,paprs,x,upd,dnd,dx)
2
3	! From LMDZ4/libf/phylmd/cvltr.F,v 1.1 2005/04/15 12:36:17
4
5	USE dimphy, ONLY: klev, klon
6	USE suphec_m, ONLY: rg
7
8	IMPLICIT NONE
9	!=====================================================================
10	! Objet : convection des traceurs / KE
11	! Auteurs: M-A Filiberti and J-Y Grandpeix
12	!=====================================================================
13	!
14	!
15	REAL, intent(in):: pdtime
16	REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
17	REAL, intent(in):: x(klon,klev) ! q de traceur (bas en haut)
18	REAL dx(klon,klev) ! tendance de traceur (bas en haut)
19	real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
20	REAL, intent(in):: upd(klon,klev) ! saturated updraft mass flux
21	REAL, intent(in):: dnd(klon,klev) ! saturated downdraft mass flux
22	!
23	!--variables locales
24	real zed(klon,klev),zmd(klon,klev,klev)
25	real za(klon,klev,klev)
26	real zmfd(klon,klev),zmfa(klon,klev)
27	real zmfp(klon,klev),zmfu(klon,klev)
28	integer i,k,j
29	! test conservation
30	! real conserv
31	! =========================================
32	! calcul des tendances liees au downdraft
33	! =========================================
34	zed(:,:)=0.
35	zmfd(:,:)=0.
36	zmfa(:,:)=0.
37	zmfu(:,:)=0.
38	zmfp(:,:)=0.
39	zmd(:,:,:)=0.
40	za(:,:,:)=0.
41	! entrainement
42	do k=1,klev-1
43	do i=1,klon
44	zed(i,k)=max(0.,mp(i,k)-mp(i,k+1))
45	end do
46	end do
47	!
48	! calcul de la matrice d echange
49	! matrice de distribution de la masse entrainee en k
50	!
51	do k=1,klev
52	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
59	if(mp(i,j+1).ne.0) then
60	zmd(i,j,k)=zmd(i,j+1,k)*min(1.,mp(i,j)/mp(i,j+1))
61	endif
62	end do
63	end do
64	end do
65	do k=1,klev
66	do j=1,klev-1
67	do i=1,klon
68	za(i,j,k)=max(0.,zmd(i,j+1,k)-zmd(i,j,k))
69	end do
70	end do
71	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
86	zmfd(i,j)=zmfd(i,j)+za(i,j,k)*(x(i,k)-x(i,j))
87	end do
88	end do
89	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
102	zmfp(i,j)=zmfp(i,j)+phi(i,j,k)*(x(i,k)-x(i,j))
103	end do
104	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	end SUBROUTINE cvltr