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

Diff of /trunk/phylmd/phyetat0.f

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

trunk/libf/phylmd/phyetat0.f90 revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/phylmd/phyetat0.f revision 310 by guez, Thu Sep 27 16:29:06 2018 UTC
# Line 1  Line 1 
1  module phyetat0_m  module phyetat0_m
2    
3    use dimphy, only: klon, klev, zmasq    use dimphy, only: klon
     
   IMPLICIT none  
   
   REAL, save:: rlat(klon), rlon(klon)  
   ! latitude et longitude pour chaque point, in degrees  
   
   private klon, klev, zmasq  
   
 contains  
   
   SUBROUTINE phyetat0(fichnom,dtime,co2_ppm_etat0,solaire_etat0, &  
        pctsrf, tsol,tsoil, &  
        ocean, tslab,seaice, & !IM "slab" ocean  
        qsurf,qsol,snow, &  
        albe, alblw, evap, rain_fall, snow_fall, solsw, sollw, &  
        fder,radsol,frugs,agesno,clesphy0, &  
        zmea,zstd,zsig,zgam,zthe,zpic,zval,rugsrel,tabcntr0, &  
        t_ancien,q_ancien,ancien_ok, rnebcon, ratqs,clwcon, &  
        run_off_lic_0)  
   
     ! From phylmd/phyetat0.F,v 1.4 2005/06/03 10:03:07  
   
     use dimens_m  
     use indicesol  
     use dimsoil  
     use temps  
     use clesphys  
   
     ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818  
     ! Objet: Lecture de l'etat initial pour la physique  
   
     include "netcdf.inc"  
   
     CHARACTER*(*) fichnom  
     REAL, intent(out):: dtime  
     INTEGER radpas  
     REAL, intent(out):: co2_ppm_etat0  
     REAL, intent(out):: solaire_etat0  
     REAL tsol(klon,nbsrf)  
     REAL tsoil(klon,nsoilmx,nbsrf)  
     !IM "slab" ocean  
     REAL tslab(klon), seaice(klon)  
     REAL qsurf(klon,nbsrf)  
     REAL qsol(klon)  
     REAL snow(klon,nbsrf)  
     REAL albe(klon,nbsrf)  
     REAL alblw(klon,nbsrf)  
     REAL evap(klon,nbsrf)  
     REAL radsol(klon)  
     REAL rain_fall(klon)  
     REAL snow_fall(klon)  
     REAL sollw(klon)  
     real solsw(klon)  
     real fder(klon)  
     REAL frugs(klon,nbsrf)  
     REAL agesno(klon,nbsrf)  
     REAL zmea(klon)  
     REAL zstd(klon)  
     REAL zsig(klon)  
     REAL zgam(klon)  
     REAL zthe(klon)  
     REAL zpic(klon)  
     REAL zval(klon)  
     REAL rugsrel(klon)  
     REAL pctsrf(klon, nbsrf)  
     REAL fractint(klon)  
     REAL run_off_lic_0(klon)  
   
     REAL t_ancien(klon,klev), q_ancien(klon,klev)  
     real rnebcon(klon,klev),clwcon(klon,klev),ratqs(klon,klev)  
     LOGICAL ancien_ok  
   
     CHARACTER*6 ocean  
   
     INTEGER        longcles  
     PARAMETER    ( longcles = 20 )  
     REAL clesphy0( longcles )  
   
     REAL xmin, xmax  
   
     INTEGER nid, nvarid  
     INTEGER ierr, i, nsrf, isoil  
     INTEGER length  
     PARAMETER (length=100)  
     REAL tab_cntrl(length), tabcntr0(length)  
     CHARACTER*7 str7  
     CHARACTER*2 str2  
   
     !---------------------------------------------------------------  
   
     print *, "Call sequence information: phyetat0"  
   
     ! Ouvrir le fichier contenant l'etat initial:  
   
     print *, 'fichnom = ', fichnom  
     ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)  
     IF (ierr.NE.NF_NOERR) THEN  
        write(6,*)' Pb d''ouverture du fichier '//fichnom  
        write(6,*)' ierr = ', ierr  
        STOP 1  
     ENDIF  
   
     ! Lecture des parametres de controle:  
   
     ierr = NF_INQ_VARID (nid, "controle", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <controle> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <controle>'  
        stop 1  
     ELSE  
        DO i = 1, length  
           tabcntr0( i ) = tab_cntrl( i )  
        ENDDO  
   
        cycle_diurne   = .FALSE.  
        soil_model     = .FALSE.  
        new_oliq       = .FALSE.  
        ok_orodr       = .FALSE.  
        ok_orolf       = .FALSE.  
        ok_limitvrai   = .FALSE.  
4    
5      IMPLICIT none
6    
7         IF( clesphy0(1).NE.tab_cntrl( 5 ) )  THEN    REAL, save, protected:: rlat(klon), rlon(klon)
8            tab_cntrl( 5 ) = clesphy0(1)    ! latitude and longitude of a point of the scalar grid identified
9         ENDIF    ! by a simple index, in degrees
10    
11         IF( clesphy0(2).NE.tab_cntrl( 6 ) )  THEN    integer, save, protected:: itau_phy
12            tab_cntrl( 6 ) = clesphy0(2)    REAL, save, protected:: zmasq(KLON) ! fraction of land
        ENDIF  
13    
14         IF( clesphy0(3).NE.tab_cntrl( 7 ) )  THEN    private klon
           tab_cntrl( 7 ) = clesphy0(3)  
        ENDIF  
15    
16         IF( clesphy0(4).NE.tab_cntrl( 8 ) )  THEN  contains
           tab_cntrl( 8 ) = clesphy0(4)  
        ENDIF  
17    
18         IF( clesphy0(5).NE.tab_cntrl( 9 ) )  THEN    SUBROUTINE phyetat0(pctsrf, ftsol, ftsoil, qsurf, qsol, snow, albe, &
19            tab_cntrl( 9 ) = clesphy0( 5 )         rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, agesno, zmea, &
20         ENDIF         zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, ancien_ok, &
21           rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, ncid_startphy)
22    
23        ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07
24        ! Author: Z.X. Li (LMD/CNRS)
25        ! Date: 1993/08/18
26        ! Objet : lecture de l'état initial pour la physique
27    
28        USE conf_gcm_m, ONLY: raz_date
29        use dimphy, only: klev
30        USE dimsoil, ONLY : nsoilmx
31        USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf
32        use netcdf, only: nf90_global, nf90_inq_varid, NF90_NOERR, NF90_NOWRITE
33        use netcdf95, only: nf95_get_att, nf95_get_var, nf95_inq_varid, &
34             nf95_inquire_variable, NF95_OPEN
35    
36        REAL, intent(out):: pctsrf(klon, nbsrf)
37        REAL, intent(out):: ftsol(klon, nbsrf)
38        REAL, intent(out):: ftsoil(klon, nsoilmx, nbsrf)
39        REAL, intent(out):: qsurf(klon, nbsrf)
40    
41        REAL, intent(out):: qsol(:)
42        ! (klon) column-density of water in soil, in kg m-2
43    
44        REAL, intent(out):: snow(klon, nbsrf)
45        REAL, intent(out):: albe(klon, nbsrf)
46        REAL, intent(out):: rain_fall(klon)
47        REAL, intent(out):: snow_fall(klon)
48        real, intent(out):: solsw(klon)
49        REAL, intent(out):: sollw(klon)
50        real, intent(out):: fder(klon)
51        REAL, intent(out):: radsol(klon)
52        REAL, intent(out):: frugs(klon, nbsrf)
53        REAL, intent(out):: agesno(klon, nbsrf)
54        REAL, intent(out):: zmea(klon)
55        REAL, intent(out):: zstd(klon)
56        REAL, intent(out):: zsig(klon)
57        REAL, intent(out):: zgam(klon)
58        REAL, intent(out):: zthe(klon)
59        REAL, intent(out):: zpic(klon)
60        REAL, intent(out):: zval(klon)
61        REAL, intent(out):: t_ancien(klon, klev), q_ancien(klon, klev)
62        LOGICAL, intent(out):: ancien_ok
63        real, intent(out):: rnebcon(klon, klev), ratqs(klon, klev)
64        REAL, intent(out):: clwcon(klon, klev), run_off_lic_0(klon)
65        real, intent(out):: sig1(klon, klev) ! section adiabatic updraft
66    
67         IF( clesphy0(6).NE.tab_cntrl( 10 ) )  THEN      real, intent(out):: w01(klon, klev)
68            tab_cntrl( 10 ) = clesphy0( 6 )      ! vertical velocity within adiabatic updraft
        ENDIF  
69    
70         IF( clesphy0(7).NE.tab_cntrl( 11 ) )  THEN      integer, intent(out):: ncid_startphy
           tab_cntrl( 11 ) = clesphy0( 7 )  
        ENDIF  
71    
72         IF( clesphy0(8).NE.tab_cntrl( 12 ) )  THEN      ! Local:
73            tab_cntrl( 12 ) = clesphy0( 8 )      REAL fractint(klon)
74         ENDIF      INTEGER varid, ndims
75        INTEGER ierr, i
76    
77        !---------------------------------------------------------------
78    
79         dtime        = tab_cntrl(1)      print *, "Call sequence information: phyetat0"
        radpas       = int(tab_cntrl(2))  
        co2_ppm_etat0      = tab_cntrl(3)  
        solaire_etat0      = tab_cntrl(4)  
        iflag_con    = tab_cntrl(5)  
        nbapp_rad    = tab_cntrl(6)  
   
   
        cycle_diurne    = .FALSE.  
        soil_model      = .FALSE.  
        new_oliq        = .FALSE.  
        ok_orodr        = .FALSE.  
        ok_orolf        = .FALSE.  
        ok_limitvrai    = .FALSE.  
   
        IF( tab_cntrl( 7) .EQ. 1. )    cycle_diurne  = .TRUE.  
        IF( tab_cntrl( 8) .EQ. 1. )       soil_model = .TRUE.  
        IF( tab_cntrl( 9) .EQ. 1. )         new_oliq = .TRUE.  
        IF( tab_cntrl(10) .EQ. 1. )         ok_orodr = .TRUE.  
        IF( tab_cntrl(11) .EQ. 1. )         ok_orolf = .TRUE.  
        IF( tab_cntrl(12) .EQ. 1. )     ok_limitvrai = .TRUE.  
     ENDIF  
80    
81      itau_phy = tab_cntrl(15)      ! Fichier contenant l'état initial :
82        call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid_startphy)
83    
84        IF (raz_date) then
85           itau_phy = 0
86        else
87           call nf95_get_att(ncid_startphy, nf90_global, "itau_phy", itau_phy)
88        end IF
89    
90      ! Lecture des latitudes (coordonnees):      ! Lecture des latitudes (coordonnees):
91    
92      ierr = NF_INQ_VARID (nid, "latitude", nvarid)      call NF95_INQ_VARID(ncid_startphy, "latitude", varid)
93      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, rlat)
        PRINT*, 'phyetat0: Le champ <latitude> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, rlat)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <latitude>'  
        stop 1  
     ENDIF  
