Skip to content
Snippets Groups Projects
avg_urban_fluxes.F90 29.3 KiB
Newer Older
!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 AVG_URBAN_FLUXES(TOP, T, B, TPN, DMT,GDD, HPROGRAM, PTS_TWN, PEMIS_TWN, &
     PT_CAN, PQ_CAN, PT_LOWCAN, PQ_LOWCAN, PTA, PQA, PRHOA, PPS, PH_TRAFFIC,       &
     PLE_TRAFFIC, PWL_O_GRND, PESN_RF, PEMIS_GR, PLW_RAD, PAC_RF, PAC_RF_WAT,      &
     PAC_WL, PAC_RD, PAC_RD_WAT, PAC_TOP, PAC_GD, PQSAT_GD, PAC_AGG_GD, PHU_AGG_GD,&
     PT_HVEG, PQSAT_HVEG, PAC_HVEG, PHU_HVEG,                                      &
     PQSAT_RF, PQSAT_RD, PDELT_RF, PDELT_RD, PRF_FRAC, PWL_FRAC, PRD_FRAC,         &
     PGD_FRAC,PHVEG_FRAC, PDF_RF, PDN_RF,                                          &
     PDF_RD, PDN_RD, PLEW_RF, PLESN_RF, PLEW_RD, PLESN_RD, PHSN_RD, PTSRAD_GD,     &
     PEVAP_GD, PRUNOFF_GD, PEVAP_GR, PRUNOFF_GR, PDRAIN_GR,                        &
     PRN_GRND, PH_GRND, PLE_GRND, PGFLX_GRND, PRN_TWN, PH_TWN,                     &
     PH_TWN_SURF, PH_TWN_WALL, PH_TWN_ROOF, PLE_TWN, PGFLX_TWN, PQF_TWN,           &
     PEVAP_TWN, PEVAP_TWN_SURF, PEVAP_TWN_WALL, PEVAP_TWN_ROOF, PEMIT_LW_RD,       &
     PEMIT_LW_GD, PEMIT_LW_GRND, PEMIS_GD, PCST_H_WASTE_CANY, PCST_LE_WASTE_CANY,  &
     PCOE_H_WASTE_CANY,PCOE_LE_WASTE_CANY, PMUL_H_WASTE_CANY, PMUL_LE_WASTE_CANY   )
!
!   ##########################################################################
!
!!****  *AVG_URBAN_FLUXES* computes fluxes on urbanized surfaces  
!!
!!    PURPOSE
!!    -------
!         
!     
!!**  METHOD
!     ------
!
!
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    MODD_CST
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    23/01/98 
!!                     12/02 (A. Lemonsu) modifications of emissivity and Tstown
!!                     07/07 (P. LeMoigne) expression of latent heat fluxes as 
!!                           functions of w'theta' instead of w'T'
!!                     17/10 (G. Pigeon)  computation of anthropogenic heat due
!!                           to domestic heating
!!                     10/11 (G. Pigeon) simplification for road, garden, roof,
!!                           wall fractions
!!                     08/13 (V. Masson) adds solar panels
!!                     07/15 (R. Schoetter) Implicitation of T_CANYON and Q_CANYON
!!                           with respect to (TI_BLD-TCANYON) and (QI_BLD-QCANYON).
!!                           Check for negative humidity.
!!                     01/16 (E.Redon/A.Lemonsu) adds high vegetation for emissivity calculation
!!                     10/16 (P. Marguinaud) Port to single precision
!!                     07/17 (M. Goret) add anthropogenic flux diagnostics
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
USE MODD_TEB_n, ONLY : TEB_t
USE MODD_BEM_n, ONLY : BEM_t
USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_t
USE MODD_CSTS,ONLY : XCPD, XLVTT, XLSTT, XSTEFAN, XSURF_EPSILON
USE MODD_ISBA_PAR, ONLY : XEMISVEG
!
USE MODE_THERMOS
!
!
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARKIND1  ,ONLY : JPRB
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
TYPE(TEB_t), INTENT(INOUT) :: T
TYPE(BEM_t), INTENT(INOUT) :: B
TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
TYPE(DIAG_MISC_TEB_t), INTENT(INOUT) :: DMT
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
REAL, DIMENSION(:), INTENT(OUT)   :: PTS_TWN           ! town surface temperature
REAL, DIMENSION(:), INTENT(OUT)   :: PEMIS_TWN         ! town equivalent emissivity
REAL, DIMENSION(:), INTENT(INOUT) :: PT_CAN            ! canyon air temperature
REAL, DIMENSION(:), INTENT(INOUT) :: PQ_CAN            ! canyon air specific humidity
REAL, DIMENSION(:), INTENT(IN)    :: PT_LOWCAN         ! low canyon air temperature
REAL, DIMENSION(:), INTENT(IN)    :: PQ_LOWCAN         ! low canyon air specific humidity
REAL, DIMENSION(:), INTENT(IN)    :: PTA               ! temperature at roof level
REAL, DIMENSION(:), INTENT(IN)    :: PQA               ! specific humidity
                                                       ! at roof level
REAL, DIMENSION(:), INTENT(IN)    :: PRHOA             ! air density
                                                       ! at the lowest level
