libf/phylmd/nflxtr.f90

SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d, &
     paprs,x,dx) 

  ! From LMDZ4/libf/phylmd/nflxtr.F,v 1.1.1.1 2004/05/19 12:53:08

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

  IMPLICIT NONE 
  !=====================================================================
  ! Objet : Melange convectif de traceurs a partir des flux de masse 
  ! Date : 13/12/1996 -- 13/01/97
  ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
  !         Brinkop et Sausen (1996) et Boucher et al. (1996).
  ! ATTENTION : meme si cette routine se veut la plus generale possible, 
  !             elle a herite de certaines notations et conventions du 
  !             schema de Tiedtke (1993). 
  ! --En particulier, les couches sont numerotees de haut en bas !!!
  !   Ceci est valable pour les flux
  !   mais pas pour les entrees x, paprs !!!!
  ! --pmfu est positif, pmfd est negatif 
  ! --Tous les flux d'entrainements et de detrainements sont positifs 
  !   contrairement au schema de Tiedtke d'ou les changements de signe!!!! 
  !=====================================================================
  !
  !
  REAL, intent(in):: pdtime
  !--les flux sont definis au 1/2 niveaux
  !--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls

  REAL, intent(in):: pmfu(klon,klev) 
  !     flux de masse dans le panache montant 

  REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
  REAL pen_u(klon,klev) ! flux entraine dans le panache montant
  REAL pde_u(klon,klev) ! flux detraine dans le panache montant
  REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
  REAL pde_d(klon,klev) ! flux detraine dans le panache descendant

  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)
  !
  !--flux convectifs mais en variables locales
  REAL zmfu(klon,klev+1) 
  REAL zmfd(klon,klev+1) 
  REAL zen_u(klon,klev) 
  REAL zde_u(klon,klev)
  REAL zen_d(klon,klev) 
  REAL zde_d(klon,klev)
  real zmfe
  !
  !--variables locales      
  !--les flux de x sont definis aux 1/2 niveaux 
  !--xu et xd sont definis aux niveaux complets
  REAL xu(klon,klev)        ! q de traceurs dans le panache montant
  REAL xd(klon,klev)        ! q de traceurs dans le panache descendant
  REAL zmfux(klon,klev+1)   ! flux de x dans le panache montant
  REAL zmfdx(klon,klev+1)   ! flux de x dans le panache descendant
  REAL zmfex(klon,klev+1)   ! flux de x dans l'environnement 
  INTEGER i, k 
  REAL zmfmin
  PARAMETER (zmfmin=1.E-10)

  ! =========================================
  !
  !
  !   Extension des flux UP et DN sur klev+1 niveaux
  ! =========================================
  do k=1,klev
     do i=1,klon
        zmfu(i,k)=pmfu(i,k)
        zmfd(i,k)=pmfd(i,k)
     enddo
  enddo
  do i=1,klon
     zmfu(i,klev+1)=0.
     zmfd(i,klev+1)=0.
  enddo

  !--modif pour diagnostiquer les detrainements
  ! =========================================
  !   on privilegie l'ajustement de l'entrainement dans l'ascendance.

  do k=1, klev
     do i=1, klon
        zen_d(i,k)=pen_d(i,k)
        zde_u(i,k)=pde_u(i,k)
        zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
        zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
     enddo
  enddo
  !
  !--calcul des flux dans le panache montant
  ! =========================================
  !
  ! Dans la premiere couche, on prend q comme valeur de qu
  !
  do i=1, klon
     zmfux(i,1)=0.0 
  enddo
  !
  ! Autres couches
  do k=1,klev
     do i=1, klon
        if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
           xu(i,k)=x(i,k)
        else
           xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k)) &
                /(zmfu(i,k+1)+zde_u(i,k))
        endif
        zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
     enddo
  enddo
  !
  !--calcul des flux dans le panache descendant
  ! =========================================
  !   
  do i=1, klon
     zmfdx(i,klev+1)=0.0 
  enddo
  !
  do k=klev,1,-1
     do i=1, klon
        if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
           xd(i,k)=x(i,k)
        else
           xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) / &
                (zmfd(i,k)-zde_d(i,k))
        endif
        zmfdx(i,k)=zmfd(i,k)*xd(i,k)
     enddo
  enddo
  !
  !--introduction du flux de retour dans l'environnement
  ! =========================================
  !
  do k=2, klev
     do i=1, klon
        zmfe=-zmfu(i,k)-zmfd(i,k)
        if (zmfe.le.0.) then
           zmfex(i,k)= zmfe*x(i,k)
        else
           zmfex(i,k)= zmfe*x(i,k-1)
        endif
     enddo
  enddo

  do i=1, klon
     zmfex(i,1)=0.
     zmfex(i,klev+1)=0.
  enddo
  !
  !--calcul final des tendances
  !
  do k=1, klev
     do i=1, klon
        dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))*pdtime* &
             ( zmfux(i,k) - zmfux(i,k+1) + &
             zmfdx(i,k) - zmfdx(i,k+1) + &
             zmfex(i,k) - zmfex(i,k+1) )
     enddo
  enddo

