urban_fluxes.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 urban_fluxes(TOP, T, B, DMT, HIMPLICIT_WIND, PT_CANYON, PPEW_A_COEF, PPEW_B_COEF,      &
                            PEXNS, PRHOA, PVMOD, PH_TRAFFIC, PLE_TRAFFIC, PAC_WL, PCD, PDF_RF,        &
                            PDN_RF, PDF_RD, PDN_RD, PRNSN_RF, PHSN_RF, PLESN_RF, PGSN_RF,             &
                            PRNSN_RD, PHSN_RD, PLESN_RD, PGSN_RD, PMELT_RF, PDQS_RF, PMELT_RD,        &
                            PDQS_RD, PDQS_WL_A, PDQS_WL_B, PFLX_BLD_RF, PFLX_BLD_WL_A,                &
                            PFLX_BLD_WL_B, PFLX_BLD_FL, PFLX_BLD_MA, PE_SHADING, PLEW_RF,             &
                            PRN_GR, PH_GR, PLE_GR, PGFLUX_GR,                                         &
                            PLEW_RD, PLE_WL_A, PLE_WL_B, PMELT_BLT, PUSTAR_TWN                        )
!   ##########################################################################
!
!!****  *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
!!      Modified    09/2012 : B. Decharme New wind implicitation
!-------------------------------------------------------------------------------
!
!*       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_diag_misc_teb_n, ONLY : diag_misc_teb_t
!
USE modd_surf_par, ONLY : xundef
USE modd_csts,     ONLY : xcpd
!
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(diag_misc_teb_t), INTENT(INOUT) :: DMT
!
 CHARACTER(LEN=*),     INTENT(IN)  :: HIMPLICIT_WIND   ! wind implicitation option
!                                                     ! 'OLD' = direct
!                                                     ! 'NEW' = Taylor serie, order 1
REAL, DIMENSION(:), INTENT(IN)    :: PT_CANYON    ! canyon air temperature

REAL, DIMENSION(:), INTENT(IN)    :: PPEW_A_COEF  ! implicit coefficients
REAL, DIMENSION(:), INTENT(IN)    :: PPEW_B_COEF  ! for wind coupling
REAL, DIMENSION(:), INTENT(IN)    :: PEXNS        ! surface exner function

REAL, DIMENSION(:), INTENT(IN)    :: PRHOA        ! air density
                                                  ! at the lowest level
REAL, DIMENSION(:), INTENT(IN)    :: PVMOD        ! module of the horizontal wind
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)    :: PAC_WL     ! surface conductance
!                                                 ! for heat transfer
!                                                 ! between wall and canyon
REAL, DIMENSION(:), INTENT(IN)    :: PCD          ! drag coefficient
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)    :: PRNSN_RF ! net radiation over snow
REAL, DIMENSION(:), INTENT(IN)    :: PHSN_RF  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PLESN_RF ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PGSN_RF  ! flux under the snow
REAL, DIMENSION(:), INTENT(IN)    :: PRNSN_RD ! net radiation over snow
REAL, DIMENSION(:), INTENT(IN)    :: PHSN_RD  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PLESN_RD ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(IN)    :: PGSN_RD  ! flux under the snow
!
REAL, DIMENSION(:), INTENT(IN)    :: PMELT_RF   ! snow melting on roof
REAL, DIMENSION(:), INTENT(IN)    :: PDQS_RF    ! storage inside roofs
REAL, DIMENSION(:), INTENT(IN)    :: PMELT_RD   ! snow melting on road
REAL, DIMENSION(:), INTENT(IN)    :: PDQS_RD    ! storage inside roads
REAL, DIMENSION(:), INTENT(IN)    :: PDQS_WL_A  ! storage inside walls
REAL, DIMENSION(:), INTENT(IN)    :: PDQS_WL_B  ! storage inside walls
REAL, DIMENSION(:), INTENT(IN)    :: PFLX_BLD_RF! heat flx from bld to roof
REAL, DIMENSION(:), INTENT(IN)    :: PFLX_BLD_WL_A! heat flx from bld to wall A
REAL, DIMENSION(:), INTENT(IN)    :: PFLX_BLD_WL_B! heat flx from bld to wall B
REAL, DIMENSION(:), INTENT(IN)    :: PFLX_BLD_FL! heat flx from bld to floor
REAL, DIMENSION(:), INTENT(IN)    :: PFLX_BLD_MA! heat flx from bld to mass
REAL, DIMENSION(:), INTENT(IN)    :: PE_SHADING   ! energy not ref., nor absorbed, nor
                                                  !trans. by glazing [W
                                                  !m-2(win)]
