SUBROUTINE INCLI5

!**** *INCLI5*

!     PURPOSE
!     -------
!     This routine modifies climatological fields describing land surface
!     on a limited rectangular domain of the globe.
!     Any of the fields computed in INCLI2 and INCLI4 may be changed, if 
!     the corresponding high resolution data are available. Fields derived
!     in INCLI1 (i.e. related to topography) or INCLI3 cannot.

!**   INTERFACE
!     ---------

!     CALL INCLI5

!     METHOD
!     ------
!     This routine modifies up to 14 fields characterizing vegetation and soil:
!      - percentage of vegetation
!      - max. percentage of vegetation
!      - land use type
!      - leaf area index
!      - minimum surface resistance of vegetation
!      - useful soil depth
!      - bare ground albedo
!      - albedo
!      - albedo of vegetation
!      - emissivity
!      - roughness length (cinetic + thermal)
!      - percentage of clay
!      - percentage of sand
!      - maximum soil depth
!     The target grid is a Gaussian grid with rotation of the pole, "Schmidt"
!     stretching as well as reduction of the number of grid points towards the
!     pole of the final representation.
!     The source grid can be any regular rectangular latitude by longitude 
!     grid, the first point being at the NW edge, longitudes going eastwards,
!     and latitude going northwards (the NE edge is before the SW edge).
!     The earth is supposed to be flat, i.e. the periodicity of the longitudes
!     as well as the symmetry of the latitudes is ignored; this program can be
!     used for a global source grid (although it has not been designed for 
!     this task), but the interpolation at the boundaries will not be optimal.
!     Inside the input domain, the variables are averaged in a rectangular
!     latitude x longitude box around each point of the target grid; the size
!     of the box is approximately twice the distance between two points in the
!     target grid.
!     The missing data have a negative value, and it is assumed that the
!     location of missing data is the same for each field. Outside the domain
!     and over parts where data are missing, the original value is kept. At
!     the boundaries of the domain, a linear combination of the old and new
!     values is performed. Values are not modified if the corresponding file
!     is not available.
!     Input data are units 10 to 23 :
!     -mask describing missing data    (unit 10,file msk_HR)
!       -9999. -> missing  1. -> available
!     -bare ground albedo              (unit 11,file als_HR)
!     -emissivity                      (unit 12,file emi_HR)
!     -percentage of clay              (unit 13,file arg_HR)
!     -percentage of sand              (unit 14,file sab_HR)
!     -maximum soil depth              (unit 15,file dps_HR)
!     -dominant land use type          (unit 16,file itp_HR)
!     -maximum vegetation cover        (unit 17,file vgx_HR)
!     -current vegetation cover        (unit 18,file veg_HR)
!     -leaf area index                 (unit 19,file lai_HR)
!     -miminum surface resistance      (unit 21,file rsm_HR)
!     -roughness length of vegetation  (unit 22,file z0v_HR)
!     -albedo of vegetation            (unit 23,file alv_HR)
!     -root depth                      (unit 24,file dpr_HR)
!     Coherence between fields computed in INCLI1,INCLI2,INCLI3 and INCLI4 is
!     checked. The output fields are added to or modified in the ARPEGE file.

!     EXTERNALS
!     ---------

!     FA-LFI package (FAITOU,FACILE,FAIENC,LFILAF,FAIRME)
!     CHIEN
!     ABOR1
!     CHK923

!     AUTHORS
!     -------

!     D. Giard 97-03-13  from INCLIC and INCLICM

!     MODIFICATIONS
!     -------------
!     D. Giard 97-10-16 roughness length of vegetation as output
!              97-12-01 maximum soil depth + root depth
!     P. Le Moigne 98-06-09 optimization under LIEEE switch
!     Modified 98-08-10 by K. YESSAD: partial removal of LRPOLE option.
!       - LRPOLE has been removed from YOMCT0 and 'CALL CHIEN' (assumed to be F)
!       - The climatology read is still assumed to have poles.
!       - computation of poles (4.2) and write poles on FA files is still made.
!     D. Giard 98-08-24 suppression of pole points (no poles written on file).
!     D. Giard 99-12-15 control of smoothing using NPINT
!     D. Giard 99-12-21 more surface types allowed
!     D. Giard 00-09-15 message passing
!     D. Giard 00-09-26 albedo of vegetation saved in clim file
!                       adjusting urbanisation to vegetation in part 2
!     D. Giard 00-10-20 new name for bare-ground albedo (both names kept)
!     R. El Khatib 03-08-18 Roughness lengths not packed
!     M.Hamrud 01-10-03 CY28 Cleaning
!     D. Giard 04-09-15 cleaning
!     F. Taillefer 09-06-02 add LZ0THER

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM   , ONLY : NDGLG    ,NDGSAG   ,NDGENG   ,NDLON    ,NFLEVG   ,NSMAX
USE YOMCT0   , ONLY : NQUAD
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMCST   , ONLY : RPI      ,RG
USE YOMLEG   , ONLY : RMU
USE YOMGEM   , ONLY : NLOENG   ,NMENG    ,NSTAGP   ,VALH     ,VBH      ,&
 & NSTTYP   ,NHTYP    ,RMUCEN   ,RLOCEN   ,RSTRET   ,VP00  
