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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 10241 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

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