utci_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 utci_teb(T, DUT, PTI_BLD, PQI_BLD, PU10, PPS, PREF_SW_GRND, PREF_SW_FAC, &
                    PSCA_SW, PDIR_SW, PZENITH, PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
                    PTRAD_IN )
!   ##########################################################################
!
!!****  *UTCI_TEB*  
!!
!!    PURPOSE
!!    -------
!
!     Computes the Universal Thermal and Climate Index Equivalent temperature
!     for 3 persons in the urban environment
!         
!     
!!**  METHOD
!     ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!! a supplement
!!    MODD_CST
!!
!!    REFERENCE
!!    ---------
!!   www.utci.org
!!      
!!    AUTHOR
!!    ------
!!
!!      G. Pigeon           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original  03/2011
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_diag_utci_teb_n, ONLY : diag_utci_teb_t
USE modd_teb_n, ONLY : teb_t
!
USE modd_csts, ONLY : xtt
USE modi_utci_approx
USE modi_trad_body
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
TYPE(teb_t), INTENT(INOUT) :: T
TYPE(diag_utci_teb_t), INTENT(INOUT) :: DUT
!
REAL, DIMENSION(:), INTENT(IN)  :: PTI_BLD !Indoor air temperature (K) 
REAL, DIMENSION(:), INTENT(IN)  :: PQI_BLD !Indoor specific humidity (kg/kg) 
REAL, DIMENSION(:), INTENT(IN)  :: PU10 !Canyon wind speed at 10m (m/s)
REAL, DIMENSION(:), INTENT(IN)  :: PPS !Atmospheric Pressure (Pa)
REAL, DIMENSION(:), INTENT(IN)  :: PREF_SW_GRND !Solar radiation reflected by ground [road + garden] (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PREF_SW_FAC !Solar radiation reflected by facade [wall + glazing] (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PSCA_SW !Diffuse solar radiation (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PDIR_SW !Direct solar radiation (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PZENITH !solar zenithal angle (rad from vert.)
REAL, DIMENSION(:), INTENT(IN)  :: PEMIT_LW_FAC !Longwave radiation emitted by the facade [wall + glazing] (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PEMIT_LW_GRND !Longwave radiation emitted by the ground [road + garden] (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PLW_RAD !Atmospheric longwave radiation (W/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PTRAD_IN !Indoor radiant temperature (K)
!
!*      0.2    declarations of local variables
REAL, DIMENSION(SIZE(PTI_BLD)) :: ZEHPA !water vapour pressure (hPa)
REAL, DIMENSION(SIZE(PTI_BLD)) :: ZUIN !indoor air wind speed (m/s)
REAL, DIMENSION(SIZE(PTI_BLD)) :: ZDIR_SW !direct solar radiation
REAL, DIMENSION(SIZE(PTI_BLD)) :: ZZENITH !zenithal angle
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('UTCI_TEB',0,zhook_handle)
! 1-calculation of UTCI_IN
zehpa = pqi_bld * pps /(0.622 + 0.378 * pqi_bld) / 100.
zuin = 0.5
dut%XUTCI_IN = utci_approx(pti_bld - xtt, zehpa, ptrad_in - xtt, zuin)
!
! 2-calculation of UTCI_OUTSUN
zehpa = t%XQ_CANYON * pps / (0.622 + 0.378 * t%XQ_CANYON) /100.
dut%XTRAD_SUN = trad_body(psca_sw, pref_sw_fac, pref_sw_grnd, pemit_lw_fac, pemit_lw_grnd, plw_rad, &
                          t%XBLD, t%XBLD_HEIGHT, t%XWALL_O_HOR, pdir_sw, pzenith )
dut%XUTCI_OUTSUN = utci_approx(t%XT_CANYON - xtt, zehpa, dut%XTRAD_SUN - xtt, pu10)
!
! 3-calculation of UTCI_OUTSHADE
zdir_sw=0.
zzenith=0.
!!DUT%XTRAD_SHADE = TRAD_BODY(PSCA_SW,PREF_SW_FAC, PREF_SW_GRND, &
!!                      PEMIT_LW_FAC, PEMIT_LW_GRND, PLW_RAD,&
!!                      T%XBLD, T%XBLD_HEIGHT, T%XWALL_O_HOR, ZDIR_SW, ZZENITH)
dut%XTRAD_SHADE = trad_body(psca_sw,pref_sw_fac, pref_sw_grnd, pemit_lw_fac, pemit_lw_grnd, plw_rad,&
                            t%XBLD, t%XBLD_HEIGHT, t%XWALL_O_HOR)
dut%XUTCI_OUTSHADE = utci_approx(t%XT_CANYON - xtt, zehpa, dut%XTRAD_SHADE - xtt, pu10)
IF (lhook) CALL dr_hook('UTCI_TEB',1,zhook_handle)
END SUBROUTINE utci_teb