/[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 69 by guez, Mon Feb 18 16:33:12 2013 UTC trunk/Sources/phylmd/phyetat0.f revision 138 by guez, Fri May 22 23:13:19 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, alblw, 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)
# Line 24  contains Line 26  contains
26      use dimphy, only: zmasq, klev      use dimphy, only: zmasq, klev
27      USE dimsoil, ONLY : nsoilmx      USE dimsoil, ONLY : nsoilmx
28      USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf      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 temps, ONLY : itau_phy      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)
43      REAL alblw(klon, nbsrf)      REAL alblw(klon, nbsrf)
44      REAL evap(klon, nbsrf)      REAL evap(klon, nbsrf)
     REAL radsol(klon)  
45      REAL, intent(out):: rain_fall(klon)      REAL, intent(out):: rain_fall(klon)
46      REAL snow_fall(klon)      REAL snow_fall(klon)
     REAL sollw(klon)  
47      real solsw(klon)      real solsw(klon)
48        REAL, intent(out):: sollw(klon)
49      real fder(klon)      real fder(klon)
50        REAL radsol(klon)
51      REAL frugs(klon, nbsrf)      REAL frugs(klon, nbsrf)
52      REAL agesno(klon, nbsrf)      REAL agesno(klon, nbsrf)
53      REAL zmea(klon)      REAL zmea(klon)
# Line 55  contains Line 57  contains
57      REAL zthe(klon)      REAL zthe(klon)
58      REAL zpic(klon)      REAL zpic(klon)
59      REAL zval(klon)      REAL zval(klon)
     REAL pctsrf(klon, nbsrf)  
     REAL fractint(klon)  
     REAL run_off_lic_0(klon)  
   
60      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)  
61      LOGICAL, intent(out):: ancien_ok      LOGICAL, intent(out):: ancien_ok
62        real rnebcon(klon, klev), ratqs(klon, klev), clwcon(klon, klev)
63        REAL run_off_lic_0(klon)
64        real, intent(out):: sig1(klon, klev) ! section adiabatic updraft
65    
66      CHARACTER(len=*), intent(in):: ocean      real, intent(out):: w01(klon, klev)
67        ! vertical velocity within adiabatic updraft
68    
69        ! Local:
70        REAL fractint(klon)
71      REAL xmin, xmax      REAL xmin, xmax
72        INTEGER ncid, varid, ndims
     INTEGER ncid, varid  
73      INTEGER ierr, i, nsrf, isoil      INTEGER ierr, i, nsrf, isoil
74      CHARACTER*7 str7      CHARACTER(len=7) str7
75      CHARACTER*2 str2      CHARACTER(len=2) str2
76    
77      !---------------------------------------------------------------      !---------------------------------------------------------------
78    
79      print *, "Call sequence information: phyetat0"      print *, "Call sequence information: phyetat0"
80    
81      ! Ouvrir le fichier contenant l'etat initial:      ! Fichier contenant l'état initial :
82      print *, 'fichnom = ', fichnom      call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid)
     call NF95_OPEN(fichnom, NF90_NOWRITE, ncid)  
83    
84      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)  
85    
86      ! Lecture des latitudes (coordonnees):      ! Lecture des latitudes (coordonnees):
87    
# Line 95  contains Line 95  contains
95    
96      ! Lecture du masque terre mer      ! Lecture du masque terre mer
97    
98      ierr = NF90_INQ_VARID(ncid, "masque", varid)      call NF95_INQ_VARID(ncid, "masque", varid)
99      IF (ierr == NF90_NOERR) THEN      call nf95_get_var(ncid, varid, zmasq)
100         call nf95_get_var(ncid, varid, zmasq)  
     else  
        PRINT *, 'phyetat0: Le champ <masque> est absent'  
        PRINT *, 'fichier startphy non compatible avec phyetat0'  
     ENDIF  
