flag_teb_vegn.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 flag_teb_veg_n (PEK, IO, PMASK, KFLAG)
!     ##################################
!
!!****  *FLAG_TEB_VEG_n* - routine to flag ISBA variables where gardens are
!!                            not present
!!                         
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2011
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
USE modd_isba_n, ONLY : isba_pe_t
USE modd_isba_options_n, ONLY : isba_options_t
!
USE modd_co2v_par,       ONLY : xanfminit, xcondctmin
!                                
USE modd_surf_par,       ONLY : xundef
!
USE modi_flag_gr_snow
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
TYPE(isba_options_t), INTENT(INOUT) :: IO
REAL, DIMENSION(:), INTENT(IN) :: PMASK
!
INTEGER, INTENT(IN) :: KFLAG ! 1 : to put physical values to run ISBA afterwards
!                            ! 2 : to flag with XUNDEF value for points wihtout garden
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL :: ZWR, ZTG, ZWG, ZRESA, ZANFM, ZDEF
INTEGER :: JL1, JL2 ! loop counter on layers
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!
!* 1D physical dimension
!
IF (lhook) CALL dr_hook('FLAG_TEB_VEG_N',0,zhook_handle)
!
zwr = xundef
!
IF (kflag==1) THEN
  ztg   = 300.
  zwg   = 0.5
  zresa = 100.
  zanfm = xanfminit
  zdef  = 0.
ELSEIF (kflag==2) THEN
  ztg   = xundef
  zwg   = xundef
  zresa = xundef
  zanfm = xundef
  zdef  = xundef
ENDIF
!
!-------------------------------------------------------------------------------
!     
  !
  DO jl1=1,io%NGROUND_LAYER
    WHERE (pmask(:)==0.) 
      pek%XTG (:,jl1) = ztg
      pek%XWG (:,jl1) = zwg
      pek%XWGI(:,jl1) = zdef
    END WHERE
  END DO
  !
  WHERE (pmask(:)==0.) 
    pek%XWR  (:) = zwr
    pek%XRESA(:) = zresa
  END WHERE
  !
  IF (io%CPHOTO/='NON') THEN
    !
    WHERE (pmask(:)==0.)
      pek%XANFM (:) = zanfm              
      pek%XAN   (:) = zdef
      pek%XANDAY(:) = zdef
      pek%XLE   (:) = zdef
    END WHERE
    !
    IF (io%CPHOTO=='NIT' .OR. io%CPHOTO=='NCB') THEN
      !
      WHERE (pmask(:)==0.) pek%XLAI(:) = zdef
      !
    ELSE IF (io%CPHOTO=='AST') THEN
      !
      DO jl1=1,SIZE(pek%XBIOMASS,2)
        WHERE (pmask(:)==0.)
          pek%XBIOMASS     (:,jl1) = zdef
          pek%XRESP_BIOMASS(:,jl1) = zdef
        END WHERE
      END DO
      !
    END IF
    !
  ENDIF
  !
!
!-------------------------------------------------------------------------------
!
!* Flag snow characteristics
!
 CALL flag_gr_snow(kflag,pmask(:)==0.,pek%TSNOW)
!
!
!* snow-free characteristics
!
IF (kflag==1) THEN
  WHERE (pmask(:)==0.) 
    pek%XSNOWFREE_ALB(:)      = 0.2
    pek%XSNOWFREE_ALB_VEG(:)  = 0.2
    pek%XSNOWFREE_ALB_SOIL(:) = 0.2
  END WHERE
ELSEIF (kflag==2) THEN
  WHERE (pmask==0.) 
    pek%XSNOWFREE_ALB(:)      = xundef
    pek%XSNOWFREE_ALB_VEG(:)  = xundef
    pek%XSNOWFREE_ALB_SOIL(:) = xundef
  END WHERE
END IF
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('FLAG_TEB_VEG_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE flag_teb_veg_n