USE YOMGC    , ONLY : GELAM    ,GELAT    ,GM
USE YOMCLI   , ONLY : LIEEE    ,NDATX    ,NDATY    ,NGLOBX   ,&
 & NTPMER   ,NTPGLA   ,NTPLAC   ,NPINT    ,ELONSW   ,&
 & ELATNE   ,EDLON    ,EDLAT    ,SMASK    ,SMANQ    ,&
 & SVEG     ,LZ0THER  ,SFCZ0    ,STHER    ,SALBN    ,SALBX    ,&
 & SALBG    ,SEMIN    ,SEMIX    ,SEMIG    ,SDEPN    ,&
 & SDEPX    ,SARGN    ,SARGX    ,SSABN    ,SSABX    ,&
 & SRSMN    ,SRSMX    ,SZZ0U    ,SZZ0D    ,SZZ0N  

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JPTYVE
REAL(KIND=JPRB) :: PPONDER

PARAMETER (PPONDER=.25_JPRB,JPTYVE=5)

REAL(KIND=JPRB) :: ZALS0(NDATX,NDATY),ZEMI0(NDATX,NDATY),ZARG0(NDATX,NDATY)&
 & ,ZSAB0(NDATX,NDATY),ZDPS0(NDATX,NDATY),ZITP0(NDATX,NDATY)&
 & ,ZVGX0(NDATX,NDATY),ZVEG0(NDATX,NDATY),ZLAI0(NDATX,NDATY)&
 & ,ZRSM0(NDATX,NDATY),ZZ0V0(NDATX,NDATY),ZALV0(NDATX,NDATY)&
 & ,ZDPR0(NDATX,NDATY),ZMSK0(NDATX,NDATY)  
REAL(KIND=JPRB) :: ZALB1(NDGLG*NDLON),ZALS1(NDGLG*NDLON),ZEMI1(NDGLG*NDLON)&
 & ,ZARG1(NDGLG*NDLON),ZSAB1(NDGLG*NDLON),ZDEP1(NDGLG*NDLON)&
 & ,ZITP1(NDGLG*NDLON),ZVGX1(NDGLG*NDLON),ZVEG1(NDGLG*NDLON)&
 & ,ZLAI1(NDGLG*NDLON),ZRSM1(NDGLG*NDLON),ZGZ01(NDGLG*NDLON)&
 & ,ZLSM1(NDGLG*NDLON),ZLND1(NDGLG*NDLON),ZGZR1(NDGLG*NDLON)&
 & ,ZGZT1(NDGLG*NDLON),ZURB1(NDGLG*NDLON),ZGZV1(NDGLG*NDLON)&
 & ,ZDPS1(NDGLG*NDLON),ZALV1(NDGLG*NDLON)  
REAL(KIND=JPRB) :: ZITP(JPTYVE)
REAL(KIND=JPRB) ,ALLOCATABLE :: ZAUX1(:), ZAUX2(:)
REAL(KIND=JPRB) :: ZALS, ZALV, ZALVO, ZARG, ZCV, ZDL, ZDLA,&
 & ZDLO, ZDPR, ZDPRO, ZDPS, ZEMI, ZEPS, ZFZ0, &
 & ZITPM, ZITPN, ZLAI, ZLAT, ZLON, ZLIS, ZLSR, ZMIS, ZMSK, &
 & ZPTL, ZRSM, ZSAB, ZSUM, ZURBO, ZVEG, ZVEGO, ZVGX, ZVGXO, &
 & ZW1, ZW2, ZZ0V, ZZ0VO, ZZARG, ZZDL, ZZSAB
REAL(KIND=JPRB) :: ZHOOK_HANDLE

CHARACTER :: CLNOMC*16,CLNOMF*10,CLFORM*12

INTEGER(KIND=JPIM) :: I, I1LA, I1LO, I2LA, I2LO, IA, IALS, IALV, IARG,&
 & IARI, IARP, IC, ID, IDLA, IDLO, IDPR, IDPS, IEMI, &
 & IINF, IITP, ILAI, ILAT, ILON, IM, IMES, INIV, &
 & INUM, IOS, IREP, IRSM, ISAB, IT, IVEG, IVGX, &
 & IZ, IZ0V, J, JJ, JLA, JLO, JT  
INTEGER(KIND=JPIM) :: INGRIG,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL

LOGICAL :: LLALS, LLALV, LLARG, LLCOSP, LLDPR, LLDPS,&
 & LLEMI, LLIMST, LLITP, LLLAI, LLMSK, LLOPEN, &
 & LLPOLE, LLRSM, LLSAB, LLVEG, LLVEGC, LLVGX, LLZ0V  

#include "abor1.intfb.h"
#include "chien.intfb.h"
#include "chk923.intfb.h"

!     ------------------------------------------------------------------

!     1. SET INITIAL VALUES.
!        -------------------

IF (LHOOK) CALL DR_HOOK('INCLI5',0,ZHOOK_HANDLE)

!     1.1 Miscellaneous

ZCV= 180._JPRB/RPI
ZDL= 180._JPRB/REAL(NDGLG,JPRB)
ZEPS= 1.E-10_JPRB
ZFZ0= SFCZ0*RG
ZLIS= 1.0_JPRB/REAL(NPINT,JPRB)
ZMIS= SMANQ - 1.0_JPRB

ID= 1

!     1.2 Type of data files

IF (LIEEE) THEN
  CLFORM='UNFORMATTED'
ELSE
  CLFORM='FORMATTED'
ENDIF

!     1.3 Missing data