REAL, DIMENSION(:), INTENT(IN)    :: PPS               ! surface pressure
REAL, DIMENSION(:), INTENT(IN)    :: PH_TRAFFIC        ! anthropogenic sensible
!                                                      ! heat fluxes due to traffic
REAL, DIMENSION(:), INTENT(IN)    :: PLE_TRAFFIC       ! anthropogenic latent
!                                                      ! heat fluxes due to traffic
REAL, DIMENSION(:), INTENT(IN)    :: PWL_O_GRND        ! wall Surf. / ground (road+green) Surf.
!   
REAL, DIMENSION(:), INTENT(IN)    :: PESN_RF           ! snow roof emissivity
REAL, DIMENSION(:), INTENT(IN)    :: PEMIS_GR          ! green roof emissivity
REAL, DIMENSION(:), INTENT(IN)    :: PLW_RAD           ! incoming longwave rad.
REAL, DIMENSION(:), INTENT(IN)    :: PAC_RF            ! surface conductance
!                                                      ! for heat transfers
!                                                      ! above roofs
REAL, DIMENSION(:), INTENT(IN)    :: PAC_RF_WAT        ! surface conductance
!                                                      ! for heat transfers
!                                                      ! above roofs (for water)
REAL, DIMENSION(:), INTENT(IN)    :: PAC_WL            ! surface conductance
!                                                      ! for heat transfer
!                                                      ! between wall and canyon
REAL, DIMENSION(:), INTENT(IN)    :: PAC_RD            ! surface conductance
!                                                      ! for heat transfers
!                                                      ! between road and canyon
REAL, DIMENSION(:), INTENT(IN)    :: PAC_RD_WAT        ! surface conductance
!                                                      ! for heat transfers
!                                                      ! inside canyon (for water)
REAL, DIMENSION(:), INTENT(IN)    :: PAC_TOP           ! aerodynamical conductance
!                                                      ! between atmosphere and
!                                                      ! canyon top
REAL, DIMENSION(:), INTENT(IN)    :: PAC_GD            ! aerodynamical conductance
!                                                      ! between atmosphere and
!                                                      ! green areas
REAL, DIMENSION(:), INTENT(IN)    :: PQSAT_GD      ! q_sat(Ts)
REAL, DIMENSION(:), INTENT(IN)    :: PAC_AGG_GD    ! aggregated aerodyn resistance for green areas
REAL, DIMENSION(:), INTENT(IN)    :: PHU_AGG_GD    ! aggregated relative humidity for green areas
!
REAL, DIMENSION(:), INTENT(IN)    :: PT_HVEG       ! Tv : temperature of leaves of trees
REAL, DIMENSION(:), INTENT(IN)    :: PQSAT_HVEG    ! q_sat(Tv)
REAL, DIMENSION(:), INTENT(IN)    :: PAC_HVEG      ! aerodyn conductance for trees (sensible heat flux)
REAL, DIMENSION(:), INTENT(IN)    :: PHU_HVEG      ! relative humidity for trees
!
REAL, DIMENSION(:), INTENT(IN)    :: PQSAT_RF        ! q_sat(Ts)
REAL, DIMENSION(:), INTENT(IN)    :: PQSAT_RD        ! q_sat(Ts)
REAL, DIMENSION(:), INTENT(IN)    :: PDELT_RF        ! water fraction on snow-free
REAL, DIMENSION(:), INTENT(IN)    :: PDELT_RD        ! roof and roads
REAL, DIMENSION(:), INTENT(IN)    :: PRF_FRAC        ! roof, wall,
REAL, DIMENSION(:), INTENT(IN)    :: PWL_FRAC        ! road, green area,
REAL, DIMENSION(:), INTENT(IN)    :: PRD_FRAC        ! and high vegetation
REAL, DIMENSION(:), INTENT(IN)    :: PGD_FRAC        ! fractions
REAL, DIMENSION(:), INTENT(IN)    :: PHVEG_FRAC      ! of exchange surf.
REAL, DIMENSION(:), INTENT(IN)    :: PDF_RF          ! snow-free    roof fraction
REAL, DIMENSION(:), INTENT(IN)    :: PDN_RF          ! snow-covered roof fraction
REAL, DIMENSION(:), INTENT(IN)    :: PDF_RD          ! snow-free    road fraction
REAL, DIMENSION(:), INTENT(IN)    :: PDN_RD          ! snow-covered road fraction
!
REAL, DIMENSION(:), INTENT(IN)    :: PLEW_RF         ! latent heat flux of snowfree roof
REAL, DIMENSION(:), INTENT(IN)    :: PLESN_RF        ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PLEW_RD         ! latent heat flux of snowfree road
REAL, DIMENSION(:), INTENT(IN)    :: PLESN_RD        ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PHSN_RD         ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PTSRAD_GD     ! green area surface temperature
REAL, DIMENSION(:), INTENT(IN)    :: PEVAP_GD      ! evaporation over ground vegetation
REAL, DIMENSION(:), INTENT(IN)    :: PRUNOFF_GD    ! surface runoff over ground vegetation  (kg/m2/s)
REAL, DIMENSION(:), INTENT(IN)    :: PEVAP_GR      ! evaporation over green roofs
REAL, DIMENSION(:), INTENT(IN)    :: PRUNOFF_GR    ! surface runoff over green roofs      (kg/m2/s)
REAL, DIMENSION(:), INTENT(IN)    :: PDRAIN_GR     ! outlet drainage at green roof base   (kg/m2/s)
!
!
REAL, DIMENSION(:), INTENT(OUT)   :: PRN_GRND         ! net radiation over ground
REAL, DIMENSION(:), INTENT(OUT)   :: PH_GRND          ! sensible heat flux over ground
REAL, DIMENSION(:), INTENT(OUT)   :: PLE_GRND         ! latent heat flux over ground
REAL, DIMENSION(:), INTENT(OUT)   :: PGFLX_GRND       ! flux through the ground
REAL, DIMENSION(:), INTENT(OUT)   :: PRN_TWN          ! net radiation over town
REAL, DIMENSION(:), INTENT(OUT)   :: PH_TWN           ! sensible heat flux over town
REAL, DIMENSION(:), INTENT(OUT)   :: PH_TWN_SURF      ! sensible heat flux over town, surface level
REAL, DIMENSION(:), INTENT(OUT)   :: PH_TWN_WALL      ! sensible heat flux over town, wall level
REAL, DIMENSION(:), INTENT(OUT)   :: PH_TWN_ROOF      ! sensible heat flux over town, roof level
REAL, DIMENSION(:), INTENT(OUT)   :: PLE_TWN          ! latent heat flux over town
REAL, DIMENSION(:), INTENT(OUT)   :: PGFLX_TWN        ! flux through the ground for town
REAL, DIMENSION(:), INTENT(OUT)   :: PQF_TWN          ! anthropogenic flux for town
REAL, DIMENSION(:), INTENT(OUT)   :: PEVAP_TWN        ! evaporation (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT)   :: PEVAP_TWN_SURF   ! evaporation flux, surface level (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT)   :: PEVAP_TWN_WALL   ! evaporation flux, wall level (kg/m2/s)
REAL, DIMENSION(:), INTENT(OUT)   :: PEVAP_TWN_ROOF   ! evaporation flux, roof level (kg/m2/s)
!
REAL, DIMENSION(:), INTENT(IN)    :: PEMIT_LW_RD   ! LW emitted by the road (W/m2 road)
REAL, DIMENSION(:), INTENT(IN)    :: PEMIT_LW_GD   ! LW emitted by the garden (W/m2 garden)
REAL, DIMENSION(:), INTENT(OUT)   :: PEMIT_LW_GRND ! LW emitted by the ground (road+garden) (W/m2 ground)
!
REAL, DIMENSION(:), INTENT(IN)    :: PEMIS_GD  ! garden emissivity
REAL, DIMENSION(:), INTENT(IN)    :: PCST_H_WASTE_CANY     ! sensible waste heat released to canyon
REAL, DIMENSION(:), INTENT(IN)    :: PCST_LE_WASTE_CANY    ! latent waste heat released to canyon
REAL, DIMENSION(:), INTENT(IN)    :: PCOE_H_WASTE_CANY
REAL, DIMENSION(:), INTENT(IN)    :: PCOE_LE_WASTE_CANY
REAL, DIMENSION(:), INTENT(IN)    :: PMUL_H_WASTE_CANY
REAL, DIMENSION(:), INTENT(IN)    :: PMUL_LE_WASTE_CANY
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PLW_RAD)) :: ZLW_UP            ! upwards radiations
REAL, DIMENSION(SIZE(T%XROAD)) :: ZRD, ZGD
REAL :: ZINTER
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('AVG_URBAN_FLUXES',0,ZHOOK_HANDLE)
!
ZRD(:)=0.
ZGD(:)=0.
DO JJ=1,SIZE(T%XROAD)
  IF (T%XROAD(JJ)+T%XGARDEN(JJ).NE.0.) THEN
    ZRD(JJ)  = T%XROAD(JJ)   / (T%XROAD(JJ)+T%XGARDEN(JJ))
    ZGD(JJ) =  T%XGARDEN(JJ) / (T%XROAD(JJ)+T%XGARDEN(JJ))
    ZRD(JJ)=0.
    ZGD(JJ)=0.
  ENDIF
