!$Header: /home/ssipsl/CVSREP/ORCHIDEE/src_parameters/constantes_veg.f90,v 1.32 2008/04/10 16:09:40 ssipsl Exp $
!IPSL (2006)
! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
!-
MODULE constantes_veg
!!--------------------------------------------------------------------
!! "constantes_soil" module contains public physical constantes
!! and public tools functions like    qsat, dev_qsat
!!--------------------------------------------------------------------
  USE IOIPSL
  USE constantes_soil
!-
  IMPLICIT NONE
!-
  LOGICAL,SAVE :: l_qsat_first=.TRUE.
!-
! Flags that (de)activate parts of the model
  TYPE(control_type),SAVE :: control
!-
! Number of vegetation types
  INTEGER(i_std),PARAMETER :: nvm=13
! Number of other surface types: land ice (lakes,cities, ...)
  INTEGER(i_std),PARAMETER :: nnobio=1
!-
! Index for land ice (see nnobio)
  INTEGER(i_std),PARAMETER :: iice = 1
! The maximum mass (kg/m^2) of a glacier.
  REAL(r_std),PARAMETER :: maxmass_glacier = 3000.
!-
! Minimal fraction of mesh a vegetation type can occupy
  REAL(r_std),PARAMETER :: min_vegfrac=0.001
!-
! Constant in the computation of surface resistance
  REAL(r_std),PARAMETER :: defc_plus=23.E-3
! Constant in the computation of surface resistance
  REAL(r_std),PARAMETER :: defc_mult=1.5
!-
! Limit of air temperature for snow
  REAL(r_std),PARAMETER :: tsnow=273.
!-
! Sets the amount above which only sublimation occures [Kg/m^2]
  REAL(r_std),PARAMETER :: snowcri=1.5
! Critical value for computation of snow albedo [Kg/m^2]
  REAL(r_std),PARAMETER :: snowcri_alb=10.
! Lower limit of snow amount
  REAL(r_std),PARAMETER :: sneige=snowcri/1000._r_std
! Latent heat of sublimation
  REAL(r_std),PARAMETER :: chalsu0 = 2.8345E06
! Latent heat of evaporation
  REAL(r_std),PARAMETER :: chalev0 = 2.5008E06
! Latent heat of evaporation 2 (?)
  REAL(r_std),PARAMETER :: chalev1 = 2.5008E06
! Latent heat of fusion
  REAL(r_std),PARAMETER :: chalfu0 = chalsu0-chalev0
!-
! Stefan-Boltzman constant
  REAL(r_std),PARAMETER :: c_stefan = 5.6697E-8
! Specific heat of air
  REAL(r_std),PARAMETER :: cp_air = 1004.675
! Constante molere
  REAL(r_std),PARAMETER :: cte_molr = 287.05
! Kappa
  REAL(r_std),PARAMETER :: kappa = cte_molr/cp_air
! in -- Kg/mole
  REAL(r_std),PARAMETER :: msmlr_air = 28.964E-03
! in -- Kg/mole
  REAL(r_std),PARAMETER :: msmlr_h2o = 18.02E-03
!
  REAL(r_std),PARAMETER :: cp_h2o = &
 & cp_air*(4._r_std*msmlr_air)/( 3.5_r_std*msmlr_h2o)
!
  REAL(r_std),PARAMETER :: cte_molr_h2o = cte_molr/4._r_std
!
  REAL(r_std),PARAMETER :: retv = msmlr_air/msmlr_h2o-1._r_std
!
  REAL(r_std),PARAMETER :: rvtmp2 = cp_h2o/cp_air-1._r_std
!
  REAL(r_std),PARAMETER :: cepdu2 = (0.1_r_std) **2
! Van Karmann Constante
  REAL(r_std),PARAMETER :: ct_karman = 0.35_r_std
! g acceleration
  REAL(r_std),PARAMETER :: cte_grav = 9.80665_r_std
! Constantes of the Louis scheme
  REAL(r_std),PARAMETER :: cb = 5._r_std
  REAL(r_std),PARAMETER :: cc = 5._r_std
  REAL(r_std),PARAMETER :: cd = 5._r_std
! The minimum wind
  REAL(r_std),PARAMETER :: min_wind = 0.1
! Transform pascal into hectopascal
  REAL(r_std),PARAMETER :: pa_par_hpa = 100._r_std
! Time constant of the albedo decay of snow
  REAL(r_std),PARAMETER :: tcst_snowa = 5._r_std
! Maximum period of snow aging
  REAL(r_std),PARAMETER :: max_snow_age = 50._r_std
