veg_from_lai.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!#######################
MODULE modi_veg_from_lai
!#######################
!
INTERFACE veg_from_lai
!
    FUNCTION veg_from_lai_0d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL,                 INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,              INTENT(IN) :: OAGRI_TO_GRASS
!
REAL                             :: PVEG         ! vegetation fraction
!
END FUNCTION veg_from_lai_0d
!
!
    FUNCTION veg_from_lai_1d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL,   DIMENSION(:),   INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:,:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,                INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI))      :: PVEG         ! vegetation fraction
!
END FUNCTION veg_from_lai_1d
!
!
    FUNCTION veg_from_lai_2d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL,   DIMENSION(:,:),   INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,                  INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: PVEG ! vegetation fraction
!
END FUNCTION veg_from_lai_2d
!

    FUNCTION veg_from_lai_vegtype_1d(PLAI,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL,   DIMENSION(:), INTENT(IN) :: PLAI         ! Leaf area Index for each vegtype
LOGICAL,              INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI)) :: PVEG ! vegetation fraction
!
END FUNCTION veg_from_lai_vegtype_1d
!
END INTERFACE
!
END MODULE modi_veg_from_lai
!
!   ####################################################
    FUNCTION veg_from_lai_0d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!   ####################################################
!!
!!    PURPOSE
!!    -------
!
!     Calculates coverage of soil by vegetation from leaf
!    area index and type of vegetation
!    (most of types; forest and vineyards; grassland)
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson and A. Boone          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    25/03/99
!!     
!!      R. Alkama    05/2012 : extantion from 12 to 19 vegtypes
!!      B. Decharme  05/2013  new param for equatorial forest
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY :nvt_no, nvt_rock, nvt_snow, nvt_tebd,     & 
                                 nvt_bone, nvt_trbe, nvt_c3, nvt_c4,     &
                                 nvt_irr, nvt_gras, nvt_trog, nvt_park,  &
                                 nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
                                 nvt_bond, nvt_bogr, nvt_shrb, nvt_c3w,  &
                                 nvt_c3s, nvt_fltr, nvt_flgr
!
USE modd_reprod_oper,    ONLY : xeverg_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,                 INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,              INTENT(IN) :: OAGRI_TO_GRASS
!
REAL                             :: PVEG         ! vegetation fraction
!
!*      0.2    declarations of local variables
!
REAL :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_0D',0,zhook_handle)
zlai = plai
IF ( pvegtype(nvt_no  ) + pvegtype(nvt_rock) + pvegtype(nvt_snow)< 1.) THEN
  zlai = plai / (1.-pvegtype(nvt_no)-pvegtype(nvt_rock)-pvegtype(nvt_snow))
END IF
!
IF(oagri_to_grass)THEN
  zagri = 0.95
ELSE
  zagri = (1. - exp( -0.6 * zlai ))
ENDIF
!
zsum1 = pvegtype(nvt_c4)
IF (nvt_irr>0 .AND. nvt_c3>0) THEN
  zsum1 = zsum1 + pvegtype(nvt_irr) + pvegtype(nvt_c3)
ELSEIF (nvt_c3w>0 .AND. nvt_c3s>0) THEN
  zsum1 = zsum1 + pvegtype(nvt_c3w) + pvegtype(nvt_c3s)
ENDIF
!
zsum2 = pvegtype(nvt_tebd) + pvegtype(nvt_trbd) + pvegtype(nvt_tebe) +   &
        pvegtype(nvt_bobd) + pvegtype(nvt_shrb) + pvegtype(nvt_bone) +   &
        pvegtype(nvt_tene) +  pvegtype(nvt_bond)
IF (nvt_fltr>0) zsum2 = zsum2 + pvegtype(nvt_fltr)
!
zsum3 = pvegtype(nvt_gras) + pvegtype(nvt_bogr) + pvegtype(nvt_trog)
IF (nvt_park>0) THEN
  zsum3 = zsum3 + pvegtype(nvt_park)
ELSEIF (nvt_flgr>0) THEN
  zsum3 = zsum3 + pvegtype(nvt_flgr)