101      ! Lecture des fractions pour chaque sous-surface      ! Lecture des fractions pour chaque sous-surface
102    
103      ! initialisation des sous-surfaces      ! initialisation des sous-surfaces
# Line 164  contains Line 160  contains
160      END DO      END DO
161    
162      ! Lecture des temperatures du sol:      ! Lecture des temperatures du sol:
163        call NF95_INQ_VARID(ncid, "TS", varid)
164      ierr = NF90_INQ_VARID(ncid, "TS", varid)      call nf95_inquire_variable(ncid, varid, ndims = ndims)
165      IF (ierr /= NF90_NOERR) THEN      if (ndims == 2) then
166         PRINT *, 'phyetat0 : Le champ <TS> est absent'         call NF95_GET_VAR(ncid, varid, tsol)
167         PRINT *, ' Mais je vais essayer de lire TS**'      else
168         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**'  
169         call nf95_get_var(ncid, varid, tsol(:, 1))         call nf95_get_var(ncid, varid, tsol(:, 1))
170         xmin = 1.0E+20         tsol(:, 2:nbsrf) = spread(tsol(:, 1), dim = 2, ncopies = nbsrf - 1)
171         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  
172    
173      ! Lecture des temperatures du sol profond:     ! Lecture des temperatures du sol profond:
174    
175      DO nsrf = 1, nbsrf      DO nsrf = 1, nbsrf
176         DO isoil=1, nsoilmx         DO isoil=1, nsoilmx
# Line 226  contains Line 193  contains
193      ENDDO      ENDDO
194    
195      !IM "slab" ocean      !IM "slab" ocean
   
196      ! Lecture de tslab (pour slab ocean seulement):      ! Lecture de tslab (pour slab ocean seulement):
197        tslab = 0.
198      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  
199    
200      ! Lecture de l'humidite de l'air juste au dessus du sol:      ! Lecture de l'humidite de l'air juste au dessus du sol:
201    
# Line 306  contains Line 247  contains
247         PRINT *, ' Valeur par defaut nulle'         PRINT *, ' Valeur par defaut nulle'
248         qsol = 0.         qsol = 0.
249      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  
250    
251      ! Lecture de neige au sol:      ! Lecture de neige au sol:
252    
# Line 468  contains Line 402  contains
402    
403      call NF95_INQ_VARID(ncid, "rain_f", varid)      call NF95_INQ_VARID(ncid, "rain_f", varid)
404      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  
405    
406      ! Lecture precipitation solide:      ! Lecture precipitation solide:
407    
# Line 516  contains Line 443  contains
443      ELSE      ELSE
444         call nf95_get_var(ncid, varid, sollw)         call nf95_get_var(ncid, varid, sollw)
445      ENDIF      ENDIF
446      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  
447    
448      ! Lecture derive des flux:      ! Lecture derive des flux:
449    
# Line 734  contains Line 655  contains
655         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
656         clwcon = 0.         clwcon = 0.
657      ELSE      ELSE
658         call nf95_get_var(ncid, varid, clwcon)         call nf95_get_var(ncid, varid, clwcon(:, 1))
659           clwcon(:, 2:) = 0.
660      ENDIF      ENDIF
661      xmin = 1.0E+20      xmin = 1.0E+20
662      xmax = -1.0E+20      xmax = -1.0E+20
# Line 748  contains Line 670  contains
670         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
671         rnebcon = 0.         rnebcon = 0.
672      ELSE      ELSE
673         call nf95_get_var(ncid, varid, rnebcon)         call nf95_get_var(ncid, varid, rnebcon(:, 1))
674           rnebcon(:, 2:) = 0.
675      ENDIF      ENDIF
676      xmin = 1.0E+20      xmin = 1.0E+20
677      xmax = -1.0E+20      xmax = -1.0E+20
# Line 764  contains Line 687  contains
687         PRINT *, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
688         ratqs = 0.         ratqs = 0.
689      ELSE      ELSE
690         call nf95_get_var(ncid, varid, ratqs)         call nf95_get_var(ncid, varid, ratqs(:, 1))
691           ratqs(:, 2:) = 0.
692      ENDIF      ENDIF
693      xmin = 1.0E+20      xmin = 1.0E+20
694      xmax = -1.0E+20      xmax = -1.0E+20
# Line 788  contains Line 712  contains
712      xmax = MAXval(run_off_lic_0)      xmax = MAXval(run_off_lic_0)
713      PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax      PRINT *, '(ecart-type) run_off_lic_0:', xmin, xmax
714    
715        call nf95_inq_varid(ncid, "sig1", varid)
716        call nf95_get_var(ncid, varid, sig1)
717    
718        call nf95_inq_varid(ncid, "w01", varid)
719        call nf95_get_var(ncid, varid, w01)
720    
721      call NF95_CLOSE(ncid)      call NF95_CLOSE(ncid)
722    
723    END SUBROUTINE phyetat0    END SUBROUTINE phyetat0
Legend:
Removed from v.69  
changed lines
  Added in v.138
  ViewVC Help
Powered by ViewVC 1.1.21