! Transformation time constant for snow (m)
  REAL(r_std),PARAMETER :: snow_trans = 0.3_r_std
! bare soil roughness length (m)
  REAL(r_std),PARAMETER :: z0_bare = 0.01
! ice roughness length (m)
  REAL(r_std),PARAMETER :: z0_ice = 0.001
!-
! allow agricultural PFTs
  LOGICAL,SAVE :: agriculture = .TRUE.
!!
!! The following tables of parameters for SECHIBA
!! are in the following order :
!!
!!    1 - Bare soil
!!    2 - tropical  broad-leaved evergreen
!!    3 - tropical  broad-leaved raingreen
!!    4 - temperate needleleaf   evergreen
!!    5 - temperate broad-leaved evergreen
!!    6 - temperate broad-leaved summergreen
!!    7 - boreal    needleleaf   evergreen
!!    8 - boreal    broad-leaved summergreen
!!    9 - boreal    needleleaf   summergreen
!!   10 -           C3           grass
!!   11 -           C4           grass
!!   12 -           C3           agriculture
!!   13 -           C4           agriculture
!!
! Value for veget_ori for tests in 0-dim simulations
  REAL(r_std),DIMENSION(nvm),SAVE :: veget_ori_fixed_test_1 = &
 & (/ 0.2, 0.0, 0.0, 0.0, 0.0, &
 &    0.0, 0.0, 0.0, 0.0, 0.8, &
 &    0.0, 0.0, 0.0 /)
! Value for frac_nobio for tests in 0-dim simulations
! laisser ca tant qu'il n'y a que de la glace (pas de lacs)
  REAL(r_std),SAVE :: frac_nobio_fixed_test_1 = 0.0
! REAL(r_std), DIMENSION(nnobio),SAVE :: frac_nobio_fixed_test_1=(/0.0/)
!-
! laimax for maximum lai see also type of lai interpolation
  REAL(r_std),DIMENSION(nvm),SAVE :: llaimax = &
 & (/ 0., 8., 8., 4., 4.5, 4.5, 4., 4.5, 4., 2., 2., 2., 2./)
! laimin for minimum lai see also type of lai interpolation
  REAL(r_std),DIMENSION(nvm),SAVE :: llaimin = &
 & (/ 0., 8., 0., 4., 4.5, 0., 4., 0., 0., 0., 0., 0., 0./)
!-
! prescribed height of vegetation.
! Value for height_presc : one for each vegetation type
  REAL(r_std),DIMENSION(nvm),SAVE :: height_presc = &
 & (/ 0.,30.,30.,20.,20.,20.,15.,15.,15.,.5,.6,1.,1./)
!-
! Structural resistance.
! Value for rstruct_const : one for each vegetation type
  REAL(r_std),DIMENSION(nvm),SAVE :: rstruct_const = &
 & (/ 0.0, 25.0, 25.0, 25.0, 25.0, 25.0, 25.0,&
 &   25.0, 25.0, 2.5, 2.0, 2.0, 2.0 /)
!-
! A vegetation dependent constant used in the calculation
! of the surface resistance.
! Value for kzero one for each vegetation type
  REAL(r_std),DIMENSION(nvm),SAVE :: kzero = &
 & (/0.0, 12.E-5, 12.E-5, 12.e-5, 12.e-5, 25.e-5, 12.e-5,&
       & 25.e-5, 25.e-5, 30.e-5, 30.e-5, 30.e-5, 30.e-5 /)
!-
! Maximum field capacity for each of the vegetations (Temporary).
! Value of wmax_veg : max quantity of water :
! one for each vegetation type en Kg/M3
  REAL(r_std),DIMENSION(nvm),SAVE :: wmax_veg = &
 & (/ 150., 150., 150., 150., 150., 150., 150.,&
 &    150., 150., 150., 150., 150., 150. /)
!-
! Root profile description for the different vegetation types.
! These are the factor in the exponential which gets
! the root density as a function of depth
  REAL(r_std),DIMENSION(nvm), SAVE :: humcste = &
 & (/5., .8, .8, 1., .8, .8, 1., 1., .8, 4., 4., 4., 4./)
!-
! Type of behaviour of the LAI evolution algorithm
! for each vegetation type.
! Value of type_of_lai, one for each vegetation type : mean or interp
!!$  CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = &
!!$ & (/ 'mean ', 'mean ', 'inter', 'mean ', 'mean ', &
!!$ &    'inter', 'mean ', 'inter', 'inter', 'inter', &
!!$ &    'inter', 'inter', 'inter' /)
! Test Nathalie : Even Sempervirens vegetation is allowed to have a small seasonal cycle.
  CHARACTER(len=5),DIMENSION(nvm),SAVE :: type_of_lai = &
 & (/ 'inter', 'inter', 'inter', 'inter', 'inter', &
 &    'inter', 'inter', 'inter', 'inter', 'inter', &
 &    'inter', 'inter', 'inter' /)