ENDIF
!
pveg = zagri                      * zsum1   &!
       + 0.95                     * zsum2   &! 
       + xeverg_veg               * pvegtype(nvt_trbe)     &! EVER 
       + 0.95                     * zsum3   &! 
       + 0.                       * pvegtype(nvt_no  )     &! no vegetation (smooth)
       + 0.                       * pvegtype(nvt_snow)     &! no vegetation (snow)
       + 0.                       * pvegtype(nvt_rock)      ! no vegetation (rocks)  
!
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_0D',1,zhook_handle)
!-----------------------------------------------------------------
!
END FUNCTION veg_from_lai_0d
!
!   ####################################################
    FUNCTION veg_from_lai_1d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!   ####################################################
!!
!!    PURPOSE
!!    -------
!
!     Calculates coverage of soil by vegetation from leaf
!    area index and type of vegetation
!    (most of types; forest and vineyards; grassland)
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson and A. Boone          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    25/03/99
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY : nvt_no, nvt_rock, nvt_snow, nvt_tebd,    & 
                                 nvt_bone, nvt_trbe, nvt_c3, nvt_c4,     &
                                 nvt_irr, nvt_gras, nvt_trog, nvt_park,  &
                                 nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
                                 nvt_bond, nvt_bogr, nvt_shrb, nvt_c3w,  &
                                 nvt_c3s, nvt_fltr, nvt_flgr 
!
USE modd_reprod_oper,    ONLY : xeverg_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,   DIMENSION(:),   INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:,:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,                INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI))      :: PVEG         ! vegetation fraction
!
!*      0.2    declarations of local variables
!
REAL,   DIMENSION(SIZE(PLAI))      :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_1D',0,zhook_handle)
zlai(:) = plai(:)
WHERE ( pvegtype(:,nvt_no  ) + pvegtype(:,nvt_rock) + pvegtype(:,nvt_snow) < 1.) 
  zlai(:) = plai(:) / (1.-pvegtype(:,nvt_no)-pvegtype(:,nvt_rock)-pvegtype(:,nvt_snow))
END WHERE
!
IF(oagri_to_grass)THEN
  zagri(:) = 0.95
ELSE
  zagri(:) = (1. - exp( -0.6 * zlai(:) ))
ENDIF
!
zsum1(:) = pvegtype(:,nvt_c4)
IF (nvt_irr>0 .AND. nvt_c3>0) THEN
  zsum1(:) = zsum1(:) + pvegtype(:,nvt_irr) + pvegtype(:,nvt_c3)
ELSEIF (nvt_c3w>0 .AND. nvt_c3s>0) THEN
  zsum1(:) = zsum1(:) + pvegtype(:,nvt_c3w) + pvegtype(:,nvt_c3s)
ENDIF
!
zsum2(:) = pvegtype(:,nvt_tebd) + pvegtype(:,nvt_trbd) + pvegtype(:,nvt_tebe) +   &  
           pvegtype(:,nvt_bobd) + pvegtype(:,nvt_shrb) + pvegtype(:,nvt_bone) +   &
           pvegtype(:,nvt_tene) +  pvegtype(:,nvt_bond)
IF (nvt_fltr>0) zsum2(:) = zsum2(:) + pvegtype(:,nvt_fltr)
!
zsum3(:) = pvegtype(:,nvt_gras) + pvegtype(:,nvt_bogr) + pvegtype(:,nvt_trog)
IF (nvt_park>0) THEN
  zsum3(:) = zsum3(:) + pvegtype(:,nvt_park)
ELSEIF (nvt_flgr>0) THEN
  zsum3(:) = zsum3(:) + pvegtype(:,nvt_flgr)
ENDIF
!
pveg(:) = zagri(:)                * zsum1(:) &
       + 0.95                     * zsum2(:) &
       + xeverg_veg               * pvegtype(:,nvt_trbe)     &! EVER 
       + 0.95                     * zsum3(:) &
       + 0.                       * pvegtype(:,nvt_no  )     &! no vegetation (smooth)
       + 0.                       * pvegtype(:,nvt_snow)     &! no vegetation (snow)
       + 0.                       * pvegtype(:,nvt_rock)      ! no vegetation (rocks)

IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_1D',1,zhook_handle)
!
!-----------------------------------------------------------------
!
END FUNCTION veg_from_lai_1d
!
!   ####################################################
    FUNCTION veg_from_lai_2d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!   ####################################################
