MODULE SUSVEG_MOD
CONTAINS
SUBROUTINE SUSVEG(LD_LELAIV)

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

USE YOS_DIM   , ONLY : NCSS, NTILES
USE YOS_CST   , ONLY : RETV
USE YOS_SOIL  , ONLY : RDAW
USE YOS_VEG   , ONLY : NVTYPES, RVCOV, RVLAI, RVROOTSA, RVLAMSK &
 & , RVLAMSKS, RVTRSR, REPEVAP, RVINTER, RCEPSW, RVRSMIN, RVHSTR &
 & , RLHAERO, RLHAEROS, RCVC, RVLT, RVRAD, REPSR, RVZ0M, RVZ0H, LELAIV &
 & , KCVL, KCVH, ALCVL, ALCVH, RVVEGALB

USE SRFROOTFR_MOD

#ifdef DOC
!**   *SUSVEG* IS THE SET-UP ROUTINE FOR COMMON BLOCK *YOS_VEG*

!     PURPOSE
!     -------
!          THIS ROUTINE INITIALIZES THE CONSTANTS IN COMMON BLOCK
!     *YOS_VEG*

!     INTERFACE.
!     ----------
!     CALLLED FRPM *SUSURF*

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!     A.C.M. BELJAARS         E.C.M.W.F.       2/11/89

!     MODIFICATIONS
!     -------------
!     J.-J. MORCRETTE  ECMWF      91/07/14
!     A. BELJAARS      ECMWF      99/01/05    SURFACE TILES
!     M. HAMRUD        ECMWF      10/11/00    FIX FOR POT. OVERWRITE
!     M.Hamrud                    01/10/2003  CY28 Cleaning
!     P.Viterbo                   24/10/2004  surf library
!     P. Viterbo       ECMWF      09/06/2005  move in surf vob
!     A. BELJAARS      ECMWF      03/12/05    roughness length tables for TOFD
!     E. Dutra/G.Balsamo          01/05/08    add lake tile
!     S. Boussetta/G.Balsamo May 2009 Add lai
!     F. Catalano A. Alessandri ENEA    01/2016     Vegetation cover dependence on LAI
!     F. Catalano A. Alessandri ENEA    05/2016     Desert albedo implementation
!     F. Catalano A. Alessandri ENEA    11/2016     Revised lookup table albedo
!     ------------------------------------------------------------------

#endif

IMPLICIT NONE

LOGICAL, INTENT(IN) :: LD_LELAIV

INTEGER(KIND=JPIM) :: IVTYPES, JS
REAL(KIND=JPRB)    :: ZLARGE, ZSNOW, ZCONV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('SUSVEG_MOD:SUSVEG',0,ZHOOK_HANDLE)

! Number of vegetation types
NVTYPES=20

IVTYPES = MAX(NVTYPES,20)

! Other constants
REPEVAP=1.E-10_JPRB
RVINTER=0.5_JPRB

! Vegetation cover
 
! 0 value acts as default for vegetation type, simplifying code ...
IF(.NOT.ALLOCATED(RVCOV)) ALLOCATE(RVCOV(0:IVTYPES))
RVCOV(1)=0.9_JPRB     ! Crops, Mixed Farming
RVCOV(2)=0.85_JPRB    ! Short Grass
RVCOV(3)=0.9_JPRB     ! Evergreen Needleleaf Trees
RVCOV(4)=0.9_JPRB     ! Deciduous Needleleaf Trees
RVCOV(5)=0.9_JPRB     ! Deciduous Broadleaf Trees
RVCOV(6)=0.99_JPRB    ! Evergreen Broadleaf Trees
RVCOV(7)=0.7_JPRB     ! Tall Grass
RVCOV(8)=0.0_JPRB     ! Desert
RVCOV(9)=0.5_JPRB     ! Tundra
RVCOV(10)=0.9_JPRB    ! Irrigated Crops
RVCOV(11)=0.1_JPRB    ! Semidesert
RVCOV(12)=0.0_JPRB      ! Ice Caps and Glaciers
RVCOV(13)=0.6_JPRB    ! Bogs and Marshes
RVCOV(14)=0.0_JPRB      ! Inland Water
RVCOV(15)=0.0_JPRB      ! Ocean
RVCOV(16)=0.5_JPRB      ! Evergreen Shrubs
RVCOV(17)=0.5_JPRB      ! Deciduous Shrubs
RVCOV(18)=0.9_JPRB    ! Mixed Forest/woodland
RVCOV(19)=0.9_JPRB    ! Interrupted Forest
RVCOV(20)=0.6_JPRB    ! Water and Land Mixtures
RVCOV(0)=RVCOV(8)

