/[lmdze]/trunk/phylmd/phyetat0.f
ViewVC logotype

Annotation of /trunk/phylmd/phyetat0.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 215 - (hide annotations)
Tue Mar 28 12:46:28 2017 UTC (7 years, 2 months ago) by guez
Original Path: trunk/Sources/phylmd/phyetat0.f
File size: 11360 byte(s) 
size(snow) is now knon in interfsurf_hq.

Renamed snow to fsnow in clmain, same name as corresponding actual
argument. We can then rename ysnow to simply snow in clmain, same name
as corresponding dummy argument of clqh. No need to initialize local
snow to 0 since it is only used with indices 1:knon and already
initialized from fsnow for each type of surface. If there is no point
for a given type of surface, fsnow should be reset to 0 for this
type. We need to give a valid value to fsnow in this case even if it
will be multiplied by pctsrf = 0 in physiq.

In physiq, no need for intermediate zxsnow for output.

Removed unused arguments tsurf, p1lay, beta, coef1lay, ps, t1lay,
q1lay, u1lay, v1lay, petAcoef, peqAcoef, petBcoef, peqBcoef of
fonte_neige, with unused computations of zx_qs and zcor. (Same was
done in LMDZ.)
1 guez 3 module phyetat0_m
2    
3 guez 15 use dimphy, only: klon
4 guez 12
5 guez 3 IMPLICIT none
6    
7 guez 138 REAL, save:: rlat(klon), rlon(klon)
8     ! latitude and longitude of a point of the scalar grid identified
9     ! by a simple index, in degrees
10 guez 3
11 guez 191 integer, save:: itau_phy
12    
13 guez 15 private klon
14 guez 3
15     contains
16    
17 guez 207 SUBROUTINE phyetat0(pctsrf, ftsol, ftsoil, qsurf, qsol, snow, albe, evap, &
18 guez 175 rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, agesno, zmea, &
19     zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, ancien_ok, &
20 guez 191 rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, ncid_startphy)
21 guez 3
22 guez 49 ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07
23     ! Author: Z.X. Li (LMD/CNRS)
24 guez 50 ! Date: 1993/08/18
25 guez 69 ! Objet : lecture de l'état initial pour la physique
26 guez 3
27 guez 191 USE conf_gcm_m, ONLY: raz_date
28 guez 69 use dimphy, only: zmasq, klev
29     USE dimsoil, ONLY : nsoilmx
30 guez 12 USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
31 guez 175 use netcdf, only: nf90_global, nf90_inq_varid, NF90_NOERR, NF90_NOWRITE
32 guez 178 use netcdf95, only: nf95_get_att, nf95_get_var, nf95_inq_varid, &
33     nf95_inquire_variable, NF95_OPEN
34 guez 12
35 guez 175 REAL, intent(out):: pctsrf(klon, nbsrf)
36 guez 207 REAL, intent(out):: ftsol(klon, nbsrf)
37     REAL, intent(out):: ftsoil(klon, nsoilmx, nbsrf)
38 guez 175 REAL, intent(out):: qsurf(klon, nbsrf)
39 guez 215
40     REAL, intent(out):: qsol(:)
41     ! (klon) column-density of water in soil, in kg m-2
42    
43 guez 175 REAL, intent(out):: snow(klon, nbsrf)
44     REAL, intent(out):: albe(klon, nbsrf)
45     REAL, intent(out):: evap(klon, nbsrf)
46 guez 62 REAL, intent(out):: rain_fall(klon)
47 guez 175 REAL, intent(out):: snow_fall(klon)
48     real, intent(out):: solsw(klon)
49 guez 72 REAL, intent(out):: sollw(klon)
50 guez 175 real, intent(out):: fder(klon)
51     REAL, intent(out):: radsol(klon)
52     REAL, intent(out):: frugs(klon, nbsrf)
53     REAL, intent(out):: agesno(klon, nbsrf)
54 guez 174 REAL, intent(out):: zmea(klon)
55 guez 13 REAL, intent(out):: zstd(klon)
56     REAL, intent(out):: zsig(klon)
57 guez 175 REAL, intent(out):: zgam(klon)
58     REAL, intent(out):: zthe(klon)
59     REAL, intent(out):: zpic(klon)
60     REAL, intent(out):: zval(klon)
61     REAL, intent(out):: t_ancien(klon, klev), q_ancien(klon, klev)
62 guez 49 LOGICAL, intent(out):: ancien_ok
63 guez 175 real, intent(out):: rnebcon(klon, klev), ratqs(klon, klev)
64     REAL, intent(out):: clwcon(klon, klev), run_off_lic_0(klon)
65 guez 72 real, intent(out):: sig1(klon, klev) ! section adiabatic updraft
66 guez 3
67 guez 72 real, intent(out):: w01(klon, klev)
68     ! vertical velocity within adiabatic updraft
69 guez 3
70 guez 191 integer, intent(out):: ncid_startphy
71 guez 157
72 guez 72 ! Local:
73     REAL fractint(klon)
74 guez 157 INTEGER varid, ndims
75 guez 156 INTEGER ierr, i
76 guez 3
77     !---------------------------------------------------------------
78    
79     print *, "Call sequence information: phyetat0"
80    
81 guez 72 ! Fichier contenant l'état initial :
82 guez 157 call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid_startphy)
83 guez 3
84 guez 191 IF (raz_date) then
85     itau_phy = 0
86     else
87     call nf95_get_att(ncid_startphy, nf90_global, "itau_phy", itau_phy)
88     end IF
89 guez 3
90     ! Lecture des latitudes (coordonnees):
91    
92 guez 157 call NF95_INQ_VARID(ncid_startphy, "latitude", varid)
93     call NF95_GET_VAR(ncid_startphy, varid, rlat)
94 guez 3
95     ! Lecture des longitudes (coordonnees):
96    
97 guez 157 call NF95_INQ_VARID(ncid_startphy, "longitude", varid)
98     call NF95_GET_VAR(ncid_startphy, varid, rlon)
99 guez 3
100     ! Lecture du masque terre mer
101    
102 guez 157 call NF95_INQ_VARID(ncid_startphy, "masque", varid)
103     call nf95_get_var(ncid_startphy, varid, zmasq)
104 guez 101
105 guez 3 ! Lecture des fractions pour chaque sous-surface
106    
107     ! initialisation des sous-surfaces
108    
109     pctsrf = 0.
110    
111     ! fraction de terre
112    
113 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "FTER", varid)
114 guez 50 IF (ierr == NF90_NOERR) THEN
115 guez 157 call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_ter))
116 guez 3 else
117 guez 43 PRINT *, 'phyetat0: Le champ <FTER> est absent'
118 guez 3 ENDIF
119    
120     ! fraction de glace de terre
121    
122 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "FLIC", varid)
123 guez 50 IF (ierr == NF90_NOERR) THEN
124 guez 157 call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_lic))
125 guez 3 else
126 guez 43 PRINT *, 'phyetat0: Le champ <FLIC> est absent'
127 guez 3 ENDIF
128    
129     ! fraction d'ocean
130    
131 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "FOCE", varid)
132 guez 50 IF (ierr == NF90_NOERR) THEN
133 guez 157 call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_oce))
134 guez 3 else
135 guez 43 PRINT *, 'phyetat0: Le champ <FOCE> est absent'
136 guez 3 ENDIF
137    
138     ! fraction glace de mer
139    
140 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "FSIC", varid)
141 guez 50 IF (ierr == NF90_NOERR) THEN
142 guez 157 call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_sic))
143 guez 3 else
144 guez 43 PRINT *, 'phyetat0: Le champ <FSIC> est absent'
145 guez 3 ENDIF
146    
147 guez 50 ! Verification de l'adequation entre le masque et les sous-surfaces
148 guez 3
149 guez 50 fractint = pctsrf(:, is_ter) + pctsrf(:, is_lic)
150 guez 3 DO i = 1 , klon
151 guez 50 IF ( abs(fractint(i) - zmasq(i) ) > EPSFRA ) THEN
152 guez 203 print *, 'phyetat0: attention fraction terre pas ', &
153     'coherente ', i, zmasq(i), pctsrf(i, is_ter), pctsrf(i, is_lic)
154 guez 3 ENDIF
155     END DO
156 guez 50 fractint = pctsrf(:, is_oce) + pctsrf(:, is_sic)
157 guez 3 DO i = 1 , klon
158 guez 50 IF ( abs( fractint(i) - (1. - zmasq(i))) > EPSFRA ) THEN
159 guez 203 print *, 'phyetat0 attention fraction ocean pas ', &
160     'coherente ', i, zmasq(i) , pctsrf(i, is_oce), pctsrf(i, is_sic)
161 guez 3 ENDIF
162     END DO
163    
164     ! Lecture des temperatures du sol:
165 guez 157 call NF95_INQ_VARID(ncid_startphy, "TS", varid)
166     call nf95_inquire_variable(ncid_startphy, varid, ndims = ndims)
167 guez 101 if (ndims == 2) then
168 guez 207 call NF95_GET_VAR(ncid_startphy, varid, ftsol)
169 guez 101 else
170     print *, "Found only one surface type for soil temperature."
171 guez 207 call nf95_get_var(ncid_startphy, varid, ftsol(:, 1))
172     ftsol(:, 2:nbsrf) = spread(ftsol(:, 1), dim = 2, ncopies = nbsrf - 1)
173 guez 156 end if
174 guez 3
175 guez 156 ! Lecture des temperatures du sol profond:
176 guez 3
177 guez 157 call NF95_INQ_VARID(ncid_startphy, 'Tsoil', varid)
178 guez 207 call NF95_GET_VAR(ncid_startphy, varid, ftsoil)
179 guez 3
180     ! Lecture de l'humidite de l'air juste au dessus du sol:
181    
182 guez 157 call NF95_INQ_VARID(ncid_startphy, "QS", varid)
183     call nf95_get_var(ncid_startphy, varid, qsurf)
184 guez 3
185 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "QSOL", varid)
186 guez 50 IF (ierr == NF90_NOERR) THEN
187 guez 157 call nf95_get_var(ncid_startphy, varid, qsol)
188 guez 3 else
189 guez 43 PRINT *, 'phyetat0: Le champ <QSOL> est absent'
190 guez 50 PRINT *, ' Valeur par defaut nulle'
191 guez 43 qsol = 0.
192 guez 3 ENDIF
193    
194     ! Lecture de neige au sol:
195    
196 guez 157 call NF95_INQ_VARID(ncid_startphy, "SNOW", varid)
197     call nf95_get_var(ncid_startphy, varid, snow)
198 guez 3
199     ! Lecture de albedo au sol:
200    
201 guez 157 call NF95_INQ_VARID(ncid_startphy, "ALBE", varid)
202     call nf95_get_var(ncid_startphy, varid, albe)
203 guez 3
204 guez 50 ! Lecture de evaporation:
205 guez 3
206 guez 157 call NF95_INQ_VARID(ncid_startphy, "EVAP", varid)
207     call nf95_get_var(ncid_startphy, varid, evap)
208 guez 3
209     ! Lecture precipitation liquide:
210    
211 guez 157 call NF95_INQ_VARID(ncid_startphy, "rain_f", varid)
212     call NF95_GET_VAR(ncid_startphy, varid, rain_fall)
213 guez 3
214     ! Lecture precipitation solide:
215    
216 guez 157 call NF95_INQ_VARID(ncid_startphy, "snow_f", varid)
217     call NF95_GET_VAR(ncid_startphy, varid, snow_fall)
218 guez 3
219     ! Lecture rayonnement solaire au sol:
220    
221 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "solsw", varid)
222 guez 49 IF (ierr /= NF90_NOERR) THEN
223 guez 43 PRINT *, 'phyetat0: Le champ <solsw> est absent'
224     PRINT *, 'mis a zero'
225 guez 3 solsw = 0.
226     ELSE
227 guez 157 call nf95_get_var(ncid_startphy, varid, solsw)
228 guez 3 ENDIF
229    
230     ! Lecture rayonnement IF au sol:
231    
232 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "sollw", varid)
233 guez 49 IF (ierr /= NF90_NOERR) THEN
234 guez 43 PRINT *, 'phyetat0: Le champ <sollw> est absent'
235     PRINT *, 'mis a zero'
236 guez 3 sollw = 0.
237     ELSE
238 guez 157 call nf95_get_var(ncid_startphy, varid, sollw)
239 guez 3 ENDIF
240    
241     ! Lecture derive des flux:
242    
243 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "fder", varid)
244 guez 49 IF (ierr /= NF90_NOERR) THEN
245 guez 43 PRINT *, 'phyetat0: Le champ <fder> est absent'
246     PRINT *, 'mis a zero'
247 guez 3 fder = 0.
248     ELSE
249 guez 157 call nf95_get_var(ncid_startphy, varid, fder)
250 guez 3 ENDIF
251    
252     ! Lecture du rayonnement net au sol:
253    
254 guez 157 call NF95_INQ_VARID(ncid_startphy, "RADS", varid)
255     call NF95_GET_VAR(ncid_startphy, varid, radsol)
256 guez 3
257     ! Lecture de la longueur de rugosite
258    
259 guez 157 call NF95_INQ_VARID(ncid_startphy, "RUG", varid)
260     call nf95_get_var(ncid_startphy, varid, frugs)
261 guez 3
262     ! Lecture de l'age de la neige:
263    
264 guez 157 call NF95_INQ_VARID(ncid_startphy, "AGESNO", varid)
265     call nf95_get_var(ncid_startphy, varid, agesno)
266 guez 3
267 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZMEA", varid)
268     call NF95_GET_VAR(ncid_startphy, varid, zmea)
269 guez 3
270 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZSTD", varid)
271     call NF95_GET_VAR(ncid_startphy, varid, zstd)
272 guez 3
273 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZSIG", varid)
274     call NF95_GET_VAR(ncid_startphy, varid, zsig)
275 guez 3
276 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZGAM", varid)
277     call NF95_GET_VAR(ncid_startphy, varid, zgam)
278 guez 3
279 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZTHE", varid)
280     call NF95_GET_VAR(ncid_startphy, varid, zthe)
281 guez 3
282 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZPIC", varid)
283     call NF95_GET_VAR(ncid_startphy, varid, zpic)
284 guez 3
285 guez 157 call NF95_INQ_VARID(ncid_startphy, "ZVAL", varid)
286     call NF95_GET_VAR(ncid_startphy, varid, zval)
287 guez 3
288     ancien_ok = .TRUE.
289    
290 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "TANCIEN", varid)
291 guez 49 IF (ierr /= NF90_NOERR) THEN
292 guez 43 PRINT *, "phyetat0: Le champ <TANCIEN> est absent"
293     PRINT *, "Depart legerement fausse. Mais je continue"
294 guez 3 ancien_ok = .FALSE.
295     ELSE
296 guez 157 call nf95_get_var(ncid_startphy, varid, t_ancien)
297 guez 3 ENDIF
298    
299 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "QANCIEN", varid)
300 guez 49 IF (ierr /= NF90_NOERR) THEN
301 guez 43 PRINT *, "phyetat0: Le champ <QANCIEN> est absent"
302     PRINT *, "Depart legerement fausse. Mais je continue"
303 guez 3 ancien_ok = .FALSE.
304     ELSE
305 guez 157 call nf95_get_var(ncid_startphy, varid, q_ancien)
306 guez 3 ENDIF
307    
308 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "CLWCON", varid)
309 guez 49 IF (ierr /= NF90_NOERR) THEN
310 guez 43 PRINT *, "phyetat0: Le champ CLWCON est absent"
311     PRINT *, "Depart legerement fausse. Mais je continue"
312 guez 3 clwcon = 0.
313     ELSE
314 guez 157 call nf95_get_var(ncid_startphy, varid, clwcon(:, 1))
315 guez 72 clwcon(:, 2:) = 0.
316 guez 3 ENDIF
317    
318 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "RNEBCON", varid)
319 guez 49 IF (ierr /= NF90_NOERR) THEN
320 guez 43 PRINT *, "phyetat0: Le champ RNEBCON est absent"
321     PRINT *, "Depart legerement fausse. Mais je continue"
322 guez 3 rnebcon = 0.
323     ELSE
324 guez 157 call nf95_get_var(ncid_startphy, varid, rnebcon(:, 1))
325 guez 72 rnebcon(:, 2:) = 0.
326 guez 3 ENDIF
327    
328     ! Lecture ratqs
329    
330 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "RATQS", varid)
331 guez 49 IF (ierr /= NF90_NOERR) THEN
332 guez 43 PRINT *, "phyetat0: Le champ <RATQS> est absent"
333     PRINT *, "Depart legerement fausse. Mais je continue"
334 guez 3 ratqs = 0.
335     ELSE
336 guez 157 call nf95_get_var(ncid_startphy, varid, ratqs(:, 1))
337 guez 72 ratqs(:, 2:) = 0.
338 guez 3 ENDIF
339    
340     ! Lecture run_off_lic_0
341    
342 guez 157 ierr = NF90_INQ_VARID(ncid_startphy, "RUNOFFLIC0", varid)
343 guez 49 IF (ierr /= NF90_NOERR) THEN
344 guez 43 PRINT *, "phyetat0: Le champ <RUNOFFLIC0> est absent"
345     PRINT *, "Depart legerement fausse. Mais je continue"
346 guez 3 run_off_lic_0 = 0.
347     ELSE
348 guez 157 call nf95_get_var(ncid_startphy, varid, run_off_lic_0)
349 guez 3 ENDIF
350    
351 guez 157 call nf95_inq_varid(ncid_startphy, "sig1", varid)
352     call nf95_get_var(ncid_startphy, varid, sig1)
353 guez 72
354 guez 157 call nf95_inq_varid(ncid_startphy, "w01", varid)
355     call nf95_get_var(ncid_startphy, varid, w01)
356 guez 72
357 guez 3 END SUBROUTINE phyetat0
358    
359     end module phyetat0_m
  ViewVC Help
Powered by ViewVC 1.1.21