!
!*      1.     Averaged fluxes for ground (green areas + road)
!              -----------------------------------------------
!
  PRN_GRND(JJ)    = ZRD(JJ) * DMT%XRN_ROAD   (JJ) 
  PH_GRND (JJ)    = ZRD(JJ) *  DMT%XH_ROAD   (JJ) + PH_TRAFFIC (JJ) / (1.-T%XBLD (JJ))
  PLE_GRND(JJ)    = ZRD(JJ) * DMT%XLE_ROAD   (JJ) + PLE_TRAFFIC(JJ) / (1.-T%XBLD (JJ))
  PGFLX_GRND(JJ)  = ZRD(JJ) * DMT%XGFLUX_ROAD(JJ)
  IF (TOP%LGARDEN) THEN
    PRN_GRND(JJ)    = PRN_GRND  (JJ) + ZGD(JJ) * GDD%XRN   (JJ)
    PH_GRND (JJ)    = PH_GRND   (JJ) + ZGD(JJ) * GDD%XH    (JJ)
!
    PLE_GRND(JJ)    = PLE_GRND  (JJ) + ZGD(JJ) * GDD%XLE   (JJ)
!
    PGFLX_GRND(JJ)  = PGFLX_GRND(JJ) + ZGD(JJ) * GDD%XGFLUX(JJ)
  END IF
  !
  IF (TOP%LSPARTACUS) THEN
     PEMIT_LW_GRND(JJ) = DMT%XEMIT_LW_GRND(JJ)
  ELSE
     PEMIT_LW_GRND(JJ) = T%XROAD_O_GRND(JJ) * PEMIT_LW_RD(JJ) + T%XGARDEN_O_GRND(JJ) * PEMIT_LW_GD(JJ)
  ENDIF
  !
