averaged_tsrad_teb.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 averaged_tsrad_teb(T, B, PEMIS_GARDEN, PTS_GARDEN, PEMIS_GREENROOF, &
                                    PTS_GREENROOF, PEMIS, PTSRAD     ) 
!     ###################################################
!
!!**** *AVERAGED_TSRAD_TEB* computes averaged emissivity and radiative surface
!!                          temperature for TEB scheme
!!
!!    PURPOSE
!!    -------
!!
!!    METHODi
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!    09/2012     C. de Munck, A. Lemonsu : add green roofs
!!
!!    Original    01/2004
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
USE modd_teb_n, ONLY : teb_t
USE modd_bem_n, ONLY : bem_t
!
USE modd_type_snow
!
USE modd_surf_par, ONLY : xundef
USE modd_csts,     ONLY : xstefan
!
USE modi_urban_lw_coef
!
USE mode_surf_snow_frac
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
TYPE(teb_t), INTENT(INOUT) :: T
TYPE(bem_t), INTENT(INOUT) :: B
!
REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GARDEN   ! green area emissivity (snowfree)
REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN     ! green area surf. temp.
REAL, DIMENSION(:), INTENT(IN) :: PEMIS_GREENROOF! green roof emissivity (snowfree)
REAL, DIMENSION(:), INTENT(IN) :: PTS_GREENROOF  ! green roof surf. temp.
REAL, DIMENSION(:), INTENT(OUT):: PEMIS          ! averaged emissivity (all tiles)
REAL, DIMENSION(:), INTENT(OUT):: PTSRAD         ! averaged radiaitve temp. (all tiles)
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROOF       ! snow fraction 
REAL, DIMENSION(SIZE(T%XEMIS_ROOF)) :: ZDN_ROAD       ! on the surface
REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROOF       ! free-snow fraction 
REAL, DIMENSION(SIZE(T%XBLD)) :: ZDF_ROAD       ! on the surface
LOGICAL, DIMENSION(SIZE(T%XBLD)) :: GMASK       ! .false. (= no snow precip.)
!
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_WB   ! longwave exchange coefficients
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_R
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_R
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_NR
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_NR
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_G
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_G
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WA_TO_WIN
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WB_TO_WIN
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WA
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WB
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_R_TO_WIN
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WA
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WB
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_G_TO_WIN
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WA
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WB
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_R
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_NR
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_G
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_S_TO_WIN
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_WA
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_WB
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_R
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_NR
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_WIN_TO_G
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WA
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WB
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_NR_TO_WIN
!
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_RAD          ! incoming LW to mimic
!                                               ! radiation behaviour of town
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_WALL     ! longwave absorbed by walls
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_ROAD     ! longwave absorbed by roads
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_ROOF     ! longwave absorbed by roofs
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_SNOW_ROAD! longwave absorbed by snow
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_SNOW_ROOF! on roads and roofs
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_GARDEN   ! longwave absorbed by gardens
REAL, DIMENSION(SIZE(T%XBLD)) :: ZABS_LW_GREENROOF! longwave absorbed by green roofs
REAL, DIMENSION(SIZE(T%XBLD)) :: ZLW_UP           ! outgoing longwave
!
REAL, DIMENSION(SIZE(T%XBLD)) :: ZT_SKY
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!* snow fractions
!  --------------
!
IF (lhook) CALL dr_hook('AVERAGED_TSRAD_TEB',0,zhook_handle)
gmask(:) = .false.
 CALL snow_frac_road(t%TSNOW_ROAD%WSNOW(:,1),gmask,zdn_road,zdf_road)
 CALL snow_frac_roof(t%TSNOW_ROOF%WSNOW(:,1),gmask,zdn_roof,zdf_roof)
!
! fixed incoming LW (W/m2)
zlw_rad(:)= xstefan * (t%XT_ROAD(:,1) ** 4)
!
! LW absorbed by roofs
zabs_lw_roof(:) = t%XEMIS_ROOF(:) * (zlw_rad(:) - xstefan * t%XT_ROOF(:,1)**4)
!
!* LW absorbed by snow on roof
zabs_lw_snow_roof(:) = t%TSNOW_ROOF%EMIS(:) * (zlw_rad(:) - xstefan * t%TSNOW_ROOF%TS(:)**4)
!
!* town averaged emissivity
pemis(:) = t%XBLD(:) * (1.-t%XGREENROOF(:)) * (zdf_roof(:)*t%XEMIS_ROOF     (:)    &
                                       + zdn_roof(:)*t%TSNOW_ROOF%EMIS(:)) &
         + t%XBLD(:) *     t%XGREENROOF(:)  *              pemis_greenroof(:)