!-
! Is the vegetation type a tree ?
  LOGICAL, DIMENSION(nvm),SAVE :: is_tree = &
 & (/ .FALSE., .TRUE.,  .TRUE., .TRUE., .TRUE.,  &
 &    .TRUE.,  .TRUE.,  .TRUE., .TRUE., .FALSE., &
 &    .FALSE., .FALSE., .FALSE. /)
!-
! Initial snow albedo value for each vegetation type
! as it will be used in condveg_snow
! Values are from the Thesis of S. Chalita (1992)
!  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = &
! & (/ 0.55, 0.,   0.,   0.14, 0.15, &
! &    0.15, 0.14, 0.15, 0.14, 0.18, &
! &    0.18, 0.18, 0.18 /)
! Nathalie - Decembre 2006 - on limite les albedos de sol nu en presence de neige, ainsi que ceux de la vegetation
! les valeurs choisies sont proches de celles que nous avions prises dans LMD5.3 avec Delphine Texier
  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_ini = &
 & (/ 0.35, 0.,   0.,   0.14, 0.14, &
 &    0.14, 0.14, 0.14, 0.14, 0.18, &
 &    0.18, 0.18, 0.18 /)
! Decay rate of snow albedo value for each vegetation type
! as it will be used in condveg_snow
! Values are from the Thesis of S. Chalita (1992)
!  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = &
! & (/ 0.30, 0.,   0.,   0.06, 0.14, &
! &    0.14, 0.06, 0.25, 0.06, 0.63, &
! &    0.63, 0.63, 0.63 /)
  ! Nathalie - Decembre 2006 - on limite les albedos de sol nu en presence de neige, ainsi que ceux de la vegetation
  ! les valeurs choisies sont proches de celles que nous avions prises dans LMD5.3 avec Delphine Texier
!-
  REAL(r_std),DIMENSION(nvm),SAVE :: snowa_dec = &
 & (/ 0.45, 0.,   0.,   0.06, 0.06, &
 &    0.11, 0.06, 0.11, 0.11, 0.52, &
 &    0.52, 0.52, 0.52 /)

! leaf albedo of vegetation type, VIS+NIR
  REAL(r_std),DIMENSION(nvm*2),SAVE :: alb_leaf = &
 & (/ .00, .04, .06, .06, .06, &
 &    .06, .06, .06, .06, .10, &
 &    .10, .10, .10, &
 &    .00, .20, .22, .22, .22, &
 &    .22, .22, .22, .22, .30, &
 &    .30, .30, .30   /)
!-
! Table which contains the correlation between the soil types
! and vegetation type. Two modes exist :
!  1) pref_soil_veg = 0 then we have an equidistribution
!     of vegetation on soil types
!  2) Else for each pft the prefered soil type is given :
!     1=sand, 2=loan, 3=clay
! The variable is initialized in slowproc.
  INTEGER(i_std),DIMENSION(nvm,nstm) ::  pref_soil_veg
!-
! albedo of dead leaves, VIS+NIR
  REAL(r_std),DIMENSION(2),SAVE :: alb_deadleaf = (/ .12, .35/)
! albedo of ice, VIS+NIR
  REAL(r_std),DIMENSION(2),SAVE :: alb_ice = (/ .60, .20/)
!-
! Is veget_ori array stored in restart file
  LOGICAL,PARAMETER :: ldveget_ori_on_restart = .TRUE.
!-
! Set to .TRUE. if you want q_cdrag coming from GCM
  LOGICAL,SAVE :: ldq_cdrag_from_gcm = .FALSE.
!-
! Constant in the computation of surface resistance
  REAL(r_std),PARAMETER :: rayt_cste = 125.
!-
! Size of local array to keep saturated humidity
! at each temperature level
  INTEGER(i_std),PARAMETER :: max_temp=370
! Minimum temperature for saturated humidity
  INTEGER(i_std),PARAMETER :: min_temp=100
! Local array to keep saturated humidity at each temperature level
  REAL(r_std),DIMENSION(max_temp),SAVE :: qsfrict
!-
!===
CONTAINS
!===
SUBROUTINE qsatcalc (kjpindex,temp_in,pres_in,qsat_out)
!---------------------------------------------------------------------
    ! input value
! Domain size
  INTEGER(i_std),INTENT(in) :: kjpindex
