SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire, . rlat,rlon, pctsrf, tsol,tsoil,deltat,qsol,snow, . albe, 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) IMPLICIT none c====================================================================== c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 c Objet: Lecture de l'etat initial pour la physique c====================================================================== #include "dimensions.h" #include "dimphy.h" #include "netcdf.inc" #include "indicesol.h" #include "dimsoil.h" #include "clesphys.h" c====================================================================== CHARACTER*(*) fichnom REAL dtime INTEGER radpas REAL rlat(klon), rlon(klon) REAL co2_ppm REAL solaire REAL tsol(klon,nbsrf) REAL tsoil(klon,nsoilmx,nbsrf) REAL deltat(klon) REAL qsol(klon,nbsrf) REAL snow(klon,nbsrf) REAL albe(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) 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 t_ancien(klon,klev), q_ancien(klon,klev) LOGICAL ancien_ok INTEGER longcles PARAMETER ( longcles = 20 ) REAL clesphy0( longcles ) c REAL xmin, xmax c 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 c c Ouvrir le fichier contenant l'etat initial: c 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 CALL ABORT ENDIF c c Lecture des parametres de controle: c ierr = NF_INQ_VARID (nid, "controle", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ELSE c DO i = 1, length tabcntr0( i ) = tab_cntrl( i ) ENDDO c cycle_diurne = .FALSE. soil_model = .FALSE. new_oliq = .FALSE. ok_orodr = .FALSE. ok_orolf = .FALSE. ok_limitvrai = .FALSE. IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN tab_cntrl( 5 ) = clesphy0(1) ENDIF IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN tab_cntrl( 6 ) = clesphy0(2) ENDIF IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN tab_cntrl( 7 ) = clesphy0(3) ENDIF IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN tab_cntrl( 8 ) = clesphy0(4) ENDIF IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN tab_cntrl( 9 ) = clesphy0( 5 ) ENDIF IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN tab_cntrl( 10 ) = clesphy0( 6 ) ENDIF IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN tab_cntrl( 11 ) = clesphy0( 7 ) ENDIF IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN tab_cntrl( 12 ) = clesphy0( 8 ) ENDIF dtime = tab_cntrl(1) radpas = tab_cntrl(2) co2_ppm = tab_cntrl(3) solaire = 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 c c Lecture des latitudes (coordonnees): c ierr = NF_INQ_VARID (nid, "latitude", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlat) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rlat) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF c c Lecture des longitudes (coordonnees): c ierr = NF_INQ_VARID (nid, "longitude", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlon) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rlon) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF C C C Lecture du masque terre mer C ierr = NF_INQ_VARID (nid, "masque", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmasq) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' PRINT*, 'fichier startphy non compatible avec phyetat0' C CALL abort ENDIF C Lecture des fractions pour chaque sous-surface C C initialisation des sous-surfaces C pctsrf = 0. C C fraction de terre C ierr = NF_INQ_VARID (nid, "FTER", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_ter)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_ter)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' c$$$ CALL abort ENDIF C C fraction de glace de terre C ierr = NF_INQ_VARID (nid, "FLIC", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_lic)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_lic)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' c$$$ CALL abort ENDIF C C fraction d'ocean C ierr = NF_INQ_VARID (nid, "FOCE", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_oce)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon,is_oce)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' c$$$ CALL abort ENDIF C C fraction glace de mer C ierr = NF_INQ_VARID (nid, "FSIC", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, pctsrf(1 : klon,is_sic)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, pctsrf(1 : klon, is_sic)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' c$$$ CALL abort ENDIF C C Verification de l'adequation entre le masque et les sous-surfaces C fractint( 1 : klon) = pctsrf(1 : klon, is_ter) $ + pctsrf(1 : klon, is_lic) DO i = 1 , klon IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN WRITE(*,*) 'phyetat0: attention fraction terre pas ', $ 'coherente ', i, zmasq(i), pctsrf(i, is_ter) $ ,pctsrf(i, is_lic) ENDIF END DO fractint (1 : klon) = pctsrf(1 : klon, is_oce) $ + pctsrf(1 : klon, is_sic) DO i = 1 , klon IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN WRITE(*,*) 'phyetat0 attention fraction ocean pas ', $ 'coherente ', i, zmasq(i) , pctsrf(i, is_oce) $ ,pctsrf(i, is_sic) ENDIF END DO C c Lecture des temperatures du sol: c ierr = NF_INQ_VARID (nid, "TS", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire TS**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "TS"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 est present' PRINT*, ' J ignore donc les autres temperatures TS**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon tsol(i,nsrf) = tsol(i,1) ENDDO ENDDO ENDIF c c Lecture des temperatures du sol profond: c DO nsrf = 1, nbsrf DO isoil=1, nsoilmx IF (isoil.GT.99 .AND. nsrf.GT.99) THEN PRINT*, "Trop de couches ou sous-mailles" CALL abort 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 est absent" PRINT*, " Il prend donc la valeur de surface" DO i=1, klon tsoil(i,isoil,nsrf)=tsol(i,nsrf) ENDDO ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "Lecture echouee pour " CALL abort ENDIF ENDIF ENDDO ENDDO c c Lecture de deltat (pour slab ocean seulement): c ierr = NF_INQ_VARID (nid, "DELTAT", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, deltat) #else ierr = NF_GET_VAR_REAL(nid, nvarid, deltat) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO i = 1, klon xmin = MIN(deltat(i),xmin) xmax = MAX(deltat(i),xmax) ENDDO PRINT*,'Ecart de la SST deltat:', xmin, xmax c c Lecture de l'humidite du sol: c ierr = NF_INQ_VARID (nid, "QS", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire QS**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "QS"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO i = 1, klon xmin = MIN(qsol(i,nsrf),xmin) xmax = MAX(qsol(i,nsrf),xmax) ENDDO PRINT*,'Humidite du sol QS**:', nsrf, xmin, xmax ENDDO ELSE PRINT*, 'phyetat0: Le champ est present' PRINT*, ' J ignore donc les autres humidites QS**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, qsol(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO i = 1, klon xmin = MIN(qsol(i,1),xmin) xmax = MAX(qsol(i,1),xmax) ENDDO PRINT*,'Humidite du sol ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon qsol(i,nsrf) = qsol(i,1) ENDDO ENDDO ENDIF c c Lecture de neige au sol: c ierr = NF_INQ_VARID (nid, "SNOW", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire SNOW**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "SNOW"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 est present' PRINT*, ' J ignore donc les autres neiges SNOW**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon snow(i,nsrf) = snow(i,1) ENDDO ENDDO ENDIF c c Lecture de albedo au sol: c ierr = NF_INQ_VARID (nid, "ALBE", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire ALBE**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "ALBE"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 est present' PRINT*, ' J ignore donc les autres ALBE**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon albe(i,nsrf) = albe(i,1) ENDDO ENDDO ENDIF c c Lecture de evaporation: c ierr = NF_INQ_VARID (nid, "EVAP", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire EVAP**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "EVAP"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 est present' PRINT*, ' J ignore donc les autres EVAP**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, evap(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon evap(i,nsrf) = evap(i,1) ENDDO ENDDO ENDIF c c Lecture precipitation liquide: c ierr = NF_INQ_VARID (nid, "rain_f", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rain_fall) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture precipitation solide: c ierr = NF_INQ_VARID (nid, "snow_f", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, snow_fall) #else ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture rayonnement solaire au sol: c ierr = NF_INQ_VARID (nid, "solsw", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, 'mis a zero' solsw = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw) #else ierr = NF_GET_VAR_REAL(nid, nvarid, solsw) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture rayonnement IF au sol: c ierr = NF_INQ_VARID (nid, "sollw", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, 'mis a zero' sollw = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw) #else ierr = NF_GET_VAR_REAL(nid, nvarid, sollw) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture derive des flux: c ierr = NF_INQ_VARID (nid, "fder", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, 'mis a zero' fder = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, fder) #else ierr = NF_GET_VAR_REAL(nid, nvarid, fder) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture du rayonnement net au sol: c ierr = NF_INQ_VARID (nid, "RADS", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, radsol) #else ierr = NF_GET_VAR_REAL(nid, nvarid, radsol) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c Lecture de la longueur de rugosite c c ierr = NF_INQ_VARID (nid, "RUG", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire RUG**' DO nsrf = 1, nbsrf IF (nsrf.GT.99) THEN PRINT*, "Trop de sous-mailles" CALL abort ENDIF WRITE(str2,'(i2.2)') nsrf ierr = NF_INQ_VARID (nid, "RUG"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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 est present' PRINT*, ' J ignore donc les autres RUG**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, frugs(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,1)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort 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*,'Neige du sol ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon frugs(i,nsrf) = frugs(i,1) ENDDO ENDDO ENDIF c c Lecture de l'age de la neige: c ierr = NF_INQ_VARID (nid, "AGESNO", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' PRINT*, " Valeur par default: 50" DO i = 1, klon agesno(i) = 50.0 ENDDO ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno) #else ierr = NF_GET_VAR_REAL(nid, nvarid, agesno) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO i = 1, klon xmin = MIN(agesno(i),xmin) xmax = MAX(agesno(i),xmax) ENDDO PRINT*,'Age de la neige agesno:', xmin, xmax ENDIF c c ierr = NF_INQ_VARID (nid, "ZMEA", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmea) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zmea) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "ZSTD", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zstd) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zstd) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "ZSIG", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zsig) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zsig) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "ZGAM", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zgam) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zgam) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "ZTHE", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zthe) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zthe) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "ZPIC", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zpic) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zpic) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c ierr = NF_INQ_VARID (nid, "ZVAL", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zval) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zval) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ierr = NF_INQ_VARID (nid, "RUGSREL", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rugsrel) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort 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 c c ancien_ok = .TRUE. c ierr = NF_INQ_VARID (nid, "TANCIEN", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" ancien_ok = .FALSE. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien) #else ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF c ierr = NF_INQ_VARID (nid, "QANCIEN", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" ancien_ok = .FALSE. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien) #else ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF c c Fermer le fichier: c ierr = NF_CLOSE(nid) c RETURN END