!
!* long-wave trapping coefficients
!  -------------------------------
!
   zt_sky(:) = (zlw_rad(:)/xstefan)**0.25
   !
   CALL urban_lw_coef(b, t, zlw_rad, pemis_garden,             &
                      t%XT_ROAD(:,1), pts_garden,              &  
                      zlw_wa_to_wb, zlw_wa_to_r, zlw_wb_to_r,  &
                      zlw_wa_to_nr,zlw_wb_to_nr,               &
                      zlw_wa_to_g, zlw_wb_to_g,                &
                      zlw_wa_to_win, zlw_wb_to_win,            &
                      zlw_r_to_wa, zlw_r_to_wb, zlw_r_to_win,  &
                      zlw_g_to_wa, zlw_g_to_wb, zlw_g_to_win,  &
                      zlw_s_to_wa, zlw_s_to_wb, zlw_s_to_r,    &
                      zlw_s_to_nr, zlw_s_to_g, zlw_s_to_win,   &
                      zlw_win_to_wa, zlw_win_to_wb, zlw_win_to_r, &
                      zlw_win_to_nr, zlw_win_to_g,                &
                      zlw_nr_to_wa, zlw_nr_to_wb, zlw_nr_to_win   )
   !
   !
   !* town averaged emissivity
   !  ------------------------
   !
   pemis(:) =  pemis(:)                                                      &
              + t%XROAD(:)*t%XSVF_ROAD(:)* (zdf_road(:)* t%XEMIS_ROAD(:)     &
                                      + zdn_road(:)* t%TSNOW_ROAD%EMIS(:)) &
              + t%XWALL_O_HOR(:)       * t%XSVF_WALL(:)   * t%XEMIS_WALL(:)  &
              + t%XGARDEN(:)           * t%XSVF_GARDEN(:) * pemis_garden(:)
   
   !
   ! LW absorbed by roads
   zabs_lw_road(:) =  zlw_s_to_r(:) * (zt_sky(:) - t%XT_ROAD(:,1)) &
                    + zlw_wa_to_r(:) * (t%XT_WALL_A(:,1) - t%XT_ROAD(:,1)) &
                    + zlw_wb_to_r(:) * (t%XT_WALL_B(:,1) - t%XT_ROAD(:,1)) &
                    + zlw_win_to_r(:) * (b%XT_WIN1    (:) - t%XT_ROAD(:,1))
   
   !
   ! LW absorbed by walls
   zabs_lw_wall(:) =( zlw_s_to_wa(:)  * (zt_sky(:)       - t%XT_WALL_A(:,1)) &
                    + zlw_r_to_wa(:)  * (t%XT_ROAD(:,1)  - t%XT_WALL_A(:,1)) &
                    + zlw_g_to_wa(:)  * (pts_garden(:)   - t%XT_WALL_A(:,1)) &
                    + zlw_win_to_wa(:)* (b%XT_WIN1(:)    - t%XT_WALL_A(:,1)) &
                    + zlw_s_to_wb(:)  * (zt_sky(:)       - t%XT_WALL_B(:,1)) &
                    + zlw_r_to_wb(:)  * (t%XT_ROAD(:,1)  - t%XT_WALL_B(:,1)) &
                    + zlw_g_to_wb(:)  * (pts_garden(:)   - t%XT_WALL_B(:,1)) &
                    + zlw_win_to_wb(:)* (b%XT_WIN1(:)    - t%XT_WALL_B(:,1)))&
                   * 0.5
   
   !
   !* LW absorbed by snow on road
   zabs_lw_snow_road(:) =  zlw_s_to_r(:) * (zt_sky(:)        - t%TSNOW_ROAD%TS(:)) &
                         + zlw_wa_to_nr(:) * (t%XT_WALL_A(:,1) - t%TSNOW_ROAD%TS(:)) &
                         + zlw_wb_to_nr(:) * (t%XT_WALL_B(:,1) - t%TSNOW_ROAD%TS(:)) &
                         + zlw_win_to_nr(:) * (b%XT_WIN1(:)     - t%TSNOW_ROAD%TS(:))
   !
   !* LW absorbed by gardens
   zabs_lw_garden(:) =  zlw_s_to_g(:)*(zt_sky(:)-pts_garden(:)) &
                      + zlw_wa_to_g(:)*(t%XT_WALL_A(:,1)-pts_garden(:)) &
                      + zlw_wb_to_g(:)*(t%XT_WALL_B(:,1)-pts_garden(:)) &
                      + zlw_win_to_g(:)*(b%XT_WIN1    (:)-pts_garden(:))
   !
   !* LW absorbed by green roofs
zabs_lw_greenroof(:) = pemis_greenroof(:) * (zlw_rad(:) - xstefan * pts_greenroof(:)** 4)
   
!
!* outgoing longwave radiation
zlw_up(:) = zlw_rad(:)                                                     &
          - ( t%XBLD(:) *(1.-t%XGREENROOF(:))*zdf_roof(:)*zabs_lw_roof(:)   &
             +t%XBLD(:) *(1.-t%XGREENROOF(:))*zdn_roof(:)*zabs_lw_snow_roof(:)   &
             +t%XBLD(:) *    t%XGREENROOF(:)             *zabs_lw_greenroof(:)   &
             +t%XROAD(:)                 *zdf_road(:)*zabs_lw_road(:)   &
             +t%XROAD(:)                 *zdn_road(:)*zabs_lw_snow_road(:)   &
             +t%XWALL_O_HOR(:)                       *zabs_lw_wall(:)   &
             +t%XGARDEN(:)                           *zabs_lw_garden(:))
!
!* town radiative surface temperature
ptsrad(:)   = ((zlw_up(:) - zlw_rad(:)*(1.-pemis(:))) /pemis(:)/xstefan)**0.25
!
IF (lhook) CALL dr_hook('AVERAGED_TSRAD_TEB',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE averaged_tsrad_teb