!-------------------------------------------------------------------------------
!
!*      2.     Averaged fluxes JJ built + green areas
!              -------------------------------------
!
  PRN_TWN(JJ)    = PRF_FRAC(JJ) * DMT%XRN_ROOF   (JJ)                  &
                 + PRD_FRAC(JJ) * DMT%XRN_ROAD   (JJ)                  &
                 + PWL_FRAC(JJ) * DMT%XRN_WALL_A (JJ) * 0.5            &
                 + PWL_FRAC(JJ) * DMT%XRN_WALL_B (JJ) * 0.5   
  PH_TWN (JJ)    = PRF_FRAC(JJ) * DMT%XH_ROOF   (JJ)                   &
                 + PRD_FRAC(JJ) * DMT%XH_ROAD   (JJ)                   &
                 + PWL_FRAC(JJ) * DMT%XH_WALL_A (JJ) * 0.5             &
                 + PWL_FRAC(JJ) * DMT%XH_WALL_B (JJ) * 0.5             &
                 + PH_TRAFFIC(JJ) + T%XH_INDUSTRY(JJ)  
  !
  ! Dispatch between surface, wall, and roof level
  !
  PH_TWN_SURF(JJ) = PRD_FRAC(JJ) * DMT%XH_ROAD(JJ)  &
                 + PH_TRAFFIC(JJ) + T%XH_INDUSTRY(JJ)
  !
  PH_TWN_WALL (JJ) = PWL_FRAC(JJ) * DMT%XH_WALL_A(JJ) * 0.5  &
                   + PWL_FRAC(JJ) * DMT%XH_WALL_B(JJ) * 0.5 
  !
  PH_TWN_ROOF (JJ) = PRF_FRAC(JJ) * DMT%XH_ROOF(JJ)
  !
  ! Check sum of fluxes
  !
  IF ( ABS(PH_TWN(JJ)-PH_TWN_SURF(JJ)-PH_TWN_WALL(JJ)-PH_TWN_ROOF(JJ)).GT.1.0E-6 ) THEN
     CALL ABOR1_SFX ("AVG_URBAN_FLUX: Wrong dispatching of sensible heat flux")
  ENDIF
  !
  PLE_TWN(JJ)    = PRF_FRAC(JJ) * DMT%XLE_ROOF  (JJ)                   &
                 + PRD_FRAC(JJ) * DMT%XLE_ROAD  (JJ)                   &
                 + PWL_FRAC(JJ) * DMT%XLE_WALL_A(JJ) * 0.5        &
                 + PWL_FRAC(JJ) * DMT%XLE_WALL_B(JJ) * 0.5        &
                 + PLE_TRAFFIC (JJ) + T%XLE_INDUSTRY(JJ)  
