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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.21