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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/phylmd/phyetat0.f90 revision 50 by guez, Wed Aug 24 13:33:28 2011 UTC trunk/Sources/phylmd/phyetat0.f revision 157 by guez, Mon Jul 20 16:01:49 2015 UTC
# Line 4  module phyetat0_m Line 4  module phyetat0_m
4    
5    IMPLICIT none    IMPLICIT none
6    
7    REAL, save:: rlat(klon), rlon(klon) ! latitude and longitude, in degrees    REAL, save:: rlat(klon), rlon(klon)
8      ! latitude and longitude of a point of the scalar grid identified
9      ! by a simple index, in degrees
10    
11    private klon    private klon
12    
13  contains  contains
14    
15    SUBROUTINE phyetat0(fichnom, pctsrf, tsol, tsoil, ocean, tslab, seaice, &    SUBROUTINE phyetat0(pctsrf, tsol, tsoil, tslab, seaice, qsurf, qsol, &
16         qsurf, qsol, snow, albe, alblw, evap, rain_fall, snow_fall, solsw, &         snow, albe, evap, rain_fall, snow_fall, solsw, sollw, fder, &
17         sollw, fder, radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, &         radsol, frugs, agesno, zmea, zstd, zsig, zgam, zthe, zpic, zval, &
18         zpic, zval, t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, &         t_ancien, q_ancien, ancien_ok, rnebcon, ratqs, clwcon, run_off_lic_0, &
19         run_off_lic_0)         sig1, w01, ncid_startphy)
20    
21      ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07      ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07
22      ! Author: Z.X. Li (LMD/CNRS)      ! Author: Z.X. Li (LMD/CNRS)
23      ! Date: 1993/08/18      ! Date: 1993/08/18
24      ! Objet : Lecture de l'état initial pour la physique      ! Objet : lecture de l'état initial pour la physique
25    
26      USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      use dimphy, only: zmasq, klev
27      USE dimsoil, ONLY : nsoilmx      USE dimsoil, ONLY : nsoilmx
28      USE temps, ONLY : itau_phy      USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
29      use netcdf, only: nf90_get_att, nf90_global, nf90_inq_varid, NF90_NOERR, &      use netcdf, only: nf90_global, nf90_inq_varid, NF90_NOERR, &
30           NF90_NOWRITE           NF90_NOWRITE
31      use netcdf95, only: handle_err, nf95_get_var, nf95_close, NF95_OPEN, &      use netcdf95, only: nf95_close, nf95_get_att, nf95_get_var, &
32           nf95_inq_varid           nf95_inq_varid, nf95_inquire_variable, NF95_OPEN
33      use dimphy, only: zmasq, klev      USE temps, ONLY : itau_phy
34    
35      CHARACTER(len=*), intent(in):: fichnom      REAL pctsrf(klon, nbsrf)
36      REAL tsol(klon, nbsrf)      REAL tsol(klon, nbsrf)
37      REAL tsoil(klon, nsoilmx, nbsrf)      REAL tsoil(klon, nsoilmx, nbsrf)
38      REAL tslab(klon), seaice(klon)      REAL tslab(klon), seaice(klon)
39      REAL qsurf(klon, nbsrf)      REAL qsurf(klon, nbsrf)
40      REAL qsol(klon)      REAL, intent(out):: qsol(:) ! (klon)
41      REAL snow(klon, nbsrf)      REAL snow(klon, nbsrf)
42      REAL albe(klon, nbsrf)      REAL albe(klon, nbsrf)
     REAL alblw(klon, nbsrf)  
43      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
44      REAL radsol(klon)      REAL, intent(out):: rain_fall(klon)
     REAL rain_fall(klon)  
45      REAL snow_fall(klon)      REAL snow_fall(klon)
     REAL sollw(klon)  
46      real solsw(klon)      real solsw(klon)
47        REAL, intent(out):: sollw(klon)
48      real fder(klon)      real fder(klon)
49        REAL radsol(klon)
50      REAL frugs(klon, nbsrf)      REAL frugs(klon, nbsrf)
51      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
52      REAL zmea(klon)      REAL zmea(klon)
# Line 55  contains Line 56  contains
56      REAL zthe(klon)      REAL zthe(klon)
57      REAL zpic(klon)      REAL zpic(klon)
58      REAL zval(klon)      REAL zval(klon)
     REAL pctsrf(klon, nbsrf)  
     REAL fractint(klon)  
     REAL run_off_lic_0(klon)  
   