! Temperature in degre Kelvin
  REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in
! Pressure
  REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in
    ! output value
! Result
  REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: qsat_out
!-
    ! local variables
  INTEGER(i_std), DIMENSION(kjpindex)       :: jt
  INTEGER(i_std)                            :: ji
  REAL(r_std),DIMENSION(kjpindex)     :: zz_a, zz_b, zz_f
  INTEGER(i_std)                     :: nbad
  INTEGER(i_std),DIMENSION(1)        :: lo
!---------------------------------------------------------------------
  IF (l_qsat_first) THEN
    CALL qsfrict_init
    l_qsat_first = .FALSE.
  ENDIF
!-
! 1. computes qsat interpolation into two successive temperature
!-
  jt = INT(temp_in(:))
!-
  nbad = COUNT(jt(:) >= max_temp-1)
  IF (nbad > 0) THEN
    WRITE(numout,*) ' qsatcalc: temperature too high at ', &
 &    nbad, ' points.'
    IF (.NOT.diag_qsat) THEN
        CALL ipslerr(2,'qsatcalc','diffuco', '', &
 &                     'temperature incorect.')
    ELSE
      lo = MAXLOC(temp_in(:))
      WRITE(numout,*) &
 &     'Maximum temperature ( ',MAXVAL(temp_in),') found at ',lo(1)
      WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
    ENDIF
  ENDIF
!-
  nbad = COUNT(jt(:) <= min_temp)
  IF (nbad > 0) THEN
    WRITE(numout,*) ' qsatcalc: temperature too low at ', &
 &    nbad, ' points.'
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(2,'qsatcalc','diffuco', '', &
 &                   'temperature incorect.')
    ELSE
      lo = MINLOC(temp_in(:))
      WRITE(numout,*) &
 &     'Minimum temperature ( ',MINVAL(temp_in),') found at ',lo(1)
      WHERE (jt(:) <= min_temp)   jt(:) = min_temp
    ENDIF
  ENDIF
!-
  DO ji = 1, kjpindex
    zz_f(ji) = temp_in(ji)-FLOAT(jt(ji))
    zz_a(ji) = qsfrict(jt(ji))
    zz_b(ji) = qsfrict(jt(ji)+1)
  ENDDO
!-
! 2. interpolates between this two values
!-
  DO ji = 1, kjpindex
    qsat_out(ji) = ((zz_b(ji)-zz_a(ji))*zz_f(ji)+zz_a(ji))/pres_in(ji)
  ENDDO
!----------------------
END SUBROUTINE qsatcalc
!===
FUNCTION qsat (temp_in,pres_in) RESULT (qsat_result)
!!--------------------------------------------------------------------
!! FUNCTION qsat (temp_in, pres_in) RESULT (qsat_result)
!!--------------------------------------------------------------------
  REAL(r_std),INTENT(in) :: temp_in  ! Temperature in degre Kelvin
  REAL(r_std),INTENT(in) :: pres_in  ! Pressure
  REAL(r_std) :: qsat_result
!-
  INTEGER(i_std)        :: jt
  REAL(r_std)     :: zz_a,zz_b,zz_f
!---------------------------------------------------------------------
  IF (l_qsat_first) THEN
    CALL qsfrict_init
    l_qsat_first = .FALSE.
  ENDIF
!-
! 1. computes qsat interpolation into two successive temperature
!-
  jt = INT(temp_in)
!-
  IF (jt >= max_temp-1) THEN
    WRITE(numout,*) &
 &   ' We stop. temperature too BIG : ',temp_in, &
 &   ' approximation for : ',jt
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(2,'qsat','', '',&
 &                   'temperature incorect.')
    ELSE
      qsat_result = 999999.
      RETURN
    ENDIF
  ENDIF
!-
  IF (jt <= min_temp ) THEN
    WRITE(numout,*) &
 &   ' We stop. temperature too SMALL : ',temp_in, &
 &   ' approximation for : ',jt
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(2,'qsat','', '',&
 &                   'temperature incorect.')
    ELSE
      qsat_result = -999999.
      RETURN
    ENDIF
  ENDIF
!-
  zz_f = temp_in-FLOAT(jt)
  zz_a = qsfrict(jt)
  zz_b = qsfrict(jt+1)
!-
! 2. interpolates between this two values
!-
  qsat_result = ((zz_b-zz_a)*zz_f+zz_a)/pres_in
!----------------
END FUNCTION qsat
!===
SUBROUTINE dev_qsatcalc (kjpindex,temp_in,pres_in,dev_qsat_out)
!---------------------------------------------------------------------
! Domain size
  INTEGER(i_std),INTENT(in)                  :: kjpindex