94    
95      ! Lecture des longitudes (coordonnees):      ! Lecture des longitudes (coordonnees):
96    
97      ierr = NF_INQ_VARID (nid, "longitude", nvarid)      call NF95_INQ_VARID(ncid_startphy, "longitude", varid)
98      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, rlon)
        PRINT*, 'phyetat0: Le champ <longitude> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, rlon)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <latitude>'  
        stop 1  
     ENDIF  
   
99    
100      ! Lecture du masque terre mer      ! Lecture du masque terre mer
101    
102      ierr = NF_INQ_VARID (nid, "masque", nvarid)      call NF95_INQ_VARID(ncid_startphy, "masque", varid)
103      IF (ierr .EQ.  NF_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, zmasq)
104         ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <masque>'  
           stop 1  
        ENDIF  
     else  
        PRINT*, 'phyetat0: Le champ <masque> est absent'  
        PRINT*, 'fichier startphy non compatible avec phyetat0'  
        !      stop 1  
     ENDIF  
105      ! Lecture des fractions pour chaque sous-surface      ! Lecture des fractions pour chaque sous-surface
106    
107      ! initialisation des sous-surfaces      ! initialisation des sous-surfaces
108    
109      pctsrf = 0.      call NF95_INQ_VARID(ncid_startphy, "pctsrf", varid)
110        call nf95_get_var(ncid_startphy, varid, pctsrf)
     ! fraction de terre  
   
     ierr = NF_INQ_VARID (nid, "FTER", nvarid)  
     IF (ierr .EQ.  NF_NOERR) THEN  
        ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_ter))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <FTER>'  
           stop 1  
        ENDIF  
     else  
        PRINT*, 'phyetat0: Le champ <FTER> est absent'  
        !$$$         stop 1  
     ENDIF  
   
     ! fraction de glace de terre  
   
     ierr = NF_INQ_VARID (nid, "FLIC", nvarid)  
     IF (ierr .EQ.  NF_NOERR) THEN  
        ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_lic))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <FLIC>'  
           stop 1  
        ENDIF  
     else  
        PRINT*, 'phyetat0: Le champ <FLIC> est absent'  
        !$$$         stop 1  
     ENDIF  
   
     ! fraction d'ocean  
   
     ierr = NF_INQ_VARID (nid, "FOCE", nvarid)  
     IF (ierr .EQ.  NF_NOERR) THEN  
        ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_oce))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <FOCE>'  
           stop 1  
        ENDIF  
     else  
        PRINT*, 'phyetat0: Le champ <FOCE> est absent'  
        !$$$         stop 1  
     ENDIF  
