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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (show annotations)
Mon May 9 19:56:28 2016 UTC (7 years, 11 months ago) by guez
File size: 8778 byte(s)
Extracted the call to read_comdissnew out of conf_gcm.

Made ok_instan a variable of module clesphys, itau_phy a variable of
module phyetat0_m, nid_ins a variable of module ini_histins_m, itap a
variable of new module time_phylmdz, so that histwrite_phy can be
called from any procedure without the need to cascade those variables
into that procedure. Made itau_w a variable of module time_phylmdz so
that it is computed only once per time step of physics.

Extracted variables of module clesphys which were in namelist
conf_phys_nml into their own namelist, clesphys_nml, and created
procedure read_clesphys reading clesphys_nml, to avoid side effect.

No need for double precision in procedure getso4fromfile. Assume there
is a single variable for the whole year in the NetCDF file instead of
one variable per month.

Created generic procedure histwrite_phy and removed procedure
write_histins, following LMDZ. histwrite_phy has only two arguments,
can be called from anywhere, and should manage the logic of writing or
not writing into various history files with various operations. So the
test on ok_instan goes inside histwrite_phy.

Test for raz_date in phyetat0 instead of physiq to avoid side effect.

Created procedure increment_itap to avoid side effect.

Removed unnecessary differences between procedures readsulfate and
readsulfate_pi.

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

  ViewVC Help
Powered by ViewVC 1.1.21