fix_meb_veg.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.
!     ################################################################
      SUBROUTINE fix_meb_veg (DTI, IG, I, &
                              kpatch)
!     ################################################################
!
!!    PURPOSE
!!    -------
!!
!!    A MEB routine:
!!
!!    For LMEB=true ...
!!
!!    ... XPAR_VEG/XDATA_VEG has to be set to >0 for those NVEGTYPE positions
!!    corresponding to the patches where TEMP_LMEB_PATCH = true.
!!    Otherwise, if XPAR_VEG/XDATA_VEG is 0 for these  NVEGTYPE positions
!!    PLAI will be set to undefined in CONVERT_PATCH_ISBA.
!!
!!    ... XPAR_VEG/XDATA_VEG has to be set to <1 for those NVEGTYPE positions
!!    corresponding to the patches where TEMP_LMEB_PATCH = true.
!!    Otherwise, if XPAR_VEG/XDATA_VEG is 1 for these  NVEGTYPE positions
!!    PALBNIR_SOIL will be set to undefined in CONVERT_PATCH_ISBA.
!!
!!    Therefore, XPAR_VEG/XDATA_VEG is set to 0.5 in the identified cases!
!!
!!
!!    METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    P. Samuelsson
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    09/2013
!!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_t
!
USE modd_data_cover,     ONLY : xdata_veg
USE modd_data_cover_par, ONLY : nvegtype
!
USE modi_vegtype_to_patch 
!
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_isba_t), INTENT(INOUT) :: dti
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
!
INTEGER, INTENT(IN) :: kpatch
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: ipatch
!
REAL, DIMENSION(IG%NDIM,DTI%NTIME)                          :: zworkpar
REAL, DIMENSION(SIZE(XDATA_VEG,1),SIZE(XDATA_VEG,2)) :: zworkdata
!
INTEGER :: jvegtype! loop on vegtype
INTEGER ::  patch_list(nvegtype)
REAL(KIND=JPRB) :: zhook_handle

!-------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('FIX_MEB_VEG',0,zhook_handle)
!
DO jvegtype=1,nvegtype
  patch_list(jvegtype) = vegtype_to_patch(jvegtype, kpatch)
ENDDO
!
DO jvegtype=1,nvegtype
  !
  zworkdata(:,:)=xdata_veg(:,:,jvegtype)
  IF (dti%LDATA_VEG) zworkpar(:,:)=dti%XPAR_VEG(:,:,jvegtype)
  !
  DO ipatch=1,kpatch
    IF(patch_list(jvegtype)==ipatch .AND. i%LMEB_PATCH(ipatch))THEN
      zworkdata(:,:)=0.5
      IF (dti%LDATA_VEG) zworkpar(:,:)=0.5
      EXIT
    ENDIF
  ENDDO
  !
  xdata_veg(:,:,jvegtype)=zworkdata(:,:)
  IF (dti%LDATA_VEG) dti%XPAR_VEG(:,:,jvegtype)=zworkpar(:,:)
  !
ENDDO
!
!
IF (lhook) CALL dr_hook('FIX_MEB_VEG',1,zhook_handle)
!-------------------------------------------------------------------------------
!   
END SUBROUTINE fix_meb_veg