111    
112      ! fraction glace de mer      ! Verification de l'adequation entre le masque et les sous-surfaces
113    
114      ierr = NF_INQ_VARID (nid, "FSIC", nvarid)      fractint = pctsrf(:, is_ter) + pctsrf(:, is_lic)
     IF (ierr .EQ.  NF_NOERR) THEN  
        ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon, is_sic))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <FSIC>'  
           stop 1  
        ENDIF  
     else  
        PRINT*, 'phyetat0: Le champ <FSIC> est absent'  
        !$$$         stop 1  
     ENDIF  
   
     !  Verification de l'adequation entre le masque et les sous-surfaces  
   
     fractint( 1 : klon) = pctsrf(1 : klon, is_ter)  &  
          + pctsrf(1 : klon, is_lic)  
115      DO i = 1 , klon      DO i = 1 , klon
116         IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN         IF ( abs(fractint(i) - zmasq(i) ) > EPSFRA ) THEN
117            WRITE(*,*) 'phyetat0: attention fraction terre pas ',  &            print *, 'phyetat0: attention fraction terre pas ', &
118                 'coherente ', i, zmasq(i), pctsrf(i, is_ter) &                 'coherente ', i, zmasq(i), pctsrf(i, is_ter), pctsrf(i, is_lic)
                ,pctsrf(i, is_lic)  
