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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 62 - (hide annotations)
Thu Jul 26 14:37:37 2012 UTC (11 years, 9 months ago) by guez
Original Path: trunk/libf/phylmd/phyetat0.f90
File size: 23919 byte(s) 
Changed handling of compiler in compilation system.

Removed the prefix letters "y", "p", "t" or "z" in some names of variables.

Replaced calls to NetCDF by calls to NetCDF95.

Extracted "ioget_calendar" procedures from "calendar.f90" into a
separate file.

Extracted to a separate file, "mathop2.f90", procedures that were not
part of the generic interface "mathop" in "mathop.f90".

Removed computation of "dq" in "bilan_dyn", which was not used.

In "iniadvtrac", removed schemes 20 Slopes and 30 Prather. Was not
compatible with declarations of array sizes.

In "clcdrag", "ustarhb", "vdif_kcay", "yamada4" and "coefkz", changed
the size of some arrays from "klon" to "knon".

Removed possible call to "conema3" in "physiq".

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