! ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phyetat0.F,v 1.2 2004/06/22 11:45:33 lmdzadmin Exp $ ! c c SUBROUTINE phyetat0 (fichnom,dtime, . rlat,rlon, tsol,tsoil, . albe, solsw, sollw, . fder,radsol, . zmea, zstd, zsig, zgam, zthe, zpic, zval, . tabcntr0, . t_ancien,ancien_ok) use dimphy 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 "netcdf.inc" #include "dimsoil.h" #include "clesphys.h" #include "temps.h" c====================================================================== CHARACTER*(*) fichnom REAL dtime INTEGER radpas REAL rlat(klon), rlon(klon) REAL tsol(klon) REAL tsoil(klon,nsoilmx) REAL albe(klon) cIM BEG alblw REAL alblw(klon) cIM END alblw REAL radsol(klon) REAL sollw(klon) real solsw(klon) real fder(klon) REAL zmea(klon), zstd(klon) REAL zsig(klon), zgam(klon), zthe(klon) REAL zpic(klon), zval(klon) REAL t_ancien(klon,klev) LOGICAL ancien_ok REAL xmin, xmax c INTEGER nid, nvarid INTEGER ierr, i, nsrf, isoil INTEGER length PARAMETER (length=100) REAL tab_cntrl(length), tabcntr0(length) 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 dtime = tab_cntrl(1) radpas = tab_cntrl(2) ENDIF itau_phy = tab_cntrl(15) 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 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*, "phyetat0: Lecture echouee pour " CALL abort ELSE PRINT*, 'phyetat0: Le champ est present' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsol(1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(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),xmin) xmax = MAX(tsol(i),xmax) ENDDO PRINT*,'Temperature du sol ', xmin, xmax ENDIF c c Lecture des temperatures du sol profond: c DO isoil=1, nsoilmx IF (isoil.GT.99) THEN PRINT*, "Trop de couches" CALL abort ENDIF WRITE(str2,'(i2.2)') isoil ierr = NF_INQ_VARID (nid, 'Tsoil'//str2, 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)=tsol(i) ENDDO ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tsoil(1,isoil)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "Lecture echouee pour " CALL abort ENDIF ENDIF ENDDO 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*, "phyetat0: Lecture echouee pour " CALL abort ELSE PRINT*, 'phyetat0: Le champ est present' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, albe(1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, albe(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),xmin) xmax = MAX(albe(i),xmax) ENDDO PRINT*,'Albedo du sol ', xmin, xmax ENDIF 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 c Lecture de l'orographie sous-maille si ok_orodr: c if(ok_orodr) then 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 else zmea = 0. zstd = 0. zsig = 0. zgam = 0. zthe = 0. zpic = 0. zval = 0. endif ! fin test sur ok_orodr c c Lecture de TANCIEN: 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 c Fermer le fichier: c ierr = NF_CLOSE(nid) c RETURN END