vegetation_update_garden.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 vegetation_update_garden (DTCO, DTI, IG, I, T, TOP, DTGR, TGRO, GDM, &
                                         tptime,ptstep,klu)  
!   ##########################################################################
!
!!****  *GARDEN*  
!!
!!    PURPOSE
!!    -------
!
!     
!!**  METHOD
!     ------
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      A. Lemonsu          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!    Original    05/2009
!!    P. Samuelsson  10/2014  Introduced MEB dummy variables in call to VEGETATION_UPDATE
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_data_cover_n, ONLY : data_cover_t
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_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_data_teb_greenroof_n, ONLY : data_teb_greenroof_t
USE modd_teb_greenroof_option_n, ONLY : teb_greenroof_options_t
USE modd_surfex_n, ONLY : teb_garden_model_t
!
USE modd_type_date_surf,    ONLY: date_time


  
!
USE modi_vegetation_update
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    Declarations of arguments
!
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(data_isba_t), INTENT(INOUT) :: dti
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(data_teb_greenroof_t), INTENT(INOUT) :: dtgr
TYPE(teb_greenroof_options_t), INTENT(INOUT) :: tgro
TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
!
TYPE(date_time)     , INTENT(IN)    :: tptime             ! current date and time from teb
REAL                , INTENT(IN)    :: ptstep             ! time step
INTEGER,              INTENT(IN)    :: klu                ! number of points
!
!
!*      0.2    Declarations of local variables
!
REAL, DIMENSION(KLU,1) :: zz0effip
REAL, DIMENSION(KLU,1) :: zz0effim
REAL, DIMENSION(KLU,1) :: zz0effjp
REAL, DIMENSION(KLU,1) :: zz0effjm
REAL, DIMENSION(KLU) :: zaosip
REAL, DIMENSION(KLU) :: zaosim
REAL, DIMENSION(KLU) :: zaosjp
REAL, DIMENSION(KLU) :: zaosjm
REAL, DIMENSION(KLU) :: zho2ip
REAL, DIMENSION(KLU) :: zho2im
REAL, DIMENSION(KLU) :: zho2jp
REAL, DIMENSION(KLU) :: zho2jm
REAL, DIMENSION(KLU,1) :: zlai
REAL, DIMENSION(KLU,1) :: zveg
REAL, DIMENSION(KLU,1) :: zz0
REAL, DIMENSION(KLU,1) :: zalbnir
REAL, DIMENSION(KLU,1) :: zalbvis
REAL, DIMENSION(KLU,1) :: zalbuv
REAL, DIMENSION(KLU,1) :: zemis
REAL, DIMENSION(KLU,1) :: zrsmin
REAL, DIMENSION(KLU,1) :: zgamma
REAL, DIMENSION(KLU,1) :: zwrmax_cf
REAL, DIMENSION(KLU,1) :: zrgl
REAL, DIMENSION(KLU,1) :: zcv
REAL, DIMENSION(KLU,1) :: zgmes
REAL, DIMENSION(KLU,1) :: zbslai
REAL, DIMENSION(KLU,1) :: zlaimin
REAL, DIMENSION(KLU,1) :: zsefold
REAL, DIMENSION(KLU,1) :: zgc
REAL, DIMENSION(KLU,1) :: zdmax
REAL, DIMENSION(KLU,1) :: zf2i
LOGICAL, DIMENSION(KLU,1) :: gstress
REAL, DIMENSION(KLU,1) :: zalbnir_veg
REAL, DIMENSION(KLU,1) :: zalbvis_veg
REAL, DIMENSION(KLU,1) :: zalbuv_veg
REAL, DIMENSION(KLU,1) :: zalbnir_soil
REAL, DIMENSION(KLU,1) :: zalbvis_soil
REAL, DIMENSION(KLU,1) :: zalbuv_soil
REAL, DIMENSION(KLU,1) :: zce_nitro
REAL, DIMENSION(KLU,1) :: zcf_nitro
REAL, DIMENSION(KLU,1) :: zcna_nitro
!
! MEB stuff
REAL, DIMENSION(KLU,1) :: zgndlitter
REAL, DIMENSION(KLU,1) :: zrglgv
REAL, DIMENSION(KLU,1) :: zgammagv
REAL, DIMENSION(KLU,1) :: zrsmingv
REAL, DIMENSION(KLU,1) :: zwrmax_cfgv
REAL, DIMENSION(KLU,1) :: zh_veg
REAL, DIMENSION(KLU,1) :: zlaigv
REAL, DIMENSION(KLU,1) :: zz0litter
!
TYPE (date_time),  DIMENSION(KLU,1) :: tzseed
TYPE (date_time), DIMENSION(KLU,1) :: tzreap
REAL, DIMENSION(KLU,1) :: zwatsup
REAL, DIMENSION(KLU,1) :: zirrig
LOGICAL :: gupdated              ! T if VEGETATION_UPDATE has reset fields
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!*      1.     various initialisations
!              -----------------------
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE_GARDEN',0,zhook_handle)
!
!* orographic roughness not used
!
zaosip = 0.
zaosim = 0.
zaosjp = 0.
zaosjm = 0.
zho2ip = 0.
zho2im = 0.
zho2jp = 0.
zho2jm = 0.
!
!* vegetation parameters to update
!
zveg(:,1) = gdm%TGDPE%CUR%XVEG
zz0(:,1) = gdm%TGDPE%CUR%XZ0
zalbnir(:,1) = gdm%TGDPE%CUR%XALBNIR
zalbvis(:,1) = gdm%TGDPE%CUR%XALBVIS
zalbuv(:,1) = gdm%TGDPE%CUR%XALBUV
zemis(:,1) = gdm%TGDPE%CUR%XEMIS
zrsmin(:,1) = gdm%TGDP%XRSMIN
zgamma(:,1) = gdm%TGDP%XGAMMA
zwrmax_cf(:,1) = gdm%TGDP%XWRMAX_CF
zrgl(:,1) = gdm%TGDP%XRGL
zcv(:,1) = gdm%TGDP%XCV
zgmes(:,1) = gdm%TGDP%XGMES
zbslai(:,1) = gdm%TGDP%XBSLAI
zlaimin(:,1) = gdm%TGDP%XLAIMIN
zsefold(:,1) = gdm%TGDP%XSEFOLD
zgc(:,1) = gdm%TGDP%XGC
zdmax(:,1) = gdm%TGDP%XDMAX
zf2i(:,1) = gdm%TGDP%XF2I
gstress(:,1) = gdm%TGDP%LSTRESS
zalbnir_veg(:,1) = gdm%TGDP%XALBNIR_VEG
zalbvis_veg(:,1) = gdm%TGDP%XALBVIS_VEG
zalbuv_veg(:,1) = gdm%TGDP%XALBUV_VEG
zalbnir_soil(:,1) = gdm%TGDP%XALBNIR_SOIL
zalbvis_soil(:,1) = gdm%TGDP%XALBVIS_SOIL
zalbuv_soil(:,1) = gdm%TGDP%XALBUV_SOIL
zce_nitro(:,1) = gdm%TGDP%XCE_NITRO
zcf_nitro(:,1) = gdm%TGDP%XCF_NITRO
zcna_nitro(:,1) = gdm%TGDP%XCNA_NITRO
! --------------------------------------------------------------------------------------
! Vegetation update (in case of non-interactive vegetation):
! --------------------------------------------------------------------------------------
!
gupdated=.false.
IF (gdm%TVG%CPHOTO=='NON' .OR. gdm%TVG%CPHOTO=='AGS' .OR. gdm%TVG%CPHOTO=='AST') THEN
     CALL vegetation_update(dtco, dti, gdm%DTGD, dtgr, ig, i, tgro, &
                            ptstep,tptime,top%XCOVER,top%LCOVER,                 &
                         gdm%TVG%CISBA,(.NOT. gdm%TGDO%LPAR_GARDEN), &
                         gdm%TVG%CPHOTO, .false.,     &
                         gdm%TVG%LTR_ML, 'GRD',                                  &
                         zlai,zveg,zz0,                                  &
                         zalbnir,zalbvis,zalbuv,zemis,                   &
                         zrsmin,zgamma,zwrmax_cf,                        &
                         zrgl,zcv,                                       &
                         zgmes,zbslai,zlaimin,zsefold,zgc,zdmax,         &
                         zf2i, gstress,                                  &
                         zaosip,zaosim,zaosjp,zaosjm,                    &
                         zho2ip,zho2im,zho2jp,zho2jm,                    &
                         zz0effip,zz0effim,zz0effjp,zz0effjm,            &
                         gdm%TVG%CALBEDO, zalbnir_veg, zalbvis_veg, zalbuv_veg,  &
                         zalbnir_soil, zalbvis_soil, zalbuv_soil,        &
                         zce_nitro, zcf_nitro, zcna_nitro,               &
                         tzseed, tzreap, zwatsup, zirrig,                &
                         zgndlitter,zrglgv,zgammagv,                     &
                         zrsmingv, zwrmax_cfgv,                          &
                         zh_veg, zlaigv, zz0litter,                      &
                         gupdated, oabsent=(t%CUR%XGARDEN==0.)                 )
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
gdm%TGDPE%CUR%XVEG = zveg(:,1)
gdm%TGDPE%CUR%XZ0 = zz0(:,1)
gdm%TGDPE%CUR%XALBNIR = zalbnir(:,1)
gdm%TGDPE%CUR%XALBVIS = zalbvis(:,1)
gdm%TGDPE%CUR%XALBUV = zalbuv(:,1)
gdm%TGDPE%CUR%XEMIS = zemis(:,1)
gdm%TGDP%XRSMIN = zrsmin(:,1)
gdm%TGDP%XGAMMA = zgamma(:,1)
gdm%TGDP%XWRMAX_CF = zwrmax_cf(:,1)
gdm%TGDP%XRGL = zrgl(:,1)
gdm%TGDP%XCV = zcv(:,1)
gdm%TGDP%XGMES = zgmes(:,1)
gdm%TGDP%XBSLAI = zbslai(:,1)
gdm%TGDP%XLAIMIN = zlaimin(:,1)
gdm%TGDP%XSEFOLD = zsefold(:,1)
gdm%TGDP%XGC = zgc(:,1)
gdm%TGDP%XDMAX = zdmax(:,1)
gdm%TGDP%XF2I = zf2i(:,1)
gdm%TGDP%LSTRESS = gstress(:,1)
gdm%TGDP%XALBNIR_VEG = zalbnir_veg(:,1)
gdm%TGDP%XALBVIS_VEG = zalbvis_veg(:,1)
gdm%TGDP%XALBUV_VEG = zalbuv_veg(:,1)
gdm%TGDP%XALBNIR_SOIL = zalbnir_soil(:,1)
gdm%TGDP%XALBVIS_SOIL = zalbvis_soil(:,1)
gdm%TGDP%XALBUV_SOIL = zalbuv_soil(:,1)
gdm%TGDP%XCE_NITRO = zce_nitro(:,1)
gdm%TGDP%XCF_NITRO = zcf_nitro(:,1)
gdm%TGDP%XCNA_NITRO = zcna_nitro(:,1)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE_GARDEN',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE vegetation_update_garden