/[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 155 by guez, Wed Jul 8 17:03:45 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)
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        ! Local:
69        REAL fractint(klon)
70      REAL xmin, xmax      REAL xmin, xmax
71        INTEGER ncid, varid, ndims
72      INTEGER ncid, varid      INTEGER ierr, i, nsrf
73      INTEGER ierr, i, nsrf, isoil      CHARACTER(len=2) str2
     CHARACTER*7 str7  
     CHARACTER*2 str2  
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)
     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, 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    
# Line 95  contains Line 93  contains
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, "masque", varid)
97      IF (ierr == NF90_NOERR) THEN      call nf95_get_var(ncid, 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 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, "TS", varid)
162      ierr = NF90_INQ_VARID(ncid, "TS", varid)      call nf95_inquire_variable(ncid, 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, 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."
           IF (nsrf > 99) THEN  
              PRINT *, "Trop de sous-mailles"  
              stop 1  
           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**'  
167         call nf95_get_var(ncid, varid, tsol(:, 1))         call nf95_get_var(ncid, varid, tsol(:, 1))
168         xmin = 1.0E+20         tsol(:, 2:nbsrf) = spread(tsol(:, 1), dim = 2, ncopies = nbsrf - 1)
169         xmax = -1.0E+20      end if      
        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, 'Tsoil', varid)
174         DO isoil=1, nsoilmx      call NF95_GET_VAR(ncid, 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    
# Line 306  contains Line 228  contains
228         PRINT *, ' Valeur par defaut nulle'         PRINT *, ' Valeur par defaut nulle'
229         qsol = 0.         qsol = 0.
230      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  
231    
232      ! Lecture de neige au sol:      ! Lecture de neige au sol:
233    
# Line 394  contains Line 309  contains
309         ENDDO         ENDDO
310      ENDIF      ENDIF
311    
     ! 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  
   
312      ! Lecture de evaporation:      ! Lecture de evaporation:
313    
314      ierr = NF90_INQ_VARID(ncid, "EVAP", varid)      ierr = NF90_INQ_VARID(ncid, "EVAP", varid)
# Line 468  contains Line 353  contains
353    
354      call NF95_INQ_VARID(ncid, "rain_f", varid)      call NF95_INQ_VARID(ncid, "rain_f", varid)
355      call NF95_GET_VAR(ncid, varid, rain_fall)      call NF95_GET_VAR(ncid, 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  
356    
357      ! Lecture precipitation solide:      ! Lecture precipitation solide:
358    
# Line 516  contains Line 394  contains
394      ELSE      ELSE
395         call nf95_get_var(ncid, varid, sollw)         call nf95_get_var(ncid, varid, sollw)
396      ENDIF      ENDIF
397      xmin = 1.0E+20      PRINT *, 'Rayonnement IF au sol sollw:', minval(sollw), maxval(sollw)
     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  
398    
399      ! Lecture derive des flux:      ! Lecture derive des flux:
400    
# Line 734  contains Line 606  contains
606         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
607         clwcon = 0.         clwcon = 0.
608      ELSE      ELSE
609         call nf95_get_var(ncid, varid, clwcon)         call nf95_get_var(ncid, varid, clwcon(:, 1))
610           clwcon(:, 2:) = 0.
611      ENDIF      ENDIF
612      xmin = 1.0E+20      xmin = 1.0E+20
613      xmax = -1.0E+20      xmax = -1.0E+20
# Line 748  contains Line 621  contains
621         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
622         rnebcon = 0.         rnebcon = 0.
623      ELSE      ELSE
624         call nf95_get_var(ncid, varid, rnebcon)         call nf95_get_var(ncid, varid, rnebcon(:, 1))
625           rnebcon(:, 2:) = 0.
626      ENDIF      ENDIF
627      xmin = 1.0E+20      xmin = 1.0E+20
628      xmax = -1.0E+20      xmax = -1.0E+20
# Line 764  contains Line 638  contains
638         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
639         ratqs = 0.         ratqs = 0.
640      ELSE      ELSE
641         call nf95_get_var(ncid, varid, ratqs)         call nf95_get_var(ncid, varid, ratqs(:, 1))
642           ratqs(:, 2:) = 0.
643      ENDIF      ENDIF
644      xmin = 1.0E+20      xmin = 1.0E+20
645      xmax = -1.0E+20      xmax = -1.0E+20
# Line 788  contains Line 663  contains
663      xmax = MAXval(run_off_lic_0)      xmax = MAXval(run_off_lic_0)
664      PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax      PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax
665    
666        call nf95_inq_varid(ncid, "sig1", varid)
667        call nf95_get_var(ncid, varid, sig1)
668    
669        call nf95_inq_varid(ncid, "w01", varid)
670        call nf95_get_var(ncid, varid, w01)
671    
672      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
673    
674    END SUBROUTINE phyetat0    END SUBROUTINE phyetat0
Legend:
Removed from v.50  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21