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_patch_1d(PLAI,PVEGTYPE,OAGRI_TO_GRASS) RESULT(PVEG)
!
REAL,   DIMENSION(:), INTENT(IN) :: plai         ! Leaf area Index for each vegtype
REAL,   DIMENSION(:), INTENT(IN) :: pvegtype     ! 
LOGICAL,              INTENT(IN) :: oagri_to_grass
!
REAL,   DIMENSION(SIZE(PLAI)) :: pveg ! vegetation fraction
!
END FUNCTION veg_from_lai_patch_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
!
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
!
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
!
pveg = zagri                      *(pvegtype(nvt_c4  ) +   &! C4 crops
                                    pvegtype(nvt_irr ) +   &! irrigated crops
                                    pvegtype(nvt_c3  )  )  &! C3 crops
       + 0.95                     *(pvegtype(nvt_tebd) +   &! TREE
                                    pvegtype(nvt_trbd) +   &! TREE
                                    pvegtype(nvt_tebe) +   &! TREE
                                    pvegtype(nvt_bobd) +   &! TREE
                                    pvegtype(nvt_shrb) +   &! TREE
                                    pvegtype(nvt_bone) +   &! CONI
                                    pvegtype(nvt_tene) +   &! CONI
                                    pvegtype(nvt_bond) )   &! CONI
       + xeverg_veg               * pvegtype(nvt_trbe)     &! EVER 
       + 0.95                     *(pvegtype(nvt_gras) +   &! grassland C3
                                    pvegtype(nvt_bogr) +   &! boral grass C3
                                    pvegtype(nvt_trog) +   &! tropical grass C4
                                    pvegtype(nvt_park)  )  &! irr. parks
       + 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 
!
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
!
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
!
pveg(:) = zagri(:)                *(pvegtype(:,nvt_c4  ) +   &! C4 crops
                                    pvegtype(:,nvt_irr ) +   &! irrigated crops
                                    pvegtype(:,nvt_c3  )  )  &! C3 crops
       + 0.95                     *(pvegtype(:,nvt_tebd) +   &! TREE
                                    pvegtype(:,nvt_trbd) +   &! TREE
                                    pvegtype(:,nvt_tebe) +   &! TREE
                                    pvegtype(:,nvt_bobd) +   &! TREE
                                    pvegtype(:,nvt_shrb) +   &! TREE
                                    pvegtype(:,nvt_bone) +   &! CONI
                                    pvegtype(:,nvt_tene) +   &! CONI
                                    pvegtype(:,nvt_bond) )   &! CONI
       + xeverg_veg               * pvegtype(:,nvt_trbe)     &! EVER 
       + 0.95                     *(pvegtype(:,nvt_gras) +   &! grassland C3
                                    pvegtype(:,nvt_bogr) +   &! boral grass C3
                                    pvegtype(:,nvt_trog) +   &! tropical grass C4
                                    pvegtype(:,nvt_park)  )  &! irr. parks
       + 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 
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
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
!
WHERE (plai(:,:) /= xundef)
pveg(:,:) = zagri(:,:)               *(pvegtype(:,:,nvt_c4  ) +   &! C4 crops
                                       pvegtype(:,:,nvt_irr ) +   &! irrigated crops
                                       pvegtype(:,:,nvt_c3  )  )  &! C3 crops
       + 0.95                        *(pvegtype(:,:,nvt_tebd) +   &! TREE
                                       pvegtype(:,:,nvt_trbd) +   &! TREE
                                       pvegtype(:,:,nvt_tebe) +   &! TREE
                                       pvegtype(:,:,nvt_bobd) +   &! TREE
                                       pvegtype(:,:,nvt_shrb) +   &! TREE
                                       pvegtype(:,:,nvt_bone) +   &! CONI
                                       pvegtype(:,:,nvt_tene) +   &! CONI
                                       pvegtype(:,:,nvt_bond) )   &! CONI
       + xeverg_veg                  * pvegtype(:,:,nvt_trbe)     &! EVER 
       + 0.95                        *(pvegtype(:,:,nvt_gras) +   &! grassland C3
                                       pvegtype(:,:,nvt_bogr) +   &! boral grass C3
                                       pvegtype(:,:,nvt_trog) +   &! tropical grass C4
                                       pvegtype(:,:,nvt_park)  )  &! irr. parks
       + 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_patch_1d(PLAI,PVEGTYPE,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 

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)) :: pveg ! vegetation fraction
!
!*      0.2    declarations of local variables
!
REAL,   DIMENSION(SIZE(PLAI)) :: zlai
REAL(KIND=JPRB) :: zhook_handle
!-----------------------------------------------------------------
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_PATCH_1D',0,zhook_handle)
zlai(:) = plai(:)
pveg(:) = xundef
!
IF(oagri_to_grass)THEN
  IF (pvegtype(nvt_c4  )>0.) pveg(nvt_c4  )= 0.95
  IF (pvegtype(nvt_irr )>0.) pveg(nvt_irr )= 0.95
  IF (pvegtype(nvt_c3  )>0.) pveg(nvt_c3  )= 0.95
ELSE
  IF (pvegtype(nvt_c4  )>0.) pveg(nvt_c4  )= 1. - exp( -0.6 * zlai(nvt_c4  ) )
  IF (pvegtype(nvt_irr )>0.) pveg(nvt_irr )= 1. - exp( -0.6 * zlai(nvt_irr ) )
  IF (pvegtype(nvt_c3  )>0.) pveg(nvt_c3  )= 1. - exp( -0.6 * zlai(nvt_c3  ) )
ENDIF
!
IF (pvegtype(nvt_tebd)>0.) pveg(nvt_tebd)=  0.95
IF (pvegtype(nvt_trbd)>0.) pveg(nvt_trbd)=  0.95
IF (pvegtype(nvt_tebe)>0.) pveg(nvt_tebe)=  0.95
IF (pvegtype(nvt_bobd)>0.) pveg(nvt_bobd)=  0.95
IF (pvegtype(nvt_shrb)>0.) pveg(nvt_shrb)=  0.95
IF (pvegtype(nvt_bone)>0.) pveg(nvt_bone)=  0.95
IF (pvegtype(nvt_tene)>0.) pveg(nvt_tene)=  0.95
IF (pvegtype(nvt_bond)>0.) pveg(nvt_bond)=  0.95
IF (pvegtype(nvt_trbe)>0.) pveg(nvt_trbe)=  xeverg_veg
!
IF (pvegtype(nvt_gras)>0.) pveg(nvt_gras)=  0.95
IF (pvegtype(nvt_bogr)>0.) pveg(nvt_bogr)=  0.95
IF (pvegtype(nvt_trog)>0.) pveg(nvt_trog)=  0.95
IF (pvegtype(nvt_park)>0.) pveg(nvt_park)=  0.95
!
IF (pvegtype(nvt_no  )>0.) pveg(nvt_no  )= 0.
IF (pvegtype(nvt_snow)>0.) pveg(nvt_snow)= 0.
IF (pvegtype(nvt_rock)>0.) pveg(nvt_rock)= 0.  
IF (lhook) CALL dr_hook('MODI_VEG_FROM_LAI:VEG_FROM_LAI_PATCH_1D',1,zhook_handle)
!
END FUNCTION veg_from_lai_patch_1d
!
!--------------------------------------------
!