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 (DTV, KDIM, OMEB_PATCH, 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_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) :: DTV
INTEGER, INTENT(IN) :: KDIM
LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH
!
INTEGER, INTENT(IN) :: KPATCH
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: IPATCH
!
REAL, DIMENSION(KDIM,DTV%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 (any(dtv%LDATA_VEG)) zworkpar(:,:)=dtv%XPAR_VEG(:,:,jvegtype)
  !
  DO ipatch=1,kpatch
    IF(patch_list(jvegtype)==ipatch .AND. omeb_patch(ipatch))THEN
      zworkdata(:,:)=0.5
      IF (any(dtv%LDATA_VEG)) zworkpar(:,:)=0.5
      EXIT
    ENDIF
  ENDDO
  !
  xdata_veg(:,:,jvegtype)=zworkdata(:,:)
  IF (any(dtv%LDATA_VEG)) dtv%XPAR_VEG(:,:,jvegtype)=zworkpar(:,:)
  !
ENDDO
!
!
IF (lhook) CALL dr_hook('FIX_MEB_VEG',1,zhook_handle)
!-------------------------------------------------------------------------------
!   
END SUBROUTINE fix_meb_veg