source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/homogene.F @ 5451

Last change on this file since 5451 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

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