!!
!!    PURPOSE
!!    -------
!
!     Calculates coverage of soil by vegetation from leaf
!    area index and type of vegetation
!    (most of types; forest and vineyards; grassland)
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson and A. Boone          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    25/03/99
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY : nvt_no, nvt_rock, nvt_snow, nvt_tebd,    & 
                                 nvt_bone, nvt_trbe, nvt_c3, nvt_c4,     &
                                 nvt_irr, nvt_gras, nvt_trog, nvt_park,  &
                                 nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
                                 nvt_bond, nvt_bogr, nvt_shrb, nvt_c3w,  &
                                 nvt_c3s, nvt_fltr, nvt_flgr 
USE modd_surf_par,       ONLY : xundef
!
USE modd_reprod_oper,    ONLY : xeverg_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,   DIMENSION(:,:),   INTENT(IN) :: PLAI         ! Leaf area Index
REAL,   DIMENSION(:,:,:), INTENT(IN) :: PVEGTYPE     ! type of vegetation
LOGICAL,                  INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: PVEG ! vegetation fraction
!
!*      0.2    declarations of local variables
!
REAL,   DIMENSION(SIZE(PLAI,1),SIZE(PLAI,2)) :: ZLAI, ZAGRI, ZSUM1, ZSUM2, ZSUM3
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_2D',0,zhook_handle)
zlai(:,:) = plai(:,:)
WHERE ( pvegtype(:,:,nvt_no  ) + pvegtype(:,:,nvt_rock) + pvegtype(:,:,nvt_snow) < 1.) 
  zlai(:,:) = plai(:,:) / (1.-pvegtype(:,:,nvt_no)-pvegtype(:,:,nvt_rock)-pvegtype(:,:,nvt_snow))
END WHERE
!
pveg(:,:) = xundef
!
IF(oagri_to_grass)THEN
  zagri(:,:) = 0.95
ELSE
  WHERE (plai(:,:) /= xundef)
        zagri(:,:) = (1. - exp( -0.6 * zlai(:,:) ))
  ELSEWHERE
        zagri(:,:) = xundef
  ENDWHERE
ENDIF
!
zsum1(:,:) = pvegtype(:,:,nvt_c4)
IF (nvt_irr>0 .AND. nvt_c3>0) THEN
  zsum1(:,:) = zsum1(:,:) + pvegtype(:,:,nvt_irr) + pvegtype(:,:,nvt_c3)
ELSEIF (nvt_c3w>0 .AND. nvt_c3s>0) THEN
  zsum1(:,:) = zsum1(:,:) + pvegtype(:,:,nvt_c3w) + pvegtype(:,:,nvt_c3s)
ENDIF
!
zsum2(:,:) = pvegtype(:,:,nvt_tebd) + pvegtype(:,:,nvt_trbd) + pvegtype(:,:,nvt_tebe) +   &   
             pvegtype(:,:,nvt_bobd) + pvegtype(:,:,nvt_shrb) + pvegtype(:,:,nvt_bone) +   &
             pvegtype(:,:,nvt_tene) +  pvegtype(:,:,nvt_bond)
IF (nvt_fltr>0) zsum2(:,:) = zsum2(:,:) + pvegtype(:,:,nvt_fltr)
!
zsum3(:,:) = pvegtype(:,:,nvt_gras) + pvegtype(:,:,nvt_bogr) + pvegtype(:,:,nvt_trog)
IF (nvt_park>0) THEN
  zsum3(:,:) = zsum3(:,:) + pvegtype(:,:,nvt_park)
ELSEIF (nvt_flgr>0) THEN
  zsum3(:,:) = zsum3(:,:) + pvegtype(:,:,nvt_flgr)
ENDIF
!
WHERE (plai(:,:) /= xundef)
pveg(:,:) = zagri(:,:)               * zsum1(:,:) &
       + 0.95                        * zsum2(:,:) &
       + xeverg_veg                  * pvegtype(:,:,nvt_trbe)     &! EVER 
       + 0.95                        * zsum3(:,:) &
       + 0.                          * pvegtype(:,:,nvt_no  )     &! no vegetation (smooth)
       + 0.                          * pvegtype(:,:,nvt_snow)     &! no vegetation (snow)
       + 0.                          * pvegtype(:,:,nvt_rock)      ! no vegetation (rocks)