59      REAL t_ancien(klon, klev), q_ancien(klon, klev)      REAL t_ancien(klon, klev), q_ancien(klon, klev)
     real rnebcon(klon, klev), clwcon(klon, klev), ratqs(klon, klev)  
60      LOGICAL, intent(out):: ancien_ok      LOGICAL, intent(out):: ancien_ok
61        real rnebcon(klon, klev), ratqs(klon, klev), clwcon(klon, klev)
62        REAL run_off_lic_0(klon)
63        real, intent(out):: sig1(klon, klev) ! section adiabatic updraft
64    
65      CHARACTER(len=*), intent(in):: ocean      real, intent(out):: w01(klon, klev)
66        ! vertical velocity within adiabatic updraft
67    
68      REAL xmin, xmax      integer, intent(out):: ncid_startphy
69    
70      INTEGER ncid, varid      ! Local:
71      INTEGER ierr, i, nsrf, isoil      REAL fractint(klon)
72      CHARACTER*7 str7      INTEGER varid, ndims
73      CHARACTER*2 str2      INTEGER ierr, i
74    
75      !---------------------------------------------------------------      !---------------------------------------------------------------
76    
77      print *, "Call sequence information: phyetat0"      print *, "Call sequence information: phyetat0"
78    
79      ! Ouvrir le fichier contenant l'etat initial:      ! Fichier contenant l'état initial :
80      print *, 'fichnom = ', fichnom      call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid_startphy)
     call NF95_OPEN(fichnom, NF90_NOWRITE, ncid)  
81    
82      ierr = nf90_get_att(ncid, nf90_global, "itau_phy", itau_phy)      call nf95_get_att(ncid_startphy, nf90_global, "itau_phy", itau_phy)
     call handle_err("phyetat0 itau_phy", ierr, ncid, nf90_global)  
83    
84      ! Lecture des latitudes (coordonnees):      ! Lecture des latitudes (coordonnees):
85    
86      call NF95_INQ_VARID(ncid, "latitude", varid)      call NF95_INQ_VARID(ncid_startphy, "latitude", varid)
87      call NF95_GET_VAR(ncid, varid, rlat)      call NF95_GET_VAR(ncid_startphy, varid, rlat)
88    
89      ! Lecture des longitudes (coordonnees):      ! Lecture des longitudes (coordonnees):
90    
91      call NF95_INQ_VARID(ncid, "longitude", varid)      call NF95_INQ_VARID(ncid_startphy, "longitude", varid)
92      call NF95_GET_VAR(ncid, varid, rlon)      call NF95_GET_VAR(ncid_startphy, varid, rlon)
93    
94      ! Lecture du masque terre mer      ! Lecture du masque terre mer
95    
96      ierr = NF90_INQ_VARID(ncid, "masque", varid)      call NF95_INQ_VARID(ncid_startphy, "masque", varid)
97      IF (ierr == NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, zmasq)
98         call nf95_get_var(ncid, varid, zmasq)  
     else  
        PRINT *, 'phyetat0: Le champ <masque> est absent'  
        PRINT *, 'fichier startphy non compatible avec phyetat0'  
     ENDIF  