119         ENDIF         ENDIF
120      END DO      END DO
121      fractint (1 : klon) =  pctsrf(1 : klon, is_oce)  &      fractint = pctsrf(:, is_oce) + pctsrf(:, is_sic)
          + pctsrf(1 : klon, is_sic)  
122      DO i = 1 , klon      DO i = 1 , klon
123         IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN         IF ( abs( fractint(i) - (1. - zmasq(i))) > EPSFRA ) THEN
124            WRITE(*,*) 'phyetat0 attention fraction ocean pas ',  &            print *, 'phyetat0 attention fraction ocean pas ', &
125                 'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &                 'coherente ', i, zmasq(i) , pctsrf(i, is_oce), pctsrf(i, is_sic)
                ,pctsrf(i, is_sic)  
126         ENDIF         ENDIF
127      END DO      END DO
128    
129      ! Lecture des temperatures du sol:      ! Lecture des temperatures du sol:
130        call NF95_INQ_VARID(ncid_startphy, "TS", varid)
131      ierr = NF_INQ_VARID (nid, "TS", nvarid)      call nf95_inquire_variable(ncid_startphy, varid, ndims = ndims)
132      IF (ierr.NE.NF_NOERR) THEN      if (ndims == 2) then
133         PRINT*, 'phyetat0: Le champ <TS> est absent'         call NF95_GET_VAR(ncid_startphy, varid, ftsol)
134         PRINT*, '          Mais je vais essayer de lire TS**'      else
135         DO nsrf = 1, nbsrf         print *, "Found only one surface type for soil temperature."
136            IF (nsrf.GT.99) THEN         call nf95_get_var(ncid_startphy, varid, ftsol(:, 1))
137               PRINT*, "Trop de sous-mailles"         ftsol(:, 2:nbsrf) = spread(ftsol(:, 1), dim = 2, ncopies = nbsrf - 1)
138               stop 1      end if
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <TS"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <TS"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <TS>"  
           stop 1  
        ENDIF  
        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  
139    
140      ! Lecture des temperatures du sol profond:      ! Lecture des temperatures du sol profond:
141    
142      DO nsrf = 1, nbsrf      call NF95_INQ_VARID(ncid_startphy, 'Tsoil', varid)
143         DO isoil=1, nsoilmx      call NF95_GET_VAR(ncid_startphy, varid, ftsoil)
           IF (isoil.GT.99 .AND. nsrf.GT.99) THEN  
              PRINT*, "Trop de couches ou sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str7,'(i2.2,"srf",i2.2)') isoil, nsrf  
           ierr = NF_INQ_VARID (nid, 'Tsoil'//str7, nvarid)  
           IF (ierr.NE.NF_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  
              ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf))  
              IF (ierr.NE.NF_NOERR) THEN  
                 PRINT*, "Lecture echouee pour <Tsoil"//str7//">"  
                 stop 1  
              ENDIF  
           ENDIF  
        ENDDO  
     ENDDO  
   
     !IM "slab" ocean  
   
     ! Lecture de tslab (pour slab ocean seulement):        
   
     IF (ocean .eq. 'slab  ') then  
        ierr = NF_INQ_VARID (nid, "TSLAB", nvarid)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Le champ <TSLAB> est absent"  
           stop 1  
        ENDIF  
        ierr = NF_GET_VAR_REAL(nid, nvarid, tslab)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <TSLAB>"  
           stop 1  
        ENDIF  
        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):  
   
        ierr = NF_INQ_VARID (nid, "SEAICE", nvarid)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Le champ <SEAICE> est absent"  
           stop 1  
        ENDIF  
        ierr = NF_GET_VAR_REAL(nid, nvarid, seaice)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <SEAICE>"  
           stop 1  
        ENDIF  
        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  