! Temperature in degre Kelvin
  REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: temp_in
! Pressure
  REAL(r_std),DIMENSION(kjpindex),INTENT(in)  :: pres_in
! Result
  REAL(r_std),DIMENSION(kjpindex),INTENT(out) :: dev_qsat_out
!-
  INTEGER(i_std),DIMENSION(kjpindex) :: jt
  INTEGER(i_std)                     :: ji
  REAL(r_std),DIMENSION(kjpindex)     :: zz_a, zz_b, zz_c, zz_f
  INTEGER(i_std)                     :: nbad
!---------------------------------------------------------------------
  IF (l_qsat_first) THEN
    CALL qsfrict_init
    l_qsat_first = .FALSE.
  ENDIF
!-
! 1. computes qsat interpolation into two successive temperature
!-
  jt = INT(temp_in(:)+undemi)
!-
  nbad = COUNT( jt(:) >= max_temp-1 )
  IF (nbad > 0) THEN
    WRITE(numout,*) &
 &   ' dev_qsatcalc: temperature too high at ',nbad,' points.'
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(3,'dev_qsatcalc','', '', &
 &                   'temperature incorect.')
    ELSE
      WHERE (jt(:) >= max_temp-1)   jt(:) = max_temp-1
    ENDIF
  ENDIF
!-
  nbad = COUNT( jt(:) <= min_temp )
  IF (nbad > 0) THEN
    WRITE(numout,*) &
 &   ' dev_qsatcalc: temperature too low at ',nbad,' points.'
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(3,'dev_qsatcalc', '', '',&
 &                   'temperature incorect.')
    ELSE
      WHERE (jt(:) <= min_temp)   jt(:) = min_temp
    ENDIF
  ENDIF
!-
  DO ji=1,kjpindex
    zz_f(ji) = temp_in(ji)+undemi-FLOAT(jt(ji))
    zz_a(ji) = qsfrict(jt(ji)-1)
    zz_b(ji) = qsfrict(jt(ji))
    zz_c(ji) = qsfrict(jt(ji)+1)
  ENDDO
!-
! 2. interpolates between this two values
!-
  DO ji = 1, kjpindex
    dev_qsat_out(ji) = &
 &   ((zz_c(ji)-deux*zz_b(ji)+zz_a(ji))*(zz_f(ji)-un) + &
 &                         zz_c(ji)-zz_b(ji))/pres_in(ji)
  ENDDO
!--------------------------
END SUBROUTINE dev_qsatcalc
!===
FUNCTION dev_qsat (temp_in,pres_in) RESULT (dev_qsat_result)
!!--------------------------------------------------------------------
!! FUNCTION dev_qsat (temp_in, pres_in) RESULT (dev_qsat_result)
!! computes deviation of qsat
!!--------------------------------------------------------------------
  REAL(r_std),INTENT(in)  :: pres_in    ! Pressure
  REAL(r_std),INTENT(in)  :: temp_in    ! Temperture in degre Kelvin
  REAL(r_std) :: dev_qsat_result
!-
  INTEGER(i_std)        :: jt
  REAL(r_std)     :: zz_a, zz_b, zz_c, zz_f
!---------------------------------------------------------------------
  IF (l_qsat_first) THEN
    CALL qsfrict_init
    l_qsat_first = .FALSE.
  ENDIF
!-
! 1. computes qsat deviation interpolation
!    into two successive temperature
!-
  jt = INT(temp_in+undemi)
!-
  IF (jt >= max_temp-1) THEN
    WRITE(numout,*) &
 &   ' We stop. temperature too HIGH : ',temp_in, &
 &   ' approximation for : ',jt
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(3,'dev_qsat','', '',&
 &                   'temperature incorect.')
    ELSE
      dev_qsat_result = 999999.
        RETURN
    ENDIF
  ENDIF
!-
  IF (jt <= min_temp ) THEN
    WRITE(numout,*) &
 &   ' We stop. temperature too LOW : ',temp_in, &
 &   ' approximation for : ',jt
    IF (.NOT.diag_qsat) THEN
      CALL ipslerr(3,'dev_qsat','', '',&
 &                    'temperature incorect.')
    ELSE
      dev_qsat_result = -999999.
        RETURN
    ENDIF
  ENDIF
!-
  zz_f = temp_in+undemi-FLOAT(jt)
  zz_a = qsfrict(jt-1)
  zz_b = qsfrict(jt)
  zz_c = qsfrict(jt+1)
