SUBROUTINE condsurf( jour, jourvrai, pctsrf, s lmt_sst,lmt_alb,lmt_rug,lmt_bils ) IMPLICIT none c c Lire les conditions aux limites du modele. c ----------------------------------------- c jour : input , numero du jour a lire c jourvrai : input , vrai jour de la simulation c c pctsrf: sous-maille fractionnelle, la somme doit = 1 c lmt_sst: temperature de la surface oceanique c lmt_alb: albedo du sol c lmt_rug: longeur de rugosite du sol c lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean") c #include "netcdf.inc" INTEGER nid, nvarid INTEGER debut(2) INTEGER epais(2) INTEGER lnblnk EXTERNAL lnblnk c #include "dimensions.h" #include "dimphy.h" #include "indicesol.h" #include "temps.h" #include "clesphys.h" c c newlmt indique l'utilisation de la sous-maille fractionnelle, c tandis que l'ancien regime utilisait l'indicateur du sol (0,1,2,3). LOGICAL newlmt PARAMETER (newlmt=.TRUE.) INTEGER nannemax PARAMETER ( nannemax = 60 ) c INTEGER jour,jourvrai REAL lmt_nat(klon) ! indicateur de la nature du sol REAL pctsrf(klon,nbsrf) ! sous-maille fractionnelle REAL lmt_sst(klon) ! temperature de la surface oceanique REAL lmt_alb(klon) ! albedo du sol REAL lmt_rug(klon) ! longeur de rugosite du sol REAL lmt_bils(klon) c c Variables locales: INTEGER ig, i, j, kt, ierr LOGICAL ok INTEGER anneelim,anneemax CHARACTER*20 fich cc cc ..................................................................... cc cc Pour lire le fichier limit correspondant vraiment a l'annee de la cc simulation en cours , il suffit de mettre ok_limitvrai = .TRUE. cc cc ...................................................................... c c IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN PRINT*,'Le jour demande n est pas correct: ', jour CALL ABORT ENDIF c c ............. modif ( P. Le Van ) ........... anneelim = anne_ini anneemax = anne_ini + nannemax c c IF( ok_limitvrai ) THEN DO kt = 1, nannemax IF(jourvrai.LE. (kt-1)*360 + 359 ) THEN WRITE(fich,'("limit",i4,".nc")') anneelim PRINT *,' Fichier Limite ',fich GO TO 100 ENDIF anneelim = anneelim + 1 ENDDO PRINT *,' PBS ! Le jour a lire sur le fichier limit ne se ' PRINT *,' trouve pas sur les ',nannemax,' annees a partir de ' PRINT *,' l annee de debut', anne_ini CALL EXIT(1) c 100 CONTINUE c ELSE WRITE(fich,'("limit.nc")') PRINT *,' Fichier Limite ',fich ENDIF c c ........... ( fin modif P. Le Van ) ............ c c Ouvrir le fichier en format NetCDF: c ierr = NF_OPEN (fich, NF_NOWRITE,nid) IF (ierr.NE.NF_NOERR) THEN WRITE(6,*)' Pb d''ouverture du fichier ', fich WRITE(6,*)' Le fichier limit ',fich,' (avec 4 chiffres , pour' WRITE(6,*)' l an 2000 ) , n existe pas ! ' WRITE(6,*)' ierr = ', ierr CALL EXIT(1) ENDIF c c La tranche de donnees a lire: c debut(1) = 1 debut(2) = jour + 1 epais(1) = klon epais(2) = 1 c IF (newlmt) THEN c c$$$c Fraction "ocean": c$$$ ierr = NF_INQ_VARID (nid, "FOCE", nvarid) c$$$ IF (ierr .NE. NF_NOERR) THEN c$$$ PRINT*, "condsurf: Le champ est absent" c$$$ CALL abort c$$$ ENDIF c$$$#ifdef NC_DOUBLE c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_oce)) c$$$#else c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce)) c$$$#endif c$$$ IF (ierr .NE. NF_NOERR) THEN c$$$ PRINT*, "condsurf: Lecture echouee pour " c$$$ CALL abort c$$$ ENDIF c c Fraction "glace de mer": c c ierr = NF_INQ_VARID (nid, "FSIC", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_sic)) #else ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_sic)) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF C C positionnement % ocean libre et verification qu'il y a compatibilite des soussurfaces pctsrf(1 : klon, is_oce) = (1. - zmasq(1 : klon)) $ - pctsrf(1 : klon, is_sic) DO i = 1, klon IF ( pctsrf(i, is_sic) .GT. (1. - zmasq(i)) ) THEN WRITE(*,*) 'condsurf : sea-ice et masque pb en ', i, $ pctsrf(i, is_sic), (1. - zmasq(i)) pctsrf(i, is_sic) = (1. - zmasq(i)) pctsrf(i, is_oce) = 0. ENDIF IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) + $ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA) $ THEN WRITE(*,*) 'physiq : pb sous surface au point ', i, $ pctsrf(i, 1 : nbsrf) ENDIF END DO c c$$$c Fraction "terre": c$$$ ierr = NF_INQ_VARID (nid, "FTER", nvarid) c$$$ IF (ierr .NE. NF_NOERR) THEN c$$$ PRINT*, "condsurf: Le champ est absent" c$$$ CALL abort c$$$ ENDIF c$$$#ifdef NC_DOUBLE c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_ter)) c$$$#else c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter)) c$$$#endif c$$$ IF (ierr .NE. NF_NOERR) THEN c$$$ PRINT*, "condsurf: Lecture echouee pour " c$$$ CALL abort c$$$ ENDIF c$$$c c$$$c Fraction "glacier terre": c$$$ ierr = NF_INQ_VARID (nid, "FLIC", nvarid) c$$$ IF (ierr .NE. NF_NOERR) THEN c$$$ PRINT*, "condsurf: Le champ est absent" c$$$ CALL abort c$$$ ENDIF c$$$#ifdef NC_DOUBLE c$$$ ierr = NF_GET_VARA_DOUBLE(nid,nvarid,debut,epais,pctsrf(1,is_lic)) c$$$#else c$$$ ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic)) c$$$#endif c$$$ IF (ierr .NE. 0) THEN c$$$ PRINT*, "condsurf: Lecture echouee pour " c$$$ CALL abort c$$$ ENDIF c ELSE ! test sur newlmt c c Indicateur de la nature du sol (0,1,2,3): ierr = NF_INQ_VARID (nid, "NAT", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_nat) #else ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_nat) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c DO ig = 1, klon pctsrf(ig,is_oce) = 0.0 pctsrf(ig,is_ter) = 0.0 pctsrf(ig,is_lic) = 0.0 pctsrf(ig,is_sic) = 0.0 ENDDO ok = .TRUE. DO ig = 1, klon IF (NINT(lmt_nat(ig)).EQ.0) THEN pctsrf(ig,is_oce) = 1.0 ELSE IF (NINT(lmt_nat(ig)).EQ.1) THEN pctsrf(ig,is_ter) = 1.0 ELSE IF (NINT(lmt_nat(ig)).EQ.2) THEN pctsrf(ig,is_lic) = 1.0 ELSE IF (NINT(lmt_nat(ig)).EQ.3) THEN pctsrf(ig,is_sic) = 1.0 ELSE ok = .FALSE. ENDIF ENDDO IF (.NOT.ok) THEN PRINT*, "valeur fausse pour lmt_nat:", lmt_nat CALL abort ENDIF c ENDIF ! fin de test sur newlmt c c Sea surface temperature: ierr = NF_INQ_VARID (nid, "SST", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_sst) #else ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_sst) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Albedo de surface: ierr = NF_INQ_VARID (nid, "ALB", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_alb) #else ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_alb) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Longueur de rugosite au sol: ierr = NF_INQ_VARID (nid, "RUG", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_rug) #else ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_rug) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Bilan flux de chaleur au sol: ierr = NF_INQ_VARID (nid, "BILS", nvarid) IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Le champ est absent" CALL abort ENDIF #ifdef NC_DOUBLE ierr = NF_GET_VARA_DOUBLE(nid, nvarid,debut,epais,lmt_bils) #else ierr = NF_GET_VARA_REAL(nid, nvarid,debut,epais,lmt_bils) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Fermer le fichier: c ierr = NF_CLOSE(nid) c c PRINT*, 'SST, ALB, RUG, etc. sont lus pour jour: ', jour c RETURN END