source: LMDZ.3.3/branches/rel-LF/libf/phylmd/condsurf.F @ 319

c $Header$
c
      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 <FOCE> 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 <FOCE>"
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 <FSIC> 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 <FSIC>"
         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(*,*) 'condsurf : 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 <FTER> 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 <FTER>"
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 <FLIC> 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 <FLIC>"
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 <NAT> 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 <NAT>"
         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 <SST> 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 <SST>"
         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 <ALB> 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 <ALB>"
         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 <RUG> 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 <RUG>"
         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 <BILS> 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 <BILS>"
         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