!
  PGFLX_TWN(JJ)=  PRF_FRAC(JJ) * DMT%XGFLUX_ROOF  (JJ)                 &
                + PRD_FRAC(JJ) * DMT%XGFLUX_ROAD  (JJ)                 &
                + PWL_FRAC(JJ) * DMT%XGFLUX_WALL_A(JJ) * 0.5           &
                + PWL_FRAC(JJ) * DMT%XGFLUX_WALL_B(JJ) * 0.5    
  IF (TOP%LGARDEN) THEN
    !
    PRN_TWN(JJ)   = PRN_TWN(JJ)   +  PGD_FRAC  (JJ) * GDD%XRN     (JJ) + PHVEG_FRAC(JJ) * DMT%XRN_HVEG(JJ)
    PH_TWN (JJ)   = PH_TWN (JJ)   +  PGD_FRAC  (JJ) * GDD%XH      (JJ) + PHVEG_FRAC(JJ) * DMT%XH_HVEG (JJ)
    PLE_TWN(JJ)   = PLE_TWN(JJ)   +  PGD_FRAC  (JJ) * GDD%XLE     (JJ) + PHVEG_FRAC(JJ) * DMT%XLE_HVEG(JJ)
    PGFLX_TWN(JJ) = PGFLX_TWN(JJ) +  PGD_FRAC  (JJ) * GDD%XGFLUX  (JJ) + PHVEG_FRAC(JJ) * DMT%XGFLUX_HVEG(JJ)
    !
    ! Both garden and hveg fluxes are attributed to the surface fluxes
    !
    PH_TWN_SURF(JJ) = PH_TWN_SURF(JJ) + PGD_FRAC(JJ) * GDD%XH(JJ) + PHVEG_FRAC(JJ) * DMT%XH_HVEG(JJ)
    !
    ! Check sum of fluxes
    !
    IF ( ABS(PH_TWN(JJ)-PH_TWN_SURF(JJ)-PH_TWN_WALL(JJ)-PH_TWN_ROOF(JJ)).GT.1.0E-6 ) THEN
       CALL ABOR1_SFX ("AVG_URBAN_FLUX: Wrong dispatching of sensible heat flux")
    ENDIF
    !
  ENDIF
  !
  IF (TOP%LSOLAR_PANEL) THEN
    !
    PRN_TWN(JJ) = PRN_TWN(JJ) + PRF_FRAC(JJ) * DMT%XRN_PANEL(JJ) * TPN%XFRAC_PANEL(JJ)
    PH_TWN (JJ) = PH_TWN (JJ) + PRF_FRAC(JJ) * DMT%XH_PANEL (JJ) * TPN%XFRAC_PANEL(JJ)
    !
    PH_TWN_ROOF(JJ) = PH_TWN_ROOF(JJ) + PRF_FRAC(JJ) * DMT%XH_PANEL (JJ) * TPN%XFRAC_PANEL(JJ)
    !
    ! Check sum of fluxes
    !
    IF ( ABS(PH_TWN(JJ)-PH_TWN_SURF(JJ)-PH_TWN_WALL(JJ)-PH_TWN_ROOF(JJ)).GT.1.0E-6 ) THEN
       CALL ABOR1_SFX ("AVG_URBAN_FLUX: Wrong dispatching of sensible heat flux")
    ENDIF
    !
!-------------------------------------------------------------------------------
!
!*      3.     Infra-red Radiative properties
!              ------------------------------
!
!*      3.1    Upward IR radiation for town
!              ----------------------------
!
  ZLW_UP(JJ) = PLW_RAD  (JJ)      &
            - ( PRF_FRAC(JJ) * (1.-T%XGREENROOF(JJ)) * PDF_RF(JJ) * DMT%XABS_LW_ROOF     (JJ) &
               +PRF_FRAC(JJ) * (1.-T%XGREENROOF(JJ)) * PDN_RF(JJ) * DMT%XABS_LW_SNOW_ROOF(JJ) &
               +PRF_FRAC(JJ) *     T%XGREENROOF(JJ)               * DMT%XABS_LW_GREENROOF(JJ) &
               +PRD_FRAC(JJ)                         * PDF_RD(JJ) * DMT%XABS_LW_ROAD     (JJ) &
               +PRD_FRAC(JJ)                         * PDN_RD(JJ) * DMT%XABS_LW_SNOW_ROAD(JJ) &
               +PGD_FRAC(JJ)                                      * DMT%XABS_LW_GARDEN   (JJ) &
               +PHVEG_FRAC(JJ)                                    * DMT%XABS_LW_HVEG     (JJ) & 
               +PWL_FRAC(JJ)*0.5*(1.-B%XGR(JJ))                   * DMT%XABS_LW_WALL_A   (JJ) &
               +PWL_FRAC(JJ)*0.5*(1.-B%XGR(JJ))                   * DMT%XABS_LW_WALL_B   (JJ) &
               +PWL_FRAC(JJ)*        B%XGR(JJ)                    * DMT%XABS_LW_WIN      (JJ) &
              )
!
!
  IF (TOP%LSOLAR_PANEL) THEN
    ZLW_UP(JJ) = ZLW_UP(JJ) - PRF_FRAC(JJ) * DMT%XABS_LW_PANEL(JJ) * TPN%XFRAC_PANEL(JJ)
  ENDIF
!
!* Upward IR radiation from the canyon     
  DMT%XLW_UP_CAN(JJ) = PLW_RAD      (JJ)                                         &
                     - ( ZRD(JJ)                  *PDF_RD (JJ)*DMT%XABS_LW_ROAD      (JJ) &
                     +ZRD(JJ)                  *PDN_RD (JJ)*DMT%XABS_LW_SNOW_ROAD (JJ) &
                     +ZGD(JJ)                              *DMT%XABS_LW_GARDEN    (JJ) &
                     +T%XURBTREE(JJ)                       *DMT%XABS_LW_HVEG     (JJ)  &   
                     +PWL_O_GRND(JJ)*0.5*(1.-B%XGR(JJ))    *DMT%XABS_LW_WALL_A    (JJ) &   
                     +PWL_O_GRND(JJ)*0.5*(1.-B%XGR(JJ))    *DMT%XABS_LW_WALL_B    (JJ) &
                     +PWL_O_GRND(JJ)*        B%XGR(JJ)     *DMT%XABS_LW_WIN       (JJ) )
!
!* Upward IR radiation from the roof
  DMT%XLW_UP_ROOF(JJ) = PLW_RAD      (JJ)                                      &
                      - ( (1.-T%XGREENROOF(JJ))*PDF_RF (JJ)*DMT%XABS_LW_ROOF      (JJ) &
                      +(1.-T%XGREENROOF(JJ))*PDN_RF (JJ)*DMT%XABS_LW_SNOW_ROOF (JJ) &
                      +    T%XGREENROOF(JJ)             *DMT%XABS_LW_GREENROOF (JJ) ) 
