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=.FALSE.) 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 Couplage OASIS: #include "oasis.h" REAL cpl_sst(iim,jjm+1), cpl_sic(iim,jjm+1) REAL cpl_alb_sst(iim,jjm+1), cpl_alb_sic(iim,jjm+1) 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 Fraction "ocean": ierr = NF_INQ_VARID (nid, "FOCE", 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_oce)) #else ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_oce)) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Fraction "glace de mer": 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 Fraction "terre": ierr = NF_INQ_VARID (nid, "FTER", 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_ter)) #else ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_ter)) #endif IF (ierr .NE. NF_NOERR) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort ENDIF c c Fraction "glacier terre": ierr = NF_INQ_VARID (nid, "FLIC", 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_lic)) #else ierr = NF_GET_VARA_REAL(nid,nvarid,debut,epais,pctsrf(1,is_lic)) #endif IF (ierr .NE. 0) THEN PRINT*, "condsurf: Lecture echouee pour " CALL abort 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 IF (ok_oasis) THEN C CALL fromcpl(jour,(jjm+1)*iim, . cpl_sst,cpl_sic,cpl_alb_sst,cpl_alb_sic) DO i = 1, iim-1 ! un seul point pour le pole nord cpl_sst(i,1) = cpl_sst(iim,1) cpl_sic(i,1) = cpl_sic(iim,1) cpl_alb_sst(i,1) = cpl_alb_sst(iim,1) cpl_alb_sic(i,1) = cpl_alb_sic(iim,1) ENDDO DO i = 2, iim ! un seul point pour le pole sud cpl_sst(i,jjm+1) = cpl_sst(1,jjm+1) cpl_sic(i,jjm+1) = cpl_sic(1,jjm+1) cpl_alb_sst(i,jjm+1) = cpl_alb_sst(1,jjm+1) cpl_alb_sic(i,jjm+1) = cpl_alb_sic(1,jjm+1) ENDDO c ig = 1 IF (pctsrf(ig,is_oce).GT.epsfra .OR. . pctsrf(ig,is_sic).GT.epsfra) THEN pctsrf(ig,is_oce) = pctsrf(ig,is_oce) . - (cpl_sic(1,1)-pctsrf(ig,is_sic)) pctsrf(ig,is_sic) = cpl_sic(1,1) lmt_sst(ig) = cpl_sst(1,1) ENDIF DO j = 2, jjm DO i = 1, iim ig = ig + 1 IF (pctsrf(ig,is_oce).GT.epsfra .OR. . pctsrf(ig,is_sic).GT.epsfra) THEN pctsrf(ig,is_oce) = pctsrf(ig,is_oce) . - (cpl_sic(i,j)-pctsrf(ig,is_sic)) pctsrf(ig,is_sic) = cpl_sic(i,j) lmt_sst(ig) = cpl_sst(i,j) ENDIF ENDDO ENDDO ig = ig + 1 IF (pctsrf(ig,is_oce).GT.epsfra .OR. . pctsrf(ig,is_sic).GT.epsfra) THEN pctsrf(ig,is_oce) = pctsrf(ig,is_oce) . - (cpl_sic(1,jjm+1)-pctsrf(ig,is_sic)) pctsrf(ig,is_sic) = cpl_sic(1,jjm+1) lmt_sst(ig) = cpl_sst(1,jjm+1) ENDIF c ENDIF ! ok_oasis c RETURN END