source: LMDZ.3.3/branches/rel-LF/libf/phylmd/phyetat0.F @ 281

Last change on this file since 281 was 151, checked in by lmdzadmin, 24 years ago

Rajout de la derivee des fluxs dans le fichier restart de la physique
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 33.0 KB
Line 
1      SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire,
2     .            rlat,rlon, pctsrf, tsol,tsoil,deltat,qsol,snow,
3     .           albe, evap, rain_fall, snow_fall, solsw, sollw,
4     .           fder,radsol,frugs,agesno,clesphy0,
5     .           zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0,
6     .           t_ancien,q_ancien,ancien_ok)
7      IMPLICIT none
8c======================================================================
9c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
10c Objet: Lecture de l'etat initial pour la physique
11c======================================================================
12#include "dimensions.h"
13#include "dimphy.h"
14#include "netcdf.inc"
15#include "indicesol.h"
16#include "dimsoil.h"
17#include "clesphys.h"
18c======================================================================
19      CHARACTER*(*) fichnom
20      REAL dtime
21      INTEGER radpas
22      REAL rlat(klon), rlon(klon)
23      REAL co2_ppm
24      REAL solaire
25      REAL tsol(klon,nbsrf)
26      REAL tsoil(klon,nsoilmx,nbsrf)
27      REAL deltat(klon)
28      REAL qsol(klon,nbsrf)
29      REAL snow(klon,nbsrf)
30      REAL albe(klon,nbsrf)
31      REAL evap(klon,nbsrf)
32      REAL radsol(klon)
33      REAL rain_fall(klon)
34      REAL snow_fall(klon)
35      REAL sollw(klon)
36      real solsw(klon)
37      real fder(klon)
38      REAL frugs(klon,nbsrf)
39      REAL agesno(klon)
40      REAL zmea(klon)
41      REAL zstd(klon)
42      REAL zsig(klon)
43      REAL zgam(klon)
44      REAL zthe(klon)
45      REAL zpic(klon)
46      REAL zval(klon)
47      REAL rugsrel(klon)
48      REAL pctsrf(klon, nbsrf)
49      REAL fractint(klon)
50
51      REAL t_ancien(klon,klev), q_ancien(klon,klev)
52      LOGICAL ancien_ok
53
54      INTEGER        longcles
55      PARAMETER    ( longcles = 20 )
56      REAL clesphy0( longcles )
57c
58      REAL xmin, xmax
59c
60      INTEGER nid, nvarid
61      INTEGER ierr, i, nsrf, isoil
62      INTEGER length
63      PARAMETER (length=100)
64      REAL tab_cntrl(length), tabcntr0(length)
65      CHARACTER*7 str7
66      CHARACTER*2 str2
67c
68c Ouvrir le fichier contenant l'etat initial:
69c
70      print*,'fichnom',fichnom
71      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
72      IF (ierr.NE.NF_NOERR) THEN
73        write(6,*)' Pb d''ouverture du fichier '//fichnom
74        write(6,*)' ierr = ', ierr
75        CALL ABORT
76      ENDIF
77c
78c Lecture des parametres de controle:
79c
80      ierr = NF_INQ_VARID (nid, "controle", nvarid)
81      IF (ierr.NE.NF_NOERR) THEN
82         PRINT*, 'phyetat0: Le champ <controle> est absent'
83         CALL abort
84      ENDIF
85#ifdef NC_DOUBLE
86      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
87#else
88      ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
89#endif
90      IF (ierr.NE.NF_NOERR) THEN
91         PRINT*, 'phyetat0: Lecture echouee pour <controle>'
92         CALL abort
93      ELSE
94c
95         DO i = 1, length
96           tabcntr0( i ) = tab_cntrl( i )
97         ENDDO
98c
99         cycle_diurne   = .FALSE.
100         soil_model     = .FALSE.
101         new_oliq       = .FALSE.
102         ok_orodr       = .FALSE.
103         ok_orolf       = .FALSE.
104         ok_limitvrai   = .FALSE.
105
106
107         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN
108             tab_cntrl( 5 ) = clesphy0(1)
109         ENDIF
110
111         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN
112             tab_cntrl( 6 ) = clesphy0(2)
113         ENDIF
114
115         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN
116             tab_cntrl( 7 ) = clesphy0(3)
117         ENDIF
118
119         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN
120             tab_cntrl( 8 ) = clesphy0(4)
121         ENDIF
122
123         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN
124             tab_cntrl( 9 ) = clesphy0( 5 )
125         ENDIF
126
127         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN
128             tab_cntrl( 10 ) = clesphy0( 6 )
129         ENDIF
130
131         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN
132             tab_cntrl( 11 ) = clesphy0( 7 )
133         ENDIF
134
135         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN
136             tab_cntrl( 12 ) = clesphy0( 8 )
137         ENDIF
138
139
140         dtime        = tab_cntrl(1)
141         radpas       = tab_cntrl(2)
142         co2_ppm      = tab_cntrl(3)
143         solaire      = tab_cntrl(4)
144         iflag_con    = tab_cntrl(5)
145         nbapp_rad    = tab_cntrl(6)
146
147
148         cycle_diurne    = .FALSE.
149         soil_model      = .FALSE.
150         new_oliq        = .FALSE.
151         ok_orodr        = .FALSE.
152         ok_orolf        = .FALSE.
153         ok_limitvrai    = .FALSE.
154
155         IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.
156         IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.
157         IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.
158         IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.
159         IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.
160         IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.
161
162      ENDIF
163c
164c Lecture des latitudes (coordonnees):
165c
166      ierr = NF_INQ_VARID (nid, "latitude", nvarid)
167      IF (ierr.NE.NF_NOERR) THEN
168         PRINT*, 'phyetat0: Le champ <latitude> est absent'
169         CALL abort
170      ENDIF
171#ifdef NC_DOUBLE
172      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat)
173#else
174      ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)
175#endif
176      IF (ierr.NE.NF_NOERR) THEN
177         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
178         CALL abort
179      ENDIF
180c
181c Lecture des longitudes (coordonnees):
182c
183      ierr = NF_INQ_VARID (nid, "longitude", nvarid)
184      IF (ierr.NE.NF_NOERR) THEN
185         PRINT*, 'phyetat0: Le champ <longitude> est absent'
186         CALL abort
187      ENDIF
188#ifdef NC_DOUBLE
189      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon)
190#else
191      ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)
192#endif
193      IF (ierr.NE.NF_NOERR) THEN
194         PRINT*, 'phyetat0: Lecture echouee pour <latitude>'
195         CALL abort
196      ENDIF
197C
198C
199C Lecture du masque terre mer
200C
201      ierr = NF_INQ_VARID (nid, "masque", nvarid)
202      IF (ierr .EQ.  NF_NOERR) THEN
203#ifdef NC_DOUBLE
204          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq)
205#else
206          ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq)
207#endif
208          IF (ierr.NE.NF_NOERR) THEN
209              PRINT*, 'phyetat0: Lecture echouee pour <masque>'
210              CALL abort
211          ENDIF
212      else
213          PRINT*, 'phyetat0: Le champ <masque> est absent'
214          PRINT*, 'fichier startphy non compatible avec phyetat0'
215C      CALL abort
216      ENDIF
217C Lecture des fractions pour chaque sous-surface
218C
219C initialisation des sous-surfaces
220C
221      pctsrf = 0.
222C
223C fraction de terre
224C
225      ierr = NF_INQ_VARID (nid, "FTER", nvarid)
226      IF (ierr .EQ.  NF_NOERR) THEN
227#ifdef NC_DOUBLE
228          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_ter))
229#else
230          ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_ter))
231#endif
232          IF (ierr.NE.NF_NOERR) THEN
233              PRINT*, 'phyetat0: Lecture echouee pour <FTER>'
234              CALL abort
235          ENDIF
236      else
237          PRINT*, 'phyetat0: Le champ <FTER> est absent'
238c$$$         CALL abort
239      ENDIF
240C
241C fraction de glace de terre
242C
243      ierr = NF_INQ_VARID (nid, "FLIC", nvarid)
244      IF (ierr .EQ.  NF_NOERR) THEN
245#ifdef NC_DOUBLE
246          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_lic))
247#else
248          ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_lic))
249#endif
250          IF (ierr.NE.NF_NOERR) THEN
251              PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'
252              CALL abort
253          ENDIF
254      else
255          PRINT*, 'phyetat0: Le champ <FLIC> est absent'
256c$$$         CALL abort
257      ENDIF
258C
259C fraction d'ocean
260C
261      ierr = NF_INQ_VARID (nid, "FOCE", nvarid)
262      IF (ierr .EQ.  NF_NOERR) THEN
263#ifdef NC_DOUBLE
264          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_oce))
265#else
266          ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_oce))
267#endif
268          IF (ierr.NE.NF_NOERR) THEN
269              PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'
270              CALL abort
271          ENDIF
272      else
273          PRINT*, 'phyetat0: Le champ <FOCE> est absent'
274c$$$         CALL abort
275      ENDIF
276C
277C fraction glace de mer
278C
279      ierr = NF_INQ_VARID (nid, "FSIC", nvarid)
280      IF (ierr .EQ.  NF_NOERR) THEN
281#ifdef NC_DOUBLE
282          ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_sic))
283#else
284          ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon, is_sic))
285#endif
286          IF (ierr.NE.NF_NOERR) THEN
287              PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'
288              CALL abort
289          ENDIF
290      else
291          PRINT*, 'phyetat0: Le champ <FSIC> est absent'
292c$$$         CALL abort
293      ENDIF
294C
295C  Verification de l'adequation entre le masque et les sous-surfaces
296C
297      fractint( 1 : klon) = pctsrf(1 : klon, is_ter)
298     $    + pctsrf(1 : klon, is_lic)
299      DO i = 1 , klon
300        IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
301            WRITE(*,*) 'phyetat0: attention fraction terre pas ',
302     $          'coherente ', i, zmasq(i), pctsrf(i, is_ter)
303     $          ,pctsrf(i, is_lic)
304        ENDIF
305      END DO
306      fractint (1 : klon) =  pctsrf(1 : klon, is_oce)
307     $    + pctsrf(1 : klon, is_sic)
308      DO i = 1 , klon
309        IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
310            WRITE(*,*) 'phyetat0 attention fraction ocean pas ',
311     $          'coherente ', i, zmasq(i) , pctsrf(i, is_oce)
312     $          ,pctsrf(i, is_sic)
313        ENDIF
314      END DO
315C
316c Lecture des temperatures du sol:
317c
318      ierr = NF_INQ_VARID (nid, "TS", nvarid)
319      IF (ierr.NE.NF_NOERR) THEN
320         PRINT*, 'phyetat0: Le champ <TS> est absent'
321         PRINT*, '          Mais je vais essayer de lire TS**'
322         DO nsrf = 1, nbsrf
323           IF (nsrf.GT.99) THEN
324             PRINT*, "Trop de sous-mailles"
325             CALL abort
326           ENDIF
327           WRITE(str2,'(i2.2)') nsrf
328           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)
329           IF (ierr.NE.NF_NOERR) THEN
330              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"
331              CALL abort
332           ENDIF
333#ifdef NC_DOUBLE
334           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf))
335#else
336           ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))
337#endif
338           IF (ierr.NE.NF_NOERR) THEN
339             PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"
340             CALL abort
341           ENDIF
342           xmin = 1.0E+20
343           xmax = -1.0E+20
344           DO i = 1, klon
345              xmin = MIN(tsol(i,nsrf),xmin)
346              xmax = MAX(tsol(i,nsrf),xmax)
347           ENDDO
348           PRINT*,'Temperature du sol TS**:', nsrf, xmin, xmax
349         ENDDO
350      ELSE
351         PRINT*, 'phyetat0: Le champ <TS> est present'
352         PRINT*, '          J ignore donc les autres temperatures TS**'
353#ifdef NC_DOUBLE
354         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1))
355#else
356         ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))
357#endif
358         IF (ierr.NE.NF_NOERR) THEN
359            PRINT*, "phyetat0: Lecture echouee pour <TS>"
360            CALL abort
361         ENDIF
362         xmin = 1.0E+20
363         xmax = -1.0E+20
364         DO i = 1, klon
365            xmin = MIN(tsol(i,1),xmin)
366            xmax = MAX(tsol(i,1),xmax)
367         ENDDO
368         PRINT*,'Temperature du sol <TS>', xmin, xmax
369         DO nsrf = 2, nbsrf
370         DO i = 1, klon
371            tsol(i,nsrf) = tsol(i,1)
372         ENDDO
373         ENDDO
374      ENDIF
375c
376c Lecture des temperatures du sol profond:
377c
378      DO nsrf = 1, nbsrf
379      DO isoil=1, nsoilmx
380      IF (isoil.GT.99 .AND. nsrf.GT.99) THEN
381         PRINT*, "Trop de couches ou sous-mailles"
382         CALL abort
383      ENDIF
384      WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf
385      ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)
386      IF (ierr.NE.NF_NOERR) THEN
387         PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
388         PRINT*, "          Il prend donc la valeur de surface"
389         DO i=1, klon
390             tsoil(i,isoil,nsrf)=tsol(i,nsrf)
391         ENDDO
392      ELSE
393#ifdef NC_DOUBLE
394         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf))
395#else
396         ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))
397#endif
398         IF (ierr.NE.NF_NOERR) THEN
399            PRINT*, "Lecture echouee pour <Tsoil"//str7//">"
400            CALL abort
401         ENDIF
402      ENDIF
403      ENDDO
404      ENDDO
405c
406c Lecture de deltat (pour slab ocean seulement):
407c
408      ierr = NF_INQ_VARID (nid, "DELTAT", nvarid)
409      IF (ierr.NE.NF_NOERR) THEN
410         PRINT*, "phyetat0: Le champ <DELTAT> est absent"
411         CALL abort
412      ENDIF
413#ifdef NC_DOUBLE
414      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, deltat)
415#else
416      ierr = NF_GET_VAR_REAL(nid, nvarid, deltat)
417#endif
418      IF (ierr.NE.NF_NOERR) THEN
419         PRINT*, "phyetat0: Lecture echouee pour <DELTAT>"
420         CALL abort
421      ENDIF
422      xmin = 1.0E+20
423      xmax = -1.0E+20
424      DO i = 1, klon
425         xmin = MIN(deltat(i),xmin)
426         xmax = MAX(deltat(i),xmax)
427      ENDDO
428      PRINT*,'Ecart de la SST deltat:', xmin, xmax
429c
430c Lecture de l'humidite du sol:
431c
432      ierr = NF_INQ_VARID (nid, "QS", nvarid)
433      IF (ierr.NE.NF_NOERR) THEN
434         PRINT*, 'phyetat0: Le champ <QS> est absent'
435         PRINT*, '          Mais je vais essayer de lire QS**'
436         DO nsrf = 1, nbsrf
437           IF (nsrf.GT.99) THEN
438             PRINT*, "Trop de sous-mailles"
439             CALL abort
440           ENDIF
441           WRITE(str2,'(i2.2)') nsrf
442           ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)
443           IF (ierr.NE.NF_NOERR) THEN
444              PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"
445              CALL abort
446           ENDIF
447#ifdef NC_DOUBLE
448           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,nsrf))
449#else
450           ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,nsrf))
451#endif
452           IF (ierr.NE.NF_NOERR) THEN
453             PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"
454             CALL abort
455           ENDIF
456           xmin = 1.0E+20
457           xmax = -1.0E+20
458           DO i = 1, klon
459              xmin = MIN(qsol(i,nsrf),xmin)
460              xmax = MAX(qsol(i,nsrf),xmax)
461           ENDDO
462           PRINT*,'Humidite du sol QS**:', nsrf, xmin, xmax
463         ENDDO
464      ELSE
465         PRINT*, 'phyetat0: Le champ <QS> est present'
466         PRINT*, '          J ignore donc les autres humidites QS**'
467#ifdef NC_DOUBLE
468         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,1))
469#else
470         ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,1))
471#endif
472         IF (ierr.NE.NF_NOERR) THEN
473            PRINT*, "phyetat0: Lecture echouee pour <QS>"
474            CALL abort
475         ENDIF
476         xmin = 1.0E+20
477         xmax = -1.0E+20
478         DO i = 1, klon
479            xmin = MIN(qsol(i,1),xmin)
480            xmax = MAX(qsol(i,1),xmax)
481         ENDDO
482         PRINT*,'Humidite du sol <QS>', xmin, xmax
483         DO nsrf = 2, nbsrf
484         DO i = 1, klon
485            qsol(i,nsrf) = qsol(i,1)
486         ENDDO
487         ENDDO
488      ENDIF
489c
490c Lecture de neige au sol:
491c
492      ierr = NF_INQ_VARID (nid, "SNOW", nvarid)
493      IF (ierr.NE.NF_NOERR) THEN
494         PRINT*, 'phyetat0: Le champ <SNOW> est absent'
495         PRINT*, '          Mais je vais essayer de lire SNOW**'
496         DO nsrf = 1, nbsrf
497           IF (nsrf.GT.99) THEN
498             PRINT*, "Trop de sous-mailles"
499             CALL abort
500           ENDIF
501           WRITE(str2,'(i2.2)') nsrf
502           ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)
503           IF (ierr.NE.NF_NOERR) THEN
504              PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"
505              CALL abort
506           ENDIF
507#ifdef NC_DOUBLE
508           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf))
509#else
510           ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))
511#endif
512           IF (ierr.NE.NF_NOERR) THEN
513             PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"
514             CALL abort
515           ENDIF
516           xmin = 1.0E+20
517           xmax = -1.0E+20
518           DO i = 1, klon
519              xmin = MIN(snow(i,nsrf),xmin)
520              xmax = MAX(snow(i,nsrf),xmax)
521           ENDDO
522           PRINT*,'Neige du sol SNOW**:', nsrf, xmin, xmax
523         ENDDO
524      ELSE
525         PRINT*, 'phyetat0: Le champ <SNOW> est present'
526         PRINT*, '          J ignore donc les autres neiges SNOW**'
527#ifdef NC_DOUBLE
528         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1))
529#else
530         ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))
531#endif
532         IF (ierr.NE.NF_NOERR) THEN
533            PRINT*, "phyetat0: Lecture echouee pour <SNOW>"
534            CALL abort
535         ENDIF
536         xmin = 1.0E+20
537         xmax = -1.0E+20
538         DO i = 1, klon
539            xmin = MIN(snow(i,1),xmin)
540            xmax = MAX(snow(i,1),xmax)
541         ENDDO
542         PRINT*,'Neige du sol <SNOW>', xmin, xmax
543         DO nsrf = 2, nbsrf
544         DO i = 1, klon
545            snow(i,nsrf) = snow(i,1)
546         ENDDO
547         ENDDO
548      ENDIF
549c
550c Lecture de albedo au sol:
551c
552      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)
553      IF (ierr.NE.NF_NOERR) THEN
554         PRINT*, 'phyetat0: Le champ <ALBE> est absent'
555         PRINT*, '          Mais je vais essayer de lire ALBE**'
556         DO nsrf = 1, nbsrf
557           IF (nsrf.GT.99) THEN
558             PRINT*, "Trop de sous-mailles"
559             CALL abort
560           ENDIF
561           WRITE(str2,'(i2.2)') nsrf
562           ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)
563           IF (ierr.NE.NF_NOERR) THEN
564              PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"
565              CALL abort
566           ENDIF
567#ifdef NC_DOUBLE
568           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,nsrf))
569#else
570           ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf))
571#endif
572           IF (ierr.NE.NF_NOERR) THEN
573             PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"
574             CALL abort
575           ENDIF
576           xmin = 1.0E+20
577           xmax = -1.0E+20
578           DO i = 1, klon
579              xmin = MIN(albe(i,nsrf),xmin)
580              xmax = MAX(albe(i,nsrf),xmax)
581           ENDDO
582           PRINT*,'Albedo du sol ALBE**:', nsrf, xmin, xmax
583         ENDDO
584      ELSE
585         PRINT*, 'phyetat0: Le champ <ALBE> est present'
586         PRINT*, '          J ignore donc les autres ALBE**'
587#ifdef NC_DOUBLE
588         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,1))
589#else
590         ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,1))
591#endif
592         IF (ierr.NE.NF_NOERR) THEN
593            PRINT*, "phyetat0: Lecture echouee pour <ALBE>"
594            CALL abort
595         ENDIF
596         xmin = 1.0E+20
597         xmax = -1.0E+20
598         DO i = 1, klon
599            xmin = MIN(albe(i,1),xmin)
600            xmax = MAX(albe(i,1),xmax)
601         ENDDO
602         PRINT*,'Neige du sol <ALBE>', xmin, xmax
603         DO nsrf = 2, nbsrf
604         DO i = 1, klon
605            albe(i,nsrf) = albe(i,1)
606         ENDDO
607         ENDDO
608      ENDIF
609
610c
611c Lecture de evaporation: 
612c
613      ierr = NF_INQ_VARID (nid, "EVAP", nvarid)
614      IF (ierr.NE.NF_NOERR) THEN
615         PRINT*, 'phyetat0: Le champ <EVAP> est absent'
616         PRINT*, '          Mais je vais essayer de lire EVAP**'
617         DO nsrf = 1, nbsrf
618           IF (nsrf.GT.99) THEN
619             PRINT*, "Trop de sous-mailles"
620             CALL abort
621           ENDIF
622           WRITE(str2,'(i2.2)') nsrf
623           ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)
624           IF (ierr.NE.NF_NOERR) THEN
625              PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"
626              CALL abort
627           ENDIF
628#ifdef NC_DOUBLE
629           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf))
630#else
631           ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))
632#endif
633           IF (ierr.NE.NF_NOERR) THEN
634             PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"
635             CALL abort
636           ENDIF
637           xmin = 1.0E+20
638           xmax = -1.0E+20
639           DO i = 1, klon
640              xmin = MIN(evap(i,nsrf),xmin)
641              xmax = MAX(evap(i,nsrf),xmax)
642           ENDDO
643           PRINT*,'evap du sol EVAP**:', nsrf, xmin, xmax
644         ENDDO
645      ELSE
646         PRINT*, 'phyetat0: Le champ <EVAP> est present'
647         PRINT*, '          J ignore donc les autres EVAP**'
648#ifdef NC_DOUBLE
649         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1))
650#else
651         ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))
652#endif
653         IF (ierr.NE.NF_NOERR) THEN
654            PRINT*, "phyetat0: Lecture echouee pour <EVAP>"
655            CALL abort
656         ENDIF
657         xmin = 1.0E+20
658         xmax = -1.0E+20
659         DO i = 1, klon
660            xmin = MIN(evap(i,1),xmin)
661            xmax = MAX(evap(i,1),xmax)
662         ENDDO
663         PRINT*,'Evap du sol <EVAP>', xmin, xmax
664         DO nsrf = 2, nbsrf
665         DO i = 1, klon
666            evap(i,nsrf) = evap(i,1)
667         ENDDO
668         ENDDO
669      ENDIF
670c
671c Lecture precipitation liquide:
672c
673      ierr = NF_INQ_VARID (nid, "rain_f", nvarid)
674      IF (ierr.NE.NF_NOERR) THEN
675         PRINT*, 'phyetat0: Le champ <rain_f> est absent'
676         CALL abort
677      ENDIF
678#ifdef NC_DOUBLE
679      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall)
680#else
681      ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall)
682#endif
683      IF (ierr.NE.NF_NOERR) THEN
684         PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'
685         CALL abort
686      ENDIF
687      xmin = 1.0E+20
688      xmax = -1.0E+20
689      DO i = 1, klon
690         xmin = MIN(rain_fall(i),xmin)
691         xmax = MAX(rain_fall(i),xmax)
692      ENDDO
693      PRINT*,'Precipitation liquide rain_f:', xmin, xmax
694c
695c Lecture precipitation solide:
696c
697      ierr = NF_INQ_VARID (nid, "snow_f", nvarid)
698      IF (ierr.NE.NF_NOERR) THEN
699         PRINT*, 'phyetat0: Le champ <snow_f> est absent'
700         CALL abort
701      ENDIF
702#ifdef NC_DOUBLE
703      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall)
704#else
705      ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall)
706#endif
707      IF (ierr.NE.NF_NOERR) THEN
708         PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'
709         CALL abort
710      ENDIF
711      xmin = 1.0E+20
712      xmax = -1.0E+20
713      DO i = 1, klon
714         xmin = MIN(snow_fall(i),xmin)
715         xmax = MAX(snow_fall(i),xmax)
716      ENDDO
717      PRINT*,'Precipitation solide snow_f:', xmin, xmax
718c
719c Lecture rayonnement solaire au sol:
720c
721      ierr = NF_INQ_VARID (nid, "solsw", nvarid)
722      IF (ierr.NE.NF_NOERR) THEN
723         PRINT*, 'phyetat0: Le champ <solsw> est absent'
724         PRINT*, 'mis a zero'
725         solsw = 0.
726      ELSE
727#ifdef NC_DOUBLE
728        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw)
729#else
730        ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)
731#endif
732        IF (ierr.NE.NF_NOERR) THEN
733          PRINT*, 'phyetat0: Lecture echouee pour <solsw>'
734          CALL abort
735        ENDIF
736      ENDIF
737      xmin = 1.0E+20
738      xmax = -1.0E+20
739      DO i = 1, klon
740         xmin = MIN(solsw(i),xmin)
741         xmax = MAX(solsw(i),xmax)
742      ENDDO
743      PRINT*,'Rayonnement solaire au sol solsw:', xmin, xmax
744c
745c Lecture rayonnement IF au sol:
746c
747      ierr = NF_INQ_VARID (nid, "sollw", nvarid)
748      IF (ierr.NE.NF_NOERR) THEN
749         PRINT*, 'phyetat0: Le champ <sollw> est absent'
750         PRINT*, 'mis a zero'
751         sollw = 0.
752      ELSE
753#ifdef NC_DOUBLE
754        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw)
755#else
756        ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)
757#endif
758        IF (ierr.NE.NF_NOERR) THEN
759          PRINT*, 'phyetat0: Lecture echouee pour <sollw>'
760          CALL abort
761        ENDIF
762      ENDIF
763      xmin = 1.0E+20
764      xmax = -1.0E+20
765      DO i = 1, klon
766         xmin = MIN(sollw(i),xmin)
767         xmax = MAX(sollw(i),xmax)
768      ENDDO
769      PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax
770
771c
772c Lecture derive des flux:
773c
774      ierr = NF_INQ_VARID (nid, "fder", nvarid)
775      IF (ierr.NE.NF_NOERR) THEN
776         PRINT*, 'phyetat0: Le champ <fder> est absent'
777         PRINT*, 'mis a zero'
778         fder = 0.
779      ELSE
780#ifdef NC_DOUBLE
781        ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder)
782#else
783        ierr = NF_GET_VAR_REAL(nid, nvarid, fder)
784#endif
785        IF (ierr.NE.NF_NOERR) THEN
786          PRINT*, 'phyetat0: Lecture echouee pour <fder>'
787          CALL abort
788        ENDIF
789      ENDIF
790      xmin = 1.0E+20
791      xmax = -1.0E+20
792      DO i = 1, klon
793         xmin = MIN(fder(i),xmin)
794         xmax = MAX(fder(i),xmax)
795      ENDDO
796      PRINT*,'Derive des flux fder:', xmin, xmax
797
798c
799c Lecture du rayonnement net au sol:
800c
801      ierr = NF_INQ_VARID (nid, "RADS", nvarid)
802      IF (ierr.NE.NF_NOERR) THEN
803         PRINT*, 'phyetat0: Le champ <RADS> est absent'
804         CALL abort
805      ENDIF
806#ifdef NC_DOUBLE
807      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol)
808#else
809      ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)
810#endif
811      IF (ierr.NE.NF_NOERR) THEN
812         PRINT*, 'phyetat0: Lecture echouee pour <RADS>'
813         CALL abort
814      ENDIF
815      xmin = 1.0E+20
816      xmax = -1.0E+20
817      DO i = 1, klon
818         xmin = MIN(radsol(i),xmin)
819         xmax = MAX(radsol(i),xmax)
820      ENDDO
821      PRINT*,'Rayonnement net au sol radsol:', xmin, xmax
822c
823c Lecture de la longueur de rugosite
824c
825c
826      ierr = NF_INQ_VARID (nid, "RUG", nvarid)
827      IF (ierr.NE.NF_NOERR) THEN
828         PRINT*, 'phyetat0: Le champ <RUG> est absent'
829         PRINT*, '          Mais je vais essayer de lire RUG**'
830         DO nsrf = 1, nbsrf
831           IF (nsrf.GT.99) THEN
832             PRINT*, "Trop de sous-mailles"
833             CALL abort
834           ENDIF
835           WRITE(str2,'(i2.2)') nsrf
836           ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)
837           IF (ierr.NE.NF_NOERR) THEN
838              PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"
839              CALL abort
840           ENDIF
841#ifdef NC_DOUBLE
842           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf))
843#else
844           ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))
845#endif
846           IF (ierr.NE.NF_NOERR) THEN
847             PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"
848             CALL abort
849           ENDIF
850           xmin = 1.0E+20
851           xmax = -1.0E+20
852           DO i = 1, klon
853              xmin = MIN(frugs(i,nsrf),xmin)
854              xmax = MAX(frugs(i,nsrf),xmax)
855           ENDDO
856           PRINT*,'rugosite du sol RUG**:', nsrf, xmin, xmax
857         ENDDO
858      ELSE
859         PRINT*, 'phyetat0: Le champ <RUG> est present'
860         PRINT*, '          J ignore donc les autres RUG**'
861#ifdef NC_DOUBLE
862         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1))
863#else
864         ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))
865#endif
866         IF (ierr.NE.NF_NOERR) THEN
867            PRINT*, "phyetat0: Lecture echouee pour <RUG>"
868            CALL abort
869         ENDIF
870         xmin = 1.0E+20
871         xmax = -1.0E+20
872         DO i = 1, klon
873            xmin = MIN(frugs(i,1),xmin)
874            xmax = MAX(frugs(i,1),xmax)
875         ENDDO
876         PRINT*,'Neige du sol <RUG>', xmin, xmax
877         DO nsrf = 2, nbsrf
878         DO i = 1, klon
879            frugs(i,nsrf) = frugs(i,1)
880         ENDDO
881         ENDDO
882      ENDIF
883
884c
885c Lecture de l'age de la neige:
886c
887      ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)
888      IF (ierr.NE.NF_NOERR) THEN
889         PRINT*, 'phyetat0: Le champ <AGESNO> est absent'
890         PRINT*, "          Valeur par default: 50"
891         DO i = 1, klon
892            agesno(i) = 50.0
893         ENDDO
894      ELSE
895#ifdef NC_DOUBLE
896         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno)
897#else
898         ierr = NF_GET_VAR_REAL(nid, nvarid, agesno)
899#endif
900         IF (ierr.NE.NF_NOERR) THEN
901            PRINT*, 'phyetat0: Lecture echouee pour <AGESNO>'
902            CALL abort
903         ENDIF
904         xmin = 1.0E+20
905         xmax = -1.0E+20
906         DO i = 1, klon
907            xmin = MIN(agesno(i),xmin)
908            xmax = MAX(agesno(i),xmax)
909         ENDDO
910         PRINT*,'Age de la neige agesno:', xmin, xmax
911      ENDIF
912c
913c
914      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)
915      IF (ierr.NE.NF_NOERR) THEN
916         PRINT*, 'phyetat0: Le champ <ZMEA> est absent'
917         CALL abort
918      ENDIF
919#ifdef NC_DOUBLE
920      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea)
921#else
922      ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)
923#endif
924      IF (ierr.NE.NF_NOERR) THEN
925         PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'
926         CALL abort
927      ENDIF
928      xmin = 1.0E+20
929      xmax = -1.0E+20
930      DO i = 1, klon
931         xmin = MIN(zmea(i),xmin)
932         xmax = MAX(zmea(i),xmax)
933      ENDDO
934      PRINT*,'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax
935c
936c
937      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)
938      IF (ierr.NE.NF_NOERR) THEN
939         PRINT*, 'phyetat0: Le champ <ZSTD> est absent'
940         CALL abort
941      ENDIF
942#ifdef NC_DOUBLE
943      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd)
944#else
945      ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)
946#endif
947      IF (ierr.NE.NF_NOERR) THEN
948         PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'
949         CALL abort
950      ENDIF
951      xmin = 1.0E+20
952      xmax = -1.0E+20
953      DO i = 1, klon
954         xmin = MIN(zstd(i),xmin)
955         xmax = MAX(zstd(i),xmax)
956      ENDDO
957      PRINT*,'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax
958c
959c
960      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)
961      IF (ierr.NE.NF_NOERR) THEN
962         PRINT*, 'phyetat0: Le champ <ZSIG> est absent'
963         CALL abort
964      ENDIF
965#ifdef NC_DOUBLE
966      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig)
967#else
968      ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)
969#endif
970      IF (ierr.NE.NF_NOERR) THEN
971         PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'
972         CALL abort
973      ENDIF
974      xmin = 1.0E+20
975      xmax = -1.0E+20
976      DO i = 1, klon
977         xmin = MIN(zsig(i),xmin)
978         xmax = MAX(zsig(i),xmax)
979      ENDDO
980      PRINT*,'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax
981c
982c
983      ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)
984      IF (ierr.NE.NF_NOERR) THEN
985         PRINT*, 'phyetat0: Le champ <ZGAM> est absent'
986         CALL abort
987      ENDIF
988#ifdef NC_DOUBLE
989      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam)
990#else
991      ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)
992#endif
993      IF (ierr.NE.NF_NOERR) THEN
994         PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'
995         CALL abort
996      ENDIF
997      xmin = 1.0E+20
998      xmax = -1.0E+20
999      DO i = 1, klon
1000         xmin = MIN(zgam(i),xmin)
1001         xmax = MAX(zgam(i),xmax)
1002      ENDDO
1003      PRINT*,'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax
1004c
1005c
1006      ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)
1007      IF (ierr.NE.NF_NOERR) THEN
1008         PRINT*, 'phyetat0: Le champ <ZTHE> est absent'
1009         CALL abort
1010      ENDIF
1011#ifdef NC_DOUBLE
1012      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe)
1013#else
1014      ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)
1015#endif
1016      IF (ierr.NE.NF_NOERR) THEN
1017         PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'
1018         CALL abort
1019      ENDIF
1020      xmin = 1.0E+20
1021      xmax = -1.0E+20
1022      DO i = 1, klon
1023         xmin = MIN(zthe(i),xmin)
1024         xmax = MAX(zthe(i),xmax)
1025      ENDDO
1026      PRINT*,'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax
1027c
1028c
1029      ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)
1030      IF (ierr.NE.NF_NOERR) THEN
1031         PRINT*, 'phyetat0: Le champ <ZPIC> est absent'
1032         CALL abort
1033      ENDIF
1034#ifdef NC_DOUBLE
1035      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic)
1036#else
1037      ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)
1038#endif
1039      IF (ierr.NE.NF_NOERR) THEN
1040         PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'
1041         CALL abort
1042      ENDIF
1043      xmin = 1.0E+20
1044      xmax = -1.0E+20
1045      DO i = 1, klon
1046         xmin = MIN(zpic(i),xmin)
1047         xmax = MAX(zpic(i),xmax)
1048      ENDDO
1049      PRINT*,'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax
1050c
1051      ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)
1052      IF (ierr.NE.NF_NOERR) THEN
1053         PRINT*, 'phyetat0: Le champ <ZVAL> est absent'
1054         CALL abort
1055      ENDIF
1056#ifdef NC_DOUBLE
1057      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval)
1058#else
1059      ierr = NF_GET_VAR_REAL(nid, nvarid, zval)
1060#endif
1061      IF (ierr.NE.NF_NOERR) THEN
1062         PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'
1063         CALL abort
1064      ENDIF
1065      xmin = 1.0E+20
1066      xmax = -1.0E+20
1067      DO i = 1, klon
1068         xmin = MIN(zval(i),xmin)
1069         xmax = MAX(zval(i),xmax)
1070      ENDDO
1071      PRINT*,'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax
1072c
1073c
1074      ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)
1075      IF (ierr.NE.NF_NOERR) THEN
1076         PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'
1077         CALL abort
1078      ENDIF
1079#ifdef NC_DOUBLE
1080      ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel)
1081#else
1082      ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)
1083#endif
1084      IF (ierr.NE.NF_NOERR) THEN
1085         PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'
1086         CALL abort
1087      ENDIF
1088      xmin = 1.0E+20
1089      xmax = -1.0E+20
1090      DO i = 1, klon
1091         xmin = MIN(rugsrel(i),xmin)
1092         xmax = MAX(rugsrel(i),xmax)
1093      ENDDO
1094      PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax
1095c
1096c
1097      ancien_ok = .TRUE.
1098c
1099      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)
1100      IF (ierr.NE.NF_NOERR) THEN
1101         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"
1102         PRINT*, "Depart legerement fausse. Mais je continue"
1103         ancien_ok = .FALSE.
1104      ELSE
1105#ifdef NC_DOUBLE
1106         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien)
1107#else
1108         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)
1109#endif
1110         IF (ierr.NE.NF_NOERR) THEN
1111            PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"
1112            CALL abort
1113         ENDIF
1114      ENDIF
1115c
1116      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)
1117      IF (ierr.NE.NF_NOERR) THEN
1118         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"
1119         PRINT*, "Depart legerement fausse. Mais je continue"
1120         ancien_ok = .FALSE.
1121      ELSE
1122#ifdef NC_DOUBLE
1123         ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien)
1124#else
1125         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)
1126#endif
1127         IF (ierr.NE.NF_NOERR) THEN
1128            PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"
1129            CALL abort
1130         ENDIF
1131      ENDIF
1132c
1133c Fermer le fichier:
1134c
1135      ierr = NF_CLOSE(nid)
1136c
1137      RETURN
1138      END
Note: See TracBrowser for help on using the repository browser.