144    
145      ! Lecture de l'humidite de l'air juste au dessus du sol:      ! Lecture de l'humidite de l'air juste au dessus du sol:
146    
147      ierr = NF_INQ_VARID (nid, "QS", nvarid)      call NF95_INQ_VARID(ncid_startphy, "QS", varid)
148      IF (ierr.NE.NF_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.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <QS"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <QS"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <QS>"  
           stop 1  
        ENDIF  
        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  
149    
150      ! Eau dans le sol (pour le modele de sol "bucket")      ierr = NF90_INQ_VARID(ncid_startphy, "QSOL", varid)
151        IF (ierr == NF90_NOERR) THEN
152      ierr = NF_INQ_VARID (nid, "QSOL", nvarid)         call nf95_get_var(ncid_startphy, varid, qsol)
     IF (ierr .EQ.  NF_NOERR) THEN  
        ierr = NF_GET_VAR_REAL(nid, nvarid, qsol)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <QSOL>'  
           stop 1  
        ENDIF  
153      else      else
154         PRINT*, 'phyetat0: Le champ <QSOL> est absent'         PRINT *, 'phyetat0: Le champ <QSOL> est absent'
155         PRINT*, '          Valeur par defaut nulle'         PRINT *, ' Valeur par defaut nulle'
156         qsol(:)=0.         qsol = 0.
        !$$$         stop 1  
157      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  
158    
159      ! Lecture de neige au sol:      ! Lecture de neige au sol:
160    
161      ierr = NF_INQ_VARID (nid, "SNOW", nvarid)      call NF95_INQ_VARID(ncid_startphy, "SNOW", varid)
162      IF (ierr.NE.NF_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.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <SNOW"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <SNOW"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <SNOW>"  
           stop 1  
        ENDIF  
        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  
163    
164      ! Lecture de albedo au sol:      ! Lecture de albedo au sol:
165    
166      ierr = NF_INQ_VARID (nid, "ALBE", nvarid)      call NF95_INQ_VARID(ncid_startphy, "ALBE", varid)
167      IF (ierr.NE.NF_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.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <ALBE"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <ALBE"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <ALBE>"  
           stop 1  
        ENDIF  
        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 = NF_INQ_VARID (nid, "ALBLW", nvarid)  
     IF (ierr.NE.NF_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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, alblw(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <ALBLW>"  
           stop 1  
        ENDIF  
        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  
   
     ! Lecture de evaporation:    
   
     ierr = NF_INQ_VARID (nid, "EVAP", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <EVAP> est absent'  
        PRINT*, '          Mais je vais essayer de lire EVAP**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <EVAP"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <EVAP"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <EVAP>"  
           stop 1  
        ENDIF  
        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  
168    
169      ! Lecture precipitation liquide:      ! Lecture precipitation liquide:
170    
171      ierr = NF_INQ_VARID (nid, "rain_f", nvarid)      call NF95_INQ_VARID(ncid_startphy, "rain_f", varid)
172      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, rain_fall)
        PRINT*, 'phyetat0: Le champ <rain_f> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <rain_f>'  
        stop 1  
     ENDIF  
     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  
173    
174      ! Lecture precipitation solide:      ! Lecture precipitation solide:
175    
176      ierr = NF_INQ_VARID (nid, "snow_f", nvarid)      call NF95_INQ_VARID(ncid_startphy, "snow_f", varid)
177      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, snow_fall)
        PRINT*, 'phyetat0: Le champ <snow_f> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <snow_f>'  
        stop 1  
     ENDIF  
     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  
178    
179      ! Lecture rayonnement solaire au sol:      ! Lecture rayonnement solaire au sol:
180    
181      ierr = NF_INQ_VARID (nid, "solsw", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "solsw", varid)
182      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
183         PRINT*, 'phyetat0: Le champ <solsw> est absent'         PRINT *, 'phyetat0: Le champ <solsw> est absent'
184         PRINT*, 'mis a zero'         PRINT *, 'mis a zero'
185         solsw = 0.         solsw = 0.
186      ELSE      ELSE
187         ierr = NF_GET_VAR_REAL(nid, nvarid, solsw)         call nf95_get_var(ncid_startphy, varid, solsw)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <solsw>'  
           stop 1  
        ENDIF  
188      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  
189    
190      ! Lecture rayonnement IF au sol:      ! Lecture rayonnement IF au sol:
191    
192      ierr = NF_INQ_VARID (nid, "sollw", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "sollw", varid)
193      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
194         PRINT*, 'phyetat0: Le champ <sollw> est absent'         PRINT *, 'phyetat0: Le champ <sollw> est absent'
195         PRINT*, 'mis a zero'         PRINT *, 'mis a zero'
196         sollw = 0.         sollw = 0.
197      ELSE      ELSE
198         ierr = NF_GET_VAR_REAL(nid, nvarid, sollw)         call nf95_get_var(ncid_startphy, varid, sollw)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <sollw>'  
           stop 1  
        ENDIF  
199      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  
   
200    
201      ! Lecture derive des flux:      ! Lecture derive des flux:
202    
203      ierr = NF_INQ_VARID (nid, "fder", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "fder", varid)
204      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
205         PRINT*, 'phyetat0: Le champ <fder> est absent'         PRINT *, 'phyetat0: Le champ <fder> est absent'
206         PRINT*, 'mis a zero'         PRINT *, 'mis a zero'
207         fder = 0.         fder = 0.
208      ELSE      ELSE
209         ierr = NF_GET_VAR_REAL(nid, nvarid, fder)         call nf95_get_var(ncid_startphy, varid, fder)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, 'phyetat0: Lecture echouee pour <fder>'  
           stop 1  
        ENDIF  
210      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  
   
211    
212      ! Lecture du rayonnement net au sol:      ! Lecture du rayonnement net au sol:
213    
214      ierr = NF_INQ_VARID (nid, "RADS", nvarid)      call NF95_INQ_VARID(ncid_startphy, "RADS", varid)
215      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, radsol)
        PRINT*, 'phyetat0: Le champ <RADS> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, radsol)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <RADS>'  
        stop 1  
     ENDIF  
     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  
216    
217      ! Lecture de la longueur de rugosite      ! Lecture de la longueur de rugosite
218    
219        call NF95_INQ_VARID(ncid_startphy, "RUG", varid)
220      ierr = NF_INQ_VARID (nid, "RUG", nvarid)      call nf95_get_var(ncid_startphy, varid, frugs)
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <RUG> est absent'  
        PRINT*, '          Mais je vais essayer de lire RUG**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <RUG"//str2//"> est absent"  
              stop 1  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <RUG"//str2//">"  
              stop 1  
           ENDIF  
           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**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <RUG>"  
           stop 1  
        ENDIF  
        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  
   
221    
222      ! Lecture de l'age de la neige:      ! Lecture de l'age de la neige:
223    
224      ierr = NF_INQ_VARID (nid, "AGESNO", nvarid)      call NF95_INQ_VARID(ncid_startphy, "AGESNO", varid)
225      IF (ierr.NE.NF_NOERR) THEN      call nf95_get_var(ncid_startphy, varid, agesno)
        PRINT*, 'phyetat0: Le champ <AGESNO> est absent'  
        PRINT*, '          Mais je vais essayer de lire AGESNO**'  
        DO nsrf = 1, nbsrf  
           IF (nsrf.GT.99) THEN  
              PRINT*, "Trop de sous-mailles"  
              stop 1  
           ENDIF  
           WRITE(str2,'(i2.2)') nsrf  
           ierr = NF_INQ_VARID (nid, "AGESNO"//str2, nvarid)  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Le champ <AGESNO"//str2//"> est absent"  
              agesno = 50.0  
           ENDIF  
           ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,nsrf))  
           IF (ierr.NE.NF_NOERR) THEN  
              PRINT*, "phyetat0: Lecture echouee pour <AGESNO"//str2//">"  
              stop 1  
           ENDIF  
           xmin = 1.0E+20  
           xmax = -1.0E+20  
           DO i = 1, klon  
              xmin = MIN(agesno(i,nsrf),xmin)  
              xmax = MAX(agesno(i,nsrf),xmax)  
           ENDDO  
           PRINT*,'Age de la neige AGESNO**:', nsrf, xmin, xmax  
        ENDDO  
     ELSE  
        PRINT*, 'phyetat0: Le champ <AGESNO> est present'  
        PRINT*, '          J ignore donc les autres AGESNO**'  
        ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,1))  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <AGESNO>"  
           stop 1  
        ENDIF  
        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  
