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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 191 - (hide annotations)
Mon May 9 19:56:28 2016 UTC (8 years 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 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 190 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 guez 191 frac_nucl, pphis, paire, dtime)
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 189 use gr_phy_write_m, only: gr_phy_write
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 guez 191 use time_phylmdz, only: itap
23 guez 78 USE tracstoke, ONLY: istphy
24 guez 3
25 guez 62 REAL, INTENT (IN):: pdtphys ! pas d'integration pour la physique (seconde)
26 guez 78 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    
68 guez 32 ! Variables local to the procedure:
69 guez 3
70 guez 32 real t(klon, klev)
71     INTEGER, SAVE:: physid
72 guez 3
73 guez 78 ! Les Thermiques
74 guez 3
75 guez 32 REAL fm_therm1(klon, klev)
76     REAL entr_therm(klon, klev)
77     REAL fm_therm(klon, klev)
78 guez 3
79 guez 32 INTEGER i, k
80 guez 3
81 guez 62 REAL, save:: mfu(klon, klev) ! flux de masse dans le panache montant
82 guez 32 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 guez 3
89 guez 32 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 guez 3
94 guez 32 REAL dtcum
95 guez 3
96 guez 62 INTEGER:: iadvtr = 0, irec = 1
97 guez 32 REAL zmin, zmax
98     LOGICAL ok_sync
99 guez 3
100 guez 62 SAVE t, mfd, en_u, de_u, en_d, de_d, coefh, dtcum
101 guez 32 SAVE fm_therm, entr_therm
102     SAVE pyu1, pyv1, pftsol, ppsrf
103 guez 3
104 guez 32 !------------------------------------------------------
105 guez 3
106 guez 78 ! Couche limite:
107 guez 32
108     ok_sync = .TRUE.
109    
110 guez 190 IF (iadvtr==0) CALL initphysto('phystoke', dtime, dtime*istphy, dtime*istphy, physid)
111 guez 32
112 guez 191 CALL histwrite(physid, 'phis', itap, gr_phy_write(pphis))
113     CALL histwrite(physid, 'aire', itap, gr_phy_write(paire))
114 guez 32 iadvtr = iadvtr + 1
115    
116 guez 62 IF (mod(iadvtr, istphy) == 1 .OR. istphy == 1) THEN
117     PRINT *, 'reinitialisation des champs cumules a iadvtr =', iadvtr
118 guez 32 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 guez 78 IF (mod(iadvtr, istphy) == 0) THEN
174     ! normalisation par le temps cumule
175 guez 32 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 guez 78 ! ecriture des champs
211 guez 32
212     irec = irec + 1
213    
214 guez 190 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 guez 32 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 guez 190 CALL histwrite(physid, 'fm_th', itap, gr_phy_write(fm_therm1))
229     CALL histwrite(physid, 'en_th', itap, gr_phy_write(entr_therm))
230 guez 78 !ccc
231 guez 190 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 guez 32 IF (ok_sync) CALL histsync(physid)
244    
245 guez 78 ! Test sur la valeur des coefficients de lessivage
246 guez 32
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 guez 62 PRINT *, 'coefs de lessivage (min et max)'
256 guez 32 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