source: LMDZ.3.3/trunk/libf/phylmd/homogene.F @ 2077

Last change on this file since 2077 was 2, checked in by lmdz, 25 years ago

Initial revision

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