!
REAL, DIMENSION(:), INTENT(IN)   :: PLEW_RF     ! latent heat flux over snow-free roof
REAL, DIMENSION(:), INTENT(IN)   :: PLEW_RD     ! latent heat flux of snow-free road
REAL, DIMENSION(:), INTENT(IN)    :: PRN_GR     ! net radiation over greenroof
REAL, DIMENSION(:), INTENT(IN)    :: PH_GR      ! sensible heat flux over greenroof
REAL, DIMENSION(:), INTENT(IN)    :: PLE_GR     ! latent heat flux over greenroof
REAL, DIMENSION(:), INTENT(IN)    :: PGFLUX_GR  ! flux through the greenroof
!
REAL, DIMENSION(:), INTENT(OUT)   :: PLE_WL_A   ! latent heat flux over wall
REAL, DIMENSION(:), INTENT(OUT)   :: PLE_WL_B   ! latent heat flux over wall
!
REAL, DIMENSION(:), INTENT(OUT)   :: PMELT_BLT    ! snow melting for town
!
REAL, DIMENSION(:), INTENT(OUT)   :: PUSTAR_TWN  ! friction velocity over town
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PRHOA)) :: ZH_RF_SNFREE
REAL, DIMENSION(SIZE(PRHOA)) :: ZRN_RF_SNFREE
REAL, DIMENSION(SIZE(PRHOA)) :: ZUSTAR2 ! square of friction velocity (m2/s2)
REAL, DIMENSION(SIZE(PRHOA)) :: ZVMOD   ! Wind
REAL, DIMENSIOn(SIZE(PRHOA)) :: ZINTER
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('URBAN_FLUXES',0,zhook_handle)
!
!*      1.     Fluxes at snow-free roofs
!              -------------------------
!
!                                            net radiation
!
!
zrn_rf_snfree(:) = dmt%XABS_SW_ROOF(:) + dmt%XABS_LW_ROOF(:)
!
!                                            sensible heat flux
!
zh_rf_snfree(:) = dmt%XH_ROOF(:)
!
!-------------------------------------------------------------------------------
!
!*      2.     Fluxes at snow-free roads
!              -------------------------
!
!                                            net radiation
!
dmt%XRN_ROAD(:) = dmt%XABS_SW_ROAD(:) + dmt%XABS_LW_ROAD(:)
!
!-------------------------------------------------------------------------------
!
!*      3.     Fluxes at walls
!              ---------------
!
!                                            net radiation
!
dmt%XRN_WALL_A(:) = dmt%XABS_SW_WALL_A(:) + dmt%XABS_LW_WALL_A(:)
dmt%XRN_WALL_B(:) = dmt%XABS_SW_WALL_B(:) + dmt%XABS_LW_WALL_B(:)
!
IF (top%CBEM=="BEM") THEN
  zinter(:) = dmt%XABS_SW_WIN (:) + dmt%XABS_LW_WIN (:)
  dmt%XRN_WALL_A(:) = dmt%XRN_WALL_A(:) * (1.-b%XGR(:))  + zinter(:) * b%XGR(:)
  dmt%XRN_WALL_B(:) = dmt%XRN_WALL_B(:) * (1.-b%XGR(:))  + zinter(:) * b%XGR(:)
ENDIF
!
!                                            heat flux into the ground
!
dmt%XGFLUX_WALL_A(:) = dmt%XRN_WALL_A(:) - dmt%XH_WALL_A(:)            
dmt%XGFLUX_WALL_B(:) = dmt%XRN_WALL_B(:) - dmt%XH_WALL_B(:)            
!
!                                            sensible heat flux
!
!before -> PH_WL in [W.m-2(wall)]
zinter(:) = pac_wl(:)*xcpd*prhoa(:)/pexns(:) * (b%XT_WIN1(:)-pt_canyon(:)) + pe_shading(:)
!
dmt%XH_WALL_A(:) = (1. - b%XGR(:)) * dmt%XH_WALL_A(:) + b%XGR(:) * zinter(:)
dmt%XH_WALL_B(:) = (1. - b%XGR(:)) * dmt%XH_WALL_B(:) + b%XGR(:) * zinter(:)
!
IF (top%CBEM=="BEM") THEN
  zinter(:) = b%XF_WASTE_CAN(:) * dmt%XH_WASTE(:) / t%XWALL_O_HOR(:)
  dmt%XH_WALL_A(:) = dmt%XH_WALL_A(:) + zinter(:)
  dmt%XH_WALL_B(:) = dmt%XH_WALL_B(:) + zinter(:)
ENDIF
!
IF (top%CBEM=="BEM") THEN
  !after PH_WALL in [W.m-2(facade=wall + win)]
  zinter(:) = b%XF_WASTE_CAN(:) * dmt%XLE_WASTE(:) / t%XWALL_O_HOR(:)
ELSE
  zinter(:) = 0.