!  Default is missing data
LLMSK=.FALSE.
LLALS=.FALSE.
LLEMI=.FALSE.
LLARG=.FALSE.
LLSAB=.FALSE.
LLDPS=.FALSE.
LLITP=.FALSE.
LLVGX=.FALSE.
LLVEG=.FALSE.
LLLAI=.FALSE.
LLRSM=.FALSE.
LLZ0V=.FALSE.
LLALV=.FALSE.
LLDPR=.FALSE.
IALS= 0
IEMI= 0
IARG= 0
ISAB= 0
IDPS= 0
IITP= 0
IVGX= 0
IVEG= 0
ILAI= 0
IRSM= 0
IZ0V= 0
IALV= 0
IDPR= 0
ZMSK0(:,:)= ZMIS
ZALS0(:,:)= ZMIS
ZEMI0(:,:)= ZMIS
ZARG0(:,:)= ZMIS
ZSAB0(:,:)= ZMIS
ZDPS0(:,:)= ZMIS
ZITP0(:,:)= ZMIS
ZVGX0(:,:)= ZMIS
ZVEG0(:,:)= ZMIS
ZLAI0(:,:)= ZMIS
ZRSM0(:,:)= ZMIS
ZZ0V0(:,:)= ZMIS
ZALV0(:,:)= ZMIS
ZDPR0(:,:)= ZMIS

!     ------------------------------------------------------------------

!     2. CHECK AND READ DATASETS.
!        ------------------------

!     2.1 Check which files are available

!  Common mask
LLOPEN=.FALSE.
IOS= 0
INQUIRE(FILE='msk_HR',IOSTAT=IOS,EXIST=LLMSK,OPENED=LLOPEN)
LLMSK= LLMSK .AND. (IOS == 0) .AND. .NOT.LLOPEN
IF (.NOT.LLMSK) THEN
  WRITE(NULERR,'('' ERROR IN INCLI5 :'',&
   & '' THE COMMON MASK (DEFINING MISSING DATA) IS NOT GIVEN !'')')  
  CALL ABOR1('INCLI5')
ENDIF
!  Bare ground albedo
INQUIRE(FILE='als_HR',IOSTAT=IOS,EXIST=LLALS,OPENED=LLOPEN)
LLALS= LLALS .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Emissivity
INQUIRE(FILE='emi_HR',IOSTAT=IOS,EXIST=LLEMI,OPENED=LLOPEN)
LLEMI= LLEMI .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Soil texture : percentages of clay and sand
INQUIRE(FILE='arg_HR',IOSTAT=IOS,EXIST=LLARG,OPENED=LLOPEN)
LLARG= LLARG .AND. (IOS == 0) .AND. .NOT.LLOPEN
INQUIRE(FILE='sab_HR',IOSTAT=IOS,EXIST=LLSAB,OPENED=LLOPEN)
LLSAB= LLSAB .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Maximum soil depth
INQUIRE(FILE='dps_HR',IOSTAT=IOS,EXIST=LLDPS,OPENED=LLOPEN)
LLDPS= LLDPS .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Land use type
INQUIRE(FILE='itp_HR',IOSTAT=IOS,EXIST=LLITP,OPENED=LLOPEN)
LLITP= LLITP .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Maximum and current vegetation cover
INQUIRE(FILE='vgx_HR',IOSTAT=IOS,EXIST=LLVGX,OPENED=LLOPEN)
LLVGX= LLVGX .AND. (IOS == 0) .AND. .NOT.LLOPEN
INQUIRE(FILE='veg_HR',IOSTAT=IOS,EXIST=LLVEG,OPENED=LLOPEN)
LLVEG= LLVEG .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Leaf area index and miminum surface resistance
INQUIRE(FILE='lai_HR',IOSTAT=IOS,EXIST=LLLAI,OPENED=LLOPEN)
LLLAI= LLLAI .AND. (IOS == 0) .AND. .NOT.LLOPEN
INQUIRE(FILE='rsm_HR',IOSTAT=IOS,EXIST=LLRSM,OPENED=LLOPEN)
LLRSM= LLRSM .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Roughness length of vegetation
INQUIRE(FILE='z0v_HR',IOSTAT=IOS,EXIST=LLZ0V,OPENED=LLOPEN)
LLZ0V= LLZ0V .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Albedo of vegetation
INQUIRE(FILE='alv_HR',IOSTAT=IOS,EXIST=LLALV,OPENED=LLOPEN)
LLALV= LLALV .AND. (IOS == 0) .AND. .NOT.LLOPEN
!  Root depth
INQUIRE(FILE='dpr_HR',IOSTAT=IOS,EXIST=LLDPR,OPENED=LLOPEN)
LLDPR= LLDPR .AND. (IOS == 0) .AND. .NOT.LLOPEN

!     2.2 Check which fields will be modified

IF (.NOT. (LLARG.AND.LLSAB)) THEN
  LLARG= .FALSE.
  LLSAB= .FALSE.
ENDIF
IF (.NOT. (LLVEG.AND.LLVGX)) THEN
  LLVEG= .FALSE.
  LLVGX= .FALSE.
ENDIF
IF (.NOT. (LLLAI.AND.LLRSM)) THEN
  LLLAI= .FALSE.
  LLRSM= .FALSE.
ENDIF

