vegetation_update_greenroof.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_greenroof (DTCO, DTI, IG, I, T, TOP, TVG, DTGD, GRM, &
                                            tptime,ptstep,klu)  
!   ##########################################################################
!
!!****  *GREENROOF*  
!!
!!    PURPOSE
!!    -------
!
!     
!!**  METHOD
!     ------
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      A. Lemonsu          * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!    Original    05/2009
!-------------------------------------------------------------------------------
!
!*       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_teb_veg_n, ONLY : teb_veg_options_t
USE modd_data_teb_garden_n, ONLY : data_teb_garden_t
USE modd_surfex_n, ONLY : teb_greenroof_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(teb_veg_options_t), INTENT(INOUT) :: tvg
TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
!
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_GREENROF',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)         = grm%TGRPE%CUR%XVEG
zz0(:,1)          = grm%TGRPE%CUR%XZ0
zalbnir(:,1)      = grm%TGRPE%CUR%XALBNIR
zalbvis(:,1)      = grm%TGRPE%CUR%XALBVIS
zalbuv(:,1)       = grm%TGRPE%CUR%XALBUV
zemis(:,1)        = grm%TGRPE%CUR%XEMIS
zrsmin(:,1)       = grm%TGRP%XRSMIN
zgamma(:,1)       = grm%TGRP%XGAMMA
zwrmax_cf(:,1)    = grm%TGRP%XWRMAX_CF
zrgl(:,1)         = grm%TGRP%XRGL
zcv(:,1)          = grm%TGRP%XCV
zgmes(:,1)        = grm%TGRP%XGMES
zbslai(:,1)       = grm%TGRP%XBSLAI
zlaimin(:,1)      = grm%TGRP%XLAIMIN
zsefold(:,1)      = grm%TGRP%XSEFOLD
zgc(:,1)          = grm%TGRP%XGC
zdmax(:,1)        = grm%TGRP%XDMAX
zf2i(:,1)         = grm%TGRP%XF2I
gstress(:,1)      = grm%TGRP%LSTRESS
zalbnir_veg(:,1)  = grm%TGRP%XALBNIR_VEG
zalbvis_veg(:,1)  = grm%TGRP%XALBVIS_VEG
zalbuv_veg(:,1)   = grm%TGRP%XALBUV_VEG
zalbnir_soil(:,1) = grm%TGRP%XALBNIR_SOIL
zalbvis_soil(:,1) = grm%TGRP%XALBVIS_SOIL
zalbuv_soil(:,1)  = grm%TGRP%XALBUV_SOIL
zce_nitro(:,1)    = grm%TGRP%XCE_NITRO
zcf_nitro(:,1)    = grm%TGRP%XCF_NITRO
zcna_nitro(:,1)   = grm%TGRP%XCNA_NITRO
! --------------------------------------------------------------------------------------
! Vegetation update (in case of non-interactive vegetation):
! --------------------------------------------------------------------------------------
!
gupdated=.false.
IF (tvg%CPHOTO=='NON' .OR. tvg%CPHOTO=='AGS' .OR. tvg%CPHOTO=='AST') THEN
     CALL vegetation_update(dtco, dti, dtgd, grm%DTGR, ig, i, grm%TGRO, &
                            ptstep,tptime,top%XCOVER,top%LCOVER,                 &
                         tvg%CISBA,(.NOT. grm%TGRO%LPAR_GREENROOF), tvg%CPHOTO, .false.,  &
                         tvg%LTR_ML, 'GR ',                                  &
                         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,            &
                         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%XGREENROOF==0.)              )
END IF
!
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
grm%TGRPE%CUR%XVEG         = zveg(:,1)
grm%TGRPE%CUR%XZ0          = zz0(:,1)
grm%TGRPE%CUR%XALBNIR      = zalbnir(:,1)
grm%TGRPE%CUR%XALBVIS      = zalbvis(:,1)
grm%TGRPE%CUR%XALBUV       = zalbuv(:,1)
grm%TGRPE%CUR%XEMIS        = zemis(:,1)
grm%TGRP%XRSMIN       = zrsmin(:,1)
grm%TGRP%XGAMMA       = zgamma(:,1)
grm%TGRP%XWRMAX_CF    = zwrmax_cf(:,1)
grm%TGRP%XRGL         = zrgl(:,1)
grm%TGRP%XCV          = zcv(:,1)
grm%TGRP%XGMES        = zgmes(:,1)
grm%TGRP%XBSLAI       = zbslai(:,1)
grm%TGRP%XLAIMIN      = zlaimin(:,1)
grm%TGRP%XSEFOLD      = zsefold(:,1)
grm%TGRP%XGC          = zgc(:,1)
grm%TGRP%XDMAX        = zdmax(:,1)
grm%TGRP%XF2I         = zf2i(:,1)
grm%TGRP%LSTRESS      = gstress(:,1)
grm%TGRP%XALBNIR_VEG  = zalbnir_veg(:,1)
grm%TGRP%XALBVIS_VEG  = zalbvis_veg(:,1)
grm%TGRP%XALBUV_VEG   = zalbuv_veg(:,1)
grm%TGRP%XALBNIR_SOIL = zalbnir_soil(:,1)
grm%TGRP%XALBVIS_SOIL = zalbvis_soil(:,1)
grm%TGRP%XALBUV_SOIL  = zalbuv_soil(:,1)
grm%TGRP%XCE_NITRO    = zce_nitro(:,1)
grm%TGRP%XCF_NITRO    = zcf_nitro(:,1)
grm%TGRP%XCNA_NITRO   = zcna_nitro(:,1)
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
IF (lhook) CALL dr_hook('VEGETATION_UPDATE_GREENROOF',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!
END SUBROUTINE vegetation_update_greenroof