/[lmdze]/trunk/Sources/phylmd/phystokenc.f
ViewVC logotype

Annotation of /trunk/Sources/phylmd/phystokenc.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 186 - (hide annotations)
Mon Mar 21 15:36:26 2016 UTC (8 years, 2 months ago) by guez
File size: 10282 byte(s) 
Removed variables nlm and nlp of module cv30_param_m. We do not
believe much in the benefit of these intermediary variables so we go
for clarity.

Removed variable noff of module cv30_param_m. Never used anywhere
else. Just set the value of nl explicitly in cv30_param.

Removed argument nd of cv30_param. Only called with nd = klev.

Replaced calls to zilch by array assignments. There was a strange
double call to zilch with the same arguments in cv30_mixing.

Removed procedure cv_flag. Just set the value of variable cvflag_grav
of module cvflag at declaration.
1 guez 32 module phystokenc_m
2 guez 3
3 guez 32 IMPLICIT NONE
4 guez 3
5 guez 32 contains
6 guez 3
7 guez 32 SUBROUTINE phystokenc(pdtphys, rlon, rlat, pt, pmfu, pmfd, pen_u, pde_u, &
8     pen_d, pde_d, pfm_therm, pentr_therm, pcoefh, yu1, yv1, ftsol, pctsrf, &
9     frac_impa, frac_nucl, pphis, paire, dtime, itap)
10 guez 3
11 guez 32 ! From phylmd/phystokenc.F, version 1.2 2004/06/22 11:45:35
12 guez 155 ! Author: Fr\'ed\'eric Hourdin
13     ! Objet : \'ecriture des variables pour transport offline
14 guez 3
15 guez 186 use gr_fi_ecrit_m, only: gr_fi_ecrit
16 guez 78 USE histwrite_m, ONLY: histwrite
17     USE histsync_m, ONLY: histsync
18 guez 178 USE dimens_m, ONLY: iim, jjm
19 guez 78 USE indicesol, ONLY: nbsrf
20 guez 155 use initphysto_m, only: initphysto
21 guez 78 USE dimphy, ONLY: klev, klon
22     USE tracstoke, ONLY: istphy
23 guez 3
24 guez 62 REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde)
25 guez 78 REAL, INTENT (IN):: rlon(klon), rlat(klon)
26     REAL, intent(in):: pt(klon, klev)
27 guez 3
28 guez 78 ! convection:
29 guez 3
30 guez 62 REAL, INTENT (IN):: pmfu(klon, klev) ! flux de masse dans le panache montant
31 guez 72
32     REAL, intent(in):: pmfd(klon, klev)
33     ! flux de masse dans le panache descendant
34    
35 guez 78 REAL, intent(in):: pen_u(klon, klev) ! flux entraine dans le panache montant
36     REAL, intent(in):: pde_u(klon, klev) ! flux detraine dans le panache montant
37 guez 3
38 guez 78 REAL, intent(in):: pen_d(klon, klev)
39     ! flux entraine dans le panache descendant
40 guez 3
41 guez 78 REAL, intent(in):: pde_d(klon, klev)
42     ! flux detraine dans le panache descendant
43    
44     ! Les Thermiques
45 guez 32 REAL pfm_therm(klon, klev+1)
46     REAL pentr_therm(klon, klev)
47 guez 3
48 guez 78 ! Couche limite:
49 guez 3
50 guez 78 REAL pcoefh(klon, klev) ! coeff melange Couche limite
51     REAL yu1(klon)
52 guez 32 REAL yv1(klon)
53 guez 3
54 guez 78 ! Arguments necessaires pour les sources et puits de traceur
55 guez 3
56 guez 32 REAL ftsol(klon, nbsrf) ! Temperature du sol (surf)(Kelvin)
57     REAL pctsrf(klon, nbsrf) ! Pourcentage de sol f(nature du sol)
58 guez 3
59 guez 78 ! Lessivage:
60 guez 3
61 guez 32 REAL frac_impa(klon, klev)
62     REAL frac_nucl(klon, klev)
63 guez 3
64 guez 78 REAL, INTENT(IN):: pphis(klon)
65     real paire(klon)
66     REAL, INTENT (IN):: dtime
67     INTEGER, INTENT (IN):: itap
68    
69 guez 32 ! Variables local to the procedure:
70 guez 3
71 guez 32 real t(klon, klev)
72     INTEGER, SAVE:: physid
73     REAL zx_tmp_3d(iim, jjm+1, klev), zx_tmp_2d(iim, jjm+1)
74 guez 3
75 guez 78 ! Les Thermiques
76 guez 3
77 guez 32 REAL fm_therm1(klon, klev)
78     REAL entr_therm(klon, klev)
79     REAL fm_therm(klon, klev)
80 guez 3
81 guez 32 INTEGER i, k
82 guez 3
83 guez 62 REAL, save:: mfu(klon, klev) ! flux de masse dans le panache montant
84 guez 32 REAL mfd(klon, klev) ! flux de masse dans le panache descendant
85     REAL en_u(klon, klev) ! flux entraine dans le panache montant
86     REAL de_u(klon, klev) ! flux detraine dans le panache montant
87     REAL en_d(klon, klev) ! flux entraine dans le panache descendant
88     REAL de_d(klon, klev) ! flux detraine dans le panache descendant
89     REAL coefh(klon, klev) ! flux detraine dans le panache descendant
90 guez 3
91 guez 32 REAL pyu1(klon), pyv1(klon)
92     REAL pftsol(klon, nbsrf), ppsrf(klon, nbsrf)
93     REAL pftsol1(klon), pftsol2(klon), pftsol3(klon), pftsol4(klon)
94     REAL ppsrf1(klon), ppsrf2(klon), ppsrf3(klon), ppsrf4(klon)
95 guez 3
96 guez 32 REAL dtcum
97 guez 3
98 guez 62 INTEGER:: iadvtr = 0, irec = 1
99 guez 32 REAL zmin, zmax
100     LOGICAL ok_sync
101 guez 3
102 guez 62 SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum
103 guez 32 SAVE fm_therm, entr_therm
104     SAVE pyu1, pyv1, pftsol, ppsrf
105 guez 3
106 guez 32 !------------------------------------------------------
107 guez 3
108 guez 78 ! Couche limite:
109 guez 32
110     ok_sync = .TRUE.
111    
112     IF (iadvtr==0) THEN
113     CALL initphysto('phystoke', rlon, rlat, dtime, dtime*istphy, &
114 guez 155 dtime*istphy, physid)
115 guez 32 END IF
116    
117     i = itap
118     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pphis, zx_tmp_2d)
119     CALL histwrite(physid, 'phis', i, zx_tmp_2d)
120    
121     i = itap
122     CALL gr_fi_ecrit(1, klon, iim, jjm+1, paire, zx_tmp_2d)
123     CALL histwrite(physid, 'aire', i, zx_tmp_2d)
124    
125     iadvtr = iadvtr + 1
126    
127 guez 62 IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN
128     PRINT *, 'reinitialisation des champs cumules a iadvtr =', iadvtr
129 guez 32 DO k = 1, klev
130     DO i = 1, klon
131     mfu(i, k) = 0.
132     mfd(i, k) = 0.
133     en_u(i, k) = 0.
134     de_u(i, k) = 0.
135     en_d(i, k) = 0.
136     de_d(i, k) = 0.
137     coefh(i, k) = 0.
138     t(i, k) = 0.
139     fm_therm(i, k) = 0.
140     entr_therm(i, k) = 0.
141     END DO
142     END DO
143     DO i = 1, klon
144     pyv1(i) = 0.
145     pyu1(i) = 0.
146     END DO
147     DO k = 1, nbsrf
148     DO i = 1, klon
149     pftsol(i, k) = 0.
150     ppsrf(i, k) = 0.
151     END DO
152     END DO
153    
154     dtcum = 0.
155     END IF
156    
157     DO k = 1, klev
158     DO i = 1, klon
159     mfu(i, k) = mfu(i, k) + pmfu(i, k)*pdtphys
160     mfd(i, k) = mfd(i, k) + pmfd(i, k)*pdtphys
161     en_u(i, k) = en_u(i, k) + pen_u(i, k)*pdtphys
162     de_u(i, k) = de_u(i, k) + pde_u(i, k)*pdtphys
163     en_d(i, k) = en_d(i, k) + pen_d(i, k)*pdtphys
164     de_d(i, k) = de_d(i, k) + pde_d(i, k)*pdtphys
165     coefh(i, k) = coefh(i, k) + pcoefh(i, k)*pdtphys
166     t(i, k) = t(i, k) + pt(i, k)*pdtphys
167     fm_therm(i, k) = fm_therm(i, k) + pfm_therm(i, k)*pdtphys
168     entr_therm(i, k) = entr_therm(i, k) + pentr_therm(i, k)*pdtphys
169     END DO
170     END DO
171     DO i = 1, klon
172     pyv1(i) = pyv1(i) + yv1(i)*pdtphys
173     pyu1(i) = pyu1(i) + yu1(i)*pdtphys
174     END DO
175     DO k = 1, nbsrf
176     DO i = 1, klon
177     pftsol(i, k) = pftsol(i, k) + ftsol(i, k)*pdtphys
178     ppsrf(i, k) = ppsrf(i, k) + pctsrf(i, k)*pdtphys
179     END DO
180     END DO
181    
182     dtcum = dtcum + pdtphys
183    
184 guez 78 IF (mod(iadvtr, istphy) == 0) THEN
185     ! normalisation par le temps cumule
186 guez 32 DO k = 1, klev
187     DO i = 1, klon
188     mfu(i, k) = mfu(i, k)/dtcum
189     mfd(i, k) = mfd(i, k)/dtcum
190     en_u(i, k) = en_u(i, k)/dtcum
191     de_u(i, k) = de_u(i, k)/dtcum
192     en_d(i, k) = en_d(i, k)/dtcum
193     de_d(i, k) = de_d(i, k)/dtcum
194     coefh(i, k) = coefh(i, k)/dtcum
195     ! Unitel a enlever
196     t(i, k) = t(i, k)/dtcum
197     fm_therm(i, k) = fm_therm(i, k)/dtcum
198     entr_therm(i, k) = entr_therm(i, k)/dtcum
199     END DO
200     END DO
201     DO i = 1, klon
202     pyv1(i) = pyv1(i)/dtcum
203     pyu1(i) = pyu1(i)/dtcum
204     END DO
205     DO k = 1, nbsrf
206     DO i = 1, klon
207     pftsol(i, k) = pftsol(i, k)/dtcum
208     pftsol1(i) = pftsol(i, 1)
209     pftsol2(i) = pftsol(i, 2)
210     pftsol3(i) = pftsol(i, 3)
211     pftsol4(i) = pftsol(i, 4)
212    
213     ppsrf(i, k) = ppsrf(i, k)/dtcum
214     ppsrf1(i) = ppsrf(i, 1)
215     ppsrf2(i) = ppsrf(i, 2)
216     ppsrf3(i) = ppsrf(i, 3)
217     ppsrf4(i) = ppsrf(i, 4)
218     END DO
219     END DO
220    
221 guez 78 ! ecriture des champs
222 guez 32
223     irec = irec + 1
224    
225     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, t, zx_tmp_3d)
226     CALL histwrite(physid, 't', itap, zx_tmp_3d)
227    
228     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfu, zx_tmp_3d)
229     CALL histwrite(physid, 'mfu', itap, zx_tmp_3d)
230     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, mfd, zx_tmp_3d)
231     CALL histwrite(physid, 'mfd', itap, zx_tmp_3d)
232     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_u, zx_tmp_3d)
233     CALL histwrite(physid, 'en_u', itap, zx_tmp_3d)
234     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_u, zx_tmp_3d)
235     CALL histwrite(physid, 'de_u', itap, zx_tmp_3d)
236     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, en_d, zx_tmp_3d)
237     CALL histwrite(physid, 'en_d', itap, zx_tmp_3d)
238     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, de_d, zx_tmp_3d)
239     CALL histwrite(physid, 'de_d', itap, zx_tmp_3d)
240     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, coefh, zx_tmp_3d)
241     CALL histwrite(physid, 'coefh', itap, zx_tmp_3d)
242    
243     DO k = 1, klev
244     DO i = 1, klon
245     fm_therm1(i, k) = fm_therm(i, k)
246     END DO
247     END DO
248    
249     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, fm_therm1, zx_tmp_3d)
250     CALL histwrite(physid, 'fm_th', itap, zx_tmp_3d)
251    
252     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, entr_therm, zx_tmp_3d)
253     CALL histwrite(physid, 'en_th', itap, zx_tmp_3d)
254 guez 78 !ccc
255 guez 32 CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_impa, zx_tmp_3d)
256     CALL histwrite(physid, 'frac_impa', itap, zx_tmp_3d)
257    
258     CALL gr_fi_ecrit(klev, klon, iim, jjm+1, frac_nucl, zx_tmp_3d)
259     CALL histwrite(physid, 'frac_nucl', itap, zx_tmp_3d)
260    
261     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyu1, zx_tmp_2d)
262     CALL histwrite(physid, 'pyu1', itap, zx_tmp_2d)
263    
264     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pyv1, zx_tmp_2d)
265     CALL histwrite(physid, 'pyv1', itap, zx_tmp_2d)
266    
267     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol1, zx_tmp_2d)
268     CALL histwrite(physid, 'ftsol1', itap, zx_tmp_2d)
269     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol2, zx_tmp_2d)
270     CALL histwrite(physid, 'ftsol2', itap, zx_tmp_2d)
271     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol3, zx_tmp_2d)
272     CALL histwrite(physid, 'ftsol3', itap, zx_tmp_2d)
273     CALL gr_fi_ecrit(1, klon, iim, jjm+1, pftsol4, zx_tmp_2d)
274     CALL histwrite(physid, 'ftsol4', itap, zx_tmp_2d)
275    
276     CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf1, zx_tmp_2d)
277     CALL histwrite(physid, 'psrf1', itap, zx_tmp_2d)
278     CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf2, zx_tmp_2d)
279     CALL histwrite(physid, 'psrf2', itap, zx_tmp_2d)
280     CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf3, zx_tmp_2d)
281     CALL histwrite(physid, 'psrf3', itap, zx_tmp_2d)
282     CALL gr_fi_ecrit(1, klon, iim, jjm+1, ppsrf4, zx_tmp_2d)
283     CALL histwrite(physid, 'psrf4', itap, zx_tmp_2d)
284    
285     IF (ok_sync) CALL histsync(physid)
286    
287 guez 78 ! Test sur la valeur des coefficients de lessivage
288 guez 32
289     zmin = 1E33
290     zmax = -1E33
291     DO k = 1, klev
292     DO i = 1, klon
293     zmax = max(zmax, frac_nucl(i, k))
294     zmin = min(zmin, frac_nucl(i, k))
295     END DO
296     END DO
297 guez 62 PRINT *, 'coefs de lessivage (min et max)'
298 guez 32 PRINT *, 'facteur de nucleation ', zmin, zmax
299     zmin = 1E33
300     zmax = -1E33
301     DO k = 1, klev
302     DO i = 1, klon
303     zmax = max(zmax, frac_impa(i, k))
304     zmin = min(zmin, frac_impa(i, k))
305     END DO
306     END DO
307     PRINT *, 'facteur d impaction ', zmin, zmax
308     END IF
309    
310     END SUBROUTINE phystokenc
311    
312     end module phystokenc_m
  ViewVC Help
Powered by ViewVC 1.1.21