226    
227        call NF95_INQ_VARID(ncid_startphy, "ZMEA", varid)
228        call NF95_GET_VAR(ncid_startphy, varid, zmea)
229    
230      ierr = NF_INQ_VARID (nid, "ZMEA", nvarid)      call NF95_INQ_VARID(ncid_startphy, "ZSTD", varid)
231      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, zstd)
        PRINT*, 'phyetat0: Le champ <ZMEA> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zmea)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZMEA>'  
        stop 1  
     ENDIF  
     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  
232    
233        call NF95_INQ_VARID(ncid_startphy, "ZSIG", varid)
234        call NF95_GET_VAR(ncid_startphy, varid, zsig)
235    
236      ierr = NF_INQ_VARID (nid, "ZSTD", nvarid)      call NF95_INQ_VARID(ncid_startphy, "ZGAM", varid)
237      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, zgam)
        PRINT*, 'phyetat0: Le champ <ZSTD> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zstd)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZSTD>'  
        stop 1  
     ENDIF  
     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  
238    
239        call NF95_INQ_VARID(ncid_startphy, "ZTHE", varid)
240        call NF95_GET_VAR(ncid_startphy, varid, zthe)
241    
242      ierr = NF_INQ_VARID (nid, "ZSIG", nvarid)      call NF95_INQ_VARID(ncid_startphy, "ZPIC", varid)
243      IF (ierr.NE.NF_NOERR) THEN      call NF95_GET_VAR(ncid_startphy, varid, zpic)
        PRINT*, 'phyetat0: Le champ <ZSIG> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zsig)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZSIG>'  
        stop 1  
     ENDIF  
     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  
   
   
     ierr = NF_INQ_VARID (nid, "ZGAM", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <ZGAM> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zgam)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZGAM>'  
        stop 1  
     ENDIF  
     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  
   
   
     ierr = NF_INQ_VARID (nid, "ZTHE", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <ZTHE> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zthe)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZTHE>'  
        stop 1  
     ENDIF  
     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  
   
   
     ierr = NF_INQ_VARID (nid, "ZPIC", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <ZPIC> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zpic)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZPIC>'  
        stop 1  
     ENDIF  
     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  
   
     ierr = NF_INQ_VARID (nid, "ZVAL", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <ZVAL> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, zval)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <ZVAL>'  
        stop 1  
     ENDIF  
     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  
   
   
     ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Le champ <RUGSREL> est absent'  
        stop 1  
     ENDIF  
     ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, 'phyetat0: Lecture echouee pour <RUGSREL>'  
        stop 1  
     ENDIF  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     DO i = 1, klon  
        xmin = MIN(rugsrel(i),xmin)  
        xmax = MAX(rugsrel(i),xmax)  
     ENDDO  
     PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax  