end SUBROUTINE nflxtr
1	guez	63	SUBROUTINE nflxtr(pdtime,pmfu,pmfd,pen_u,pde_u,pen_d,pde_d, &
2			paprs,x,dx)
3	guez	62
4	guez	63	! From LMDZ4/libf/phylmd/nflxtr.F,v 1.1.1.1 2004/05/19 12:53:08
5	guez	62
6	guez	63	USE dimphy, ONLY: klev, klon
7			USE suphec_m, ONLY: rg
8	guez	3
9	guez	63	IMPLICIT NONE
10			!=====================================================================
11			! Objet : Melange convectif de traceurs a partir des flux de masse
12			! Date : 13/12/1996 -- 13/01/97
13			! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
14			! Brinkop et Sausen (1996) et Boucher et al. (1996).
15			! ATTENTION : meme si cette routine se veut la plus generale possible,
16			! elle a herite de certaines notations et conventions du
17			! schema de Tiedtke (1993).
18			! --En particulier, les couches sont numerotees de haut en bas !!!
19			! Ceci est valable pour les flux
20			! mais pas pour les entrees x, paprs !!!!
21			! --pmfu est positif, pmfd est negatif
22			! --Tous les flux d'entrainements et de detrainements sont positifs
23			! contrairement au schema de Tiedtke d'ou les changements de signe!!!!
24			!=====================================================================
25			!
26			!
27			REAL, intent(in):: pdtime
28			!--les flux sont definis au 1/2 niveaux
29			!--pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
30	guez	3
31	guez	63	REAL, intent(in):: pmfu(klon,klev)
32			! flux de masse dans le panache montant
33	guez	3
34	guez	63	REAL pmfd(klon,klev) ! flux de masse dans le panache descendant
35			REAL pen_u(klon,klev) ! flux entraine dans le panache montant
36			REAL pde_u(klon,klev) ! flux detraine dans le panache montant
37			REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
38			REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
39	guez	3
40	guez	63	REAL, intent(in):: paprs(klon,klev+1) ! pression aux 1/2 couches (bas en haut)
41			REAL, intent(in):: x(klon,klev) ! q de traceur (bas en haut)
42			REAL dx(klon,klev) ! tendance de traceur (bas en haut)
43			!
44			!--flux convectifs mais en variables locales
45			REAL zmfu(klon,klev+1)
46			REAL zmfd(klon,klev+1)
47			REAL zen_u(klon,klev)
48			REAL zde_u(klon,klev)
49			REAL zen_d(klon,klev)
50			REAL zde_d(klon,klev)
51			real zmfe
52			!
53			!--variables locales
54			!--les flux de x sont definis aux 1/2 niveaux
55			!--xu et xd sont definis aux niveaux complets
56			REAL xu(klon,klev) ! q de traceurs dans le panache montant
57			REAL xd(klon,klev) ! q de traceurs dans le panache descendant
58			REAL zmfux(klon,klev+1) ! flux de x dans le panache montant
59			REAL zmfdx(klon,klev+1) ! flux de x dans le panache descendant
60			REAL zmfex(klon,klev+1) ! flux de x dans l'environnement
61			INTEGER i, k
62			REAL zmfmin
63			PARAMETER (zmfmin=1.E-10)
64	guez	3
65	guez	63	! =========================================
66			!
67			!
68			! Extension des flux UP et DN sur klev+1 niveaux
69			! =========================================
70			do k=1,klev
71			do i=1,klon
72			zmfu(i,k)=pmfu(i,k)
73			zmfd(i,k)=pmfd(i,k)
74			enddo
75			enddo
76			do i=1,klon
77			zmfu(i,klev+1)=0.
78			zmfd(i,klev+1)=0.
79			enddo
80
81			!--modif pour diagnostiquer les detrainements
82			! =========================================
83			! on privilegie l'ajustement de l'entrainement dans l'ascendance.
84
85			do k=1, klev
86			do i=1, klon
87			zen_d(i,k)=pen_d(i,k)
88			zde_u(i,k)=pde_u(i,k)
89			zde_d(i,k) =-zmfd(i,k+1)+zmfd(i,k)+zen_d(i,k)
90			zen_u(i,k) = zmfu(i,k+1)-zmfu(i,k)+zde_u(i,k)
91			enddo
92			enddo
93			!
94			!--calcul des flux dans le panache montant
95			! =========================================
96			!
97			! Dans la premiere couche, on prend q comme valeur de qu
98			!
99			do i=1, klon
100			zmfux(i,1)=0.0
101			enddo
102			!
103			! Autres couches
104			do k=1,klev
105			do i=1, klon
106			if ((zmfu(i,k+1)+zde_u(i,k)).lt.zmfmin) THEN
107			xu(i,k)=x(i,k)
108			else
109			xu(i,k)=(zmfux(i,k)+zen_u(i,k)*x(i,k)) &
110			/(zmfu(i,k+1)+zde_u(i,k))
111			endif
112			zmfux(i,k+1)=zmfu(i,k+1)*xu(i,k)
113			enddo
114			enddo
115			!
116			!--calcul des flux dans le panache descendant
117			! =========================================
118			!
119			do i=1, klon
120			zmfdx(i,klev+1)=0.0
121			enddo
122			!
123			do k=klev,1,-1
124			do i=1, klon
125			if ((zde_d(i,k)-zmfd(i,k)).lt.zmfmin) THEN
126			xd(i,k)=x(i,k)
127			else
128			xd(i,k)=(zmfdx(i,k+1)-zen_d(i,k)*x(i,k)) / &
129			(zmfd(i,k)-zde_d(i,k))
130			endif
131			zmfdx(i,k)=zmfd(i,k)*xd(i,k)
132			enddo
133			enddo
134			!
135			!--introduction du flux de retour dans l'environnement
136			! =========================================
137			!
138			do k=2, klev
139			do i=1, klon
140			zmfe=-zmfu(i,k)-zmfd(i,k)
141			if (zmfe.le.0.) then
142			zmfex(i,k)= zmfe*x(i,k)
143			else
144			zmfex(i,k)= zmfe*x(i,k-1)
145			endif
146			enddo
147			enddo
148
149			do i=1, klon
150			zmfex(i,1)=0.
151			zmfex(i,klev+1)=0.
152			enddo
153			!
154			!--calcul final des tendances
155			!
156			do k=1, klev
157			do i=1, klon
158			dx(i,k)=RG/(paprs(i,k)-paprs(i,k+1))pdtime &
159			( zmfux(i,k) - zmfux(i,k+1) + &
160			zmfdx(i,k) - zmfdx(i,k+1) + &
161			zmfex(i,k) - zmfex(i,k+1) )
162			enddo
163			enddo
164
165			end SUBROUTINE nflxtr