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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21