greenroof_properties.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 greenroof_properties (T, TVG, GRM, &
                                       pdir_sw, psca_sw, psw_bands, ksw,&
                                      pts, pemis, palb, pta,           &  
                                      palbnir_tveg, palbvis_tveg,      &
                                      palbnir_tsoil, palbvis_tsoil     )  
!     ##########################################################################
!
!!****  *GREENROOF_PROPERTIES*  
!!
!!    PURPOSE
!!    -------
!
!     Based on garden_properties
!     Calculates grid-averaged albedo and emissivity (according to snow scheme)
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!      S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original                      ?     
!!      C. de Munck and A. Lemonsu    09/2011  
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
USE modd_teb_n, ONLY : teb_t
USE modd_teb_veg_n, ONLY : teb_veg_options_t
USE modd_surfex_n, ONLY : teb_greenroof_model_t
!
USE modd_surf_par,            ONLY : xundef
!
!
!
USE modi_isba_properties
USE modi_flag_teb_greenroof_n
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_veg_options_t), INTENT(INOUT) :: tvg
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
!
REAL, DIMENSION(:,:), INTENT(IN)   :: pdir_sw            ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN)   :: psca_sw            ! diffus incoming solar radiation
REAL, DIMENSION(:)  , INTENT(IN)   :: psw_bands          ! mean wavelength of each shortwave band (m)
INTEGER,              INTENT(IN)   :: ksw                ! number of short-wave spectral bands
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: pts                ! radiative surface temperature
REAL, DIMENSION(:)  , INTENT(OUT)  :: pemis              ! green areas emissivity
REAL, DIMENSION(:)  , INTENT(OUT)  :: palb               ! green areas albedo
!
REAL, DIMENSION(:)  , INTENT(IN), OPTIONAL :: pta        ! Air temperature (K)
!
REAL, DIMENSION(:)  , INTENT(OUT), OPTIONAL  :: palbnir_tveg       ! nearIR  veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT), OPTIONAL  :: palbvis_tveg       ! visible veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT), OPTIONAL  :: palbnir_tsoil      ! nearIR  soil tot albedo
REAL, DIMENSION(:)  , INTENT(OUT), OPTIONAL  :: palbvis_tsoil      ! visible soil tot albedo
!
!-------------------------------------------------------------------------------
!
!*      0.2    Local variables
!              ---------------
!
INTEGER                        :: jlayer
INTEGER                        :: jswb
!
REAL, DIMENSION(SIZE(PALB))    :: ztsnosnow ! surf. temp. on snow free part
REAL, DIMENSION(SIZE(PALB))    :: ztssnow   ! surf. temp. on snow covered part
REAL, DIMENSION(SIZE(PALB))    :: zanosnow  ! snow-free surface albedo
REAL, DIMENSION(SIZE(PALB))    :: zasnow    ! snow albedo
REAL, DIMENSION(SIZE(PALB))    :: zenosnow  ! snow-free surface emissivity
REAL, DIMENSION(SIZE(PALB))    :: zesnow    ! snow emissivity
!
REAL, DIMENSION(SIZE(PALB))    :: zalbnir_tveg       ! nearIR  veg tot albedo
REAL, DIMENSION(SIZE(PALB))    :: zalbvis_tveg       ! visible veg tot albedo
REAL, DIMENSION(SIZE(PALB))    :: zalbnir_tsoil      ! nearIR  soil tot albedo
REAL, DIMENSION(SIZE(PALB))    :: zalbvis_tsoil      ! visible soil tot albedo
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!* only one patch for green roofs
IF (lhook) CALL dr_hook('GREENROOF_PROPERTIES',0,zhook_handle)
!
!*      1.     Set physical values for points where there is no green roof
!              -----------------------------------------------------------
!
! This way, ISBA can run without problem for these points
!
 CALL flag_teb_greenroof_n(grm%TGR, grm%TGRO, grm%TGRPE, t, tvg, &
                           1)
!
!
!*      2.     Computes several properties of green roofs
!              ------------------------------------------
!
!
 CALL isba_properties(grm%TGRO%CISBA_GR, grm%TGRO%LTR_ML_GR, grm%TGR%CUR%TSNOW, 1,       &
                      pdir_sw, psca_sw, psw_bands, ksw,          &
                      grm%TGRPE%CUR%XALBNIR, grm%TGRPE%CUR%XALBVIS, grm%TGRPE%CUR%XALBUV,  &
                      grm%TGRP%XALBNIR_VEG, grm%TGRP%XALBVIS_VEG, grm%TGRP%XALBUV_VEG,      &
                      grm%TGRP%XALBNIR_SOIL, grm%TGRP%XALBVIS_SOIL,                &
                      grm%TGRP%XALBUV_SOIL, grm%TGRPE%CUR%XVEG, grm%TGRPE%CUR%XLAI, &
                      grm%TGRPE%CUR%XZ0, grm%TGRPE%CUR%XEMIS, grm%TGR%CUR%XTG(:,1),          &
                      zasnow,zanosnow,                           &
                      zesnow,zenosnow,                           &
                      ztssnow,ztsnosnow,                         &
                      grm%TGR%CUR%XSNOWFREE_ALB_VEG, grm%TGR%CUR%XSNOWFREE_ALB_SOIL,     &
                      zalbnir_tveg, zalbvis_tveg, zalbnir_tsoil, &
                      zalbvis_tsoil,                             &
                      grm%TGR%CUR%XPSN, grm%TGR%CUR%XPSNV_A, grm%TGR%CUR%XPSNG, grm%TGR%CUR%XPSNV         )
!
grm%TGR%CUR%XSNOWFREE_ALB = zanosnow
!
!* averaged albedo
palb =  grm%TGR%CUR%XPSN(:)    * zasnow              + (1.-grm%TGR%CUR%XPSN(:)) * zanosnow
!* averaged emissivity
pemis=  grm%TGR%CUR%XPSN(:)    * zesnow              + (1.-grm%TGR%CUR%XPSN(:)) * zenosnow
!* averaged surface radiative temperature
!  (recomputed from emitted long wave)
pts  =((grm%TGR%CUR%XPSN(:)    * zesnow * ztssnow**4 + &
        (1.-grm%TGR%CUR%XPSN(:)) * zenosnow * ztsnosnow**4) / pemis)**0.25
!
IF(present(palbnir_tveg))palbnir_tveg(:)=zalbnir_tveg(:)
IF(present(palbvis_tveg))palbvis_tveg(:)=zalbvis_tveg(:)
IF(present(palbnir_tsoil))palbnir_tsoil(:)=zalbnir_tsoil(:)
IF(present(palbvis_tsoil))palbvis_tsoil(:)=zalbvis_tsoil(:)
!
IF (lhook) CALL dr_hook('GREENROOF_PROPERTIES',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!

END SUBROUTINE greenroof_properties