244    
245        call NF95_INQ_VARID(ncid_startphy, "ZVAL", varid)
246        call NF95_GET_VAR(ncid_startphy, varid, zval)
247    
248      ancien_ok = .TRUE.      ancien_ok = .TRUE.
249    
250      ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "TANCIEN", varid)
251      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
252         PRINT*, "phyetat0: Le champ <TANCIEN> est absent"         PRINT *, "phyetat0: Le champ <TANCIEN> est absent"
253         PRINT*, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
254         ancien_ok = .FALSE.         ancien_ok = .FALSE.
255      ELSE      ELSE
256         ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien)         call nf95_get_var(ncid_startphy, varid, t_ancien)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <TANCIEN>"  
           stop 1  
        ENDIF  
257      ENDIF      ENDIF
258    
259      ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "QANCIEN", varid)
260      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
261         PRINT*, "phyetat0: Le champ <QANCIEN> est absent"         PRINT *, "phyetat0: Le champ <QANCIEN> est absent"
262         PRINT*, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
263         ancien_ok = .FALSE.         ancien_ok = .FALSE.
264      ELSE      ELSE
265         ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)         call nf95_get_var(ncid_startphy, varid, q_ancien)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"  
           stop 1  
        ENDIF  
266      ENDIF      ENDIF
267    
268      ierr = NF_INQ_VARID (nid, "CLWCON", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "CLWCON", varid)
269      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
270         PRINT*, "phyetat0: Le champ CLWCON est absent"         PRINT *, "phyetat0: Le champ CLWCON est absent"
271         PRINT*, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
272         clwcon = 0.         clwcon = 0.
273      ELSE      ELSE
274         ierr = NF_GET_VAR_REAL(nid, nvarid, clwcon)         call nf95_get_var(ncid_startphy, varid, clwcon(:, 1))
275         IF (ierr.NE.NF_NOERR) THEN         clwcon(:, 2:) = 0.
           PRINT*, "phyetat0: Lecture echouee pour <CLWCON>"  
           stop 1  
        ENDIF  
276      ENDIF      ENDIF
277      xmin = 1.0E+20  
278      xmax = -1.0E+20      ierr = NF90_INQ_VARID(ncid_startphy, "RNEBCON", varid)
279      xmin = MINval(clwcon)      IF (ierr /= NF90_NOERR) THEN
280      xmax = MAXval(clwcon)         PRINT *, "phyetat0: Le champ RNEBCON est absent"
281      PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax         PRINT *, "Depart legerement fausse. Mais je continue"
   
     ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, "phyetat0: Le champ RNEBCON est absent"  
        PRINT*, "Depart legerement fausse. Mais je continue"  
