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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 138 - (hide annotations)
Fri May 22 23:13:19 2015 UTC (9 years ago) by guez
File size: 22015 byte(s)
Moved variable nb_files from module histcom_var to module
histbeg_totreg_m.

Removed unused argument q of writehist.

No history file is created in program ce0l so there is no need to call
histclo in etat0.

In phyredem, access variables rlat and rlon directly from module
phyetat0_m instead of having them as arguments. This is clearer for
the program gcm. There are bad side effects for the program ce0l: we
have to modify the module variables rlat and rlon in procedure etat0,
and we need the additional file phyetat0.f to compile ce0l.

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 15 private klon
12 guez 3
13     contains
14    
15 guez 99 SUBROUTINE phyetat0(pctsrf, tsol, tsoil, tslab, seaice, qsurf, qsol, &
16     snow, albe, alblw, evap, rain_fall, snow_fall, solsw, sollw, fder, &
17     radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
18     t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, &
19     sig1, w01)
20 guez 3
21 guez 49 ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07
22     ! Author: Z.X. Li (LMD/CNRS)
23 guez 50 ! Date: 1993/08/18
24 guez 69 ! Objet : lecture de l'état initial pour la physique
25 guez 3
26 guez 69 use dimphy, only: zmasq, klev
27     USE dimsoil, ONLY : nsoilmx
28 guez 12 USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
29 guez 101 use netcdf, only: nf90_global, nf90_inq_varid, NF90_NOERR, &
30 guez 50 NF90_NOWRITE
31 guez 101 use netcdf95, only: nf95_close, nf95_get_att, nf95_get_var, &
32     nf95_inq_varid, nf95_inquire_variable, NF95_OPEN
33 guez 69 USE temps, ONLY : itau_phy
34 guez 12
35 guez 72 REAL pctsrf(klon, nbsrf)
36 guez 49 REAL tsol(klon, nbsrf)
37     REAL tsoil(klon, nsoilmx, nbsrf)
38 guez 3 REAL tslab(klon), seaice(klon)
39 guez 49 REAL qsurf(klon, nbsrf)
40 guez 99 REAL, intent(out):: qsol(:) ! (klon)
41 guez 49 REAL snow(klon, nbsrf)
42     REAL albe(klon, nbsrf)
43     REAL alblw(klon, nbsrf)
44     REAL evap(klon, nbsrf)
45 guez 62 REAL, intent(out):: rain_fall(klon)
46 guez 3 REAL snow_fall(klon)
47     real solsw(klon)
48 guez 72 REAL, intent(out):: sollw(klon)
49 guez 3 real fder(klon)
50 guez 72 REAL radsol(klon)
51 guez 49 REAL frugs(klon, nbsrf)
52     REAL agesno(klon, nbsrf)
53 guez 3 REAL zmea(klon)
54 guez 13 REAL, intent(out):: zstd(klon)
55     REAL, intent(out):: zsig(klon)
56 guez 3 REAL zgam(klon)
57     REAL zthe(klon)
58     REAL zpic(klon)
59     REAL zval(klon)
60 guez 49 REAL t_ancien(klon, klev), q_ancien(klon, klev)
61     LOGICAL, intent(out):: ancien_ok
62 guez 72 real rnebcon(klon, klev), ratqs(klon, klev), clwcon(klon, klev)
63     REAL run_off_lic_0(klon)
64     real, intent(out):: sig1(klon, klev) ! section adiabatic updraft
65 guez 3
66 guez 72 real, intent(out):: w01(klon, klev)
67     ! vertical velocity within adiabatic updraft
68 guez 3
69 guez 72 ! Local:
70     REAL fractint(klon)
71 guez 3 REAL xmin, xmax
72 guez 101 INTEGER ncid, varid, ndims
73 guez 3 INTEGER ierr, i, nsrf, isoil
74 guez 72 CHARACTER(len=7) str7
75     CHARACTER(len=2) str2
76 guez 3
77     !---------------------------------------------------------------
78    
79     print *, "Call sequence information: phyetat0"
80    
81 guez 72 ! Fichier contenant l'état initial :
82 guez 99 call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid)
83 guez 3
84 guez 101 call nf95_get_att(ncid, nf90_global, "itau_phy", itau_phy)
85 guez 3
86     ! Lecture des latitudes (coordonnees):
87    
88 guez 50 call NF95_INQ_VARID(ncid, "latitude", varid)
89     call NF95_GET_VAR(ncid, varid, rlat)
90 guez 3
91     ! Lecture des longitudes (coordonnees):
92    
93 guez 50 call NF95_INQ_VARID(ncid, "longitude", varid)
94     call NF95_GET_VAR(ncid, varid, rlon)
95 guez 3
96     ! Lecture du masque terre mer
97    
98 guez 101 call NF95_INQ_VARID(ncid, "masque", varid)
99     call nf95_get_var(ncid, varid, zmasq)
100    
101 guez 3 ! Lecture des fractions pour chaque sous-surface
102    
103     ! initialisation des sous-surfaces
104    
105     pctsrf = 0.
106    
107     ! fraction de terre
108    
109 guez 49 ierr = NF90_INQ_VARID(ncid, "FTER", varid)
110 guez 50 IF (ierr == NF90_NOERR) THEN
111     call nf95_get_var(ncid, varid, pctsrf(:, is_ter))
112 guez 3 else
113 guez 43 PRINT *, 'phyetat0: Le champ <FTER> est absent'
114 guez 3 ENDIF
115    
116     ! fraction de glace de terre
117    
118 guez 49 ierr = NF90_INQ_VARID(ncid, "FLIC", varid)
119 guez 50 IF (ierr == NF90_NOERR) THEN
120     call nf95_get_var(ncid, varid, pctsrf(:, is_lic))
121 guez 3 else
122 guez 43 PRINT *, 'phyetat0: Le champ <FLIC> est absent'
123 guez 3 ENDIF
124    
125     ! fraction d'ocean
126    
127 guez 49 ierr = NF90_INQ_VARID(ncid, "FOCE", varid)
128 guez 50 IF (ierr == NF90_NOERR) THEN
129     call nf95_get_var(ncid, varid, pctsrf(:, is_oce))
130 guez 3 else
131 guez 43 PRINT *, 'phyetat0: Le champ <FOCE> est absent'
132 guez 3 ENDIF
133    
134     ! fraction glace de mer
135    
136 guez 49 ierr = NF90_INQ_VARID(ncid, "FSIC", varid)
137 guez 50 IF (ierr == NF90_NOERR) THEN
138     call nf95_get_var(ncid, varid, pctsrf(:, is_sic))
139 guez 3 else
140 guez 43 PRINT *, 'phyetat0: Le champ <FSIC> est absent'
141 guez 3 ENDIF
142    
143 guez 50 ! Verification de l'adequation entre le masque et les sous-surfaces
144 guez 3
145 guez 50 fractint = pctsrf(:, is_ter) + pctsrf(:, is_lic)
146 guez 3 DO i = 1 , klon
147 guez 50 IF ( abs(fractint(i) - zmasq(i) ) > EPSFRA ) THEN
148     WRITE(*, *) 'phyetat0: attention fraction terre pas ', &
149 guez 3 'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
150 guez 49 , pctsrf(i, is_lic)
151 guez 3 ENDIF
152     END DO
153 guez 50 fractint = pctsrf(:, is_oce) + pctsrf(:, is_sic)
154 guez 3 DO i = 1 , klon
155 guez 50 IF ( abs( fractint(i) - (1. - zmasq(i))) > EPSFRA ) THEN
156     WRITE(*, *) 'phyetat0 attention fraction ocean pas ', &
157 guez 3 'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
158 guez 49 , pctsrf(i, is_sic)
159 guez 3 ENDIF
160     END DO
161    
162     ! Lecture des temperatures du sol:
163 guez 101 call NF95_INQ_VARID(ncid, "TS", varid)
164     call nf95_inquire_variable(ncid, varid, ndims = ndims)
165     if (ndims == 2) then
166     call NF95_GET_VAR(ncid, varid, tsol)
167     else
168     print *, "Found only one surface type for soil temperature."
169 guez 49 call nf95_get_var(ncid, varid, tsol(:, 1))
170 guez 101 tsol(:, 2:nbsrf) = spread(tsol(:, 1), dim = 2, ncopies = nbsrf - 1)
171     end if
172 guez 3
173 guez 101 ! Lecture des temperatures du sol profond:
174 guez 3
175     DO nsrf = 1, nbsrf
176     DO isoil=1, nsoilmx
177 guez 50 IF (isoil > 99 .AND. nsrf > 99) THEN
178 guez 43 PRINT *, "Trop de couches ou sous-mailles"
179 guez 3 stop 1
180     ENDIF
181 guez 49 WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf
182     ierr = NF90_INQ_VARID(ncid, 'Tsoil'//str7, varid)
183     IF (ierr /= NF90_NOERR) THEN
184 guez 43 PRINT *, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
185 guez 50 PRINT *, " Il prend donc la valeur de surface"
186 guez 3 DO i=1, klon
187 guez 49 tsoil(i, isoil, nsrf)=tsol(i, nsrf)
188 guez 3 ENDDO
189     ELSE
190 guez 50 call NF95_GET_VAR(ncid, varid, tsoil(:, isoil, nsrf))
191 guez 3 ENDIF
192     ENDDO
193     ENDDO
194    
195     !IM "slab" ocean
196 guez 50 ! Lecture de tslab (pour slab ocean seulement):
197 guez 99 tslab = 0.
198     seaice = 0.
199 guez 3
200     ! Lecture de l'humidite de l'air juste au dessus du sol:
201    
202 guez 49 ierr = NF90_INQ_VARID(ncid, "QS", varid)
203     IF (ierr /= NF90_NOERR) THEN
204 guez 43 PRINT *, 'phyetat0: Le champ <QS> est absent'
205 guez 50 PRINT *, ' Mais je vais essayer de lire QS**'
206 guez 3 DO nsrf = 1, nbsrf
207 guez 50 IF (nsrf > 99) THEN
208 guez 43 PRINT *, "Trop de sous-mailles"
209 guez 3 stop 1
210     ENDIF
211 guez 49 WRITE(str2, '(i2.2)') nsrf
212 guez 50 call NF95_INQ_VARID(ncid, "QS"//str2, varid)
213     call NF95_GET_VAR(ncid, varid, qsurf(:, nsrf))
214 guez 3 xmin = 1.0E+20
215     xmax = -1.0E+20
216     DO i = 1, klon
217 guez 49 xmin = MIN(qsurf(i, nsrf), xmin)
218     xmax = MAX(qsurf(i, nsrf), xmax)
219 guez 3 ENDDO
220 guez 49 PRINT *, 'Humidite pres du sol QS**:', nsrf, xmin, xmax
221 guez 3 ENDDO
222     ELSE
223 guez 43 PRINT *, 'phyetat0: Le champ <QS> est present'
224 guez 50 PRINT *, ' J ignore donc les autres humidites QS**'
225 guez 49 call nf95_get_var(ncid, varid, qsurf(:, 1))
226 guez 3 xmin = 1.0E+20
227     xmax = -1.0E+20
228     DO i = 1, klon
229 guez 49 xmin = MIN(qsurf(i, 1), xmin)
230     xmax = MAX(qsurf(i, 1), xmax)
231 guez 3 ENDDO
232 guez 49 PRINT *, 'Humidite pres du sol <QS>', xmin, xmax
233 guez 3 DO nsrf = 2, nbsrf
234     DO i = 1, klon
235 guez 49 qsurf(i, nsrf) = qsurf(i, 1)
236 guez 3 ENDDO
237     ENDDO
238     ENDIF
239    
240     ! Eau dans le sol (pour le modele de sol "bucket")
241    
242 guez 49 ierr = NF90_INQ_VARID(ncid, "QSOL", varid)
243 guez 50 IF (ierr == NF90_NOERR) THEN
244 guez 49 call nf95_get_var(ncid, varid, qsol)
245 guez 3 else
246 guez 43 PRINT *, 'phyetat0: Le champ <QSOL> est absent'
247 guez 50 PRINT *, ' Valeur par defaut nulle'
248 guez 43 qsol = 0.
249 guez 3 ENDIF
250    
251     ! Lecture de neige au sol:
252    
253 guez 49 ierr = NF90_INQ_VARID(ncid, "SNOW", varid)
254     IF (ierr /= NF90_NOERR) THEN
255 guez 43 PRINT *, 'phyetat0: Le champ <SNOW> est absent'
256 guez 50 PRINT *, ' Mais je vais essayer de lire SNOW**'
257 guez 3 DO nsrf = 1, nbsrf
258 guez 50 IF (nsrf > 99) THEN
259 guez 43 PRINT *, "Trop de sous-mailles"
260 guez 3 stop 1
261     ENDIF
262 guez 49 WRITE(str2, '(i2.2)') nsrf
263 guez 50 call NF95_INQ_VARID(ncid, "SNOW"//str2, varid)
264     call NF95_GET_VAR(ncid, varid, snow(:, nsrf))
265 guez 3 xmin = 1.0E+20
266     xmax = -1.0E+20
267     DO i = 1, klon
268 guez 49 xmin = MIN(snow(i, nsrf), xmin)
269     xmax = MAX(snow(i, nsrf), xmax)
270 guez 3 ENDDO
271 guez 49 PRINT *, 'Neige du sol SNOW**:', nsrf, xmin, xmax
272 guez 3 ENDDO
273     ELSE
274 guez 43 PRINT *, 'phyetat0: Le champ <SNOW> est present'
275 guez 50 PRINT *, ' J ignore donc les autres neiges SNOW**'
276 guez 49 call nf95_get_var(ncid, varid, snow(:, 1))
277 guez 3 xmin = 1.0E+20
278     xmax = -1.0E+20
279     DO i = 1, klon
280 guez 49 xmin = MIN(snow(i, 1), xmin)
281     xmax = MAX(snow(i, 1), xmax)
282 guez 3 ENDDO
283 guez 49 PRINT *, 'Neige du sol <SNOW>', xmin, xmax
284 guez 3 DO nsrf = 2, nbsrf
285     DO i = 1, klon
286 guez 49 snow(i, nsrf) = snow(i, 1)
287 guez 3 ENDDO
288     ENDDO
289     ENDIF
290    
291     ! Lecture de albedo au sol:
292    
293 guez 49 ierr = NF90_INQ_VARID(ncid, "ALBE", varid)
294     IF (ierr /= NF90_NOERR) THEN
295 guez 43 PRINT *, 'phyetat0: Le champ <ALBE> est absent'
296 guez 50 PRINT *, ' Mais je vais essayer de lire ALBE**'
297 guez 3 DO nsrf = 1, nbsrf
298 guez 50 IF (nsrf > 99) THEN
299 guez 43 PRINT *, "Trop de sous-mailles"
300 guez 3 stop 1
301     ENDIF
302 guez 49 WRITE(str2, '(i2.2)') nsrf
303 guez 50 call NF95_INQ_VARID(ncid, "ALBE"//str2, varid)
304     call NF95_GET_VAR(ncid, varid, albe(:, nsrf))
305 guez 3 xmin = 1.0E+20
306     xmax = -1.0E+20
307     DO i = 1, klon
308 guez 49 xmin = MIN(albe(i, nsrf), xmin)
309     xmax = MAX(albe(i, nsrf), xmax)
310 guez 3 ENDDO
311 guez 49 PRINT *, 'Albedo du sol ALBE**:', nsrf, xmin, xmax
312 guez 3 ENDDO
313     ELSE
314 guez 43 PRINT *, 'phyetat0: Le champ <ALBE> est present'
315 guez 50 PRINT *, ' J ignore donc les autres ALBE**'
316 guez 49 call nf95_get_var(ncid, varid, albe(:, 1))
317 guez 3 xmin = 1.0E+20
318     xmax = -1.0E+20
319     DO i = 1, klon
320 guez 49 xmin = MIN(albe(i, 1), xmin)
321     xmax = MAX(albe(i, 1), xmax)
322 guez 3 ENDDO
323 guez 49 PRINT *, 'Neige du sol <ALBE>', xmin, xmax
324 guez 3 DO nsrf = 2, nbsrf
325     DO i = 1, klon
326 guez 49 albe(i, nsrf) = albe(i, 1)
327 guez 3 ENDDO
328     ENDDO
329     ENDIF
330    
331     ! Lecture de albedo au sol LW:
332    
333 guez 49 ierr = NF90_INQ_VARID(ncid, "ALBLW", varid)
334     IF (ierr /= NF90_NOERR) THEN
335 guez 43 PRINT *, 'phyetat0: Le champ <ALBLW> est absent'
336 guez 50 ! PRINT *, ' Mais je vais essayer de lire ALBLW**'
337     PRINT *, ' Mais je vais prendre ALBE**'
338 guez 3 DO nsrf = 1, nbsrf
339     DO i = 1, klon
340 guez 49 alblw(i, nsrf) = albe(i, nsrf)
341 guez 3 ENDDO
342     ENDDO
343     ELSE
344 guez 43 PRINT *, 'phyetat0: Le champ <ALBLW> est present'
345 guez 50 PRINT *, ' J ignore donc les autres ALBLW**'
346 guez 49 call nf95_get_var(ncid, varid, alblw(:, 1))
347 guez 3 xmin = 1.0E+20
348     xmax = -1.0E+20
349     DO i = 1, klon
350 guez 49 xmin = MIN(alblw(i, 1), xmin)
351     xmax = MAX(alblw(i, 1), xmax)
352 guez 3 ENDDO
353 guez 49 PRINT *, 'Neige du sol <ALBLW>', xmin, xmax
354 guez 3 DO nsrf = 2, nbsrf
355     DO i = 1, klon
356 guez 49 alblw(i, nsrf) = alblw(i, 1)
357 guez 3 ENDDO
358     ENDDO
359     ENDIF
360    
361 guez 50 ! Lecture de evaporation:
362 guez 3
363 guez 49 ierr = NF90_INQ_VARID(ncid, "EVAP", varid)
364     IF (ierr /= NF90_NOERR) THEN
365 guez 43 PRINT *, 'phyetat0: Le champ <EVAP> est absent'
366 guez 50 PRINT *, ' Mais je vais essayer de lire EVAP**'
367 guez 3 DO nsrf = 1, nbsrf
368 guez 50 IF (nsrf > 99) THEN
369 guez 43 PRINT *, "Trop de sous-mailles"
370 guez 3 stop 1
371     ENDIF
372 guez 49 WRITE(str2, '(i2.2)') nsrf
373 guez 50 call NF95_INQ_VARID(ncid, "EVAP"//str2, varid)
374     call NF95_GET_VAR(ncid, varid, evap(:, nsrf))
375 guez 3 xmin = 1.0E+20
376     xmax = -1.0E+20
377     DO i = 1, klon
378 guez 49 xmin = MIN(evap(i, nsrf), xmin)
379     xmax = MAX(evap(i, nsrf), xmax)
380 guez 3 ENDDO
381 guez 49 PRINT *, 'evap du sol EVAP**:', nsrf, xmin, xmax
382 guez 3 ENDDO
383     ELSE
384 guez 43 PRINT *, 'phyetat0: Le champ <EVAP> est present'
385 guez 50 PRINT *, ' J ignore donc les autres EVAP**'
386 guez 49 call nf95_get_var(ncid, varid, evap(:, 1))
387 guez 3 xmin = 1.0E+20
388     xmax = -1.0E+20
389     DO i = 1, klon
390 guez 49 xmin = MIN(evap(i, 1), xmin)
391     xmax = MAX(evap(i, 1), xmax)
392 guez 3 ENDDO
393 guez 49 PRINT *, 'Evap du sol <EVAP>', xmin, xmax
394 guez 3 DO nsrf = 2, nbsrf
395     DO i = 1, klon
396 guez 49 evap(i, nsrf) = evap(i, 1)
397 guez 3 ENDDO
398     ENDDO
399     ENDIF
400    
401     ! Lecture precipitation liquide:
402    
403 guez 50 call NF95_INQ_VARID(ncid, "rain_f", varid)
404     call NF95_GET_VAR(ncid, varid, rain_fall)
405 guez 3
406     ! Lecture precipitation solide:
407    
408 guez 50 call NF95_INQ_VARID(ncid, "snow_f", varid)
409     call NF95_GET_VAR(ncid, varid, snow_fall)
410 guez 3 xmin = 1.0E+20
411     xmax = -1.0E+20
412     DO i = 1, klon
413 guez 49 xmin = MIN(snow_fall(i), xmin)
414     xmax = MAX(snow_fall(i), xmax)
415 guez 3 ENDDO
416 guez 49 PRINT *, 'Precipitation solide snow_f:', xmin, xmax
417 guez 3
418     ! Lecture rayonnement solaire au sol:
419    
420 guez 49 ierr = NF90_INQ_VARID(ncid, "solsw", varid)
421     IF (ierr /= NF90_NOERR) THEN
422 guez 43 PRINT *, 'phyetat0: Le champ <solsw> est absent'
423     PRINT *, 'mis a zero'
424 guez 3 solsw = 0.
425     ELSE
426 guez 49 call nf95_get_var(ncid, varid, solsw)
427 guez 3 ENDIF
428     xmin = 1.0E+20
429     xmax = -1.0E+20
430     DO i = 1, klon
431 guez 49 xmin = MIN(solsw(i), xmin)
432     xmax = MAX(solsw(i), xmax)
433 guez 3 ENDDO
434 guez 49 PRINT *, 'Rayonnement solaire au sol solsw:', xmin, xmax
435 guez 3
436     ! Lecture rayonnement IF au sol:
437    
438 guez 49 ierr = NF90_INQ_VARID(ncid, "sollw", varid)
439     IF (ierr /= NF90_NOERR) THEN
440 guez 43 PRINT *, 'phyetat0: Le champ <sollw> est absent'
441     PRINT *, 'mis a zero'
442 guez 3 sollw = 0.
443     ELSE
444 guez 49 call nf95_get_var(ncid, varid, sollw)
445 guez 3 ENDIF
446 guez 72 PRINT *, 'Rayonnement IF au sol sollw:', minval(sollw), maxval(sollw)
447 guez 3
448     ! Lecture derive des flux:
449    
450 guez 49 ierr = NF90_INQ_VARID(ncid, "fder", varid)
451     IF (ierr /= NF90_NOERR) THEN
452 guez 43 PRINT *, 'phyetat0: Le champ <fder> est absent'
453     PRINT *, 'mis a zero'
454 guez 3 fder = 0.
455     ELSE
456 guez 49 call nf95_get_var(ncid, varid, fder)
457 guez 3 ENDIF
458     xmin = 1.0E+20
459     xmax = -1.0E+20
460     DO i = 1, klon
461 guez 49 xmin = MIN(fder(i), xmin)
462     xmax = MAX(fder(i), xmax)
463 guez 3 ENDDO
464 guez 49 PRINT *, 'Derive des flux fder:', xmin, xmax
465 guez 3
466     ! Lecture du rayonnement net au sol:
467    
468 guez 50 call NF95_INQ_VARID(ncid, "RADS", varid)
469     call NF95_GET_VAR(ncid, varid, radsol)
470 guez 3 xmin = 1.0E+20
471     xmax = -1.0E+20
472     DO i = 1, klon
473 guez 49 xmin = MIN(radsol(i), xmin)
474     xmax = MAX(radsol(i), xmax)
475 guez 3 ENDDO
476 guez 49 PRINT *, 'Rayonnement net au sol radsol:', xmin, xmax
477 guez 3
478     ! Lecture de la longueur de rugosite
479    
480 guez 49 ierr = NF90_INQ_VARID(ncid, "RUG", varid)
481     IF (ierr /= NF90_NOERR) THEN
482 guez 43 PRINT *, 'phyetat0: Le champ <RUG> est absent'
483 guez 50 PRINT *, ' Mais je vais essayer de lire RUG**'
484 guez 3 DO nsrf = 1, nbsrf
485 guez 50 IF (nsrf > 99) THEN
486 guez 43 PRINT *, "Trop de sous-mailles"
487 guez 3 stop 1
488     ENDIF
489 guez 49 WRITE(str2, '(i2.2)') nsrf
490 guez 50 call NF95_INQ_VARID(ncid, "RUG"//str2, varid)
491     call NF95_GET_VAR(ncid, varid, frugs(:, nsrf))
492 guez 3 xmin = 1.0E+20
493     xmax = -1.0E+20
494     DO i = 1, klon
495 guez 49 xmin = MIN(frugs(i, nsrf), xmin)
496     xmax = MAX(frugs(i, nsrf), xmax)
497 guez 3 ENDDO
498 guez 49 PRINT *, 'rugosite du sol RUG**:', nsrf, xmin, xmax
499 guez 3 ENDDO
500     ELSE
501 guez 43 PRINT *, 'phyetat0: Le champ <RUG> est present'
502 guez 50 PRINT *, ' J ignore donc les autres RUG**'
503 guez 49 call nf95_get_var(ncid, varid, frugs(:, 1))
504 guez 3 xmin = 1.0E+20
505     xmax = -1.0E+20
506     DO i = 1, klon
507 guez 49 xmin = MIN(frugs(i, 1), xmin)
508     xmax = MAX(frugs(i, 1), xmax)
509 guez 3 ENDDO
510 guez 49 PRINT *, 'rugosite <RUG>', xmin, xmax
511 guez 3 DO nsrf = 2, nbsrf
512     DO i = 1, klon
513 guez 49 frugs(i, nsrf) = frugs(i, 1)
514 guez 3 ENDDO
515     ENDDO
516     ENDIF
517    
518     ! Lecture de l'age de la neige:
519    
520 guez 49 ierr = NF90_INQ_VARID(ncid, "AGESNO", varid)
521     IF (ierr /= NF90_NOERR) THEN
522 guez 43 PRINT *, 'phyetat0: Le champ <AGESNO> est absent'
523 guez 50 PRINT *, ' Mais je vais essayer de lire AGESNO**'
524 guez 3 DO nsrf = 1, nbsrf
525 guez 50 IF (nsrf > 99) THEN
526 guez 43 PRINT *, "Trop de sous-mailles"
527 guez 3 stop 1
528     ENDIF
529 guez 49 WRITE(str2, '(i2.2)') nsrf
530     ierr = NF90_INQ_VARID(ncid, "AGESNO"//str2, varid)
531     IF (ierr /= NF90_NOERR) THEN
532 guez 43 PRINT *, "phyetat0: Le champ <AGESNO"//str2//"> est absent"
533 guez 3 agesno = 50.0
534     ENDIF
535 guez 50 call NF95_GET_VAR(ncid, varid, agesno(:, nsrf))
536 guez 3 xmin = 1.0E+20
537     xmax = -1.0E+20
538     DO i = 1, klon
539 guez 49 xmin = MIN(agesno(i, nsrf), xmin)
540     xmax = MAX(agesno(i, nsrf), xmax)
541 guez 3 ENDDO
542 guez 49 PRINT *, 'Age de la neige AGESNO**:', nsrf, xmin, xmax
543 guez 3 ENDDO
544     ELSE
545 guez 43 PRINT *, 'phyetat0: Le champ <AGESNO> est present'
546 guez 50 PRINT *, ' J ignore donc les autres AGESNO**'
547 guez 49 call nf95_get_var(ncid, varid, agesno(:, 1))
548 guez 3 xmin = 1.0E+20
549     xmax = -1.0E+20
550     DO i = 1, klon
551 guez 49 xmin = MIN(agesno(i, 1), xmin)
552     xmax = MAX(agesno(i, 1), xmax)
553 guez 3 ENDDO
554 guez 49 PRINT *, 'Age de la neige <AGESNO>', xmin, xmax
555 guez 3 DO nsrf = 2, nbsrf
556     DO i = 1, klon
557 guez 49 agesno(i, nsrf) = agesno(i, 1)
558 guez 3 ENDDO
559     ENDDO
560     ENDIF
561    
562 guez 50 call NF95_INQ_VARID(ncid, "ZMEA", varid)
563     call NF95_GET_VAR(ncid, varid, zmea)
564 guez 3 xmin = 1.0E+20
565     xmax = -1.0E+20
566     DO i = 1, klon
567 guez 49 xmin = MIN(zmea(i), xmin)
568     xmax = MAX(zmea(i), xmax)
569 guez 3 ENDDO
570 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
571 guez 3
572 guez 50 call NF95_INQ_VARID(ncid, "ZSTD", varid)
573     call NF95_GET_VAR(ncid, varid, zstd)
574 guez 3 xmin = 1.0E+20
575     xmax = -1.0E+20
576     DO i = 1, klon
577 guez 49 xmin = MIN(zstd(i), xmin)
578     xmax = MAX(zstd(i), xmax)
579 guez 3 ENDDO
580 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
581 guez 3
582 guez 50 call NF95_INQ_VARID(ncid, "ZSIG", varid)
583     call NF95_GET_VAR(ncid, varid, zsig)
584 guez 3 xmin = 1.0E+20
585     xmax = -1.0E+20
586     DO i = 1, klon
587 guez 49 xmin = MIN(zsig(i), xmin)
588     xmax = MAX(zsig(i), xmax)
589 guez 3 ENDDO
590 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
591 guez 3
592 guez 50 call NF95_INQ_VARID(ncid, "ZGAM", varid)
593     call NF95_GET_VAR(ncid, varid, zgam)
594 guez 3 xmin = 1.0E+20
595     xmax = -1.0E+20
596     DO i = 1, klon
597 guez 49 xmin = MIN(zgam(i), xmin)
598     xmax = MAX(zgam(i), xmax)
599 guez 3 ENDDO
600 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
601 guez 3
602 guez 50 call NF95_INQ_VARID(ncid, "ZTHE", varid)
603     call NF95_GET_VAR(ncid, varid, zthe)
604 guez 3 xmin = 1.0E+20
605     xmax = -1.0E+20
606     DO i = 1, klon
607 guez 49 xmin = MIN(zthe(i), xmin)
608     xmax = MAX(zthe(i), xmax)
609 guez 3 ENDDO
610 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
611 guez 3
612 guez 50 call NF95_INQ_VARID(ncid, "ZPIC", varid)
613     call NF95_GET_VAR(ncid, varid, zpic)
614 guez 3 xmin = 1.0E+20
615     xmax = -1.0E+20
616     DO i = 1, klon
617 guez 49 xmin = MIN(zpic(i), xmin)
618     xmax = MAX(zpic(i), xmax)
619 guez 3 ENDDO
620 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
621 guez 3
622 guez 50 call NF95_INQ_VARID(ncid, "ZVAL", varid)
623     call NF95_GET_VAR(ncid, varid, zval)
624 guez 3 xmin = 1.0E+20
625     xmax = -1.0E+20
626     DO i = 1, klon
627 guez 49 xmin = MIN(zval(i), xmin)
628     xmax = MAX(zval(i), xmax)
629 guez 3 ENDDO
630 guez 49 PRINT *, 'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
631 guez 3
632     ancien_ok = .TRUE.
633    
634 guez 49 ierr = NF90_INQ_VARID(ncid, "TANCIEN", varid)
635     IF (ierr /= NF90_NOERR) THEN
636 guez 43 PRINT *, "phyetat0: Le champ <TANCIEN> est absent"
637     PRINT *, "Depart legerement fausse. Mais je continue"
638 guez 3 ancien_ok = .FALSE.
639     ELSE
640 guez 49 call nf95_get_var(ncid, varid, t_ancien)
641 guez 3 ENDIF
642    
643 guez 49 ierr = NF90_INQ_VARID(ncid, "QANCIEN", varid)
644     IF (ierr /= NF90_NOERR) THEN
645 guez 43 PRINT *, "phyetat0: Le champ <QANCIEN> est absent"
646     PRINT *, "Depart legerement fausse. Mais je continue"
647 guez 3 ancien_ok = .FALSE.
648     ELSE
649 guez 49 call nf95_get_var(ncid, varid, q_ancien)
650 guez 3 ENDIF
651    
652 guez 49 ierr = NF90_INQ_VARID(ncid, "CLWCON", varid)
653     IF (ierr /= NF90_NOERR) THEN
654 guez 43 PRINT *, "phyetat0: Le champ CLWCON est absent"
655     PRINT *, "Depart legerement fausse. Mais je continue"
656 guez 3 clwcon = 0.
657     ELSE
658 guez 72 call nf95_get_var(ncid, varid, clwcon(:, 1))
659     clwcon(:, 2:) = 0.
660 guez 3 ENDIF
661     xmin = 1.0E+20
662     xmax = -1.0E+20
663     xmin = MINval(clwcon)
664     xmax = MAXval(clwcon)
665 guez 49 PRINT *, 'Eau liquide convective (ecart-type) clwcon:', xmin, xmax
666 guez 3
667 guez 49 ierr = NF90_INQ_VARID(ncid, "RNEBCON", varid)
668     IF (ierr /= NF90_NOERR) THEN
669 guez 43 PRINT *, "phyetat0: Le champ RNEBCON est absent"
670     PRINT *, "Depart legerement fausse. Mais je continue"
671 guez 3 rnebcon = 0.
672     ELSE
673 guez 72 call nf95_get_var(ncid, varid, rnebcon(:, 1))
674     rnebcon(:, 2:) = 0.
675 guez 3 ENDIF
676     xmin = 1.0E+20
677     xmax = -1.0E+20
678     xmin = MINval(rnebcon)
679     xmax = MAXval(rnebcon)
680 guez 49 PRINT *, 'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax
681 guez 3
682     ! Lecture ratqs
683    
684 guez 49 ierr = NF90_INQ_VARID(ncid, "RATQS", varid)
685     IF (ierr /= NF90_NOERR) THEN
686 guez 43 PRINT *, "phyetat0: Le champ <RATQS> est absent"
687     PRINT *, "Depart legerement fausse. Mais je continue"
688 guez 3 ratqs = 0.
689     ELSE
690 guez 72 call nf95_get_var(ncid, varid, ratqs(:, 1))
691     ratqs(:, 2:) = 0.
692 guez 3 ENDIF
693     xmin = 1.0E+20
694     xmax = -1.0E+20
695     xmin = MINval(ratqs)
696     xmax = MAXval(ratqs)
697 guez 49 PRINT *, '(ecart-type) ratqs:', xmin, xmax
698 guez 3
699     ! Lecture run_off_lic_0
700    
701 guez 49 ierr = NF90_INQ_VARID(ncid, "RUNOFFLIC0", varid)
702     IF (ierr /= NF90_NOERR) THEN
703 guez 43 PRINT *, "phyetat0: Le champ <RUNOFFLIC0> est absent"
704     PRINT *, "Depart legerement fausse. Mais je continue"
705 guez 3 run_off_lic_0 = 0.
706     ELSE
707 guez 49 call nf95_get_var(ncid, varid, run_off_lic_0)
708 guez 3 ENDIF
709     xmin = 1.0E+20
710     xmax = -1.0E+20
711     xmin = MINval(run_off_lic_0)
712     xmax = MAXval(run_off_lic_0)
713 guez 49 PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax
714 guez 3
715 guez 72 call nf95_inq_varid(ncid, "sig1", varid)
716     call nf95_get_var(ncid, varid, sig1)
717    
718     call nf95_inq_varid(ncid, "w01", varid)
719     call nf95_get_var(ncid, varid, w01)
720    
721 guez 49 call NF95_CLOSE(ncid)
722 guez 3
723     END SUBROUTINE phyetat0
724    
725     end module phyetat0_m

  ViewVC Help
Powered by ViewVC 1.1.21