! Coefficients for Lambert Beer parameterization for effective vegetation covers
! used if N_COMPUTE_EFF_VEG_FRACTION=2
KCVL=0.5_JPRB
KCVH=0.5_JPRB
ALCVL=1._JPRB
ALCVH=1._JPRB

! Leaf area index

IF(.NOT.ALLOCATED(RVLAI)) ALLOCATE(RVLAI(0:IVTYPES))
RVLAI(1)=3._JPRB     ! Crops, Mixed Farming
RVLAI(2)=2._JPRB     ! Short Grass
RVLAI(3)=5._JPRB     ! Evergreen Needleleaf Trees
RVLAI(4)=5._JPRB     ! Deciduous Needleleaf Trees
RVLAI(5)=5._JPRB     ! Deciduous Broadleaf Trees
RVLAI(6)=6._JPRB     ! Evergreen Broadleaf Trees
RVLAI(7)=2._JPRB     ! Tall Grass
RVLAI(8)=0.5_JPRB      ! Desert
RVLAI(9)=1.0_JPRB       ! Tundra
RVLAI(10)=3._JPRB    ! Irrigated Crops
RVLAI(11)=0.5_JPRB     ! Semidesert
RVLAI(12)=0.0_JPRB     ! Ice Caps and Glaciers
RVLAI(13)=4._JPRB    ! Bogs and Marshes
RVLAI(14)=0.0_JPRB     ! Inland Water
RVLAI(15)=0.0_JPRB     ! Ocean
RVLAI(16)=3._JPRB    ! Evergreen Shrubs
RVLAI(17)=1.5_JPRB   ! Deciduous Shrubs
RVLAI(18)=5._JPRB    ! Mixed Forest/woodland
RVLAI(19)=2.5_JPRB   ! Interrupted Forest
RVLAI(20)=4._JPRB    ! Water and Land Mixtures
RVLAI(0)=RVLAI(8)
!print*,'SUSVEG_MOD:',IVTYPES,RVLAI(0:IVTYPES)
LELAIV = LD_LELAIV
! Skin layer conductivity

ZSNOW=7._JPRB
ZLARGE=1.E10_JPRB
RLHAERO=15._JPRB
RLHAEROS=10._JPRB

! Unstable skin layer conductivity

IF(.NOT.ALLOCATED(RVLAMSK)) ALLOCATE(RVLAMSK(NTILES))
IF (NTILES >= 1) RVLAMSK(1)=ZLARGE           !  Water
IF (NTILES >= 2) RVLAMSK(2)=58._JPRB         !  Sea ice
IF (NTILES >= 3) RVLAMSK(3)=10._JPRB         !  Wet skin
IF (NTILES >= 4) RVLAMSK(4)=10._JPRB         !  Low veg. (Aerodyn.+Rad.+Soil)
IF (NTILES >= 5) RVLAMSK(5)=ZSNOW            !  Snow
IF (NTILES >= 5) RVLAMSK(6)=RLHAERO+5._JPRB  !  High veg. (Aerodyn.+Rad.)
IF (NTILES >= 7) RVLAMSK(7)=RLHAERO+5._JPRB  !  Snow under veg (Aerodyn.+Rad.)
IF (NTILES >= 8) RVLAMSK(8)=15._JPRB         !  Bare soil
IF (NTILES >= 9) RVLAMSK(9)=ZLARGE           !  LAKES = WATER  

! Stable skin layer conductivity