!
  IF (TOP%LSOLAR_PANEL) THEN
    DMT%XLW_UP_ROOF(JJ) =DMT%XLW_UP_ROOF(JJ) -  TPN%XFRAC_PANEL(JJ) *DMT%XABS_LW_PANEL     (JJ) 
!
!*      3.2    Town emissivity
!              ---------------
!
! simplifications are made to evaluate the emissivity in case of high vegetation: 
!  walls are not obstructed, high vegetation only obstruct road and garden.
!
    PEMIS_TWN(JJ) = T%XBLD        (JJ)  * (1.-T%XGREENROOF(JJ)) * PDF_RF(JJ) * T%XEMIS_ROOF(JJ)      * (1.-TPN%XFRAC_PANEL(JJ)) &
                  + T%XBLD        (JJ)  * (1.-T%XGREENROOF(JJ)) * PDN_RF(JJ) * PESN_RF     (JJ)      * (1.-TPN%XFRAC_PANEL(JJ)) &
                  + T%XBLD        (JJ)  *     T%XGREENROOF(JJ)               * PEMIS_GR    (JJ)      * (1.-TPN%XFRAC_PANEL(JJ)) &
                  + T%XBLD        (JJ)                                       * TPN%XEMIS_PANEL(JJ)   *     TPN%XFRAC_PANEL(JJ)  &
                  + T%XWALL_O_HOR (JJ)  *  T%XSVF_WS(JJ)                     * T%XEMIS_WALL(JJ)                                 &
                  + (1.-T%XBLD    (JJ)) *  T%XSVF_RS(JJ)                     * XEMISVEG              *     T%XURBTREE(JJ)       &
                  + T%XROAD       (JJ)  *  T%XSVF_RS(JJ)        *( PDF_RD(JJ)* T%XEMIS_ROAD(JJ)                                 &
                                                                  +PDN_RD(JJ)* T%TSNOW_ROAD%EMIS(JJ))* (1.-T%XURBTREE(JJ))      &
                  + T%XGARDEN     (JJ)  *  T%XSVF_RS(JJ)                     * PEMIS_GD(JJ)          * (1.-T%XURBTREE(JJ))
!*      3.3    Town radiative surface temperature
!              ----------------------------------
!
  PTS_TWN(JJ)   = ((ZLW_UP(JJ) - PLW_RAD(JJ)*(1.-PEMIS_TWN(JJ))) /PEMIS_TWN(JJ)/XSTEFAN)**0.25
!
!-------------------------------------------------------------------------------
!
!*      4.     Averaged evaporative flux (kg/m2/s)
!              -----------------------------------
!
  PEVAP_TWN(JJ) = PRF_FRAC  (JJ) * PDF_RF(JJ) * (1.-T%XGREENROOF(JJ)) * PLEW_RF   (JJ) / XLVTT  &
                 + PRF_FRAC  (JJ) * PDN_RF(JJ) * (1.-T%XGREENROOF(JJ)) * PLESN_RF  (JJ) / XLSTT  &
                 + PRF_FRAC  (JJ)              *     T%XGREENROOF(JJ)  * PEVAP_GR  (JJ)          &
                 + PRD_FRAC  (JJ) * PDF_RD(JJ)                         * PLEW_RD   (JJ) / XLVTT  &
                 + PRD_FRAC  (JJ) * PDN_RD(JJ)                         * PLESN_RD  (JJ) / XLSTT  &
                 + PGD_FRAC  (JJ)                                      * PEVAP_GD  (JJ)          &
                 + PHVEG_FRAC(JJ)                                      * DMT%XLE_HVEG(JJ)/XLVTT  &
                 + PWL_FRAC  (JJ) * 0.5  * (DMT%XLE_WALL_A(JJ) + DMT%XLE_WALL_B(JJ)) / XLVTT     &
                 +                                                     PLE_TRAFFIC (JJ) / XLVTT  &
                 +                                                   T%XLE_INDUSTRY(JJ) / XLVTT  &
                 + PRF_FRAC  (JJ) * DMT%XLE_WASTE_ROOF(JJ) / XLVTT
  !
  PEVAP_TWN_SURF(JJ) =  PRD_FRAC  (JJ)*PDF_RD(JJ)                  *PLEW_RD  (JJ) /XLVTT  &
                      + PRD_FRAC  (JJ)*PDN_RD(JJ)                  *PLESN_RD (JJ) /XLSTT  &
                      + PGD_FRAC  (JJ)                             *PEVAP_GD (JJ)        & 
                      + PHVEG_FRAC(JJ)                             *DMT%XLE_HVEG(JJ)/XLVTT  &
                      + PLE_TRAFFIC (JJ) /XLVTT                                           &
                      + T%XLE_INDUSTRY(JJ) /XLVTT
  !
  PEVAP_TWN_WALL(JJ) = PWL_FRAC  (JJ)*0.5 * (DMT%XLE_WALL_A(JJ)+DMT%XLE_WALL_B (JJ))/XLVTT
  !
  PEVAP_TWN_ROOF(JJ) = PRF_FRAC  (JJ)*PDF_RF(JJ)*(1.-T%XGREENROOF(JJ))*PLEW_RF(JJ)  / XLVTT &
                 + PRF_FRAC  (JJ)*PDN_RF(JJ)*(1.-T%XGREENROOF(JJ))*PLESN_RF(JJ) / XLSTT &
                 + PRF_FRAC  (JJ)           *    T%XGREENROOF(JJ) *PEVAP_GR(JJ)         &
                 + PRF_FRAC  (JJ)             *  DMT%XLE_WASTE_ROOF(JJ) / XLVTT  
  !
  IF (ABS(PEVAP_TWN(JJ)-PEVAP_TWN_SURF(JJ)-PEVAP_TWN_WALL(JJ)-PEVAP_TWN_ROOF(JJ)).GT.1.0E-8) THEN
     CALL ABOR1_SFX("AVG_URBAN_FLUXES: Wrong dispatching of evaporation flux")