LLVEGC=LLLAI.AND.LLZ0V.AND.LLALV.AND.LLDPR.AND.LLEMI
IF (LLVEG .AND. .NOT. LLVEGC) THEN
  WRITE(NULERR,'('' CAUTION :'',&
   & '' IF VEGETATION FRACTION IS MODIFIED BY INCLI5,'',&
   & '' ALL VEGETATION CHARACTERISTICS SHOULD BE MODIFIED !'')')  
  WRITE(NULOUT,'('' CAUTION :'',&
   & '' IF VEGETATION FRACTION IS MODIFIED BY INCLI5,'',&
   & '' ALL VEGETATION CHARACTERISTICS SHOULD BE MODIFIED !'')')  
ENDIF
IF (LLITP .AND. .NOT. LLVEGC) THEN
  WRITE(NULERR,'('' CAUTION :'',&
   & '' IF LAND USE TYPE IS MODIFIED BY INCLI5,'',&
   & '' ALL VEGETATION CHARACTERISTICS SHOULD BE MODIFIED !'')')  
  WRITE(NULOUT,'('' CAUTION :'',&
   & '' IF LAND USE TYPE IS MODIFIED BY INCLI5,'',&
   & '' ALL VEGETATION CHARACTERISTICS SHOULD BE MODIFIED !'')')  
ENDIF

IF ((LLDPS.OR.LLDPR).AND..NOT.LLARG) THEN
  WRITE(NULERR,'('' CAUTION :'',&
   & '' SOIL DEPTH MODIFIED BY INCLI5 BUT NOT SOIL TEXTURE'')')  
  WRITE(NULOUT,'('' CAUTION :'',&
   & '' SOIL DEPTH MODIFIED BY INCLI5 BUT NOT SOIL TEXTURE'')')  
ENDIF
IF (LLARG.AND..NOT.(LLDPS.OR.LLDPR)) THEN
  WRITE(NULERR,'('' CAUTION :'',&
   & '' SOIL TEXTURE MODIFIED BY INCLI5 BUT NOT SOIL DEPTH'')')  
  WRITE(NULOUT,'('' CAUTION :'',&
   & '' SOIL TEXTURE MODIFIED BY INCLI5 BUT NOT SOIL DEPTH'')')  
ENDIF

IF (LLVEG.AND..NOT.LLITP) WRITE(NULERR,'('' CAUTION :'',&
 & '' VEGET. COVER MODIFIED BY INCLI5 BUT NOT VEGETATION TYPE'')')  
IF (LLLAI.AND..NOT.LLITP) WRITE(NULERR,'('' CAUTION :'',&
 & '' LAI AND RSMIN MODIFIED BY INCLI5 BUT NOT VEGETATION TYPE'')')  
IF (LLZ0V.AND..NOT.LLITP) WRITE(NULERR,'('' CAUTION :'',&
 & '' Z0 OF VEGET. MODIFIED BY INCLI5 BUT NOT VEGETATION TYPE'')')  
IF (LLALV.AND..NOT.LLITP) WRITE(NULERR,'('' CAUTION :'',&
 & '' VEGET. ALBEDO MODIFIED BY INCLI5 BUT NOT VEGETATION TYPE'')')  
IF (LLDPR.AND..NOT.LLITP) WRITE(NULERR,'('' CAUTION :'',&
 & '' ROOT DEPTH MODIFIED BY INCLI5 BUT NOT VEGETATION TYPE'')')  

IF (.NOT.(LLALS.OR.LLEMI.OR.LLARG.OR.LLDPS.OR.LLITP.OR.&
 & LLVEG.OR.LLLAI.OR.LLZ0V.OR.LLALV.OR.LLDPR))&
 & CALL ABOR1('ERROR IN INCLI5 : NO FIELDS TO MODIFY !')  

!     2.3 Read and check the mask (missing)

IF (LIEEE) THEN
  ALLOCATE (ZAUX1(NDATX*NDATY))
  IF (LLARG.OR.LLVEG.OR.LLLAI) THEN
    ALLOCATE (ZAUX2(NDATX*NDATY))
  ENDIF
ENDIF

OPEN(UNIT=10,FILE='msk_HR',FORM=CLFORM)
IF (LIEEE) THEN
  READ(10)ZAUX1
  DO JJ=1,NDATY
    DO J=1,NDATX
      IZ=J+(JJ-1)*NDATX
      ZMSK0(J,JJ)=ZAUX1(IZ)
    ENDDO
  ENDDO
ELSE
  READ(10,*) ((ZMSK0(J,JJ),J=1,NDATX),JJ=1,NDATY)
ENDIF
CLOSE(10)
DO JJ=1,NDATY
  DO J=1,NDATX
    IF ((ZMSK0(J,JJ) > SMANQ) .AND. (ABS(ZMSK0(J,JJ)-1.0_JPRB) > ZEPS))&
     & CALL ABOR1(' ERROR IN INCLI5 : UNEXPECTED MASK VALUE !')           
  ENDDO
ENDDO

!     2.4 Read new data

