source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/flxtr.F90 @ 2404

Last change on this file since 2404 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

  • 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: 6.6 KB
Line 
1
2! $Header$
3
4SUBROUTINE flxtr(pdtime, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, pt, pplay, &
5    paprs, kcbot, kctop, kdtop, x, dx)
6  USE dimphy
7  IMPLICIT NONE
8  ! =====================================================================
9  ! Objet : Melange convectif de traceurs a partir des flux de masse
10  ! Date : 13/12/1996 -- 13/01/97
11  ! Auteur: O. Boucher (LOA) sur inspiration de Z. X. Li (LMD),
12  ! Brinkop et Sausen (1996) et Boucher et al. (1996).
13  ! ATTENTION : meme si cette routine se veut la plus generale possible,
14  ! elle a herite de certaines notations et conventions du
15  ! schema de Tiedtke (1993).
16  ! --En particulier, les couches sont numerotees de haut en bas !!!
17  ! Ceci est valable pour les flux, kcbot, kctop et kdtop
18  ! mais pas pour les entrees x, pplay, paprs !!!!
19  ! --Un schema amont est choisi pour calculer les flux pour s'assurer
20  ! de la positivite des valeurs de traceurs, cela implique des eqs
21  ! differentes pour les flux de traceurs montants et descendants.
22  ! --pmfu est positif, pmfd est negatif
23  ! --Tous les flux d'entrainements et de detrainements sont positifs
24  ! contrairement au schema de Tiedtke d'ou les changements de signe!!!!
25  ! =====================================================================
26
27  ! ym#include "dimensions.h"
28  ! ym#include "dimphy.h"
29  include "YOMCST.h"
30  include "YOECUMF.h"
31
32  REAL pdtime
33  ! --les flux sont definis au 1/2 niveaux
34  ! --pmfu(klev+1) et pmfd(klev+1) sont implicitement nuls
35  REAL pmfu(klon, klev) ! flux de masse dans le panache montant
36  REAL pmfd(klon, klev) ! flux de masse dans le panache descendant
37  REAL pen_u(klon, klev) ! flux entraine dans le panache montant
38  REAL pde_u(klon, klev) ! flux detraine dans le panache montant
39  REAL pen_d(klon, klev) ! flux entraine dans le panache descendant
40  REAL pde_d(klon, klev) ! flux detraine dans le panache descendant
41  ! --idem mais en variables locales
42  REAL zpen_u(klon, klev)
43  REAL zpde_u(klon, klev)
44  REAL zpen_d(klon, klev)
45  REAL zpde_d(klon, klev)
46
47  REAL pplay(klon, klev) ! pression aux couches (bas en haut)
48  REAL pap(klon, klev) ! pression aux couches (haut en bas)
49  REAL pt(klon, klev) ! temperature aux couches (bas en haut)
50  REAL zt(klon, klev) ! temperature aux couches (haut en bas)
51  REAL paprs(klon, klev+1) ! pression aux 1/2 couches (bas en haut)
52  REAL paph(klon, klev+1) ! pression aux 1/2 couches (haut en bas)
53  INTEGER kcbot(klon) ! niveau de base de la convection
54  INTEGER kctop(klon) ! niveau du sommet de la convection +1
55  INTEGER kdtop(klon) ! niveau de sommet du panache descendant
56  REAL x(klon, klev) ! q de traceur (bas en haut)
57  REAL zx(klon, klev) ! q de traceur (haut en bas)
58  REAL dx(klon, klev) ! tendance de traceur  (bas en haut)
59
60  ! --variables locales
61  ! --les flux de x sont definis aux 1/2 niveaux
62  ! --xu et xd sont definis aux niveaux complets
63  REAL xu(klon, klev) ! q de traceurs dans le panache montant
64  REAL xd(klon, klev) ! q de traceurs dans le panache descendant
65  REAL xe(klon, klev) ! q de traceurs dans l'environnement
66  REAL zmfux(klon, klev+1) ! flux de x dans le panache montant
67  REAL zmfdx(klon, klev+1) ! flux de x dans le panache descendant
68  REAL zmfex(klon, klev+1) ! flux de x dans l'environnement
69  INTEGER i, k
70  REAL zmfmin
71  PARAMETER (zmfmin=1.E-10)
72
73  ! On remet les taux d'entrainement et de detrainement dans le panache
74  ! descendant a des valeurs positives.
75  ! On ajuste les valeurs de pen_u, pen_d pde_u et pde_d pour que la
76  ! conservation de la masse soit realisee a chaque niveau dans les 2
77  ! panaches.
78  DO k = 1, klev
79    DO i = 1, klon
80      zpen_u(i, k) = pen_u(i, k)
81      zpde_u(i, k) = pde_u(i, k)
82    END DO
83  END DO
84
85  DO k = 1, klev - 1
86    DO i = 1, klon
87      zpen_d(i, k) = -pen_d(i, k+1)
88      zpde_d(i, k) = -pde_d(i, k+1)
89    END DO
90  END DO
91
92  DO i = 1, klon
93    zpen_d(i, klev) = 0.0
94    zpde_d(i, klev) = -pmfd(i, klev)
95    ! Correction 03 11 97
96    ! zpen_d(i,kdtop(i)-1) = pmfd(i,kdtop(i)-1)-pmfd(i,kdtop(i))
97    IF (kdtop(i)==klev+1) THEN
98      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1)
99    ELSE
100      zpen_d(i, kdtop(i)-1) = pmfd(i, kdtop(i)-1) - pmfd(i, kdtop(i))
101    END IF
102
103    zpde_u(i, kctop(i)-2) = pmfu(i, kctop(i)-1)
104    zpen_u(i, klev) = pmfu(i, klev)
105  END DO
106
107  DO i = 1, klon
108    DO k = kcbot(i), klev - 1
109      zpen_u(i, k) = pmfu(i, k) - pmfu(i, k+1)
110    END DO
111  END DO
112
113  ! conversion des sens de notations bas-haut et haut-bas
114
115  DO k = 1, klev + 1
116    DO i = 1, klon
117      paph(i, klev+2-k) = paprs(i, k)
118    END DO
119  END DO
120
121  DO i = 1, klon
122    DO k = 1, klev
123      pap(i, klev+1-k) = pplay(i, k)
124      zt(i, klev+1-k) = pt(i, k)
125      zx(i, klev+1-k) = x(i, k)
126    END DO
127  END DO
128
129  ! --initialisations des flux de traceurs aux extremites de la colonne
130
131  DO i = 1, klon
132    zmfux(i, klev+1) = 0.0
133    zmfdx(i, 1) = 0.0
134    zmfex(i, 1) = 0.0
135  END DO
136
137  ! --calcul des flux dans le panache montant
138
139  DO k = klev, 1, -1
140    DO i = 1, klon
141      IF (k>=kcbot(i)) THEN
142        xu(i, k) = zx(i, k)
143        zmfux(i, k) = pmfu(i, k)*xu(i, k)
144      ELSE
145        zmfux(i, k) = (zmfux(i,k+1)+zpen_u(i,k)*zx(i,k))/ &
146          (1.+zpde_u(i,k)/max(zmfmin,pmfu(i,k)))
147        xu(i, k) = zmfux(i, k)/max(zmfmin, pmfu(i,k))
148      END IF
149    END DO
150  END DO
151
152  ! --calcul des flux dans le panache descendant
153
154  DO k = 1, klev - 1
155    DO i = 1, klon
156      IF (k<=kdtop(i)-1) THEN
157        xd(i, k) = (zx(i,k)+xu(i,k))/2.
158        zmfdx(i, k+1) = pmfd(i, k+1)*xd(i, k)
159      ELSE
160        zmfdx(i, k+1) = (zmfdx(i,k)-zpen_d(i,k)*zx(i,k))/ &
161          (1.-zpde_d(i,k)/min(-zmfmin,pmfd(i,k+1)))
162        xd(i, k) = zmfdx(i, k+1)/min(-zmfmin, pmfd(i,k+1))
163      END IF
164    END DO
165  END DO
166  DO i = 1, klon
167    zmfdx(i, klev+1) = 0.0
168    xd(i, klev) = (zpen_d(i,klev)*zx(i,klev)-zmfdx(i,klev))/ &
169      max(zmfmin, zpde_d(i,klev))
170  END DO
171
172  ! --introduction du flux de retour dans l'environnement
173
174  DO k = 1, klev - 1
175    DO i = 1, klon
176      IF (k<=kctop(i)-3) THEN
177        xe(i, k) = zx(i, k)
178        zmfex(i, k+1) = -(pmfu(i,k+1)+pmfd(i,k+1))*xe(i, k)
179      ELSE
180        zmfex(i, k+1) = (zmfex(i,k)-(zpde_u(i,k)*xu(i,k)+zpde_d(i,k)*xd(i, &
181          k)))/(1.-(zpen_d(i,k)+zpen_u(i,k))/min(-zmfmin,-pmfu(i,k+1)-pmfd(i, &
182          k+1)))
183        xe(i, k) = zmfex(i, k+1)/min(-zmfmin, -pmfu(i,k+1)-pmfd(i,k+1))
184      END IF
185    END DO
186  END DO
187  DO i = 1, klon
188    zmfex(i, klev+1) = 0.0
189    xe(i, klev) = (zpde_u(i,klev)*xu(i,klev)+zpde_d(i,klev)*xd(i,klev)-zmfex( &
190      i,klev))/max(zmfmin, zpen_u(i,klev)+zpen_d(i,klev))
191  END DO
192
193  ! --calcul final des tendances
194
195  DO k = 1, klev
196    DO i = 1, klon
197      dx(i, klev+1-k) = rg/(paph(i,k+1)-paph(i,k))*pdtime* &
198        (zmfux(i,k+1)-zmfux(i,k)+zmfdx(i,k+1)-zmfdx(i,k)+zmfex(i,k+1)- &
199        zmfex(i,k))
200    END DO
201  END DO
202
203  RETURN
204END SUBROUTINE flxtr
Note: See TracBrowser for help on using the repository browser.