!-------------------------------------------------------------------------------
!
!*      5.     Averaged runoff flux (kg/m2/s)
!              -----------------------------------
    DMT%XRUNOFF_TOWN(JJ) =  ((1.-T%XGREENROOF(JJ))* DMT%XRUNOFF_STRLROOF (JJ)                        &
                              +   T%XGREENROOF(JJ) *(PRUNOFF_GR(JJ) + PDRAIN_GR(JJ))) * T%XBLD(JJ)   &
                              +    T%XROAD    (JJ) * DMT%XRUNOFF_ROAD(JJ)                            &
                              +    T%XGARDEN  (JJ) * PRUNOFF_GD(JJ)                                  &
                              +    T%XROAD    (JJ) * DMT%XRUNOFFSOIL_ROAD(JJ)                        & 
                              +    T%XBLD     (JJ) * DMT%XRUNOFFSOIL_BLD(JJ)        
  IF (TOP%LURBHYDRO) &
    DMT%XRUNOFF_TOWN(JJ) =   DMT%XRUNOFF_TOWN(JJ)                                                    &
                              +    T%XROAD    (JJ) *(DMT%XRUNOFF_WW(JJ) + DMT%XRUNOFF_SW(JJ))
!
!-------------------------------------------------------------------------------
!
!*      6.    Air canyon temperature at time t+dt
!             -----------------------------------
!
  IF (.NOT. TOP%LCANOPY) THEN
    ZINTER = ZRD(JJ) * PAC_RD(JJ) * PDF_RD(JJ) +   ZGD(JJ) * PAC_GD(JJ) + PAC_WL(JJ) * PWL_O_GRND(JJ) &
           + PAC_TOP(JJ)                        +  PAC_HVEG(JJ) * PHVEG_FRAC(JJ) 
    IF (TOP%CBEM=="BEM") THEN
      ZINTER = ZINTER +  PCOE_H_WASTE_CANY(JJ)/ ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XCPD )
    ENDIF
    PT_CAN(JJ) =  (  T%XT_ROAD  (JJ,1) * PAC_RD (JJ) * PDF_RD (JJ) * ZRD(JJ)        &
                   + T%XT_WALL_A(JJ,1) * PAC_WL (JJ) * (1.-B%XGR(JJ)) * PWL_O_GRND(JJ) * 0.5 &
                   + T%XT_WALL_B(JJ,1) * PAC_WL (JJ) * (1.-B%XGR(JJ)) * PWL_O_GRND(JJ) * 0.5 &
                   + B%XT_WIN1    (JJ) * PAC_WL (JJ) *     B%XGR(JJ)  * PWL_O_GRND(JJ)       &
                   + PTA          (JJ) * PAC_TOP(JJ)                                         &
                   + PH_TRAFFIC   (JJ) / (1.-T%XBLD (JJ))               / PRHOA(JJ) / XCPD   &
                   + PHSN_RD(JJ) * PDN_RD(JJ)                           / PRHOA(JJ) / XCPD  ) &
                       / ZINTER  
!   
    PT_CAN(JJ) = PT_CAN(JJ) + (ZGD(JJ) * PTSRAD_GD(JJ) * PAC_GD  (JJ)) / ZINTER                 
    PT_CAN(JJ) = PT_CAN(JJ) + ( PT_HVEG(JJ)  * PAC_HVEG(JJ) * PHVEG_FRAC(JJ) ) / ZINTER   
    !
    IF (TOP%CBEM=="BEM") THEN
      PT_CAN(JJ) = PT_CAN(JJ) +  (   PCST_H_WASTE_CANY(JJ) / ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XCPD )             &
                 + PMUL_H_WASTE_CANY(JJ) / ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XCPD ) )  / ZINTER 
