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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 99 - (hide annotations)
Wed Jul 2 18:39:15 2014 UTC (9 years, 10 months ago) by guez
Original Path: trunk/phylmd/phyetat0.f
File size: 23236 byte(s)
Created procedure test_disvert (following LMDZ). Added procedures
hybrid and funcd in module disvert_m. Upgraded compute_ab from
internal procedure of disvert to module procedure. Added variables y,
ya in module disvert_m. Upgraded s from local variable of procedure
disvert to module variable.

Renamed allowed value of variable vert_sampling in procedure disvert
from "read" to "read_hybrid". Added possibility to read pressure
values, value "read_pressure". Replaced vertical distribution for
value "param" by the distribution "strato_correct" from LMDZ (but kept
the value "param"). In case "tropo", replaced 1 by dsigmin (following
LMDZ). In case "strato", replaced 0.3 by dsigmin (following LMDZ).

Changed computation of bp in procedure compute_ab.

Removed debugindex case in clmain. Removed useless argument rlon of
procedure clmain. Removed useless variables ytaux, ytauy of procedure
clmain.

Removed intermediary variables tsol, qsol, tsolsrf, tslab in procedure
etat0.

Removed variable ok_veget:. coupling with the model Orchid is not
possible. Removed variable ocean: modeling an ocean slab is not
possible.

Removed useless variables tmp_rriv and tmp_rcoa from module
interface_surf.

Moved initialization of variables da, mp, phi in procedure physiq to
to inside the test iflag_con >= 3.

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

  ViewVC Help
Powered by ViewVC 1.1.21