IF(.NOT.ALLOCATED(RVLAMSKS)) ALLOCATE(RVLAMSKS(NTILES))
IF (NTILES >= 1) RVLAMSKS(1)=ZLARGE            !  Water
IF (NTILES >= 2) RVLAMSKS(2)=58._JPRB          !  Sea ice
IF (NTILES >= 3) RVLAMSKS(3)=10._JPRB          !  Wet skin
IF (NTILES >= 4) RVLAMSKS(4)=10._JPRB          !  Low veg. (Aerodyn.+Rad.+Soil)
IF (NTILES >= 5) RVLAMSKS(5)=ZSNOW             !  Snow
IF (NTILES >= 5) RVLAMSKS(6)=RLHAEROS+5._JPRB  !  High veg. (Aerodyn.+Rad.)
IF (NTILES >= 7) RVLAMSKS(7)=RLHAEROS+5._JPRB  !  Snow under veg (Aerodyn.+Rad.+Snow
IF (NTILES >= 8) RVLAMSKS(8)=15._JPRB          !  Bare soil
IF (NTILES >= 9) RVLAMSKS(9)=ZLARGE            !  LAKES = WATER  

! Transmission of net solar rad. through vegetation

IF(.NOT.ALLOCATED(RVTRSR)) ALLOCATE(RVTRSR(NTILES))
IF (NTILES >= 1) RVTRSR(1)=0.00_JPRB     ! Ocean (SSR transmission does not apply)
IF (NTILES >= 2) RVTRSR(2)=0.00_JPRB     ! Ice   (SSR transmission does not apply)
IF (NTILES >= 3) RVTRSR(3)=0.05_JPRB     ! Wet skin (this is a compromise)
IF (NTILES >= 4) RVTRSR(4)=0.05_JPRB     ! Low vegetation
IF (NTILES >= 5) RVTRSR(5)=0.00_JPRB     ! Snow on vegetation (SSR transmission does not apply)
IF (NTILES >= 5) RVTRSR(6)=0.03_JPRB     ! High veg.
IF (NTILES >= 7) RVTRSR(7)=0.03_JPRB     ! Snow under veg.
IF (NTILES >= 8) RVTRSR(8)=0.00_JPRB     ! Bare soil (SSR transmission does not apply)
IF (NTILES >= 9) RVTRSR(9)=0.00_JPRB     ! LAKES (SSR transmission does not apply) 

! Root fraction

IF(.NOT.ALLOCATED(RVROOTSA)) ALLOCATE(RVROOTSA(NCSS,0:NVTYPES))
IF (NCSS >= 1) CALL SRFROOTFR(NCSS,NVTYPES,RDAW,RVROOTSA(:,1:NVTYPES))
DO JS=1,NCSS
  RVROOTSA(JS,0)=RVROOTSA(JS,8)
ENDDO

! Set other constants

RCEPSW  =1.E-3_JPRB

! Minimum stomatal resitance for each vegetation type (s/m)

!                 The additinal correction coefficient (1.30 etc.) accounts
!                 for the decreased radiation stress function at full 
!                 light saturation.

IF(.NOT.ALLOCATED(RVRSMIN)) ALLOCATE (RVRSMIN(0:IVTYPES))
!RVRSMIN(1)=180._JPRB    ! Crops, Mixed Farming
!RVRSMIN(2)=110._JPRB    ! Short Grass
RVRSMIN(1)=100._JPRB    ! Crops, Mixed Farming
RVRSMIN(2)=100._JPRB    ! Short Grass
!RVRSMIN(3)=500._JPRB    ! Evergreen Needleleaf Trees
!RVRSMIN(4)=500._JPRB    ! Deciduous Needleleaf Trees
RVRSMIN(3)=250._JPRB    ! Evergreen Needleleaf Trees
RVRSMIN(4)=250._JPRB    ! Deciduous Needleleaf Trees
RVRSMIN(5)=175._JPRB    ! Deciduous Broadleaf Trees
RVRSMIN(6)=240._JPRB    ! Evergreen Broadleaf Trees
RVRSMIN(7)=100._JPRB    ! Tall Grass
RVRSMIN(8)=250._JPRB    ! Desert
RVRSMIN(9)=80._JPRB     ! Tundra
!RVRSMIN(10)=180._JPRB   ! Irrigated Crops
RVRSMIN(10)=100._JPRB   ! Irrigated Crops
RVRSMIN(11)=150._JPRB   ! Semidesert
RVRSMIN(12)=0.0_JPRB      ! Ice Caps and Glaciers
RVRSMIN(13)=240._JPRB   ! Bogs and Marshes
RVRSMIN(14)=0.0_JPRB      ! Inland Water
RVRSMIN(15)=0.0_JPRB      ! Ocean
RVRSMIN(16)=225._JPRB   ! Evergreen Shrubs
RVRSMIN(17)=225._JPRB   ! Deciduous Shrubs
RVRSMIN(18)=250._JPRB   ! Mixed Forest/woodland
RVRSMIN(19)=175._JPRB   ! Interrupted Forest
RVRSMIN(20)=150._JPRB   ! Water and Land Mixtures
RVRSMIN(0)=RVRSMIN(8)

! Parameter in humidity stress function (m/s mbar, converted to M/S kgkg-1)
IF(.NOT.ALLOCATED(RVHSTR)) ALLOCATE (RVHSTR(0:IVTYPES))
ZCONV=1013.25_JPRB*(RETV+1)
RVHSTR(1)=0.0_JPRB     ! Crops, Mixed Farming
RVHSTR(2)=0.0_JPRB     ! Short Grass
RVHSTR(3)=0.03_JPRB  ! Evergreen Needleleaf Trees
RVHSTR(4)=0.03_JPRB  ! Deciduous Needleleaf Trees
RVHSTR(5)=0.03_JPRB  ! Deciduous Broadleaf Trees
RVHSTR(6)=0.03_JPRB  ! Evergreen Broadleaf Trees
RVHSTR(7)=0.0_JPRB     ! Tall Grass
RVHSTR(8)=0.0_JPRB     ! Desert
RVHSTR(9)=0.0_JPRB     ! Tundra
RVHSTR(10)=0.0_JPRB    ! Irrigated Crops
RVHSTR(11)=0.0_JPRB    ! Semidesert
RVHSTR(12)=0.0_JPRB    ! Ice Caps and Glaciers
RVHSTR(13)=0.0_JPRB    ! Bogs and Marshes
RVHSTR(14)=0.0_JPRB    ! Inland Water
RVHSTR(15)=0.0_JPRB    ! Ocean
RVHSTR(16)=0.0_JPRB    ! Evergreen Shrubs
RVHSTR(17)=0.0_JPRB    ! Deciduous Shrubs
RVHSTR(18)=0.03_JPRB ! Mixed Forest/woodland
RVHSTR(19)=0.03_JPRB ! Interrupted Forest
RVHSTR(20)=0.0_JPRB    ! Water and Land Mixtures
RVHSTR(0)=RVHSTR(8)
RVHSTR(:)=ZCONV*RVHSTR(:)

! Roughness length for momentum (Mahfouf et al. 1995)

IF(.NOT.ALLOCATED(RVZ0M)) ALLOCATE (RVZ0M(0:IVTYPES))
RVZ0M(1)=0.15_JPRB     ! Crops, Mixed Farming
RVZ0M(2)=0.02_JPRB     ! Short Grass
RVZ0M(3)=2.00_JPRB     ! Evergreen Needleleaf Trees
RVZ0M(4)=2.00_JPRB     ! Deciduous Needleleaf Trees
RVZ0M(5)=2.00_JPRB     ! Deciduous Broadleaf Trees
RVZ0M(6)=2.00_JPRB     ! Evergreen Broadleaf Trees
RVZ0M(7)=0.10_JPRB     ! Tall Grass
RVZ0M(8)=0.013_JPRB    ! Desert                    # Masson et al.
RVZ0M(9)=0.05_JPRB     ! Tundra
RVZ0M(10)=0.15_JPRB    ! Irrigated Crops           # Crops type 1
RVZ0M(11)=0.05_JPRB    ! Semidesert 
RVZ0M(12)=0.0013_JPRB  ! Ice Caps and Glaciers     # Mason et al. 
RVZ0M(13)=0.05_JPRB    ! Bogs and Marshes
RVZ0M(14)=0.0001_JPRB  ! Inland Water              # Not used but needs value here
RVZ0M(15)=0.0001_JPRB  ! Ocean                     # Not used but needs value here
RVZ0M(16)=0.10_JPRB    ! Evergreen Shrubs
RVZ0M(17)=0.10_JPRB    ! Deciduous Shrubs
RVZ0M(18)=2.00_JPRB    ! Mixed Forest/woodland
RVZ0M(19)=0.50_JPRB    ! Interrupted Forest        # New value invented here
RVZ0M(20)=0.02_JPRB    ! Water and Land Mixtures   # Not used but needs value here
RVZ0M(0)=RVZ0M(8)      !                           # Bare soil value

!
! Roughness length for heat

IF(.NOT.ALLOCATED(RVZ0H)) ALLOCATE (RVZ0H(0:IVTYPES))
RVZ0H(1)=RVZ0M( 1)/10._JPRB     ! Crops, Mixed Farming
RVZ0H(2)=RVZ0M( 2)/10._JPRB     ! Short Grass
RVZ0H(3)=RVZ0M( 3)              ! Evergreen Needleleaf Trees
RVZ0H(4)=RVZ0M( 4)              ! Deciduous Needleleaf Trees
RVZ0H(5)=RVZ0M( 5)              ! Deciduous Broadleaf Trees
RVZ0H(6)=RVZ0M( 6)              ! Evergreen Broadleaf Trees
RVZ0H(7)=RVZ0M( 7)/10._JPRB     ! Tall Grass
RVZ0H(8)=RVZ0M( 8)/10._JPRB     ! Desert 
RVZ0H(9)=RVZ0M( 9)/10._JPRB     ! Tundra
RVZ0H(10)=RVZ0M(10)/10._JPRB    ! Irrigated Crops 
RVZ0H(11)=RVZ0M(11)/10._JPRB    ! Semidesert 
RVZ0H(12)=RVZ0M(12)/10._JPRB    ! Ice Caps and Glaciers 
RVZ0H(13)=RVZ0M(13)/10._JPRB    ! Bogs and Marshes
RVZ0H(14)=RVZ0M(14)/10._JPRB    ! Inland Water  
RVZ0H(15)=RVZ0M(15)/10._JPRB    ! Ocean 
RVZ0H(16)=RVZ0M(16)/10._JPRB    ! Evergreen Shrubs
RVZ0H(17)=RVZ0M(17)/10._JPRB    ! Deciduous Shrubs
RVZ0H(18)=RVZ0M(18)             ! Mixed Forest/woodland
RVZ0H(19)=RVZ0M(19)/10._JPRB    ! Interrupted Forest 
RVZ0H(20)=RVZ0M(20)/10._JPRB    ! Water and Land Mixtures 
RVZ0H(0)=RVZ0H(8)        

! Simplified physics constants

RCVC=240._JPRB
RVLT=4._JPRB
RVRAD  =0.5_JPRB
REPSR  =1.E-10_JPRB

! albedo

IF(.NOT.ALLOCATED(RVVEGALB)) ALLOCATE(RVVEGALB(0:IVTYPES,4))

! Regression+Rechid parameters
RVVEGALB(0:20,:) = transpose(reshape((/ &
 & 0.0000, 0.0000, 0.0000, 0.0000, &
 & 0.0265, 0.0341, 0.2848, 0.3210, &      ! Crops, Mixed Farming
 & 0.0378, 0.0552, 0.2509, 0.3054, &      ! Short Grass
 & 0.0121, 0.0145, 0.2046, 0.2202, &      ! Evergreen Needleleaf Trees
 & 0.0126, 0.0153, 0.2134, 0.2288, &      ! Deciduous Needleleaf Trees
 & 0.0130, 0.0170, 0.2308, 0.2582, &      ! Deciduous Broadleaf Trees
 & 0.0097, 0.0132, 0.2096, 0.2389, &      ! Evergreen Broadleaf Trees
 & 0.0248, 0.0359, 0.2226, 0.2692, &      ! Tall Grass
 & 0.0000, 0.0000, 0.0000, 0.0000, &      ! Desert
 & 0.0183, 0.0238, 0.2574, 0.2724, &      ! Tundra
 & 0.0250, 0.0296, 0.2572, 0.2790, &      ! Irrigated Crops
 & 0.0529, 0.0865, 0.2045, 0.2900, &      ! Semidesert
 & 0.0000, 0.0000, 0.0000, 0.0000, &      ! Ice Caps and Glaciers
 & 0.0252, 0.0288, 0.1966, 0.2088, &      ! Bogs and Marshes
 & 0.0000, 0.0000, 0.0000, 0.0000, &      ! Inland Water
 & 0.0000, 0.0000, 0.0000, 0.0000, &      ! Ocean
 & 0.0570, 0.0633, 0.2093, 0.2309, &      ! Evergreen Shrubs
 & 0.0520, 0.0652, 0.2377, 0.2766, &      ! Deciduous Shrubs
 & 0.0135, 0.0166, 0.2194, 0.2417, &      ! Mixed Forest/woodland
 & 0.0067, 0.0102, 0.2427, 0.2759, &      ! Interrupted Forest
 & 0.0000, 0.0000, 0.0000, 0.0000  &      ! Water and Land Mixtures
            /), (/4,21/)  ))

IF (LHOOK) CALL DR_HOOK('SUSVEG_MOD:SUSVEG',1,ZHOOK_HANDLE)

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

END SUBROUTINE SUSVEG
END MODULE SUSVEG_MOD
