source: LMDZ5/trunk/libf/phylmd/homogene.F @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
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.