282         rnebcon = 0.         rnebcon = 0.
283      ELSE      ELSE
284         ierr = NF_GET_VAR_REAL(nid, nvarid, rnebcon)         call nf95_get_var(ncid_startphy, varid, rnebcon(:, 1))
285         IF (ierr.NE.NF_NOERR) THEN         rnebcon(:, 2:) = 0.
           PRINT*, "phyetat0: Lecture echouee pour <RNEBCON>"  
           stop 1  
        ENDIF  
     ENDIF  
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(rnebcon)  
     xmax = MAXval(rnebcon)  
     PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax  
   
   
     ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid)  
     IF (ierr.NE.NF_NOERR) THEN  
        PRINT*, "phyetat0: Le champ <QANCIEN> est absent"  
        PRINT*, "Depart legerement fausse. Mais je continue"  
        ancien_ok = .FALSE.  
     ELSE  
        ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien)  
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <QANCIEN>"  
           stop 1  
        ENDIF  
286      ENDIF      ENDIF
287    
288      ! Lecture ratqs      ! Lecture ratqs
289    
290      ierr = NF_INQ_VARID (nid, "RATQS", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "RATQS", varid)
291      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
292         PRINT*, "phyetat0: Le champ <RATQS> est absent"         PRINT *, "phyetat0: Le champ <RATQS> est absent"
293         PRINT*, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
294         ratqs = 0.         ratqs = 0.
295      ELSE      ELSE
296         ierr = NF_GET_VAR_REAL(nid, nvarid, ratqs)         call nf95_get_var(ncid_startphy, varid, ratqs(:, 1))
297         IF (ierr.NE.NF_NOERR) THEN         ratqs(:, 2:) = 0.
           PRINT*, "phyetat0: Lecture echouee pour <RATQS>"  
           stop 1  
        ENDIF  
298      ENDIF      ENDIF
     xmin = 1.0E+20  
     xmax = -1.0E+20  
     xmin = MINval(ratqs)  
     xmax = MAXval(ratqs)  
     PRINT*,'(ecart-type) ratqs:', xmin, xmax  
299    
300      ! Lecture run_off_lic_0      ! Lecture run_off_lic_0
301    
302      ierr = NF_INQ_VARID (nid, "RUNOFFLIC0", nvarid)      ierr = NF90_INQ_VARID(ncid_startphy, "RUNOFFLIC0", varid)
303      IF (ierr.NE.NF_NOERR) THEN      IF (ierr /= NF90_NOERR) THEN
304         PRINT*, "phyetat0: Le champ <RUNOFFLIC0> est absent"         PRINT *, "phyetat0: Le champ <RUNOFFLIC0> est absent"
305         PRINT*, "Depart legerement fausse. Mais je continue"         PRINT *, "Depart legerement fausse. Mais je continue"
306         run_off_lic_0 = 0.         run_off_lic_0 = 0.
307      ELSE      ELSE
308         ierr = NF_GET_VAR_REAL(nid, nvarid, run_off_lic_0)         call nf95_get_var(ncid_startphy, varid, run_off_lic_0)
        IF (ierr.NE.NF_NOERR) THEN  
           PRINT*, "phyetat0: Lecture echouee pour <RUNOFFLIC0>"  
           stop 1  
        ENDIF  
309      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  
310    
311      ! Fermer le fichier:      call nf95_inq_varid(ncid_startphy, "sig1", varid)
312        call nf95_get_var(ncid_startphy, varid, sig1)
313    
314      ierr = NF_CLOSE(nid)      call nf95_inq_varid(ncid_startphy, "w01", varid)
315        call nf95_get_var(ncid_startphy, varid, w01)
316    
317    END SUBROUTINE phyetat0    END SUBROUTINE phyetat0
318    
319      !*********************************************************************
320    
321      subroutine phyetat0_new
322    
323        use nr_util, only: rad_to_deg
324    
325        use dimensions, only: iim, jjm
326        use dynetat0_m, only: rlatu, rlonv
327        use grid_change, only: dyn_phy
328        USE start_init_orog_m, only: mask
329        
330        !-------------------------------------------------------------------------
331        
332        rlat(1) = 90.
333        rlat(2:klon-1) = pack(spread(rlatu(2:jjm), 1, iim), .true.) * rad_to_deg
334        rlat(klon) = - 90.
335    
336        rlon(1) = 0.
337        rlon(2:klon-1) = pack(spread(rlonv(:iim), 2, jjm - 1), .true.) * rad_to_deg
338        rlon(klon) = 0.
339    
340        zmasq = pack(mask, dyn_phy)
341        itau_phy = 0
342    
343      end subroutine phyetat0_new
344    
345  end module phyetat0_m  end module phyetat0_m

Legend:
Removed from v.3  
changed lines
  Added in v.310

  ViewVC Help
Powered by ViewVC 1.1.21