99      ! Lecture des fractions pour chaque sous-surface      ! Lecture des fractions pour chaque sous-surface
100    
101      ! initialisation des sous-surfaces      ! initialisation des sous-surfaces
# Line 110  contains Line 104  contains
104    
105      ! fraction de terre      ! fraction de terre
106    
107      ierr = NF90_INQ_VARID(ncid, "FTER", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "FTER", varid)
108      IF (ierr == NF90_NOERR) THEN      IF (ierr == NF90_NOERR) THEN
109         call nf95_get_var(ncid, varid, pctsrf(:, is_ter))         call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_ter))
110      else      else
111         PRINT *, 'phyetat0: Le champ <FTER> est absent'         PRINT *, 'phyetat0: Le champ <FTER> est absent'
112      ENDIF      ENDIF
113    
114      ! fraction de glace de terre      ! fraction de glace de terre
115    
116      ierr = NF90_INQ_VARID(ncid, "FLIC", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "FLIC", varid)
117      IF (ierr == NF90_NOERR) THEN      IF (ierr == NF90_NOERR) THEN
118         call nf95_get_var(ncid, varid, pctsrf(:, is_lic))         call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_lic))
119      else      else
120         PRINT *, 'phyetat0: Le champ <FLIC> est absent'         PRINT *, 'phyetat0: Le champ <FLIC> est absent'
121      ENDIF      ENDIF
122    
123      ! fraction d'ocean      ! fraction d'ocean
124    
125      ierr = NF90_INQ_VARID(ncid, "FOCE", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "FOCE", varid)
126      IF (ierr == NF90_NOERR) THEN      IF (ierr == NF90_NOERR) THEN
127         call nf95_get_var(ncid, varid, pctsrf(:, is_oce))         call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_oce))
128      else      else
129         PRINT *, 'phyetat0: Le champ <FOCE> est absent'         PRINT *, 'phyetat0: Le champ <FOCE> est absent'
130      ENDIF      ENDIF
131    
132      ! fraction glace de mer      ! fraction glace de mer
133    
134      ierr = NF90_INQ_VARID(ncid, "FSIC", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "FSIC", varid)
135      IF (ierr == NF90_NOERR) THEN      IF (ierr == NF90_NOERR) THEN
136         call nf95_get_var(ncid, varid, pctsrf(:, is_sic))         call nf95_get_var(ncid_startphy, varid, pctsrf(:, is_sic))
137      else      else
138         PRINT *, 'phyetat0: Le champ <FSIC> est absent'         PRINT *, 'phyetat0: Le champ <FSIC> est absent'
139      ENDIF      ENDIF
# Line 164  contains Line 158  contains
158      END DO      END DO
159    
160      ! Lecture des temperatures du sol:      ! Lecture des temperatures du sol:
161        call NF95_INQ_VARID(ncid_startphy, "TS", varid)
162      ierr = NF90_INQ_VARID(ncid, "TS", varid)      call nf95_inquire_variable(ncid_startphy, varid, ndims = ndims)
163      IF (ierr /= NF90_NOERR) THEN      if (ndims == 2) then
164         PRINT *, 'phyetat0 : Le champ <TS> est absent'         call NF95_GET_VAR(ncid_startphy, varid, tsol)
165         PRINT *, ' Mais je vais essayer de lire TS**'      else
166         DO nsrf = 1, nbsrf         print *, "Found only one surface type for soil temperature."
167            IF (nsrf > 99) THEN         call nf95_get_var(ncid_startphy, varid, tsol(:, 1))
168               PRINT *, "Trop de sous-mailles"         tsol(:, 2:nbsrf) = spread(tsol(:, 1), dim = 2, ncopies = nbsrf - 1)
169               stop 1      end if
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "TS"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, tsol(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(tsol(i, nsrf), xmin)  
              xmax = MAX(tsol(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'Temperature du sol TS**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <TS> est present'  
        PRINT *, ' J ignore donc les autres temperatures TS**'  
        call nf95_get_var(ncid, varid, tsol(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(tsol(i, 1), xmin)  
           xmax = MAX(tsol(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Temperature du sol <TS>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              tsol(i, nsrf) = tsol(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
170    
171      ! Lecture des temperatures du sol profond:      ! Lecture des temperatures du sol profond:
172    
173      DO nsrf = 1, nbsrf      call NF95_INQ_VARID(ncid_startphy, 'Tsoil', varid)
174         DO isoil=1, nsoilmx      call NF95_GET_VAR(ncid_startphy, varid, tsoil)
           IF (isoil > 99 .AND. nsrf > 99) THEN  
              PRINT *, "Trop de couches ou sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str7, '(i2.2, "srf", i2.2)') isoil, nsrf  
           ierr = NF90_INQ_VARID(ncid, 'Tsoil'//str7, varid)  
           IF (ierr /= NF90_NOERR) THEN  
              PRINT *, "phyetat0: Le champ <Tsoil"//str7//"> est absent"  
              PRINT *, " Il prend donc la valeur de surface"  
              DO i=1, klon  
                 tsoil(i, isoil, nsrf)=tsol(i, nsrf)  
              ENDDO  
           ELSE  
              call NF95_GET_VAR(ncid, varid, tsoil(:, isoil, nsrf))  
           ENDIF  
        ENDDO  
     ENDDO  
175    
176      !IM "slab" ocean      !IM "slab" ocean
   
177      ! Lecture de tslab (pour slab ocean seulement):      ! Lecture de tslab (pour slab ocean seulement):
178        tslab = 0.
179      IF (ocean .eq. 'slab ') then      seaice = 0.
        call NF95_INQ_VARID(ncid, "TSLAB", varid)  
        call nf95_get_var(ncid, varid, tslab)  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(tslab(i), xmin)  
           xmax = MAX(tslab(i), xmax)  
        ENDDO  
        PRINT *, 'Ecart de la SST tslab:', xmin, xmax  
   
        ! Lecture de seaice (pour slab ocean seulement):  
   
        call NF95_INQ_VARID(ncid, "SEAICE", varid)  
        call nf95_get_var(ncid, varid, seaice)  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(seaice(i), xmin)  
           xmax = MAX(seaice(i), xmax)  
        ENDDO  
        PRINT *, 'Masse de la glace de mer seaice:', xmin, xmax  
     ELSE  
        tslab = 0.  
        seaice = 0.  
     ENDIF  
180    
181      ! Lecture de l'humidite de l'air juste au dessus du sol:      ! Lecture de l'humidite de l'air juste au dessus du sol:
182    
183      ierr = NF90_INQ_VARID(ncid, "QS", varid)      call NF95_INQ_VARID(ncid_startphy, "QS", varid)
184      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, qsurf)
        PRINT *, 'phyetat0: Le champ <QS> est absent'  
        PRINT *, ' Mais je vais essayer de lire QS**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "QS"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, qsurf(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(qsurf(i, nsrf), xmin)  
              xmax = MAX(qsurf(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'Humidite pres du sol QS**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <QS> est present'  
        PRINT *, ' J ignore donc les autres humidites QS**'  
        call nf95_get_var(ncid, varid, qsurf(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(qsurf(i, 1), xmin)  
           xmax = MAX(qsurf(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Humidite pres du sol <QS>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              qsurf(i, nsrf) = qsurf(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
185    
186      ! Eau dans le sol (pour le modele de sol "bucket")      ! Eau dans le sol (pour le modele de sol "bucket")
187    
188      ierr = NF90_INQ_VARID(ncid, "QSOL", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "QSOL", varid)
189      IF (ierr == NF90_NOERR) THEN      IF (ierr == NF90_NOERR) THEN
190         call nf95_get_var(ncid, varid, qsol)         call nf95_get_var(ncid_startphy, varid, qsol)
191      else      else
192         PRINT *, 'phyetat0: Le champ <QSOL> est absent'         PRINT *, 'phyetat0: Le champ <QSOL> est absent'
193         PRINT *, ' Valeur par defaut nulle'         PRINT *, ' Valeur par defaut nulle'
194         qsol = 0.         qsol = 0.
195      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(qsol(i), xmin)  
        xmax = MAX(qsol(i), xmax)  
     ENDDO  
     PRINT *, 'Eau dans le sol (mm) <QSOL>', xmin, xmax  
196    
197      ! Lecture de neige au sol:      ! Lecture de neige au sol:
198    
199      ierr = NF90_INQ_VARID(ncid, "SNOW", varid)      call NF95_INQ_VARID(ncid_startphy, "SNOW", varid)
200      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, snow)
        PRINT *, 'phyetat0: Le champ <SNOW> est absent'  
        PRINT *, ' Mais je vais essayer de lire SNOW**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "SNOW"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, snow(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(snow(i, nsrf), xmin)  
              xmax = MAX(snow(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'Neige du sol SNOW**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <SNOW> est present'  
        PRINT *, ' J ignore donc les autres neiges SNOW**'  
        call nf95_get_var(ncid, varid, snow(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(snow(i, 1), xmin)  
           xmax = MAX(snow(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Neige du sol <SNOW>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              snow(i, nsrf) = snow(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
201    
202      ! Lecture de albedo au sol:      ! Lecture de albedo au sol:
203    
204      ierr = NF90_INQ_VARID(ncid, "ALBE", varid)      call NF95_INQ_VARID(ncid_startphy, "ALBE", varid)
205      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, albe)
        PRINT *, 'phyetat0: Le champ <ALBE> est absent'  
        PRINT *, ' Mais je vais essayer de lire ALBE**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "ALBE"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, albe(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(albe(i, nsrf), xmin)  
              xmax = MAX(albe(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'Albedo du sol ALBE**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <ALBE> est present'  
        PRINT *, ' J ignore donc les autres ALBE**'  
        call nf95_get_var(ncid, varid, albe(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(albe(i, 1), xmin)  
           xmax = MAX(albe(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Neige du sol <ALBE>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              albe(i, nsrf) = albe(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
   
     ! Lecture de albedo au sol LW:  
   
     ierr = NF90_INQ_VARID(ncid, "ALBLW", varid)  
     IF (ierr /= NF90_NOERR) THEN  
        PRINT *, 'phyetat0: Le champ <ALBLW> est absent'  
        ! PRINT *, ' Mais je vais essayer de lire ALBLW**'  
        PRINT *, ' Mais je vais prendre ALBE**'  
        DO nsrf = 1, nbsrf  
           DO i = 1, klon  
              alblw(i, nsrf) = albe(i, nsrf)  
           ENDDO  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <ALBLW> est present'  
        PRINT *, ' J ignore donc les autres ALBLW**'  
        call nf95_get_var(ncid, varid, alblw(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(alblw(i, 1), xmin)  
           xmax = MAX(alblw(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Neige du sol <ALBLW>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              alblw(i, nsrf) = alblw(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
206    
207      ! Lecture de evaporation:      ! Lecture de evaporation:
208    
209      ierr = NF90_INQ_VARID(ncid, "EVAP", varid)      call NF95_INQ_VARID(ncid_startphy, "EVAP", varid)
210      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, evap)
        PRINT *, 'phyetat0: Le champ <EVAP> est absent'  
        PRINT *, ' Mais je vais essayer de lire EVAP**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "EVAP"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, evap(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(evap(i, nsrf), xmin)  
              xmax = MAX(evap(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'evap du sol EVAP**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <EVAP> est present'  
        PRINT *, ' J ignore donc les autres EVAP**'  
        call nf95_get_var(ncid, varid, evap(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(evap(i, 1), xmin)  
           xmax = MAX(evap(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Evap du sol <EVAP>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              evap(i, nsrf) = evap(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
211    
212      ! Lecture precipitation liquide:      ! Lecture precipitation liquide:
213    
214      call NF95_INQ_VARID(ncid, "rain_f", varid)      call NF95_INQ_VARID(ncid_startphy, "rain_f", varid)
215      call NF95_GET_VAR(ncid, varid, rain_fall)      call NF95_GET_VAR(ncid_startphy, varid, rain_fall)
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(rain_fall(i), xmin)  
        xmax = MAX(rain_fall(i), xmax)  
     ENDDO  
     PRINT *, 'Precipitation liquide rain_f:', xmin, xmax  
216    
217      ! Lecture precipitation solide:      ! Lecture precipitation solide:
218    
219      call NF95_INQ_VARID(ncid, "snow_f", varid)      call NF95_INQ_VARID(ncid_startphy, "snow_f", varid)
220      call NF95_GET_VAR(ncid, varid, snow_fall)      call NF95_GET_VAR(ncid_startphy, varid, snow_fall)
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(snow_fall(i), xmin)  
        xmax = MAX(snow_fall(i), xmax)  
     ENDDO  
     PRINT *, 'Precipitation solide snow_f:', xmin, xmax  
221    
222      ! Lecture rayonnement solaire au sol:      ! Lecture rayonnement solaire au sol:
223    
224      ierr = NF90_INQ_VARID(ncid, "solsw", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "solsw", varid)
225      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
226         PRINT *, 'phyetat0: Le champ <solsw> est absent'         PRINT *, 'phyetat0: Le champ <solsw> est absent'
227         PRINT *, 'mis a zero'         PRINT *, 'mis a zero'
228         solsw = 0.         solsw = 0.
229      ELSE      ELSE
230         call nf95_get_var(ncid, varid, solsw)         call nf95_get_var(ncid_startphy, varid, solsw)
231      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(solsw(i), xmin)  
        xmax = MAX(solsw(i), xmax)  
     ENDDO  
     PRINT *, 'Rayonnement solaire au sol solsw:', xmin, xmax  
232    
233      ! Lecture rayonnement IF au sol:      ! Lecture rayonnement IF au sol:
234    
235      ierr = NF90_INQ_VARID(ncid, "sollw", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "sollw", varid)
236      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
237         PRINT *, 'phyetat0: Le champ <sollw> est absent'         PRINT *, 'phyetat0: Le champ <sollw> est absent'
238         PRINT *, 'mis a zero'         PRINT *, 'mis a zero'
239         sollw = 0.         sollw = 0.
240      ELSE      ELSE
241         call nf95_get_var(ncid, varid, sollw)         call nf95_get_var(ncid_startphy, varid, sollw)
242      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(sollw(i), xmin)  
        xmax = MAX(sollw(i), xmax)  
     ENDDO  
     PRINT *, 'Rayonnement IF au sol sollw:', xmin, xmax  
243    
244      ! Lecture derive des flux:      ! Lecture derive des flux:
245    
246      ierr = NF90_INQ_VARID(ncid, "fder", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "fder", varid)
247      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
248         PRINT *, 'phyetat0: Le champ <fder> est absent'         PRINT *, 'phyetat0: Le champ <fder> est absent'
249         PRINT *, 'mis a zero'         PRINT *, 'mis a zero'
250         fder = 0.         fder = 0.
251      ELSE      ELSE
252         call nf95_get_var(ncid, varid, fder)         call nf95_get_var(ncid_startphy, varid, fder)
253      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(fder(i), xmin)  
        xmax = MAX(fder(i), xmax)  
     ENDDO  
     PRINT *, 'Derive des flux fder:', xmin, xmax  
254    
255      ! Lecture du rayonnement net au sol:      ! Lecture du rayonnement net au sol:
256    
257      call NF95_INQ_VARID(ncid, "RADS", varid)      call NF95_INQ_VARID(ncid_startphy, "RADS", varid)
258      call NF95_GET_VAR(ncid, varid, radsol)      call NF95_GET_VAR(ncid_startphy, varid, radsol)
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(radsol(i), xmin)  
        xmax = MAX(radsol(i), xmax)  
     ENDDO  
     PRINT *, 'Rayonnement net au sol radsol:', xmin, xmax  
259    
260      ! Lecture de la longueur de rugosite      ! Lecture de la longueur de rugosite
261    
262      ierr = NF90_INQ_VARID(ncid, "RUG", varid)      call NF95_INQ_VARID(ncid_startphy, "RUG", varid)
263      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, frugs)
        PRINT *, 'phyetat0: Le champ <RUG> est absent'  
        PRINT *, ' Mais je vais essayer de lire RUG**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2, '(i2.2)') nsrf  
           call NF95_INQ_VARID(ncid, "RUG"//str2, varid)  
           call NF95_GET_VAR(ncid, varid, frugs(:, nsrf))  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(frugs(i, nsrf), xmin)  
              xmax = MAX(frugs(i, nsrf), xmax)  
           ENDDO  
           PRINT *, 'rugosite du sol RUG**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <RUG> est present'  
        PRINT *, ' J ignore donc les autres RUG**'  
        call nf95_get_var(ncid, varid, frugs(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(frugs(i, 1), xmin)  
           xmax = MAX(frugs(i, 1), xmax)  
        ENDDO  
        PRINT *, 'rugosite <RUG>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              frugs(i, nsrf) = frugs(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
264    
265      ! Lecture de l'age de la neige:      ! Lecture de l'age de la neige:
266    
267      ierr = NF90_INQ_VARID(ncid, "AGESNO", varid)      call NF95_INQ_VARID(ncid_startphy, "AGESNO", varid)
268      IF (ierr /= NF90_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, agesno)
269         PRINT *, 'phyetat0: Le champ <AGESNO> est absent'  
270         PRINT *, ' Mais je vais essayer de lire AGESNO**'      call NF95_INQ_VARID(ncid_startphy, "ZMEA", varid)
271         DO nsrf = 1, nbsrf      call NF95_GET_VAR(ncid_startphy, varid, zmea)
272            IF (nsrf > 99) THEN  
273               PRINT *, "Trop de sous-mailles"      call NF95_INQ_VARID(ncid_startphy, "ZSTD", varid)
274               stop 1      call NF95_GET_VAR(ncid_startphy, varid, zstd)
275            ENDIF  
276            WRITE(str2, '(i2.2)') nsrf      call NF95_INQ_VARID(ncid_startphy, "ZSIG", varid)
277            ierr = NF90_INQ_VARID(ncid, "AGESNO"//str2, varid)      call NF95_GET_VAR(ncid_startphy, varid, zsig)
278            IF (ierr /= NF90_NOERR) THEN  
279               PRINT *, "phyetat0: Le champ <AGESNO"//str2//"> est absent"      call NF95_INQ_VARID(ncid_startphy, "ZGAM", varid)
280               agesno = 50.0      call NF95_GET_VAR(ncid_startphy, varid, zgam)
281            ENDIF  
282            call NF95_GET_VAR(ncid, varid, agesno(:, nsrf))      call NF95_INQ_VARID(ncid_startphy, "ZTHE", varid)
283            xmin = 1.0E+20      call NF95_GET_VAR(ncid_startphy, varid, zthe)
284            xmax = -1.0E+20  
285            DO i = 1, klon      call NF95_INQ_VARID(ncid_startphy, "ZPIC", varid)
286               xmin = MIN(agesno(i, nsrf), xmin)      call NF95_GET_VAR(ncid_startphy, varid, zpic)
287               xmax = MAX(agesno(i, nsrf), xmax)  
288            ENDDO      call NF95_INQ_VARID(ncid_startphy, "ZVAL", varid)
289            PRINT *, 'Age de la neige AGESNO**:', nsrf, xmin, xmax      call NF95_GET_VAR(ncid_startphy, varid, zval)
        ENDDO  
     ELSE  
        PRINT *, 'phyetat0: Le champ <AGESNO> est present'  
        PRINT *, ' J ignore donc les autres AGESNO**'  
        call nf95_get_var(ncid, varid, agesno(:, 1))  
        xmin = 1.0E+20  
        xmax = -1.0E+20  
        DO i = 1, klon  
           xmin = MIN(agesno(i, 1), xmin)  
           xmax = MAX(agesno(i, 1), xmax)  
        ENDDO  
        PRINT *, 'Age de la neige <AGESNO>', xmin, xmax  
        DO nsrf = 2, nbsrf  
           DO i = 1, klon  
              agesno(i, nsrf) = agesno(i, 1)  
           ENDDO  
        ENDDO  
     ENDIF  
   
     call NF95_INQ_VARID(ncid, "ZMEA", varid)  
     call NF95_GET_VAR(ncid, varid, zmea)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zmea(i), xmin)  
        xmax = MAX(zmea(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zmea:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZSTD", varid)  
     call NF95_GET_VAR(ncid, varid, zstd)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zstd(i), xmin)  
        xmax = MAX(zstd(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zstd:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZSIG", varid)  
     call NF95_GET_VAR(ncid, varid, zsig)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zsig(i), xmin)  
        xmax = MAX(zsig(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zsig:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZGAM", varid)  
     call NF95_GET_VAR(ncid, varid, zgam)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zgam(i), xmin)  
        xmax = MAX(zgam(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zgam:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZTHE", varid)  
     call NF95_GET_VAR(ncid, varid, zthe)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zthe(i), xmin)  
        xmax = MAX(zthe(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zthe:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZPIC", varid)  
     call NF95_GET_VAR(ncid, varid, zpic)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zpic(i), xmin)  
        xmax = MAX(zpic(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zpic:', xmin, xmax  
   
     call NF95_INQ_VARID(ncid, "ZVAL", varid)  
     call NF95_GET_VAR(ncid, varid, zval)  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(zval(i), xmin)  
        xmax = MAX(zval(i), xmax)  
     ENDDO  
     PRINT *, 'OROGRAPHIE SOUS-MAILLE zval:', xmin, xmax  
290    
291      ancien_ok = .TRUE.      ancien_ok = .TRUE.
292    
293      ierr = NF90_INQ_VARID(ncid, "TANCIEN", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "TANCIEN", varid)
294      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
295         PRINT *, "phyetat0: Le champ <TANCIEN> est absent"         PRINT *, "phyetat0: Le champ <TANCIEN> est absent"
296         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
297         ancien_ok = .FALSE.         ancien_ok = .FALSE.
298      ELSE      ELSE
299         call nf95_get_var(ncid, varid, t_ancien)         call nf95_get_var(ncid_startphy, varid, t_ancien)
300      ENDIF      ENDIF
301    
302      ierr = NF90_INQ_VARID(ncid, "QANCIEN", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "QANCIEN", varid)
303      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
304         PRINT *, "phyetat0: Le champ <QANCIEN> est absent"         PRINT *, "phyetat0: Le champ <QANCIEN> est absent"
305         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
306         ancien_ok = .FALSE.         ancien_ok = .FALSE.
307      ELSE      ELSE
308         call nf95_get_var(ncid, varid, q_ancien)         call nf95_get_var(ncid_startphy, varid, q_ancien)
309      ENDIF      ENDIF
310    
311      ierr = NF90_INQ_VARID(ncid, "CLWCON", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "CLWCON", varid)
312      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
313         PRINT *, "phyetat0: Le champ CLWCON est absent"         PRINT *, "phyetat0: Le champ CLWCON est absent"
314         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
315         clwcon = 0.         clwcon = 0.
316      ELSE      ELSE
317         call nf95_get_var(ncid, varid, clwcon)         call nf95_get_var(ncid_startphy, varid, clwcon(:, 1))
318           clwcon(:, 2:) = 0.
319      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(clwcon)  
     xmax = MAXval(clwcon)  
     PRINT *, 'Eau liquide convective (ecart-type) clwcon:', xmin, xmax  
320    
321      ierr = NF90_INQ_VARID(ncid, "RNEBCON", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "RNEBCON", varid)
322      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
323         PRINT *, "phyetat0: Le champ RNEBCON est absent"         PRINT *, "phyetat0: Le champ RNEBCON est absent"
324         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
325         rnebcon = 0.         rnebcon = 0.
326      ELSE      ELSE
327         call nf95_get_var(ncid, varid, rnebcon)         call nf95_get_var(ncid_startphy, varid, rnebcon(:, 1))
328           rnebcon(:, 2:) = 0.
329      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(rnebcon)  
     xmax = MAXval(rnebcon)  
     PRINT *, 'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax  
330    
331      ! Lecture ratqs      ! Lecture ratqs
332    
333      ierr = NF90_INQ_VARID(ncid, "RATQS", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "RATQS", varid)
334      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
335         PRINT *, "phyetat0: Le champ <RATQS> est absent"         PRINT *, "phyetat0: Le champ <RATQS> est absent"
336         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
337         ratqs = 0.         ratqs = 0.
338      ELSE      ELSE
339         call nf95_get_var(ncid, varid, ratqs)         call nf95_get_var(ncid_startphy, varid, ratqs(:, 1))
340           ratqs(:, 2:) = 0.
341      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(ratqs)  
     xmax = MAXval(ratqs)  
     PRINT *, '(ecart-type) ratqs:', xmin, xmax  
342    
343      ! Lecture run_off_lic_0      ! Lecture run_off_lic_0
344    
345      ierr = NF90_INQ_VARID(ncid, "RUNOFFLIC0", varid)      ierr = NF90_INQ_VARID(ncid_startphy, "RUNOFFLIC0", varid)
346      IF (ierr /= NF90_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
347         PRINT *, "phyetat0: Le champ <RUNOFFLIC0> est absent"         PRINT *, "phyetat0: Le champ <RUNOFFLIC0> est absent"
348         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
349         run_off_lic_0 = 0.         run_off_lic_0 = 0.
350      ELSE      ELSE
351         call nf95_get_var(ncid, varid, run_off_lic_0)         call nf95_get_var(ncid_startphy, varid, run_off_lic_0)
352      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(run_off_lic_0)  
     xmax = MAXval(run_off_lic_0)  
     PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax  
353    
354      call NF95_CLOSE(ncid)      call nf95_inq_varid(ncid_startphy, "sig1", varid)
355        call nf95_get_var(ncid_startphy, varid, sig1)
356    
357        call nf95_inq_varid(ncid_startphy, "w01", varid)
358        call nf95_get_var(ncid_startphy, varid, w01)
359    
360    END SUBROUTINE phyetat0    END SUBROUTINE phyetat0
361    
Legend:
Removed from v.50  
changed lines
  Added in v.157
  ViewVC Help
Powered by ViewVC 1.1.21