!-
! 2. interpolates
!-
  dev_qsat_result=((zz_c-deux*zz_b+zz_a)*(zz_f-un)+zz_c-zz_b)/pres_in
!--------------------
END FUNCTION dev_qsat
!===
SUBROUTINE qsfrict_init
!!--------------------------------------------------------------------
!! The qsfrict_init routine initialises qsfrict array
!! to store precalculated value for qsat
!!--------------------------------------------------------------------
  INTEGER(i_std)        :: ji
  REAL(r_std)     :: zrapp,zcorr,ztemperature,zqsat
!---------------------------------------------------------------------
! initialisation
  zrapp = msmlr_h2o/msmlr_air
  zcorr = 0.00320991_r_std
! computes saturated humidity one time and store in qsfrict local array
  DO ji=100,max_temp
    ztemperature = FLOAT(ji)
    IF (ztemperature < 273._r_std) THEN
      zqsat = zrapp*10.0_r_std**(2.07023_r_std-zcorr*ztemperature &
 &             -2484.896/ztemperature+3.56654*LOG10(ztemperature))
    ELSE
      zqsat = zrapp*10.0**(23.8319-2948.964/ztemperature &
 &              -5.028*LOG10(ztemperature) &
 &              -29810.16*EXP(-0.0699382*ztemperature) &
 &              +25.21935*EXP(-2999.924/ztemperature))
    ENDIF
    qsfrict (ji) = zqsat
  ENDDO
!-
  qsfrict(1:100) = zero
!-
  IF (long_print) WRITE (numout,*) ' qsfrict_init done'
!--------------------------
END SUBROUTINE qsfrict_init
!===
FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
!!--------------------------------------------------------------------
!! FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
!! this function interpolates value between ztempmin and ztempmax
!! used for lai detection
!!--------------------------------------------------------------------
  REAL(r_std),INTENT(in)  :: temp_in  !! Temperature in degre Kelvin
  REAL(r_std) :: tempfunc_result
!-
  REAL(r_std),PARAMETER :: ztempmin=273._r_std !! Temperature for laimin
  REAL(r_std),PARAMETER :: ztempmax=293._r_std !! Temperature for laimax
  REAL(r_std)           :: zfacteur           !! Interpolation factor
!---------------------------------------------------------------------
  zfacteur = un/(ztempmax-ztempmin)**2
  IF     (temp_in > ztempmax) THEN
    tempfunc_result = un
  ELSEIF (temp_in < ztempmin) THEN
    tempfunc_result = zero
  ELSE
    tempfunc_result = un-zfacteur*(ztempmax-temp_in)**2
  ENDIF
!--------------------
END FUNCTION tempfunc
!===
SUBROUTINE get_vegcorr (nolson,vegcorr,nobiocorr)
!---------------------------------------------------------------------
  INTEGER(i_std),INTENT(in)                    :: nolson
  REAL(r_std),DIMENSION(nolson,nvm),INTENT(out) :: vegcorr(nolson,nvm)
  REAL(r_std),DIMENSION(nolson,nnobio),INTENT(out) :: nobiocorr
!-
  INTEGER(i_std)           :: ib
  INTEGER(i_std),PARAMETER :: nolson94 = 94
  INTEGER(i_std),PARAMETER :: nvm13 = 13
!---------------------------------------------------------------------
  IF (nolson /= nolson94) THEN
    WRITE(numout,*) nolson,nolson94
    CALL ipslerr(3,'get_vegcorr', '', '',&
 &                 'wrong number of OLSON vegetation types.')
  ENDIF
  IF (nvm /= nvm13) THEN
    WRITE(numout,*) nvm,nvm13
    CALL ipslerr(3,'get_vegcorr', '', '',&
 &                 'wrong number of SECHIBA vegetation types.')
  ENDIF
!-
! 1 set the indices of non-biospheric surface types to 0.
!-
  nobiocorr(:,:) = 0.