END WHERE
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_2D',1,zhook_handle)
!
!-----------------------------------------------------------------
!
END FUNCTION veg_from_lai_2d
!
!
!
!   ####################################################
    FUNCTION veg_from_lai_vegtype_1d(PLAI,OAGRI_TO_GRASS) RESULT(PVEG)
!   ####################################################
!!
!!    PURPOSE
!!    -------
!
!     Calculates coverage of soil by vegetation from leaf
!    area index and type of vegetation for each vegetation patch
!    (most of types; forest and vineyards; grassland)
!              
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      
!!    none
!!
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!    F.Solmon/V.Masson
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    25/03/99
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_data_cover_par, ONLY : nvt_no, nvt_rock, nvt_snow, nvt_tebd,    & 
                                 nvt_bone, nvt_trbe, nvt_c3, nvt_c4,     &
                                 nvt_irr, nvt_gras, nvt_trog, nvt_park,  &
                                 nvt_trbd, nvt_tebe, nvt_tene, nvt_bobd, &
                                 nvt_bond, nvt_bogr, nvt_shrb, nvt_c3w,  &
                                 nvt_c3s, nvt_fltr, nvt_flgr 

USE modd_surf_par,       ONLY : xundef
!
USE modd_reprod_oper,    ONLY : xeverg_veg
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL,   DIMENSION(:), INTENT(IN) :: PLAI         ! Leaf area Index
LOGICAL,              INTENT(IN) :: OAGRI_TO_GRASS
!
REAL,   DIMENSION(SIZE(PLAI)) :: PVEG ! vegetation fraction
!
!*      0.2    declarations of local variables
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-----------------------------------------------------------------
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_VEGTYPE_1D',0,zhook_handle)
pveg(:) = xundef
!
IF(oagri_to_grass)THEN
  pveg(nvt_c4  )= 0.95
  IF (nvt_irr>0) THEN
    pveg(nvt_irr )= 0.95
  ENDIF
  IF (nvt_c3>0) THEN
    pveg(nvt_c3  )= 0.95
  ELSEIF (nvt_c3w>0 .AND. nvt_c3s>0) THEN
    pveg(nvt_c3w )= 0.95
    pveg(nvt_c3s )= 0.95
  ENDIF
ELSE
  IF (plai(nvt_c4)/=xundef) pveg(nvt_c4  )= 1. - exp( -0.6 * plai(nvt_c4  ) )
  IF (nvt_irr>0) THEN
    IF (plai(nvt_irr)/=xundef) pveg(nvt_irr )= 1. - exp( -0.6 * plai(nvt_irr ) )
  ENDIF
  IF (nvt_c3>0) THEN
    IF (plai(nvt_c3)/=xundef) pveg(nvt_c3  )= 1. - exp( -0.6 * plai(nvt_c3  ) )
  ELSEIF (nvt_c3w>0 .AND. nvt_c3s>0) THEN
    IF (plai(nvt_c3w)/=xundef) pveg(nvt_c3w )= 1. - exp( -0.6 * plai(nvt_c3w ) )
    IF (plai(nvt_c3s)/=xundef) pveg(nvt_c3s )= 1. - exp( -0.6 * plai(nvt_c3s ) )
  ENDIF
ENDIF
!
pveg(nvt_tebd)=  0.95
pveg(nvt_trbd)=  0.95
pveg(nvt_tebe)=  0.95
pveg(nvt_bobd)=  0.95
pveg(nvt_shrb)=  0.95
pveg(nvt_bone)=  0.95
pveg(nvt_tene)=  0.95
pveg(nvt_bond)=  0.95
IF (nvt_fltr>0) THEN
  pveg(nvt_fltr)=  0.95
ENDIF
pveg(nvt_trbe)=  xeverg_veg
!
pveg(nvt_gras)=  0.95
pveg(nvt_bogr)=  0.95
pveg(nvt_trog)=  0.95
IF (nvt_park>0) THEN
  pveg(nvt_park)=  0.95
ELSEIF (nvt_flgr>0) THEN
  pveg(nvt_flgr)=  0.95
ENDIF
!
pveg(nvt_no  )= 0.
pveg(nvt_snow)= 0.
pveg(nvt_rock)= 0.  
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_VEGTYPE_1D',1,zhook_handle)
!
END FUNCTION veg_from_lai_vegtype_1d
!
!--------------------------------------------
!