! ! $Header$ ! c c SUBROUTINE phyetat0 (fichnom, . ocean_in, ok_veget_in, . clesphy0, . tabcntr0) USE dimphy USE mod_grid_phy_lmdz USE mod_phys_lmdz_para USE iophy USE ocean_slab_mod, ONLY : ocean_slab_init USE ocean_cpl_mod, ONLY : ocean_cpl_init USE ocean_forced_mod, ONLY : ocean_forced_init USE fonte_neige_mod, ONLY : fonte_neige_init USE pbl_surface_mod, ONLY : pbl_surface_init USE surface_data, ONLY : ocean, ok_veget USE phys_state_var_mod 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 "indicesol.h" #include "dimsoil.h" #include "clesphys.h" #include "temps.h" #include "thermcell.h" #include "compbl.h" c====================================================================== CHARACTER*(*) fichnom c les variables globales lues dans le fichier restart REAL rlat_glo(klon_glo), rlon_glo(klon_glo) REAL pctsrf_glo(klon_glo, nbsrf) REAL tsol_glo(klon_glo,nbsrf) REAL alb1_glo(klon_glo,nbsrf) REAL alb2_glo(klon_glo,nbsrf) REAL rain_fall_glo(klon_glo) REAL snow_fall_glo(klon_glo) real solsw_glo(klon_glo) real sollw_glo(klon_glo) REAL radsol_glo(klon_glo) REAL zmea_glo(klon_glo) REAL zstd_glo(klon_glo) REAL zsig_glo(klon_glo) REAL zgam_glo(klon_glo) REAL zthe_glo(klon_glo) REAL zpic_glo(klon_glo) REAL zval_glo(klon_glo) REAL rugsrel_glo(klon_glo) REAL t_ancien_glo(klon_glo,klev), q_ancien_glo(klon_glo,klev) REAL clwcon_glo(klon_glo,klev) REAL rnebcon_glo(klon_glo,klev) REAL ratqs_glo(klon_glo,klev) REAL pbl_tke_glo(klon_glo,klev+1,nbsrf) REAL zmax0_glo(klon_glo), f0_glo(klon) REAL ema_work1_glo(klon_glo, klev), ema_work2_glo(klon_glo, klev) REAL wake_deltat_glo(klon_glo,klev) REAL wake_deltaq_glo(klon_glo,klev) REAL wake_s_glo(klon_glo), wake_cstar_glo(klon_glo) REAL wake_fip_glo(klon_glo) REAL tsoil_p(klon,nsoilmx,nbsrf) REAL tslab_p(klon), seaice_p(klon) REAL qsurf_p(klon,nbsrf) REAL qsol_p(klon) REAL snow_p(klon,nbsrf) REAL evap_p(klon,nbsrf) real fder_p(klon) REAL frugs_p(klon,nbsrf) REAL agesno_p(klon,nbsrf) REAL run_off_lic_0_p(klon) LOGICAL,SAVE :: ancien_ok_glo !$OMP THREADPRIVATE(ancien_ok_glo) REAL zmasq_glo(klon_glo) REAL tsoil(klon_glo,nsoilmx,nbsrf) cIM "slab" ocean REAL tslab(klon_glo), seaice(klon_glo) REAL qsurf(klon_glo,nbsrf) REAL qsol(klon_glo) REAL snow(klon_glo,nbsrf) REAL evap(klon_glo,nbsrf) real fder(klon_glo) REAL frugs(klon_glo,nbsrf) REAL agesno(klon_glo,nbsrf) REAL fractint(klon_glo) REAL run_off_lic_0(klon_glo) CHARACTER*6 ocean_in LOGICAL ok_veget_in INTEGER longcles PARAMETER ( longcles = 20 ) REAL clesphy0( longcles ) c REAL xmin, xmax c INTEGER nid, nvarid INTEGER ierr, i, nsrf, isoil ,k INTEGER length PARAMETER (length=100) REAL tab_cntrl(length), tabcntr0(length) REAL,SAVE :: tab_cntrl_omp(length) CHARACTER*7 str7 CHARACTER*2 str2 c FH1D c real iolat(jjm+1) real iolat(jjm+1-1/iim) c c Ouvrir le fichier contenant l'etat initial: c c$OMP MASTER print *,'MASTER -x , omp_rank=',omp_rank c$OMP END MASTER c$OMP MASTER IF (is_mpi_root) THEN 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 ENDIF c$OMP END MASTER c c Lecture des parametres de controle: c c$OMP MASTER IF (is_mpi_root) THEN 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 ENDIF ENDIF c$OMP END MASTER CALL bcast(tab_cntrl) c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique ! Les constantes de la physiques sont lues dans la physique seulement. ! Les egalites du type ! tab_cntrl( 5 )=clesphy0(1) ! sont remplacees par ! clesphy0(1)=tab_cntrl( 5 ) ! On inverse aussi la logique. ! On remplit les tab_cntrl avec les parametres lus dans les .def !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DO i = 1, length tabcntr0( i ) = tab_cntrl( i ) ENDDO c tab_cntrl(1)=dtime tab_cntrl(2)=radpas co2_ppm_etat0 = tab_cntrl(3) solaire_etat0 = tab_cntrl(4) tab_cntrl(5)=iflag_con tab_cntrl(6)=nbapp_rad if (cycle_diurne) tab_cntrl( 7) =1. if (soil_model) tab_cntrl( 8) =1. if (new_oliq) tab_cntrl( 9) =1. if (ok_orodr) tab_cntrl(10) =1. if (ok_orolf) tab_cntrl(11) =1. if (ok_limitvrai) tab_cntrl(12) =1. itau_phy = tab_cntrl(15) IF( clesphy0(1).NE.tab_cntrl( 5 ) ) THEN clesphy0(1)=tab_cntrl( 5 ) ENDIF IF( clesphy0(2).NE.tab_cntrl( 6 ) ) THEN clesphy0(2)=tab_cntrl( 6 ) ENDIF IF( clesphy0(3).NE.tab_cntrl( 7 ) ) THEN clesphy0(3)=tab_cntrl( 7 ) ENDIF IF( clesphy0(4).NE.tab_cntrl( 8 ) ) THEN clesphy0(4)=tab_cntrl( 8 ) ENDIF IF( clesphy0(5).NE.tab_cntrl( 9 ) ) THEN clesphy0(5)=tab_cntrl( 9 ) ENDIF IF( clesphy0(6).NE.tab_cntrl( 10 ) ) THEN clesphy0(6)=tab_cntrl( 10 ) ENDIF IF( clesphy0(7).NE.tab_cntrl( 11 ) ) THEN clesphy0(7)=tab_cntrl( 11 ) ENDIF IF( clesphy0(8).NE.tab_cntrl( 12 ) ) THEN clesphy0(8)=tab_cntrl( 12 ) ENDIF c c Lecture des latitudes (coordonnees): c c$OMP MASTER IF (is_mpi_root) THEN 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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rlat_glo) #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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rlon_glo) #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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zmasq_glo) #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_glo(1 : klon_glo,is_ter)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, . pctsrf_glo(1 : klon_glo,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_glo(1 : klon_glo,is_lic)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, . pctsrf_glo(1 : klon_glo,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_glo(1 : klon_glo,is_oce)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, . pctsrf_glo(1 : klon_glo,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_glo(1 : klon_glo,is_sic)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, . pctsrf_glo(1 : klon_glo, 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_glo) = pctsrf_glo(1 : klon_glo, is_ter) $ + pctsrf_glo(1 : klon_glo, is_lic) DO i = 1 , klon_glo IF ( abs(fractint(i) - zmasq_glo(i) ) .GT. EPSFRA ) THEN WRITE(*,*) 'phyetat0: attention fraction terre pas ', $ 'coherente ', i, zmasq_glo(i), pctsrf_glo(i, is_ter) $ ,pctsrf_glo(i, is_lic) ENDIF END DO fractint (1 : klon_glo) = pctsrf_glo(1 : klon_glo, is_oce) $ + pctsrf_glo(1 : klon_glo, is_sic) DO i = 1 , klon_glo IF ( abs( fractint(i) - (1. - zmasq_glo(i))) .GT. EPSFRA ) THEN WRITE(*,*) 'phyetat0 attention fraction ocean pas ', $ 'coherente ', i, zmasq_glo(i) , pctsrf_glo(i, is_oce) $ ,pctsrf_glo(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_glo(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsol_glo(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_glo xmin = MIN(tsol_glo(i,nsrf),xmin) xmax = MAX(tsol_glo(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_glo(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tsol_glo(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_glo xmin = MIN(tsol_glo(i,1),xmin) xmax = MAX(tsol_glo(i,1),xmax) ENDDO PRINT*,'Temperature du sol ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon_glo tsol_glo(i,nsrf) = tsol_glo(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_glo tsoil(i,isoil,nsrf)=tsol_glo(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 cIM "slab" ocean c c Lecture de tslab (pour slab ocean seulement): c IF (ocean_in .eq. 'slab ') then ierr = NF_INQ_VARID (nid, "TSLAB", 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, tslab) #else ierr = NF_GET_VAR_REAL(nid, nvarid, tslab) #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_glo xmin = MIN(tslab(i),xmin) xmax = MAX(tslab(i),xmax) ENDDO PRINT*,'Min, Max tslab (utilise si OCEAN=slab )', xmin, xmax c c Lecture de seaice (pour slab ocean seulement): c ierr = NF_INQ_VARID (nid, "SEAICE", 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, seaice) #else ierr = NF_GET_VAR_REAL(nid, nvarid, seaice) #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_glo xmin = MIN(seaice(i),xmin) xmax = MAX(seaice(i),xmax) ENDDO PRINT*,'Masse de la glace de mer (utilise si OCEAN=slab)', $ xmin, xmax ELSE tslab = 0. seaice = 0. ENDIF c c Lecture de l'humidite de l'air juste au dessus 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, qsurf(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(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_glo 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**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsurf(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, qsurf(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_glo 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_glo qsurf(i,nsrf) = qsurf(i,1) ENDDO ENDDO ENDIF C C Eau dans le sol (pour le modele de sol "bucket") C ierr = NF_INQ_VARID (nid, "QSOL", nvarid) IF (ierr .EQ. NF_NOERR) THEN #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, qsol) #else ierr = NF_GET_VAR_REAL(nid, nvarid, qsol) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Lecture echouee pour ' CALL abort ENDIF else PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Valeur par defaut nulle' qsol(:)=0. c@$$ CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO i = 1, klon_glo xmin = MIN(qsol(i),xmin) xmax = MAX(qsol(i),xmax) ENDDO PRINT*,'Eau dans le sol (mm) ', xmin, xmax 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_glo 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_glo 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_glo snow(i,nsrf) = snow(i,1) ENDDO ENDDO ENDIF c c Lecture de albedo de l'interval visible 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, alb1_glo(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, alb1_glo(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_glo xmin = MIN(alb1_glo(i,nsrf),xmin) xmax = MAX(alb1_glo(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, alb1_glo(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, alb1_glo(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_glo xmin = MIN(alb1_glo(i,1),xmin) xmax = MAX(alb1_glo(i,1),xmax) ENDDO PRINT*,'Neige du sol ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon_glo alb1_glo(i,nsrf) = alb1_glo(i,1) ENDDO ENDDO ENDIF c c Lecture de albedo au sol dans l'interval proche infra-rouge: c ierr = NF_INQ_VARID (nid, "ALBLW", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, 'phyetat0: Le champ est absent' c PRINT*, ' Mais je vais essayer de lire ALBLW**' PRINT*, ' Mais je vais prendre ALBE**' DO nsrf = 1, nbsrf DO i = 1, klon_glo alb2_glo(i,nsrf) = alb1_glo(i,nsrf) ENDDO ENDDO ELSE PRINT*, 'phyetat0: Le champ est present' PRINT*, ' J ignore donc les autres ALBLW**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, alb2_glo(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, alb2_glo(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_glo xmin = MIN(alb2_glo(i,1),xmin) xmax = MAX(alb2_glo(i,1),xmax) ENDDO PRINT*,'Neige du sol ', xmin, xmax DO nsrf = 2, nbsrf DO i = 1, klon_glo alb2_glo(i,nsrf) = alb2_glo(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_glo 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_glo 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_glo 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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rain_fall_glo) #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_glo xmin = MIN(rain_fall_glo(i),xmin) xmax = MAX(rain_fall_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, snow_fall_glo) #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_glo xmin = MIN(snow_fall_glo(i),xmin) xmax = MAX(snow_fall_glo(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_glo = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, solsw_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, solsw_glo) #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_glo xmin = MIN(solsw_glo(i),xmin) xmax = MAX(solsw_glo(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_glo = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, sollw_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, sollw_glo) #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_glo xmin = MIN(sollw_glo(i),xmin) xmax = MAX(sollw_glo(i),xmax) ENDDO PRINT*,'Rayonnement IF au sol sollw:', xmin, xmax ENDIF ! is_mpi_root c$OMP END MASTER c$OMP MASTER IF (is_mpi_root) THEN 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_glo 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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, radsol_glo) #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_glo xmin = MIN(radsol_glo(i),xmin) xmax = MAX(radsol_glo(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_glo 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_glo 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_glo 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*, ' Mais je vais essayer de lire AGESNO**' 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, "AGESNO"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" agesno = 50.0 ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(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_glo 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**' #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, agesno(1,1)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, agesno(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_glo 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_glo agesno(i,nsrf) = agesno(i,1) ENDDO ENDDO ENDIF 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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zmea_glo) #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_glo xmin = MIN(zmea_glo(i),xmin) xmax = MAX(zmea_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zstd_glo) #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_glo xmin = MIN(zstd_glo(i),xmin) xmax = MAX(zstd_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zsig_glo) #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_glo xmin = MIN(zsig_glo(i),xmin) xmax = MAX(zsig_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zgam_glo) #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_glo xmin = MIN(zgam_glo(i),xmin) xmax = MAX(zgam_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zthe_glo) #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_glo xmin = MIN(zthe_glo(i),xmin) xmax = MAX(zthe_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zpic_glo) #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_glo xmin = MIN(zpic_glo(i),xmin) xmax = MAX(zpic_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zval_glo) #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_glo xmin = MIN(zval_glo(i),xmin) xmax = MAX(zval_glo(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_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rugsrel_glo) #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_glo xmin = MIN(rugsrel_glo(i),xmin) xmax = MAX(rugsrel_glo(i),xmax) ENDDO PRINT*,'Rugosite relief (ecart-type) rugsrel:', xmin, xmax c c ancien_ok_glo = .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_glo = .FALSE. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, t_ancien_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, t_ancien_glo) #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_glo = .FALSE. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_ancien_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, q_ancien_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF c clwcon_glo=0. ierr = NF_INQ_VARID (nid, "CLWCON", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ CLWCON est absent" PRINT*, "Depart legerement fausse. Mais je continue" c clwcon_glo = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, clwcon_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, clwcon_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(clwcon_glo) xmax = MAXval(clwcon_glo) PRINT*,'Eau liquide convective (ecart-type) clwcon:', xmin, xmax c rnebcon_glo = 0. ierr = NF_INQ_VARID (nid, "RNEBCON", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ RNEBCON est absent" PRINT*, "Depart legerement fausse. Mais je continue" c rnebcon_glo = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rnebcon_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, rnebcon_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(rnebcon_glo) xmax = MAXval(rnebcon_glo) PRINT*,'Nebulosite convective (ecart-type) rnebcon:', xmin, xmax c c Lecture ratqs c ratqs_glo=0. ierr = NF_INQ_VARID (nid, "RATQS", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" ratqs_glo = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ratqs_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, ratqs_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(ratqs_glo) xmax = MAXval(ratqs_glo) PRINT*,'(ecart-type) ratqs:', xmin, xmax c c Lecture run_off_lic_0 c ierr = NF_INQ_VARID (nid, "RUNOFFLIC0", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" run_off_lic_0 = 0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, run_off_lic_0) #else ierr = NF_GET_VAR_REAL(nid, nvarid, run_off_lic_0) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(run_off_lic_0) xmax = MAXval(run_off_lic_0) PRINT*,'(ecart-type) run_off_lic_0:', xmin, xmax c Lecture de l'energie cinetique turbulente c IF (iflag_pbl>1) then PRINT*, 'phyetat0: Le champ est absent' PRINT*, ' Mais je vais essayer de lire TKE**' 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, "TKE"//str2, nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "WARNING phyetat0: est absent" pbl_tke_glo(:,:,nsrf)=1.e-8 ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, & pbl_tke_glo(1,1,nsrf)) #else ierr = NF_GET_VAR_REAL(nid, nvarid, pbl_tke_glo(1,1,nsrf)) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "WARNING phyetat0: echec lect " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO k = 1, klev DO i = 1, klon_glo xmin = MIN(pbl_tke_glo(i,k,nsrf),xmin) xmax = MAX(pbl_tke_glo(i,k,nsrf),xmax) ENDDO ENDDO PRINT*,'Temperature du sol TKE**:', nsrf, xmin, xmax ENDDO ENDIF c c zmax0 ierr = NF_INQ_VARID (nid, "ZMAX0", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" zmax0_glo=40. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, zmax0_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, zmax0_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(zmax0_glo) xmax = MAXval(zmax0_glo) PRINT*,'(ecart-type) zmax0:', xmin, xmax c c f0(ig)=1.e-5 c f0 ierr = NF_INQ_VARID (nid, "f0", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" f0_glo=1.e-5 ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, f0_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, f0_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(f0_glo) xmax = MAXval(f0_glo) PRINT*,'(ecart-type) f0:', xmin, xmax c c ema_work1 c ierr = NF_INQ_VARID (nid, "EMA_WORK1", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" ema_work1_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ema_work1_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, ema_work1_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO k = 1, klev DO i = 1, klon xmin = MIN(ema_work1_glo(i,k),xmin) xmax = MAX(ema_work1_glo(i,k),xmax) ENDDO ENDDO PRINT*,'ema_work1:', xmin, xmax ENDIF c c ema_work2 c ierr = NF_INQ_VARID (nid, "EMA_WORK2", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" ema_work2_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ema_work2_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, ema_work2_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO k = 1, klev DO i = 1, klon xmin = MIN(ema_work2_glo(i,k),xmin) xmax = MAX(ema_work2_glo(i,k),xmax) ENDDO ENDDO PRINT*,'ema_work2:', xmin, xmax ENDIF c c wake_deltat c ierr = NF_INQ_VARID (nid, "WAKE_DELTAT", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" wake_deltat_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltat_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltat_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO k = 1, klev DO i = 1, klon_glo xmin = MIN(wake_deltat_glo(i,k),xmin) xmax = MAX(wake_deltat_glo(i,k),xmax) ENDDO ENDDO PRINT*,'wake_deltat:', xmin, xmax ENDIF c c wake_deltaq c ierr = NF_INQ_VARID (nid, "WAKE_DELTAQ", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" wake_deltaq_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_deltaq_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, wake_deltaq_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF xmin = 1.0E+20 xmax = -1.0E+20 DO k = 1, klev DO i = 1, klon_glo xmin = MIN(wake_deltaq_glo(i,k),xmin) xmax = MAX(wake_deltaq_glo(i,k),xmax) ENDDO ENDDO PRINT*,'wake_deltaq:', xmin, xmax ENDIF c c wake_s c ierr = NF_INQ_VARID (nid, "WAKE_S", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" wake_s_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_s_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, wake_s_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(wake_s_glo) xmax = MAXval(wake_s_glo) PRINT*,'(ecart-type) wake_s:', xmin, xmax c c wake_cstar c ierr = NF_INQ_VARID (nid, "WAKE_CSTAR", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" wake_cstar_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_cstar_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, wake_cstar_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(wake_cstar_glo) xmax = MAXval(wake_cstar_glo) PRINT*,'(ecart-type) wake_cstar:', xmin, xmax c c wake_fip c ierr = NF_INQ_VARID (nid, "WAKE_FIP", nvarid) IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Le champ est absent" PRINT*, "Depart legerement fausse. Mais je continue" wake_fip_glo=0. ELSE #ifdef NC_DOUBLE ierr = NF_GET_VAR_DOUBLE(nid, nvarid, wake_fip_glo) #else ierr = NF_GET_VAR_REAL(nid, nvarid, wake_fip_glo) #endif IF (ierr.NE.NF_NOERR) THEN PRINT*, "phyetat0: Lecture echouee pour " CALL abort ENDIF ENDIF xmin = 1.0E+20 xmax = -1.0E+20 xmin = MINval(wake_fip_glo) xmax = MAXval(wake_fip_glo) PRINT*,'(ecart-type) wake_fip:', xmin, xmax c c Fermer le fichier: c ierr = NF_CLOSE(nid) ENDIF ! is_mpi_root c c$OMP END MASTER c$OMP MASTER cym en attendant mieux iolat(1)=rlat_glo(1) !FH1D !iolat(jjm+1)=rlat(klon_glo) iolat(jjm+1-1/iim)=rlat_glo(klon_glo) if (iim.gt.1) then do i=2,jjm iolat(i)=rlat_glo(2+(i-2)*iim) enddo endif CALL bcast_mpi(iolat) CALL bcast_mpi(rlon_glo) !FH1D ! call init_iophy(iolat,rlon(2:iim+1)) call init_iophy(iolat,rlon_glo(2-1/iim:iim+1-1/iim)) c$OMP END MASTER call Scatter( rlat_glo,rlat) call Scatter( rlon_glo,rlon) call Scatter( tsol_glo,ftsol) IF (iflag_pbl>1) then call Scatter( pbl_tke_glo,pbl_tke) endif call Scatter( zmax0_glo,zmax0) call Scatter( f0_glo,f0) call Scatter( ema_work1_glo, ema_work1) call Scatter( ema_work2_glo, ema_work2) call Scatter( wake_deltat_glo, wake_deltat) call Scatter( wake_deltaq_glo, wake_deltaq) call Scatter( wake_s_glo, wake_s) call Scatter( wake_cstar_glo, wake_cstar) call Scatter( wake_fip_glo, wake_fip) call Scatter( tsoil,tsoil_p) call Scatter( tslab,tslab_p) call Scatter( seaice,seaice_p) call Scatter( qsurf,qsurf_p) call Scatter( qsol,qsol_p) call Scatter( snow,snow_p) call Scatter( alb1_glo,falb1) call Scatter( alb2_glo,falb2) call Scatter( evap,evap_p) call Scatter( radsol_glo,radsol) call Scatter( rain_fall_glo,rain_fall) call Scatter( snow_fall_glo,snow_fall) call Scatter( sollw_glo,sollw) call Scatter( solsw_glo,solsw) call Scatter( fder,fder_p) call Scatter( frugs,frugs_p) call Scatter( agesno,agesno_p) call Scatter( zmea_glo,zmea) call Scatter( zstd_glo,zstd) call Scatter( zsig_glo,zsig) call Scatter( zgam_glo,zgam) call Scatter( zthe_glo,zthe) call Scatter( zpic_glo,zpic) call Scatter( zval_glo,zval) call Scatter( rugsrel_glo,rugoro) call Scatter( pctsrf_glo,pctsrf) call Scatter( run_off_lic_0,run_off_lic_0_p) call Scatter( t_ancien_glo,t_ancien) call Scatter( q_ancien_glo,q_ancien) call Scatter( rnebcon_glo,rnebcon) call Scatter( clwcon_glo,clwcon) call Scatter( ratqs_glo,ratqs) call Scatter( zmasq_glo,zmasq) c c Initilalize variables in module surface_data c ok_veget = ok_veget_in ocean = ocean_in c c Initialize module pbl_surface_mod c CALL pbl_surface_init(qsol_p, fder_p, snow_p, qsurf_p, $ evap_p, frugs_p, agesno_p, tsoil_p) c Initialize ocean module according to ocean type IF ( ocean == 'slab' ) THEN c initilalize module ocean_slab_init CALL ocean_slab_init(dtime, tslab_p, seaice_p, pctsrf) ELSEIF ( ocean == 'couple' ) THEN c initilalize module ocean_cpl_init CALL ocean_cpl_init(dtime, rlon, rlat) ELSE c initilalize module ocean_forced_init CALL ocean_forced_init ENDIF c c Initilialize module fonte_neige_mod c CALL fonte_neige_init(run_off_lic_0_p) RETURN END