ENDIF
ple_wl_a(:) = zinter(:)
ple_wl_b(:) = zinter(:)
!
!-------------------------------------------------------------------------------
!
!*      4.     Snow-free and snow-covered surfaces averaging
!              ---------------------------------------------
!
!*      4.1    Roads
!              -----
!
!                                            heat flux into the ground
!
dmt%XGFLUX_ROAD (:) =  pdf_rd(:) * (dmt%XRN_ROAD(:) - dmt%XH_ROAD (:) - plew_rd(:) )&
                       + pdn_rd(:) * pgsn_rd(:)  
!
!                                            net radiation
!
dmt%XRN_ROAD(:) = dmt%XRN_ROAD(:) * pdf_rd(:) + prnsn_rd(:) * pdn_rd(:)
!
!                                            sensible heat flux
!                                            total latent heat of evaporation from
!                                            the road (snow free + snow)
!
! sensible heat flux
!
dmt%XH_ROAD  (:) = dmt%XH_ROAD (:) * pdf_rd(:) + phsn_rd(:) * pdn_rd(:)
! total latent heat of evaporation from  the road (snow free + snow)
!
dmt%XLE_ROAD (:) = plew_rd(:) * pdf_rd(:) + plesn_rd(:) * pdn_rd(:)
!
!*      4.2    Roofs
!              -----
!
!                                            heat flux into the ground
!
dmt%XGFLUX_STRLROOF(:) =  pdf_rf(:) * (zrn_rf_snfree(:) - zh_rf_snfree(:) - plew_rf(:)) + pdn_rf(:) *  pgsn_rf(:)  
dmt%XGFLUX_ROOF    (:) = (1.-t%XGREENROOF(:)) * dmt%XGFLUX_STRLROOF(:) + t%XGREENROOF(:) * pgflux_gr(:)
!
!
!                                            net radiation
! 
dmt%XRN_STRLROOF   (:) = zrn_rf_snfree(:) * pdf_rf(:) + prnsn_rf(:) * pdn_rf(:)
dmt%XRN_ROOF       (:) = (1.-t%XGREENROOF(:)) * dmt%XRN_STRLROOF(:) + t%XGREENROOF(:) * prn_gr(:)
!
!                                            sensible heat flux
!                                            total latent heat of evaporation from
!                                            the roof (snow free + snow)
!
! sensible heat flux
!
dmt%XH_STRLROOF    (:) = dmt%XH_ROOF(:) * pdf_rf(:) + phsn_rf(:)  * pdn_rf(:)
dmt%XH_ROOF        (:) = (1.-t%XGREENROOF(:)) * dmt%XH_STRLROOF(:) + t%XGREENROOF(:) * ph_gr(:)
!
!
! total latent heat of evaporation from the roof (snow free + snow)
!
dmt%XLE_STRLROOF   (:) = plew_rf(:) * pdf_rf(:)  + plesn_rf(:) * pdn_rf(:)
dmt%XLE_ROOF       (:) = (1.-t%XGREENROOF(:)) * dmt%XLE_STRLROOF(:) + t%XGREENROOF(:) * ple_gr(:) 
!
IF (top%CBEM=="BEM") THEN
  dmt%XH_ROOF (:) = dmt%XH_ROOF (:) + (1 - b%XF_WASTE_CAN(:)) * dmt%XH_WASTE (:)/t%XBLD(:)
  dmt%XLE_ROOF(:) = dmt%XLE_ROOF(:) + (1 - b%XF_WASTE_CAN(:)) * dmt%XLE_WASTE(:)/t%XBLD(:)
ENDIF

!-------------------------------------------------------------------------------
!
!*      5.     Momentum fluxes
!              ---------------
!
pustar_twn(:) = xundef
!
IF (.NOT. top%LCANOPY) THEN
  !
  zustar2(:) = 0.0
  zvmod(:) = pvmod(:)
  !
  IF(himplicit_wind=='OLD')THEN 
    ! old implicitation
    zustar2(:) = (pcd(:)*pvmod(:)*ppew_b_coef(:))/ (1.0-prhoa(:)*pcd(:)*pvmod(:)*ppew_a_coef(:))
  ELSE
    ! new implicitation
    zustar2(:) = (pcd(:)*pvmod(:)*(2.*ppew_b_coef(:)-pvmod(:)))/ &
                 (1.0-2.0*prhoa(:)*pcd(:)*pvmod(:)*ppew_a_coef(:))
    !                   
    zvmod(:) = prhoa(:)*ppew_a_coef(:)*zustar2(:) + ppew_b_coef(:)
    zvmod(:) = max(zvmod(:),0.)
    !
    WHERE(ppew_a_coef(:)/= 0.)
      zustar2(:) = max( ( zvmod(:) - ppew_b_coef(:) ) / (prhoa(:)*ppew_a_coef(:)), 0.)
    ENDWHERE
    !               
  ENDIF
  !
  pustar_twn(:) = sqrt(zustar2(:))     
  !  