!  Bare ground albedo
IF (LLALS) THEN
  OPEN(UNIT=11,FILE='als_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(11)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZALS0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(11,*) ((ZALS0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(11)
  IALS= 1
ENDIF
!  Emissivity
IF (LLEMI) THEN
  OPEN(UNIT=12,FILE='emi_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(12)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZEMI0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(12,*) ((ZEMI0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(12)
  IEMI= 1
ENDIF
!  Soil texture : percentages of clay and sand
IF (LLARG) THEN
  OPEN(UNIT=13,FILE='arg_HR',FORM=CLFORM)
  OPEN(UNIT=14,FILE='sab_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(13)ZAUX1
    READ(14)ZAUX2
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZARG0(J,JJ)=ZAUX1(IZ)
        ZSAB0(J,JJ)=ZAUX2(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(13,*) ((ZARG0(J,JJ),J=1,NDATX),JJ=1,NDATY)
    READ(14,*) ((ZSAB0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(13)
  CLOSE(14)
  IARG= 1
  ISAB= 1
ENDIF
!  Maximum soil depth
IF (LLDPS) THEN
  OPEN(UNIT=15,FILE='dps_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(15)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZDPS0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(15,*) ((ZDPS0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(15)
  IDPS= 1
ENDIF
!  Land use type
IF (LLITP) THEN
  OPEN(UNIT=16,FILE='itp_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(16)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZITP0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(16,*) ((ZITP0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(16)
  IITP= 1
ENDIF
!  Maximum and current vegetation cover
IF (LLVEG) THEN
  OPEN(UNIT=17,FILE='vgx_HR',FORM=CLFORM)
  OPEN(UNIT=18,FILE='veg_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(17)ZAUX1
    READ(18)ZAUX2
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZVGX0(J,JJ)=ZAUX1(IZ)
        ZVEG0(J,JJ)=ZAUX2(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(17,*) ((ZVGX0(J,JJ),J=1,NDATX),JJ=1,NDATY)
    READ(18,*) ((ZVEG0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(17)
  CLOSE(18)
  IVGX= 1
  IVEG= 1
ENDIF
!  Leaf area index and miminum surface resistance
IF (LLLAI) THEN
  OPEN(UNIT=19,FILE='lai_HR',FORM=CLFORM)
  OPEN(UNIT=21,FILE='rsm_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(19)ZAUX1
    READ(21)ZAUX2
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZLAI0(J,JJ)=ZAUX1(IZ)
        ZRSM0(J,JJ)=ZAUX2(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(19,*) ((ZLAI0(J,JJ),J=1,NDATX),JJ=1,NDATY)
    READ(21,*) ((ZRSM0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(19)
  CLOSE(21)
  ILAI= 1
  IRSM= 1
ENDIF
!  Roughness length of vegetation
IF (LLZ0V) THEN
  OPEN(UNIT=22,FILE='z0v_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(22)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZZ0V0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(22,*) ((ZZ0V0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(22)
  IZ0V= 1
ENDIF
!  Albedo of vegetation
IF (LLALV) THEN
  OPEN(UNIT=23,FILE='alv_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(23)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZALV0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(23,*) ((ZALV0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(23)
  IALV= 1
ENDIF
!  Root depth
IF (LLDPR) THEN
  OPEN(UNIT=24,FILE='dpr_HR',FORM=CLFORM)
  IF (LIEEE) THEN
    READ(24)ZAUX1
    DO JJ=1,NDATY
      DO J=1,NDATX
        IZ=J+(JJ-1)*NDATX
        ZDPR0(J,JJ)=ZAUX1(IZ)
      ENDDO
    ENDDO
  ELSE
    READ(24,*) ((ZDPR0(J,JJ),J=1,NDATX),JJ=1,NDATY)
  ENDIF
  CLOSE(24)
  IDPR= 1
ENDIF

!  Deallocate temporary space
IF (LIEEE) THEN
  DEALLOCATE (ZAUX1)
  IF (LLARG.OR.LLVEG.OR.LLLAI) THEN
    DEALLOCATE (ZAUX2)
  ENDIF
ENDIF

IC= IALS + IEMI + IARG + ISAB + IDPS + IITP + IVGX &
 & + IVEG + ILAI + IRSM + IZ0V + IALV + IDPR  

!     ------------------------------------------------------------------

!     3. READ ARPEGE FIELDS.
!        -------------------

INUM=3
IREP=0
IARI=0
IARP=31
IMES=1
CLNOMF='Const.Clim'
CLNOMC='Const.Clim.Surfa'
LLIMST=.TRUE.

IINF=-1
LLPOLE=.TRUE.
INIV=0
LLCOSP=.FALSE.

CALL FAITOU(IREP,INUM,.TRUE.,CLNOMF,'OLD',.TRUE.,LLIMST,&
 & IMES,IARP,IARI,CLNOMC)  
CALL CHIEN(CLNOMC,NSTTYP,RMUCEN,RLOCEN,RSTRET,NSMAX,&
 & NDGLG,NDLON,NLOENG,NMENG,RMU,NHTYP,NFLEVG,VP00,VALH,VBH,&
 & NQUAD,IINF,NDGSAG,NDGENG,ZEPS,LLPOLE,NULOUT)  
IF (LLPOLE) CALL ABOR1(' CLIM. FILES MUST NOT HAVE POLES !')

CALL FACILE(IREP,INUM,'SURF',INIV,'IND.TERREMER',ZLSM1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.TERRE  ',ZLND1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.URBANIS',ZURB1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.VEGETAT',ZVEG1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.VEG.MAX',ZVGX1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'IND.VEG.DOMI',ZITP1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'IND.FOLIAIRE',ZLAI1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'RESI.STO.MIN',ZRSM1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'EPAIS.SOL   ',ZDEP1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'Z0.FOIS.G   ',ZGZ01,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'Z0REL.FOIS.G',ZGZR1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'Z0VEG.FOIS.G',ZGZV1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'GZ0.THERM   ',ZGZT1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'ALBEDO      ',ZALB1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'ALBEDO.SOLNU',ZALS1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'ALBEDO.VEG  ',ZALV1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'EMISSIVITE  ',ZEMI1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.ARGILE ',ZARG1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'PROP.SABLE  ',ZSAB1,LLCOSP)
CALL FACILE(IREP,INUM,'SURF',INIV,'EPAI.SOL.MAX',ZDPS1,LLCOSP)

!     ------------------------------------------------------------------

!     4. LOOP ON THE ARPEGE GRID.
!        ------------------------

!     4.1 Standard grid

I=0
IM=0
IT=0
DO JJ=1,NDGLG
  DO J=1,NLOENG(JJ)
!  Addresses
    I=I+1
    IA=J+NSTAGP(JJ)-ID

!  Only land points are considered here :        
    IF (ZLSM1(I) <= SMASK) GO TO 410
    IT=IT+1

!  Check the position of the point relative to the dataset and define the
!  interpolation box if required. Only points inside the domain or close to
!  its boundary are considered here.
!   ILAT/ILON : latitude/longitude of the nearest point in the input grid 
!   IDLA/IDLO : latitude/longitude radius of the box
!   I1LA/I2LA/I1LO/I2LO : north/south/west/east edges of the box
!  The size of the box inside which input data are considered and averaged 
!  is by default twice the model mesh-size if each direction. This can be 
!  reduced (to keep sharp gradients) by increasing the namelist variable 
!  NPINT (1 by default), i.e. decreasing ZLIS.

!  Check the latitude
    ZZDL= ZDL/GM(IA)
    ZLAT= GELAT(IA)*ZCV
    ILAT= NINT((ELATNE-ZLAT)/EDLAT)+1
    ZDLA= ZLIS*ZZDL/EDLAT
    IDLA= INT(ZDLA)
    IF (ILAT < (1-IDLA) .OR. ILAT > (NDATY+IDLA)) GO TO 410
    I1LA= MAX(1    ,ILAT-IDLA)
    I2LA= MIN(NDATY,ILAT+IDLA)

!  Check the longitude
    ZLON= GELAM(IA)*ZCV
    ILON= NINT((ZLON-ELONSW)/EDLON)+1
    ZDLO= ZLIS*ZZDL/EDLON/COS(GELAT(IA))
    IDLO= MIN(INT(ZDLO),NDATX/4)
    I1LO= MOD(ILON-IDLO-1+2*NGLOBX,NGLOBX)+1
    I2LO= MOD(ILON+IDLO-1+2*NGLOBX,NGLOBX)+1
    IF (I1LO > NDATX .AND. I2LO >= I1LO) GO TO 410
    IF (I1LO > NDATX) I1LO=1
    I2LO=MIN(NDATX,I2LO)

!  Initialize new fields
    ZMSK= 0.0_JPRB
    ZALS= 0.0_JPRB
    ZEMI= 0.0_JPRB
    ZARG= 0.0_JPRB
    ZSAB= 0.0_JPRB
    ZDPS= 0.0_JPRB
    ZVGX= 0.0_JPRB
    ZVEG= 0.0_JPRB
    ZLAI= 0.0_JPRB
    ZLSR= 0.0_JPRB
    ZZ0V= 0.0_JPRB
    ZALV= 0.0_JPRB
    ZDPR= 0.0_JPRB
    DO JT=1,JPTYVE
      ZITP(JT)= 0.0_JPRB
    ENDDO

!  Save previous fields
    ZVEGO= ZVEG1(I)
    ZVGXO= ZVGX1(I)
    ZURBO= ZURB1(I)
    ZZ0VO= ZGZV1(I)/ZFZ0
    ZALVO= ZALB1(I)
    ZDPRO= ZDEP1(I)
    IF (ZVEGO >= SVEG) THEN
      ZALVO= (ZALB1(I)-(1.0_JPRB-ZVEGO)*ZALS1(I))/ZVEGO
      ZZ0VO= (ZZ0VO - ZURBO*SZZ0U - (1.0_JPRB-ZURBO-ZVEGO)*SZZ0D)/ZVEGO
    ENDIF
    IF (ZVGXO >= SVEG) THEN
      ZDPRO= (ZDEP1(I)-(1.0_JPRB-ZVGXO)*ZDPS1(I))/ZVGXO
    ENDIF

!  Compute new values
    DO JLA=I1LA,I2LA
      DO JLO=I1LO,I2LO
!  Mask
        ZMSK= ZMSK + MAX(0.0_JPRB,ZMSK0(JLO,JLA))
!  Land use type
        DO JT=1,JPTYVE
          IF (NINT(ZITP0(JLO,JLA)) == JT) ZITP(JT)= ZITP(JT) + 1.0_JPRB
        ENDDO
!  Bare ground albedo, emissivity
        ZALS= ZALS + MAX(0.0_JPRB,ZALS0(JLO,JLA))
        ZEMI= ZEMI + MAX(0.0_JPRB,ZEMI0(JLO,JLA))
!  Soil texture and depth
        ZARG= ZARG + MAX(0.0_JPRB,ZARG0(JLO,JLA))
        ZSAB= ZSAB + MAX(0.0_JPRB,ZSAB0(JLO,JLA))
        ZDPS= ZDPS + MAX(0.0_JPRB,ZDPS0(JLO,JLA))
!  Vegetation cover
        ZVGX= ZVGX + MAX(0.0_JPRB,ZVGX0(JLO,JLA))
        ZVEG= ZVEG + MAX(0.0_JPRB,ZVEG0(JLO,JLA))
!  Leaf area index and minimum surface resistance
        ZLAI= ZLAI + MAX(0.0_JPRB,ZLAI0(JLO,JLA))
        IF (ZRSM0(JLO,JLA) > ZEPS) THEN
          ZLSR= ZLSR + MAX(0.0_JPRB,ZLAI0(JLO,JLA))/ZRSM0(JLO,JLA)
        ENDIF
!  Roughness length, albedo and root depth of vegetation
        ZZ0V= ZZ0V + MAX(0.0_JPRB,ZZ0V0(JLO,JLA))
        ZALV= ZALV + MAX(0.0_JPRB,ZALV0(JLO,JLA))
        ZDPR= ZDPR + MAX(0.0_JPRB,ZDPR0(JLO,JLA))
      ENDDO
    ENDDO
!  End of the two loops in the rectangular latitude x longitude box
!  ZMSK : Number of non-missing data in the box
!  ZPTL : Maximum number of land points in the box 
!         (including the part of the box outside the domain)
    IF (ZMSK < ZEPS) GO TO 410
    IM=IM+1
    ZPTL=REAL((2*IDLA+1)*(2*IDLO+1),JPRB)*ZLND1(I)
    ZPTL=MAX(ZMSK,ZPTL)

!  Compute new fields
!  Choice of the dominant type of vegetation. The dominant vegetation must
!  exceed 25%, otherwise the old type is kept.
    ZITPN= ZITP1(I)
    ZITPM= PPONDER*ZPTL
    DO JT=1,JPTYVE
      IF ((JT /= NTPMER).AND.(JT /= NTPLAC).AND.(ZITP(JT) >= ZITPM)) THEN
        ZITPN= REAL(JT,JPRB)
        ZITPM= ZITP(JT)
      ENDIF
    ENDDO
    ZITP1(I)= ZITPN*IITP + ZITP1(I)*(1-IITP)
!  For the other parameters, a linear combination is done with the weights
!  ZW1 for the input data and ZW2 for the initial data, provided data are not
!  missing (Ixxx=1). Else (Ixxx=0), the previous value is kept.
    ZW1=1.0_JPRB/ZPTL
    ZW2=1.0_JPRB-ZMSK*ZW1
!  Bare ground albedo, emissivity
    ZALS1(I)= (ZW1*ZALS + ZW2*ZALS1(I))*IALS + ZALS1(I)*(1-IALS)
    ZEMI1(I)= (ZW1*ZEMI + ZW2*ZEMI1(I))*IEMI + ZEMI1(I)*(1-IEMI)
!  Soil texture and maximum depth
    ZARG1(I)= (ZW1*ZARG + ZW2*ZARG1(I))*IARG + ZARG1(I)*(1-IARG)
    ZSAB1(I)= (ZW1*ZSAB + ZW2*ZSAB1(I))*ISAB + ZSAB1(I)*(1-ISAB)
    ZDPS1(I)= (ZW1*ZDPS + ZW2*ZDPS1(I))*IDPS + ZDPS1(I)*(1-IDPS)
!  Vegetation cover
    ZVGX= MAX(0.0_JPRB,MIN(ZMSK,ZVGX*ZLND1(I)))
    ZVEG= MAX(0.0_JPRB,MIN(ZVGX,ZVEG*ZLND1(I)))
    ZVGX1(I)= (ZW1*ZVGX + ZW2*ZVGX1(I))*IVGX + ZVGX1(I)*(1-IVGX)
    ZVEG1(I)= (ZW1*ZVEG + ZW2*ZVEG1(I))*IVEG + ZVEG1(I)*(1-IVEG)
    ZURB1(I)= MIN(1.0_JPRB-ZVGX1(I),ZURB1(I))
!  Leaf area index and minimum surface resistance
    ZLSR= ZW1*ZLSR + ZW2*ZLAI1(I)/MAX(ZEPS,ZRSM1(I))
    ZLAI= MAX(0.0_JPRB,ZLAI)
    ZLAI1(I)= (ZW1*ZLAI + ZW2*ZLAI1(I))*ILAI + ZLAI1(I)*(1-ILAI)
    IF (ZLSR > ZEPS) THEN
      ZRSM= ZLAI1(I)/ZLSR
    ELSE
      ZRSM= SRSMX
    ENDIF
    ZRSM1(I)= ZRSM*IRSM + ZRSM1(I)*(1-IRSM)
!  Roughness lengths
    ZZ0V= (ZW1*ZZ0V + ZW2*ZZ0VO)*IZ0V + ZZ0VO*(1-IZ0V)
    ZZ0V= ZVEG1(I)*ZZ0V+ZURB1(I)*SZZ0U+(1.0_JPRB-ZURB1(I)-ZVEG1(I))*SZZ0D
    ZGZV1(I)= ZFZ0*ZZ0V
    ZGZ01(I)= SQRT( ZGZR1(I)**2 + ZGZV1(I)**2 )
    IF (LZ0THER) THEN
      ZGZT1(I)= ZGZ01(I)*STHER
    ELSE
      ZGZT1(I)= ZGZV1(I)*STHER
    ENDIF
!  Albedos (total, vegetation)
    ZALV1(I)= (ZW1*ZALV + ZW2*ZALVO)*IALV + ZALVO*(1-IALV)
    ZALB1(I)= ZVEG1(I)*ZALV1(I) + (1.0_JPRB-ZVEG1(I))*ZALS1(I)
!  Useful soil depth
    ZDPR= (ZW1*ZDPR + ZW2*ZDPRO)*IDPR + ZDPRO*(1-IDPR)
    ZDEP1(I)= ZVGX1(I)*ZDPR + (1.0_JPRB-ZVGX1(I))*ZDPS1(I)

! Corrections according to land use type
!  Ice
    IF (NINT(ZITP1(I)) == NTPGLA) THEN
      ZALS1(I)= SALBG
      ZEMI1(I)= SEMIG
      ZARG1(I)= SARGN
      ZSAB1(I)= SSABN
      ZDPS1(I)= SDEPN
      ZDEP1(I)= SDEPN
      ZVGX1(I)= 0.0_JPRB
      ZVEG1(I)= 0.0_JPRB
    ENDIF
!  Desert
    IF (ZVGX1(I) < SVEG*ZLND1(I)) THEN
      ZVGX1(I)= 0.0_JPRB
      ZDEP1(I)= ZDPS1(I)
    ENDIF
    IF (ZVEG1(I) < SVEG*ZLND1(I)) THEN
      ZVEG1(I)= 0.0_JPRB
      ZLAI1(I)= 0.0_JPRB
      ZRSM1(I)= SRSMX
      ZALB1(I)= ZALS1(I)
      ZALV1(I)= SALBN
      ZGZV1(I)= ZFZ0*(ZURB1(I)*SZZ0U+(1.0_JPRB-ZURB1(I))*SZZ0D)
      ZGZ01(I)= SQRT( ZGZR1(I)**2 + ZGZV1(I)**2 )
      IF (LZ0THER) THEN
        ZGZT1(I)= ZGZ01(I)*STHER
      ELSE
        ZGZT1(I)= ZGZV1(I)*STHER
      ENDIF
    ENDIF
!  Extrema
    ZALS1(I)= MIN(SALBX,MAX(SALBN,ZALS1(I)))
    ZALV1(I)= MIN(SALBX,MAX(SALBN,ZALV1(I)))
    ZALB1(I)= MIN(SALBX,MAX(SALBN,ZALB1(I)))
    ZEMI1(I)= MIN(SEMIX,MAX(SEMIN,ZEMI1(I)))
    ZDPS1(I)= MIN(SDEPX,MAX(SDEPN,ZDPS1(I)))
    ZDEP1(I)= MIN(SDEPX,MAX(SDEPN,ZDEP1(I)))
    ZRSM1(I)= MIN(SRSMX,MAX(SRSMN,ZRSM1(I)))
    ZGZV1(I)= MAX(SZZ0N*ZFZ0,ZGZV1(I))
    ZGZ01(I)= MAX(SZZ0N*ZFZ0,ZGZ01(I))
    ZGZT1(I)= MAX(SZZ0N*ZFZ0*STHER,ZGZT1(I))
    ZZARG= MIN(SARGX,MAX(SARGN,ZARG1(I)))
    ZZSAB= MIN(SSABX,MAX(SSABN,ZSAB1(I)))
    ZSUM=MAX(100._JPRB,ZZARG+ZZSAB)/100._JPRB
    ZARG1(I)= ZZARG/ZSUM
    ZSAB1(I)= ZZSAB/ZSUM

410 CONTINUE
  ENDDO
ENDDO

IF (IM == 0) CALL ABOR1(' ERROR IN INCLI5 : NO MODIFICATION !')
WRITE(NULOUT,'(I6,''/'',I6,'' POINTS MODIFIED BY INCLI5'')') IM,IT
WRITE(NULOUT,'(I2,'' FIELDS MODIFIED BY INCLI5'')') IC

!     ------------------------------------------------------------------

!     5. WRITING THE ARPEGE FILE.
!        ------------------------

CALL FAIENC(IREP,INUM,'SURF',INIV,'PROP.URBANIS',ZURB1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'PROP.VEGETAT',ZVEG1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'PROP.VEG.MAX',ZVGX1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'IND.VEG.DOMI',ZITP1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'IND.FOLIAIRE',ZLAI1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'RESI.STO.MIN',ZRSM1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'EPAIS.SOL   ',ZDEP1,LLCOSP)
! Do not pack roughness lengths
CALL FAVEUR(IREP,INUM,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
INGRIG=0
CALL FAGOTE(IREP,INUM,INGRIG,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
CALL FAIENC(IREP,INUM,'SURF',INIV,'Z0.FOIS.G   ',ZGZ01,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'Z0VEG.FOIS.G',ZGZV1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'GZ0.THERM   ',ZGZT1,LLCOSP)
! Reset packing after the treatment of roughness lengths
CALL FAGOTE(IREP,INUM,INGRIB,INBPDG,INBCSP,ISTRON,IPUILA,IDMOPL)
CALL FAIENC(IREP,INUM,'SURF',INIV,'ALBEDO      ',ZALB1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'ALBEDO.SOLNU',ZALS1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'ALBEDO.COMPL',ZALS1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'ALBEDO.VEG  ',ZALV1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'EMISSIVITE  ',ZEMI1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'PROP.ARGILE ',ZARG1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'PROP.SABLE  ',ZSAB1,LLCOSP)
CALL FAIENC(IREP,INUM,'SURF',INIV,'EPAI.SOL.MAX',ZDPS1,LLCOSP)

CALL CHK923(INUM)

CALL LFILAF(IREP,INUM,.FALSE.)
CALL FAIRME(IREP,INUM,'KEEP')

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('INCLI5',1,ZHOOK_HANDLE)
END SUBROUTINE INCLI5
