flag_teb_gardenn.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_garden_n (TGD, TGDO, TGDPE, T, TVG, &
                                    kflag)
!     ##################################
!
!!****  *FLAG_TEB_GARDEN_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_teb_garden_n, ONLY : teb_garden_t
USE modd_teb_garden_option_n, ONLY : teb_garden_options_t
USE modd_teb_garden_pgd_evol_n, ONLY : teb_garden_pgd_evol_t
USE modd_teb_n, ONLY : teb_t
USE modd_teb_veg_n, ONLY : teb_veg_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(teb_garden_t), INTENT(INOUT) :: tgd
TYPE(teb_garden_options_t), INTENT(INOUT) :: tgdo
TYPE(teb_garden_pgd_evol_t), INTENT(INOUT) :: tgdpe
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_veg_options_t), INTENT(INOUT) :: tvg
!
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_GARDEN_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,tgdo%NGROUND_LAYER
    WHERE (t%CUR%XGARDEN(:)==0.) 
      tgd%CUR%XTG (:,jl1) = ztg
      tgd%CUR%XWG (:,jl1) = zwg
      tgd%CUR%XWGI(:,jl1) = zdef
    END WHERE
  END DO
  !
  WHERE (t%CUR%XGARDEN(:)==0.) 
    tgd%CUR%XWR  (:) = zwr
    tgd%CUR%XRESA(:) = zresa
  END WHERE
  !
  IF (tvg%CPHOTO/='NON') THEN
    !
    WHERE (t%CUR%XGARDEN(:)==0.)
      tgd%CUR%XANFM (:) = zanfm              
      tgd%CUR%XAN   (:) = zdef
      tgd%CUR%XANDAY(:) = zdef
      tgd%CUR%XLE   (:) = zdef
    END WHERE
    !
    IF (tvg%CPHOTO=='LAI' .OR. tvg%CPHOTO=='LST' .OR. tvg%CPHOTO=='NIT' .OR. tvg%CPHOTO=='NCB') THEN
      !
      WHERE (t%CUR%XGARDEN(:)==0.) tgdpe%CUR%XLAI(:) = zdef
      !
    ELSE IF (tvg%CPHOTO=='AGS' .OR. tvg%CPHOTO=='AST') THEN
      !
      DO jl1=1,SIZE(tgd%CUR%XBIOMASS,2)
        WHERE (t%CUR%XGARDEN(:)==0.)
          tgd%CUR%XBIOMASS     (:,jl1) = zdef
          tgd%CUR%XRESP_BIOMASS(:,jl1) = zdef
        END WHERE
      END DO
      !
    END IF
    !
  ENDIF
  !
!
!-------------------------------------------------------------------------------
!
!* Flag snow characteristics
!
 CALL flag_gr_snow(kflag,t%CUR%XGARDEN(:)==0.,tgd%CUR%TSNOW)
!
!
!* snow-free characteristics
!
IF (kflag==1) THEN
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB      = 0.2
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB_VEG  = 0.2
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB_SOIL = 0.2
ELSEIF (kflag==2) THEN
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB      = xundef
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB_VEG  = xundef
  WHERE (t%CUR%XGARDEN==0.) tgd%CUR%XSNOWFREE_ALB_SOIL = xundef
END IF
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('FLAG_TEB_GARDEN_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE flag_teb_garden_n