ENDIF
!
!-------------------------------------------------------------------------------
!
!*      6.     Averaged fluxes
!              ---------------
!
!*      6.1    Built fraction
!              --------------
!
dmt%XRN_BLT (:)    = ( t%XBLD(:)        * dmt%XRN_ROOF(:)        &
                  +     t%XROAD(:)       * dmt%XRN_ROAD(:)        &
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XRN_WALL_A(:)      &
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XRN_WALL_B(:))     &
                  / (t%XROAD(:) + t%XBLD(:))
!
dmt%XH_BLT  (:)    = ( t%XBLD(:)        * dmt%XH_ROOF(:)         &
                  +     t%XROAD(:)       * dmt%XH_ROAD(:)         &
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XH_WALL_A(:)       &   
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XH_WALL_B(:))      &   
                  / (t%XROAD(:) + t%XBLD(:))
!
dmt%XLE_BLT (:)    = ( t%XBLD(:)        * dmt%XLE_ROOF (:)       &
                  +     t%XROAD(:)       * dmt%XLE_ROAD (:)       &
                  + 0.5*t%XWALL_O_HOR(:) * ple_wl_a(:)     & 
                  + 0.5*t%XWALL_O_HOR(:) * ple_wl_b(:))    & 
                  / (t%XROAD(:) + t%XBLD(:))
!
dmt%XGFLUX_BLT (:) = ( t%XBLD(:)        * dmt%XGFLUX_ROOF (:)    &
                  +     t%XROAD(:)       * dmt%XGFLUX_ROAD (:)    &
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XGFLUX_WALL_A (:)  &
                  + 0.5*t%XWALL_O_HOR(:) * dmt%XGFLUX_WALL_B (:)) &
                  / (t%XROAD(:) + t%XBLD(:))
!
pmelt_blt(:) = (     t%XBLD(:)         * pmelt_rf(:) * pdn_rf(:)  &
                  +    t%XROAD(:)        * pmelt_rd(:) * pdn_rd(:)) &
                  / (t%XROAD(:) + t%XBLD(:))
!
dmt%XDQS_TOWN  (:) = (  t%XBLD(:)         * pdqs_rf(:)      &
                  +      t%XROAD(:)      * pdqs_rd(:)      &
                  + 0.5*t%XWALL_O_HOR(:) * pdqs_wl_a(:)    &
                  + 0.5*t%XWALL_O_HOR(:) * pdqs_wl_b(:) )  &
                / (t%XROAD(:) + t%XBLD(:))
!
IF (top%CBEM == "DEF") THEN
  dmt%XQF_BLD(:) = ( zh_rf_snfree(:) + plew_rf(:) +          & 
                 pdqs_rf(:) - zrn_rf_snfree(:)  ) * pdf_rf(:) &
             + ( pdqs_rf(:) - pgsn_rf(:)  ) * pdn_rf(:) &
             + 0.5*t%XWALL_O_HOR(:)/t%XBLD(:) * ( dmt%XH_WALL_A(:) + ple_wl_a(:) + pdqs_wl_a(:) - dmt%XRN_WALL_A(:) ) &
             + 0.5*t%XWALL_O_HOR(:)/t%XBLD(:) * ( dmt%XH_WALL_B(:) + ple_wl_b(:) + pdqs_wl_b(:) - dmt%XRN_WALL_B(:) )
  dmt%XFLX_BLD(:)= xundef
ELSEIF (top%CBEM == "BEM") THEN
  dmt%XQF_BLD(:) = dmt%XQIN(:)*b%XN_FLOOR(:) + dmt%XHVAC_COOL(:) + dmt%XHVAC_HEAT(:)
  dmt%XFLX_BLD(:)=  pflx_bld_rf(:) + 0.5*t%XWALL_O_HOR(:)/t%XBLD(:)*pflx_bld_wl_a(:) &
                 +                    0.5*t%XWALL_O_HOR(:)/t%XBLD(:)*pflx_bld_wl_b(:) &
                 + pflx_bld_fl(:) + pflx_bld_ma(:)  
ENDIF
!
dmt%XQF_TOWN(:)= t%XBLD(:)*dmt%XQF_BLD(:) + ph_traffic(:) + t%XH_INDUSTRY(:) + ple_traffic(:) + t%XLE_INDUSTRY(:)
!
!Flux from the building to its structure -> we need to add the component to the
!floor, the mass and the window
!
!
IF (lhook) CALL dr_hook('URBAN_FLUXES',1,zhook_handle)
!
END SUBROUTINE urban_fluxes