source: trunk/libf/phylmd/homogene.F @ 1

Last change on this file since 1 was 1, checked in by emillour, 14 years ago

Import initial LMDZ5

File size: 3.1 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE homogene(paprs, q, dq, u,v, du, dv)
5      USE dimphy
6      IMPLICIT NONE
7c==============================================================
8c Schema ad hoc du melange vertical pour les vitesses u et v,
9c a appliquer apres le schema de convection (fiajc et fiajh).
10c
11c paprs:input, pression demi-couche (inter-couche)
12c q:    input, vapeur d'eau (kg/kg)
13c dq:   input, incrementation de vapeur d'eau (de la convection)
14c u:    input, vitesse u
15c v:    input, vitesse v
16c
17c du:   output, incrementation pour u
18c dv:   output, incrementation pour v
19c==============================================================
20cym#include "dimensions.h"
21cym#include "dimphy.h"
22c
23      REAL paprs(klon,klev+1)
24      REAL q(klon,klev), dq(klon,klev)
25      REAL u(klon,klev), du(klon,klev)
26      REAL v(klon,klev), dv(klon,klev)
27c
28      REAL zm_dq(klon) ! quantite totale de l'eau deplacee
29      REAL zm_q(klon)  ! quantite totale de la vapeur d'eau
30      REAL zm_u(klon)  ! moyenne de u (brassage parfait et total)
31      REAL zm_v(klon)  ! moyenne de v (brassage parfait et total)
32      REAL z_frac(klon) ! fraction du brassage parfait et total
33      REAL zm_dp(klon)
34c
35      REAL zx
36      INTEGER i, k
37      REAL frac_max
38      PARAMETER (frac_max=0.1)
39      REAL seuil
40      PARAMETER (seuil=1.0e-10)
41      LOGICAL faisrien
42      PARAMETER (faisrien=.true.)
43c
44      DO k = 1, klev
45      DO i = 1, klon
46         du(i,k) = 0.0
47         dv(i,k) = 0.0
48      ENDDO
49      ENDDO
50c
51      IF (faisrien) RETURN
52c
53      DO i = 1, klon
54         zm_dq(i)=0.
55         zm_q(i) =0.
56         zm_u(i)=0.
57         zm_v(i)=0.
58         zm_dp(i)=0.
59      ENDDO
60      DO k = 1, klev
61      DO i = 1, klon
62      IF (ABS(dq(i,k)).GT.seuil) THEN
63         zx = paprs(i,k) - paprs(i,k+1)
64         zm_dq(i) = zm_dq(i) + ABS(dq(i,k))*zx
65         zm_q(i) = zm_q(i) + q(i,k)*zx
66         zm_dp(i) = zm_dp(i) + zx
67         zm_u(i) = zm_u(i) + u(i,k)*zx
68         zm_v(i) = zm_v(i) + v(i,k)*zx
69      ENDIF
70      ENDDO
71      ENDDO
72c
73c Hypothese principale: apres la convection, la vitesse de chaque
74c couche est composee de deux parties: celle (1-z_frac) de la vitesse
75c original et celle (z_frac) de la vitesse moyenne qui serait la
76c vitesse de chaque couche si le brassage etait parfait et total.
77c La fraction du brassage est calculee par le rapport entre la quantite
78c totale de la vapeur d'eau deplacee (ou condensee) et la quantite
79c totale de la vapeur d'eau. Et cette fraction est limitee a frac_max
80c (Est-ce vraiment raisonnable ? Z.X. Li, le 07-09-1995).
81c
82      DO i = 1, klon
83      IF (zm_dp(i).GE.1.0E-15 .AND. zm_q(i).GE.1.0E-15) THEN
84         z_frac(i)=MIN(frac_max,zm_dq(i)/zm_q(i))
85         zm_u(i)=zm_u(i)/zm_dp(i)
86         zm_v(i)=zm_v(i)/zm_dp(i)
87      ENDIF
88      ENDDO
89      DO k = 1, klev
90      DO i = 1, klon
91      IF (zm_dp(i).GE.1.e-15 .AND. zm_q(i).GE.1.e-15
92     .                         .AND. ABS(dq(i,k)).GT.seuil) THEN
93         du(i,k) = u(i,k)*(1.-z_frac(i)) + zm_u(i)*z_frac(i) - u(i,k)
94         dv(i,k) = v(i,k)*(1.-z_frac(i)) + zm_v(i)*z_frac(i) - v(i,k)
95      ENDIF
96      ENDDO
97      ENDDO
98c
99      RETURN
100      END
Note: See TracBrowser for help on using the repository browser.