--- trunk/libf/phylmd/phyetat0.f90 2011/04/08 12:43:31 43 +++ trunk/phylmd/phyetat0.f90 2019/06/13 14:40:06 328 @@ -4,991 +4,343 @@ IMPLICIT none - REAL, save:: rlat(klon), rlon(klon) ! latitude and longitude, in degrees + REAL, save, protected:: rlat(klon), rlon(klon) + ! latitude and longitude of a point of the scalar grid identified + ! by a simple index, in degrees + + integer, save, protected:: itau_phy + REAL, save, protected:: masque(KLON) ! fraction of land private klon contains - SUBROUTINE phyetat0(fichnom, pctsrf, tsol,tsoil, ocean, tslab,seaice, & - qsurf,qsol,snow, & - albe, alblw, evap, rain_fall, snow_fall, solsw, sollw, & - fder,radsol,frugs,agesno, & - zmea,zstd,zsig,zgam,zthe,zpic,zval, & - 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 - ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 - ! Objet: Lecture de l'etat initial pour la physique + SUBROUTINE phyetat0(pctsrf, ftsol, ftsoil, qsurf, qsol, snow, albe, & + rain_fall, snow_fall, solsw, sollw, fder, radsol, frugs, agesno, zmea, & + zstd, zsig, zgam, zthe, zpic, zval, t_ancien, q_ancien, ancien_ok, & + rnebcon, ratqs, clwcon, run_off_lic_0, sig1, w01, ncid_startphy) + + ! From phylmd/phyetat0.F, version 1.4 2005/06/03 10:03:07 + ! Author: Z.X. Li (LMD/CNRS) + ! Date: 1993/08/18 + ! Objet : lecture de l'état initial pour la physique - USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf + USE conf_gcm_m, ONLY: raz_date + use dimphy, only: klev USE dimsoil, ONLY : nsoilmx - USE temps, ONLY : itau_phy - use netcdf, only: nf90_get_att, nf90_global, nf90_inq_varid, NF90_NOERR - use netcdf95, only: handle_err, nf95_get_var - use dimphy, only: zmasq, klev - - include "netcdf.inc" - - CHARACTER(len=*) fichnom - 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) + USE indicesol, ONLY : epsfra, is_lic, is_oce, is_sic, is_ter, nbsrf + use netcdf, only: nf90_global, nf90_inq_varid, NF90_NOERR, NF90_NOWRITE + use netcdf95, only: nf95_get_att, nf95_get_var, nf95_inq_varid, & + nf95_inquire_variable, NF95_OPEN + + REAL, intent(out):: pctsrf(:, :) ! (klon, nbsrf) + REAL, intent(out):: ftsol(klon, nbsrf) + REAL, intent(out):: ftsoil(klon, nsoilmx, nbsrf) + REAL, intent(out):: qsurf(klon, nbsrf) + + REAL, intent(out):: qsol(:) + ! (klon) column-density of water in soil, in kg m-2 + + REAL, intent(out):: snow(klon, nbsrf) + REAL, intent(out):: albe(klon, nbsrf) + REAL, intent(out):: rain_fall(klon) + REAL, intent(out):: snow_fall(klon) + real, intent(out):: solsw(klon) + REAL, intent(out):: sollw(klon) + real, intent(out):: fder(klon) + REAL, intent(out):: radsol(klon) + REAL, intent(out):: frugs(klon, nbsrf) + REAL, intent(out):: agesno(klon, nbsrf) + REAL, intent(out):: zmea(klon) REAL, intent(out):: zstd(klon) REAL, intent(out):: zsig(klon) - REAL zgam(klon) - REAL zthe(klon) - REAL zpic(klon) - REAL zval(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(len=*), intent(in):: ocean - - REAL xmin, xmax - - INTEGER nid, nvarid - INTEGER ierr, i, nsrf, isoil - CHARACTER*7 str7 - CHARACTER*2 str2 + REAL, intent(out):: zgam(klon) + REAL, intent(out):: zthe(klon) + REAL, intent(out):: zpic(klon) + REAL, intent(out):: zval(klon) + REAL, intent(out):: t_ancien(klon, klev), q_ancien(klon, klev) + LOGICAL, intent(out):: ancien_ok + real, intent(out):: rnebcon(klon, klev), ratqs(klon, klev) + REAL, intent(out):: clwcon(klon, klev), run_off_lic_0(klon) + real, intent(out):: sig1(klon, klev) ! section adiabatic updraft + + real, intent(out):: w01(klon, klev) + ! vertical velocity within adiabatic updraft + + integer, intent(out):: ncid_startphy + + ! Local: + INTEGER varid, ndims + INTEGER ierr, i !--------------------------------------------------------------- print *, "Call sequence information: phyetat0" - ! Ouvrir le fichier contenant l'etat initial: + ! Fichier contenant l'état initial : + call NF95_OPEN("startphy.nc", NF90_NOWRITE, ncid_startphy) - print *, 'fichnom = ', fichnom - ierr = NF_OPEN (fichnom, NF_NOWRITE,nid) - IF (ierr.NE.NF90_NOERR) THEN - write(6,*)' Pb d''ouverture du fichier '//fichnom - write(6,*)' ierr = ', ierr - STOP 1 - ENDIF - - ierr = nf90_get_att(nid, nf90_global, "itau_phy", itau_phy) - call handle_err("phyetat0 itau_phy", ierr, nid, nf90_global) + IF (raz_date) then + itau_phy = 0 + else + call nf95_get_att(ncid_startphy, nf90_global, "itau_phy", itau_phy) + end IF ! Lecture des latitudes (coordonnees): - ierr = NF90_INQ_VARID (nid, "latitude", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, rlat) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - stop 1 - ENDIF + call NF95_INQ_VARID(ncid_startphy, "latitude", varid) + call NF95_GET_VAR(ncid_startphy, varid, rlat) ! Lecture des longitudes (coordonnees): - ierr = NF90_INQ_VARID (nid, "longitude", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, rlon) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - stop 1 - ENDIF - + call NF95_INQ_VARID(ncid_startphy, "longitude", varid) + call NF95_GET_VAR(ncid_startphy, varid, rlon) ! Lecture du masque terre mer - ierr = NF90_INQ_VARID (nid, "masque", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, zmasq) - else - PRINT *, 'phyetat0: Le champ est absent' - PRINT *, 'fichier startphy non compatible avec phyetat0' - ! stop 1 - ENDIF + call NF95_INQ_VARID(ncid_startphy, "masque", varid) + call nf95_get_var(ncid_startphy, varid, masque) + ! Lecture des fractions pour chaque sous-surface ! initialisation des sous-surfaces - pctsrf = 0. - - ! fraction de terre - - ierr = NF90_INQ_VARID (nid, "FTER", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, pctsrf(1 : klon,is_ter)) - else - PRINT *, 'phyetat0: Le champ est absent' - !$$$ stop 1 - ENDIF - - ! fraction de glace de terre - - ierr = NF90_INQ_VARID (nid, "FLIC", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, pctsrf(1 : klon,is_lic)) - else - PRINT *, 'phyetat0: Le champ est absent' - !$$$ stop 1 - ENDIF - - ! fraction d'ocean - - ierr = NF90_INQ_VARID (nid, "FOCE", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, pctsrf(1 : klon,is_oce)) - else - PRINT *, 'phyetat0: Le champ est absent' - !$$$ stop 1 - ENDIF + call NF95_INQ_VARID(ncid_startphy, "pctsrf", varid) + call nf95_get_var(ncid_startphy, varid, pctsrf) - ! fraction glace de mer + ! Verification de l'adequation entre le masque et les sous-surfaces - ierr = NF90_INQ_VARID (nid, "FSIC", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, pctsrf(1 : klon, is_sic)) - else - PRINT *, 'phyetat0: Le champ 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) 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) + IF (abs(pctsrf(i, is_ter) + pctsrf(i, is_lic) - masque(i)) > EPSFRA) THEN + print *, & + 'phyetat0: pctsrf does not agree with masque for continents', & + i, masque(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) + IF (abs(pctsrf(i, is_oce) + pctsrf(i, is_sic) - (1. - masque(i))) & + > EPSFRA) THEN + print *, 'phyetat0: pctsrf does not agree with masque for ocean ', & + 'and sea-ice', i, masque(i) , pctsrf(i, is_oce), & + pctsrf(i, is_sic) ENDIF END DO ! Lecture des temperatures du sol: - - ierr = NF90_INQ_VARID (nid, "TS", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "TS"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, tsol(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres temperatures TS**' - call nf95_get_var(nid, nvarid, tsol(:,1)) - 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 + call NF95_INQ_VARID(ncid_startphy, "TS", varid) + call nf95_inquire_variable(ncid_startphy, varid, ndims = ndims) + if (ndims == 2) then + call NF95_GET_VAR(ncid_startphy, varid, ftsol) + else + print *, "Found only one surface type for soil temperature." + call nf95_get_var(ncid_startphy, varid, ftsol(:, 1)) + ftsol(:, 2:nbsrf) = spread(ftsol(:, 1), dim = 2, ncopies = nbsrf - 1) + end if ! Lecture des temperatures du sol profond: - DO nsrf = 1, nbsrf - DO isoil=1, nsoilmx - 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 = NF90_INQ_VARID (nid, 'Tsoil'//str7, nvarid) - IF (ierr.NE.NF90_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 - ierr = NF_GET_VAR_REAL(nid, nvarid, tsoil(1,isoil,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "Lecture echouee pour " - stop 1 - ENDIF - ENDIF - ENDDO - ENDDO - - !IM "slab" ocean - - ! Lecture de tslab (pour slab ocean seulement): - - IF (ocean .eq. 'slab ') then - ierr = NF90_INQ_VARID (nid, "TSLAB", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - call nf95_get_var(nid, nvarid, tslab) - xmin = 1.0E+20 - xmax = -1.0E+20 - DO i = 1, klon - xmin = MIN(tslab(i),xmin) - xmax = MAX(tslab(i),xmax) - ENDDO - PRINT *,'Ecart de la SST tslab:', xmin, xmax - - ! Lecture de seaice (pour slab ocean seulement): - - ierr = NF90_INQ_VARID (nid, "SEAICE", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - call nf95_get_var(nid, nvarid, seaice) - xmin = 1.0E+20 - xmax = -1.0E+20 - DO i = 1, klon - xmin = MIN(seaice(i),xmin) - xmax = MAX(seaice(i),xmax) - ENDDO - PRINT *,'Masse de la glace de mer seaice:', xmin, xmax - ELSE - tslab = 0. - seaice = 0. - ENDIF + call NF95_INQ_VARID(ncid_startphy, 'Tsoil', varid) + call NF95_GET_VAR(ncid_startphy, varid, ftsoil) ! Lecture de l'humidite de l'air juste au dessus du sol: - ierr = NF90_INQ_VARID (nid, "QS", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "QS"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres humidites QS**' - call nf95_get_var(nid, nvarid, qsurf(:,1)) - 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 ', xmin, xmax - DO nsrf = 2, nbsrf - DO i = 1, klon - qsurf(i,nsrf) = qsurf(i,1) - ENDDO - ENDDO - ENDIF - - ! Eau dans le sol (pour le modele de sol "bucket") + call NF95_INQ_VARID(ncid_startphy, "QS", varid) + call nf95_get_var(ncid_startphy, varid, qsurf) - ierr = NF90_INQ_VARID(nid, "QSOL", nvarid) - IF (ierr == NF90_NOERR) THEN - call nf95_get_var(nid, nvarid, qsol) + ierr = NF90_INQ_VARID(ncid_startphy, "QSOL", varid) + IF (ierr == NF90_NOERR) THEN + call nf95_get_var(ncid_startphy, varid, qsol) else PRINT *, 'phyetat0: Le champ est absent' - PRINT *, ' Valeur par defaut nulle' + PRINT *, ' Valeur par defaut nulle' qsol = 0. 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) ', xmin, xmax ! Lecture de neige au sol: - ierr = NF90_INQ_VARID (nid, "SNOW", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "SNOW"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, snow(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres neiges SNOW**' - call nf95_get_var(nid, nvarid, snow(:,1)) - 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 + call NF95_INQ_VARID(ncid_startphy, "SNOW", varid) + call nf95_get_var(ncid_startphy, varid, snow) ! Lecture de albedo au sol: - ierr = NF90_INQ_VARID (nid, "ALBE", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "ALBE"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, albe(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres ALBE**' - call nf95_get_var(nid, nvarid, albe(:,1)) - 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 - - - ! Lecture de albedo au sol LW: - - ierr = NF90_INQ_VARID (nid, "ALBLW", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ 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 est present' - PRINT *, ' J ignore donc les autres ALBLW**' - call nf95_get_var(nid, nvarid, alblw(:,1)) - 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 ', xmin, xmax - DO nsrf = 2, nbsrf - DO i = 1, klon - alblw(i,nsrf) = alblw(i,1) - ENDDO - ENDDO - ENDIF - - ! Lecture de evaporation: - - ierr = NF90_INQ_VARID (nid, "EVAP", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "EVAP"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, evap(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres EVAP**' - call nf95_get_var(nid, nvarid, evap(:,1)) - 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 + call NF95_INQ_VARID(ncid_startphy, "ALBE", varid) + call nf95_get_var(ncid_startphy, varid, albe) ! Lecture precipitation liquide: - ierr = NF90_INQ_VARID (nid, "rain_f", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "rain_f", varid) + call NF95_GET_VAR(ncid_startphy, varid, rain_fall) ! Lecture precipitation solide: - ierr = NF90_INQ_VARID (nid, "snow_f", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "snow_f", varid) + call NF95_GET_VAR(ncid_startphy, varid, snow_fall) ! Lecture rayonnement solaire au sol: - ierr = NF90_INQ_VARID (nid, "solsw", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "solsw", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, 'phyetat0: Le champ est absent' PRINT *, 'mis a zero' solsw = 0. ELSE - call nf95_get_var(nid, nvarid, solsw) + call nf95_get_var(ncid_startphy, varid, solsw) 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 ! Lecture rayonnement IF au sol: - ierr = NF90_INQ_VARID (nid, "sollw", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "sollw", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, 'phyetat0: Le champ est absent' PRINT *, 'mis a zero' sollw = 0. ELSE - call nf95_get_var(nid, nvarid, sollw) + call nf95_get_var(ncid_startphy, varid, sollw) 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 - ! Lecture derive des flux: - ierr = NF90_INQ_VARID (nid, "fder", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "fder", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, 'phyetat0: Le champ est absent' PRINT *, 'mis a zero' fder = 0. ELSE - call nf95_get_var(nid, nvarid, fder) + call nf95_get_var(ncid_startphy, varid, fder) 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 - ! Lecture du rayonnement net au sol: - ierr = NF90_INQ_VARID (nid, "RADS", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, radsol) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "RADS", varid) + call NF95_GET_VAR(ncid_startphy, varid, radsol) ! Lecture de la longueur de rugosite - - ierr = NF90_INQ_VARID (nid, "RUG", nvarid) - IF (ierr.NE.NF90_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" - stop 1 - ENDIF - WRITE(str2,'(i2.2)') nsrf - ierr = NF90_INQ_VARID (nid, "RUG"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, frugs(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres RUG**' - call nf95_get_var(nid, nvarid, frugs(:,1)) - 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 ', xmin, xmax - DO nsrf = 2, nbsrf - DO i = 1, klon - frugs(i,nsrf) = frugs(i,1) - ENDDO - ENDDO - ENDIF - + call NF95_INQ_VARID(ncid_startphy, "RUG", varid) + call nf95_get_var(ncid_startphy, varid, frugs) ! Lecture de l'age de la neige: - ierr = NF90_INQ_VARID (nid, "AGESNO", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ 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 = NF90_INQ_VARID (nid, "AGESNO"//str2, nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - agesno = 50.0 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(1,nsrf)) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Lecture echouee pour " - 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 est present' - PRINT *, ' J ignore donc les autres AGESNO**' - call nf95_get_var(nid, nvarid, agesno(:,1)) - 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 ', xmin, xmax - DO nsrf = 2, nbsrf - DO i = 1, klon - agesno(i,nsrf) = agesno(i,1) - ENDDO - ENDDO - ENDIF - - - ierr = NF90_INQ_VARID (nid, "ZMEA", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zmea) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 - - - ierr = NF90_INQ_VARID (nid, "ZSTD", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zstd) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 - + call NF95_INQ_VARID(ncid_startphy, "AGESNO", varid) + call nf95_get_var(ncid_startphy, varid, agesno) - ierr = NF90_INQ_VARID (nid, "ZSIG", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zsig) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "ZMEA", varid) + call NF95_GET_VAR(ncid_startphy, varid, zmea) + call NF95_INQ_VARID(ncid_startphy, "ZSTD", varid) + call NF95_GET_VAR(ncid_startphy, varid, zstd) - ierr = NF90_INQ_VARID (nid, "ZGAM", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zgam) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "ZSIG", varid) + call NF95_GET_VAR(ncid_startphy, varid, zsig) + call NF95_INQ_VARID(ncid_startphy, "ZGAM", varid) + call NF95_GET_VAR(ncid_startphy, varid, zgam) - ierr = NF90_INQ_VARID (nid, "ZTHE", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zthe) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "ZTHE", varid) + call NF95_GET_VAR(ncid_startphy, varid, zthe) + call NF95_INQ_VARID(ncid_startphy, "ZPIC", varid) + call NF95_GET_VAR(ncid_startphy, varid, zpic) - ierr = NF90_INQ_VARID (nid, "ZPIC", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zpic) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 = NF90_INQ_VARID (nid, "ZVAL", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Le champ est absent' - stop 1 - ENDIF - ierr = NF_GET_VAR_REAL(nid, nvarid, zval) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, 'phyetat0: Lecture echouee pour ' - 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 + call NF95_INQ_VARID(ncid_startphy, "ZVAL", varid) + call NF95_GET_VAR(ncid_startphy, varid, zval) ancien_ok = .TRUE. - ierr = NF90_INQ_VARID (nid, "TANCIEN", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "TANCIEN", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ est absent" PRINT *, "Depart legerement fausse. Mais je continue" ancien_ok = .FALSE. ELSE - call nf95_get_var(nid, nvarid, t_ancien) + call nf95_get_var(ncid_startphy, varid, t_ancien) ENDIF - ierr = NF90_INQ_VARID (nid, "QANCIEN", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "QANCIEN", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ est absent" PRINT *, "Depart legerement fausse. Mais je continue" ancien_ok = .FALSE. ELSE - call nf95_get_var(nid, nvarid, q_ancien) + call nf95_get_var(ncid_startphy, varid, q_ancien) ENDIF - ierr = NF90_INQ_VARID (nid, "CLWCON", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "CLWCON", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ CLWCON est absent" PRINT *, "Depart legerement fausse. Mais je continue" clwcon = 0. ELSE - call nf95_get_var(nid, nvarid, clwcon) + call nf95_get_var(ncid_startphy, varid, clwcon(:, 1)) + clwcon(:, 2:) = 0. ENDIF - xmin = 1.0E+20 - xmax = -1.0E+20 - xmin = MINval(clwcon) - xmax = MAXval(clwcon) - PRINT *,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax - ierr = NF90_INQ_VARID (nid, "RNEBCON", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "RNEBCON", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ RNEBCON est absent" PRINT *, "Depart legerement fausse. Mais je continue" rnebcon = 0. ELSE - call nf95_get_var(nid, nvarid, rnebcon) - ENDIF - xmin = 1.0E+20 - xmax = -1.0E+20 - xmin = MINval(rnebcon) - xmax = MAXval(rnebcon) - PRINT *,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax - - - ierr = NF90_INQ_VARID (nid, "QANCIEN", nvarid) - IF (ierr.NE.NF90_NOERR) THEN - PRINT *, "phyetat0: Le champ est absent" - PRINT *, "Depart legerement fausse. Mais je continue" - ancien_ok = .FALSE. - ELSE - call nf95_get_var(nid, nvarid, q_ancien) + call nf95_get_var(ncid_startphy, varid, rnebcon(:, 1)) + rnebcon(:, 2:) = 0. ENDIF ! Lecture ratqs - ierr = NF90_INQ_VARID (nid, "RATQS", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "RATQS", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ est absent" PRINT *, "Depart legerement fausse. Mais je continue" ratqs = 0. ELSE - call nf95_get_var(nid, nvarid, ratqs) + call nf95_get_var(ncid_startphy, varid, ratqs(:, 1)) + ratqs(:, 2:) = 0. ENDIF - xmin = 1.0E+20 - xmax = -1.0E+20 - xmin = MINval(ratqs) - xmax = MAXval(ratqs) - PRINT *,'(ecart-type) ratqs:', xmin, xmax ! Lecture run_off_lic_0 - ierr = NF90_INQ_VARID (nid, "RUNOFFLIC0", nvarid) - IF (ierr.NE.NF90_NOERR) THEN + ierr = NF90_INQ_VARID(ncid_startphy, "RUNOFFLIC0", varid) + IF (ierr /= NF90_NOERR) THEN PRINT *, "phyetat0: Le champ est absent" PRINT *, "Depart legerement fausse. Mais je continue" run_off_lic_0 = 0. ELSE - call nf95_get_var(nid, nvarid, run_off_lic_0) + call nf95_get_var(ncid_startphy, varid, run_off_lic_0) 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 - ! Fermer le fichier: + call nf95_inq_varid(ncid_startphy, "sig1", varid) + call nf95_get_var(ncid_startphy, varid, sig1) - ierr = NF_CLOSE(nid) + call nf95_inq_varid(ncid_startphy, "w01", varid) + call nf95_get_var(ncid_startphy, varid, w01) END SUBROUTINE phyetat0 + !********************************************************************* + + subroutine phyetat0_new + + use nr_util, only: rad_to_deg + + use dimensions, only: iim, jjm + use dynetat0_m, only: rlatu, rlonv + use grid_change, only: dyn_phy + USE start_init_orog_m, only: mask + + !------------------------------------------------------------------------- + + rlat(1) = 90. + rlat(2:klon-1) = pack(spread(rlatu(2:jjm), 1, iim), .true.) * rad_to_deg + rlat(klon) = - 90. + + rlon(1) = 0. + rlon(2:klon-1) = pack(spread(rlonv(:iim), 2, jjm - 1), .true.) * rad_to_deg + rlon(klon) = 0. + + masque = pack(mask, dyn_phy) + itau_phy = 0 + + end subroutine phyetat0_new + end module phyetat0_m