SUBROUTINE phyetat0 (fichnom,dtime,co2_ppm,solaire, . rlat,rlon, pctsrf, tsol,tsoil,deltat,qsol,snow, . albe, evap, rain_fall, snow_fall, solsw, sollw, . 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 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(snow(i,nsrf),xmin) xmax = MAX(snow(i,nsrf),xmax) ENDDO PRINT*,'Neige 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 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*,'evap 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