!-
! 2 Here we construct the correspondance table
!   between Olson and the following SECHIBA Classes.
!   vegcorr(i,:)+nobiocorr(i,:) = 1.  for all i.
!-
! The modified OLSON types found in file carteveg5km.nc
! created by Nicolas Viovy :
!  1 Urban
  vegcorr( 1,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
!  2 Cool low sparse grassland
  vegcorr( 2,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
!  3 Cold conifer forest
  vegcorr( 3,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
!  4 Cold deciduous conifer forest
  vegcorr( 4,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0/)
!  5 Cool Deciduous broadleaf forest
  vegcorr( 5,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
!  6 Cool evergreen broadleaf forests
  vegcorr( 6,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
!  7 Cool tall grasses and shrubs
  vegcorr( 7,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
!  8 Warm C3 tall grasses and shrubs
  vegcorr( 8,:) = &
 & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
!  9 Warm C4 tall grases and shrubs
  vegcorr( 9,:) = &
 & (/0.1, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
! 10 Bare desert
  vegcorr(10,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 11 Cold upland tundra
  vegcorr(11,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
! 12 Cool irrigated grassland
  vegcorr(12,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
! 13 Semi desert
  vegcorr(13,:) = &
 & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
! 14 Glacier ice
  vegcorr(14,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
    nobiocorr(14,iice) = 1.
! 15 Warm wooded wet swamp
  vegcorr(15,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0/)
! 16 Inland water
  vegcorr(16,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 17 sea water
  vegcorr(17,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 18 cool shrub evergreen
  vegcorr(18,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 19 cold shrub deciduous
  vegcorr(19,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 20 Cold evergreen forest and fields
  vegcorr(20,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.0, 0.0/)
! 21 cool rain forest
  vegcorr(21,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 22 cold conifer boreal forest
  vegcorr(22,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 23 cool conifer forest
  vegcorr(23,:) = &
 & (/0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 24 warm mixed forest
  vegcorr(24,:) = &
 & (/0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0/)
! 25 cool mixed forest
  vegcorr(25,:) = &
 & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 26 cool broadleaf forest
  vegcorr(26,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
! 27 cool deciduous broadleaf forest
  vegcorr(27,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.3, 0.5, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 28 warm montane tropical forest
  vegcorr(28,:) = &
 & (/0.0, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0/)
! 29 warm seasonal tropical forest
  vegcorr(29,:) = &
 & (/0.0, 0.5, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
! 30 cool crops and towns
  vegcorr(30,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
! 31 warm crops and towns
  vegcorr(31,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8/)
! 32 cool crops and towns
  vegcorr(32,:) = &
 & (/0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
! 33 warm dry tropical woods
  vegcorr(33,:) = &
 & (/0.2, 0.0, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
! 34 warm tropical rain forest
  vegcorr(34,:) = &
 & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 35 warm tropical degraded forest
  vegcorr(35,:) = &
 & (/0.1, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0/)
! 36 warm corn and beans cropland
  vegcorr(36,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
! 37 cool corn and bean cropland
  vegcorr(37,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
! 38 warm rice paddy and field
  vegcorr(38,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
! 39 hot irrigated cropland
  vegcorr(39,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0/)
! 40 cool irrigated cropland
  vegcorr(40,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
! 41 cold irrigated cropland
  vegcorr(41,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
! 42 cool grasses and shrubs
  vegcorr(42,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
! 43 hot and mild grasses and shrubs
  vegcorr(43,:) = &
 & (/0.2, 0.0, 0.1, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0/)
! 44 cold grassland
  vegcorr(44,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.0/)
! 45 Savanna (woods) C3
  vegcorr(45,:) = &
 & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
! 46 Savanna woods C4
  vegcorr(46,:) = &
 & (/0.1, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0/)
! 47 Mire, bog, fen
  vegcorr(47,:) = &
 & (/0.1, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.0/)
! 48 Warm marsh wetland
  vegcorr(48,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
! 49 cold marsh wetland
  vegcorr(49,:) = &
 & (/0.0, 0.0, 0.0, 0.1, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
! 50 mediteraean scrub
  vegcorr(50,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
! 51 Cool dry woody scrub
  vegcorr(51,:) = &
 & (/0.3, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 52 Warm dry evergreen woods
  vegcorr(52,:) = &
 & (/0.1, 0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 53 Volcanic rocks
  vegcorr(53,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 54 sand desert
  vegcorr(54,:) = &
 & (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 55 warm semi desert shrubs
  vegcorr(55,:) = &
 & (/0.7, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
! 56 cool semi desert shrubs
  vegcorr(56,:) = &
 & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
! 57 semi desert sage
  vegcorr(57,:) = &
 & (/0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 58 Barren tundra
  vegcorr(58,:) = &
 & (/0.6, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0/)
! 59 cool southern hemisphere mixed forest
  vegcorr(59,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.3, 0.3, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
! 60 cool fields and woods
  vegcorr(60,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
! 61 warm forest and filed
  vegcorr(61,:) = &
 & (/0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
! 62 cool forest and field
  vegcorr(62,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
! 63 warm C3 fields and woody savanna
  vegcorr(63,:) = &
 & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
! 64 warm C4 fields and woody savanna
  vegcorr(64,:) = &
 & (/0.1, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6/)
! 65 cool fields and woody savanna
  vegcorr(65,:) = &
 & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
! 66 warm succulent and thorn scrub
  vegcorr(66,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0/)
! 67 cold small leaf mixed woods
  vegcorr(67,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.3, 0.0, 0.5, 0.0, 0.0, 0.0/)
! 68 cold deciduous and mixed boreal fores
  vegcorr(68,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.7, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0/)
! 69 cold narrow conifers
  vegcorr(69,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
! 70 cold wooded tundra
  vegcorr(70,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
! 71 cold heath scrub
  vegcorr(71,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.7, 0.0, 0.0, 0.0/)
! 72 Polar and alpine desert
  vegcorr(72,:) = &
 & (/0.9, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.1, 0.0, 0.0, 0.0/)
! 73 warm Mangrove
  vegcorr(73,:) = &
 & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 74 cool crop and water mixtures
  vegcorr(74,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0/)
! 75 cool southern hemisphere mixed forest
  vegcorr(75,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.4, 0.4, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 76 cool moist eucalyptus
  vegcorr(76,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0/)
! 77 warm rain green tropical forest
  vegcorr(77,:) = &
 & (/0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
! 78 warm C3 woody savanna
  vegcorr(78,:) = &
 & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 79 warm C4 woody savanna
  vegcorr(79,:) = &
 & (/0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 80 cool woody savanna
  vegcorr(80,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.4, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 81 cold woody savanna
  vegcorr(81,:) = &
 & (/0.0, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, 0.6, 0.0, 0.0, 0.0/)
! 82 warm broadleaf crops
  vegcorr(82,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
! 83 warm C3 grass crops
  vegcorr(83,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9, 0.0/)
! 84 warm C4 grass crops
  vegcorr(84,:) = &
 & (/0.1, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.9/)
! 85 cool grass crops
  vegcorr(85,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0/)
! 86 warm C3 crops grass,shrubs
  vegcorr(86,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0/)
! 87 cool crops,grass,shrubs
  vegcorr(87,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.0, 0.5, 0.0/)
! 88 warm evergreen tree crop
  vegcorr(88,:) = &
 & (/0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
! 89 cool evergreen tree crop
  vegcorr(89,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
! 90 cold evergreen tree crop
  vegcorr(90,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
! 91 warm deciduous tree crop
  vegcorr(91,:) = &
 & (/0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2/)
! 92 cool deciduous tree crop
  vegcorr(92,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, 0.2, 0.0/)
! 93 cold deciduous tree crop
  vegcorr(93,:) = &
 & (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0, 0.2, 0.0/)
! 94 wet sclerophylic forest
  vegcorr(94,:) = &
 & (/0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/)
!-
! 3 Check the mapping for the Olson types which are going into the
!   the veget and nobio array.
!-
  DO ib=1,nolson
    IF ( ABS(SUM(vegcorr(ib,:))+SUM(nobiocorr(ib,:))-1.0) &
 &       > EPSILON(1.0)) THEN
      WRITE(numout,*) 'Wrong correspondance for Olson type :', ib
      CALL ipslerr(3,'get_vegcorr', '', '',&
 &                 'Wrong correspondance for Olson type.')
    ENDIF
  ENDDO
!-------------------------
END SUBROUTINE get_vegcorr
!===
SUBROUTINE get_soilcorr (nzobler,textfrac_table)
!!--------------------------------------------------------------------
!! The "get_soilcorr" routine defines the table of correspondence
!! between the Zobler types and the three texture
!! types known by SECHIBA & STOMATE : silt, sand and clay
!!--------------------------------------------------------------------
  INTEGER(i_std),INTENT(in)                      :: nzobler
  REAL(r_std),DIMENSION(nzobler,nstm),INTENT(out) :: textfrac_table
!-
  INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7
  INTEGER(i_std) :: ib
!---------------------------------------------------------------------
  IF (nzobler /= nbtypes_zobler) THEN
    CALL ipslerr(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
 &   'We do not have the correct number of classes', &
 &                 ' in the code for the file.')
  ENDIF
!-
! Textural fraction for : silt        sand         clay
!-
  textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
  textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
  textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
  textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
  textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
  textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
  textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)

  DO ib=1,nzobler
    IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(1.0)) THEN
      WRITE(numout,*) &
 &     'Error in the correspondence table', &
 &     ' sum is not equal to 1 in', ib
    WRITE(numout,*) textfrac_table(ib,:)
       CALL ipslerr(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
 &                 '', 'Error in the correspondence table')
    ENDIF
  ENDDO
!--------------------------
END SUBROUTINE GET_soilcorr
!===
!------------------------
END MODULE constantes_veg