!-------------------------------------------------------------------------------
!
!*      7.     Air canyon specific humidity
!              ----------------------------
!
    ZINTER = ZRD(JJ) * PAC_RD_WAT  (JJ) * PDF_RD      (JJ) * PDELT_RD(JJ)        &
           + ZGD(JJ) * PAC_AGG_GD  (JJ) * PHU_AGG_GD  (JJ)                       &
           + PAC_HVEG    (JJ) * PHU_HVEG    (JJ) *                PHVEG_FRAC(JJ) &
           + PAC_TOP     (JJ)
    IF (TOP%CBEM=="BEM") THEN
      ZINTER = ZINTER +  PCOE_LE_WASTE_CANY(JJ)/ ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XLVTT )
    ENDIF
    PQ_CAN(JJ) = (  ZRD(JJ) * PQSAT_RD   (JJ) * PAC_RD_WAT  (JJ) * PDF_RD    (JJ) * PDELT_RD(JJ)  &
                  + ZGD(JJ) * PQSAT_GD   (JJ) * PAC_AGG_GD  (JJ) * PHU_AGG_GD(JJ)                 &
                  + PQSAT_HVEG (JJ) * PAC_HVEG    (JJ) * PHU_HVEG  (JJ) * PHVEG_FRAC(JJ)          &
                  + PQA        (JJ) * PAC_TOP(JJ)                                                 &
                  + PLE_TRAFFIC(JJ) / (1.-T%XBLD(JJ)) / PRHOA(JJ) / XLVTT                         &
                  + PLESN_RD   (JJ) * PDN_RD(JJ)      / PRHOA(JJ) / XLVTT * ZRD(JJ)  ) / ZINTER

    IF (TOP%CBEM=="BEM") THEN
      PQ_CAN(JJ) = PQ_CAN(JJ) +  (   PCST_LE_WASTE_CANY(JJ) / ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XLVTT )             &
                 + PMUL_LE_WASTE_CANY(JJ) / ( (1.-T%XBLD (JJ)) * PRHOA(JJ) * XLVTT ) )  / ZINTER 
! Check for negative humidities
!
   IF (PQ_CAN(JJ).LT.-XSURF_EPSILON) THEN
      !
      CALL GET_LUOUT(HPROGRAM,ILUOUT)
      !
      WRITE(ILUOUT,*) "                                          "
      WRITE(ILUOUT,*) "In avg urban fluxes                       "
      WRITE(ILUOUT,*) "Check terms leading to negative humidity  "
      WRITE(ILUOUT,*) "                                          "
      WRITE(ILUOUT,*) "JJ                     : ",JJ
      WRITE(ILUOUT,*) "PQSAT_RD(JJ)           : ",PQSAT_RD(JJ)
      WRITE(ILUOUT,*) "PAC_RD_WAT(JJ)         : ",PAC_RD_WAT(JJ)
      WRITE(ILUOUT,*) "PDF_RD(JJ)             : ",PDF_RD(JJ)
      WRITE(ILUOUT,*) "ZRD (JJ)               : ",ZRD(JJ)
      WRITE(ILUOUT,*) "PDELT_RD(JJ)           : ",PDELT_RD(JJ)
      WRITE(ILUOUT,*) "PQSAT_GD(JJ)           : ",PQSAT_GD(JJ)
      WRITE(ILUOUT,*) "PAC_AGG_GD(JJ)         : ",PAC_AGG_GD(JJ)
      WRITE(ILUOUT,*) "PHU_AGG_GD(JJ)         : ",PHU_AGG_GD(JJ)
      WRITE(ILUOUT,*) "PAC_HVEG(JJ)           : ",PAC_HVEG(JJ)
      WRITE(ILUOUT,*) "PHU_HVEG(JJ)           : ",PHU_HVEG(JJ)
      WRITE(ILUOUT,*) "ZGD(JJ)                : ",ZGD(JJ)
      WRITE(ILUOUT,*) "PHVEG_FRAC(JJ)         : ",PHVEG_FRAC(JJ)
      WRITE(ILUOUT,*) "PQA(JJ)                : ",PQA(JJ)
      WRITE(ILUOUT,*) "PAC_TOP(JJ)            : ",PAC_TOP(JJ)
      WRITE(ILUOUT,*) "PLE_TRAFFIC(JJ)        : ",PLE_TRAFFIC(JJ)
      WRITE(ILUOUT,*) "T%XBLD(JJ)             : ",T%XBLD(JJ)
      WRITE(ILUOUT,*) "PRHOA(JJ)              : ",PRHOA(JJ)
      WRITE(ILUOUT,*) "PLESN_RD(JJ)           : ",PLESN_RD(JJ)
      WRITE(ILUOUT,*) "PDN_RD(JJ)             : ",PDN_RD(JJ)
      WRITE(ILUOUT,*) "PCST_LE_WASTE_CANY(JJ) : ",PCST_LE_WASTE_CANY(JJ)
      WRITE(ILUOUT,*) "PMUL_LE_WASTE_CANY(JJ) : ",PMUL_LE_WASTE_CANY(JJ)
      WRITE(ILUOUT,*) "------------------------------------------"
      WRITE(ILUOUT,*) "PQ_CAN(JJ)             : ",PQ_CAN(JJ)
      WRITE(ILUOUT,*) "                                          "
      CALL FLUSH(ILUOUT)
      CALL ABOR1_SFX("In avg_urban_fluxes: negative humidity in canyon")
   ENDIF
IF (LHOOK) CALL DR_HOOK('AVG_URBAN_FLUXES',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
END SUBROUTINE AVG_URBAN_FLUXES