road_layer_e_budget.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 road_layer_e_budget(PT_ROAD, PTSTEP, PHC_ROAD, PTC_ROAD, PD_ROAD,       &
                                   pdn_road, prhoa, pac_road, pac_road_wat,            &
                                   plw_rad, pps, pqsat_road, pdelt_road, pexns,        &
                                   pabs_sw_road, pgsnow_road, pq_lowcan, pt_lowcan,    &
                                   pts_wall_a, pts_wall_b, ptsnow_road,                &
                                   pts_garden, pts_win,                                &
                                   plw_wa_to_r, plw_wb_to_r, plw_s_to_r, plw_win_to_r, &
                                   pemis_road, pemit_lw_road, pdqs_road, pabs_lw_road, &
                                   phfree_road, plefree_road, pimb_road, prr )
!   ##########################################################################
!
!!****  *ROAD_LAYER_E_BUDGET*  
!!
!!    PURPOSE
!!    -------
!
!     Computes the evoultion of roads surface temperatures
!         
!     
!!**  METHOD
!     ------
!
!    6 : equations for evolution of Ts_road 
!        **********************************
!
!
!     dTr_1(t) / dt = 1/(dr_1*Cr_1) * (  Rn_r - H_r - LE_r 
!                                      - 2*Kr_1*(Tr_1-Tr_2)/(dr_1 +dr_2)       )
!
!     dTr_k(t) / dt = 1/(dr_k*Cr_k) * (- 2*Kr_k-1*(Tr_k-Tr_k-1)/(dr_k-1 +dr_k) 
!                                      - 2*Kr_k  *(Tr_k-Tr_k+1)/(dr_k+1 +dr_k) )
!
!       with
!
!   K*_k  = (d*_k+ d*_k+1)/(d*_k/k*_k+ d*_k+1/k*_k+1)
!
!   Rn_r = abs_Rg_r
!  - sigma * emis_r                                                   * Ts_r**4 (t+dt)
!  +         emis_r                       *    SVF_r                  * LWR
!  + sigma * emis_r * emis_w              * (1-SVF_r)                 * Ts_w**4 (t+dt)
!  +         emis_r            (1-emis_w) * (1-SVF_r)   *      SVF_w  * LWR
!  + sigma * emis_r * emis_w * (1-emis_w) * (1-SVF_r)   * (1-2*SVF_w) * Ts_w**4 (t+dt)
!  + sigma * emis_r * emis_r * (1-emis_w) * (1-SVF_r)   *      SVF_w  * Ts_r**4 (t+dt)
!
!  H_r  = rho Cp CH V ( Ts_r (t+dt) - Ta_canyon )
!
!  LE_r = rho Lv CH V ( qs_r (t+dt) - qa_canyon )
!
!
! The system is implicited (or semi-implicited).
!
! ZIMPL=1    ---> implicit system
! ZIMPL=0.5  ---> semi-implicit system
! ZIMPL=0    ---> explicit system
!
!
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    MODD_CST
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    23/01/98 
!!                  21/11/01 (V. Masson and A. Lemonsu) bug of latent flux
!!                           for very strong evaporation (all reservoir emptied
!!                           in one time-step)
!!                     02/11 (V. Masson) split of the routine for roads and walls separately
!!      G. Pigeon      09/2012: add heating/cooling of rain from air temperature
!!                             to surface road temp. for the road energy budget 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_csts,ONLY : xcpd, xlvtt, xstefan, xcl
!
USE mode_thermos
!
USE modi_layer_e_budget
USE modi_layer_e_budget_get_coef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: pt_road    ! road layers temperatures
REAL,               INTENT(IN)    :: ptstep       ! time step
REAL, DIMENSION(:,:), INTENT(IN)  :: phc_road     ! heat capacity for road layers
REAL, DIMENSION(:,:), INTENT(IN)  :: ptc_road     ! thermal conductivity for road layers
REAL, DIMENSION(:,:), INTENT(IN)  :: pd_road      ! depth of road layers
REAL, DIMENSION(:), INTENT(IN)    :: pdn_road     ! road snow fraction
REAL, DIMENSION(:), INTENT(IN)    :: prhoa        ! rho
REAL, DIMENSION(:), INTENT(IN)    :: pac_road     ! aerodynamical conductance
!                                                 ! between road and canyon
REAL, DIMENSION(:), INTENT(IN)    :: pac_road_wat ! aerodynamical conductance
!                                                 ! between road and canyon
!                                                 ! (for water)
REAL, DIMENSION(:), INTENT(IN)    :: plw_rad      ! atmospheric infrared radiation
REAL, DIMENSION(:), INTENT(IN)    :: pps          ! pressure at the surface
REAL, DIMENSION(:), INTENT(IN)    :: pqsat_road   ! q_sat(Ts)
REAL, DIMENSION(:), INTENT(IN)    :: pdelt_road   ! fraction of water
REAL, DIMENSION(:), INTENT(IN)    :: pexns        ! surface Exner function
REAL, DIMENSION(:), INTENT(IN)    :: pabs_sw_road ! absorbed solar radiation
REAL, DIMENSION(:), INTENT(IN)    :: pgsnow_road  ! road snow conduction
!                                                 ! heat fluxes at mantel
!                                                 ! base
REAL, DIMENSION(:), INTENT(IN)    :: pq_lowcan    ! and specific humidity
REAL, DIMENSION(:), INTENT(IN)    :: pt_lowcan    ! low canyon air temperature
REAL, DIMENSION(:), INTENT(IN)    :: pts_wall_a   ! wall surface temperature
REAL, DIMENSION(:), INTENT(IN)    :: pts_wall_b   ! wall surface temperature
REAL, DIMENSION(:), INTENT(IN)    :: ptsnow_road  ! road snow temperature
REAL, DIMENSION(:), INTENT(IN)    :: pts_garden   ! green area surface temperature
REAL, DIMENSION(:), INTENT(IN)    :: pts_win      ! window outdoor surface temperature [K]
!
REAL, DIMENSION(:), INTENT(IN)    :: plw_wa_to_r   ! LW interactions wall  -> road 
REAL, DIMENSION(:), INTENT(IN)    :: plw_wb_to_r   ! LW interactions wall  -> road 
REAL, DIMENSION(:), INTENT(IN)    :: plw_s_to_r    ! LW interactions sky   -> road 
REAL, DIMENSION(:), INTENT(IN)    :: plw_win_to_r ! LW interactions window -> road 
!
REAL, DIMENSION(:), INTENT(IN)    :: pemis_road   ! road emissivity
!
REAL, DIMENSION(:), INTENT(OUT)   :: pemit_lw_road! LW flux emitted by the road (W/m2 of road)
REAL, DIMENSION(:), INTENT(OUT)   :: pdqs_road    !heat storage inside the road
REAL, DIMENSION(:), INTENT(OUT)   :: pabs_lw_road ! absorbed infrared rad.
REAL, DIMENSION(:), INTENT(OUT)   :: phfree_road  ! sensible heat flux on the
                                                  ! snow free part of the road [W m-2]
REAL, DIMENSION(:), INTENT(OUT)   :: plefree_road ! latent heat flux on the
                                                  ! snow free part of the road [W m-2]
REAL, DIMENSION(:), INTENT(OUT)   :: pimb_road    ! road residual energy imbalance 
                                                  ! for verification [W m-2]
REAL, DIMENSION(:), INTENT(IN)    :: prr          ! rain rate [kg m-2 s-1]

!
!*      0.2    declarations of local variables
!
REAL :: zimpl=1.0      ! implicit coefficient
REAL :: zexpl=0.0      ! explicit coefficient
!
REAL, DIMENSION(SIZE(PT_ROAD,1),SIZE(PT_ROAD,2)) :: za,& ! lower diag.
                                                    zb,& ! main  diag.
                                                    zc,& ! upper diag.
                                                    zy   ! r.h.s.
!
REAL, DIMENSION(SIZE(PPS)) :: zdn_road    ! snow-covered surface fraction on road
REAL, DIMENSION(SIZE(PPS)) :: zdf_road    ! snow-free surface fraction on road
!
REAL, DIMENSION(SIZE(PPS)) :: zdqsat_road ! dq_sat/dTs
REAL, DIMENSION(SIZE(PPS)) :: zrho_acf_r  ! rho * conductance
!                                         !     * snow-free f.
REAL, DIMENSION(SIZE(PPS)) :: zrho_acf_r_wat ! rho * conductance for water
!                                         !     * snow-free f.
! thermal capacity times layer depth
REAL, DIMENSION(SIZE(PPS)) :: zts_road    ! road surface temperature
REAL, DIMENSION(SIZE(PPS)) :: zheat_rr    ! heat used too cool/heat the rain from the roof
REAL, DIMENSION(SIZE(PPS)) :: zt_sky      ! road surface temperature
!
INTEGER :: iroad_layer           ! number of road layers
INTEGER :: jj            ! loop counter
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ROAD_LAYER_E_BUDGET',0,zhook_handle)
!
 CALL layer_e_budget_get_coef( pt_road, ptstep, zimpl, phc_road, ptc_road, pd_road, &
                              za, zb, zc, zy )
!
!*      1.     Layer thermal properties
!              ------------------------
!
iroad_layer = SIZE(pt_road,2)
!
DO jj=1, SIZE(pdn_road) 
  !
  zdn_road(jj) = pdn_road(jj)
  zdf_road(jj) = 1. - zdn_road(jj)
  !
  !*      2.3    Surface temperatures
  !              --------------------
  !
  zts_road(jj) = pt_road(jj,1)
  !
  !*      2.2    flux properties
  !              ---------------
  !
  zrho_acf_r(jj) = prhoa(jj) * pac_road(jj)    * zdf_road(jj)
  zrho_acf_r_wat(jj) = prhoa(jj) * pac_road_wat(jj) * zdf_road(jj)
  !
  !*     2.4   Sky temperature
  !            ---------------
  !
  zt_sky(jj) = (plw_rad(jj)/xstefan)**0.25
  !
ENDDO
!
!*      2.4    qsat, dqsat/dTs, and humidity for roads
!              ---------------------------------------
! 
zdqsat_road(:) = dqsat(zts_road(:),pps(:),pqsat_road(:))
!
!-------------------------------------------------------------------------------
!
!*      3.     First road layers coefficients (in contact with outdoor env.)
!              -------------------------------------------------------------
!
DO jj=1,SIZE(pt_road,1)
  !
  zb(jj,1) = zb(jj,1) + zimpl * xcpd/pexns(jj) * zrho_acf_r(jj) &
                      + zimpl * xlvtt * zrho_acf_r_wat(jj) * pdelt_road(jj) * zdqsat_road(jj)
  !
  zy(jj,1) = zy(jj,1)  &
             + xcpd/pexns(jj) * zrho_acf_r(jj) * ( pt_lowcan(jj) - zexpl * zts_road(jj) ) &
             + zdf_road(jj)*pabs_sw_road(jj) + zdn_road(jj)*pgsnow_road(jj)               &
             + xlvtt * zrho_acf_r_wat(jj) * pdelt_road(jj)                                &
               * ( pq_lowcan(jj) - pqsat_road(jj) + zimpl * zdqsat_road(jj) * zts_road(jj) )     
  !
  zb(jj,1) = zb(jj,1) &
             + zimpl * zdf_road(jj) * ( plw_s_to_r(jj) + plw_wa_to_r(jj) + &
                                        plw_wb_to_r(jj) + plw_win_to_r(jj) + &
                                        prr(jj) * xcl ) ! heat/cool rain
  !
  zy(jj,1) = zy(jj,1) &
             + zdf_road(jj) * (                                             &
               plw_s_to_r(jj) * (zt_sky(jj)     - zexpl * zts_road(jj))   &
             + plw_win_to_r(jj) * (pts_win(jj)    - zexpl * zts_road(jj))   &
             + plw_wa_to_r(jj) * (pts_wall_a(jj) - zexpl * zts_road(jj))   & 
             + plw_wb_to_r(jj) * (pts_wall_b(jj) - zexpl * zts_road(jj))   &
             + prr(jj) * xcl *    (pt_lowcan(jj)- zexpl * zts_road(jj) ))   !heat/cool rain     
  !     
ENDDO
!
!
 CALL layer_e_budget( pt_road, ptstep, zimpl, phc_road, ptc_road, pd_road, &
                     za, zb, zc, zy, pdqs_road )
!
!-------------------------------------------------------------------------------
!
!*     12.    Road and wall absorbed infra-red radiation on snow-free surfaces
!             ----------------------------------------------------------------
!
!* absorbed LW
DO jj=1,SIZE(pt_road,1)
  !
  ! surface temperature used in energy balance
  zts_road(jj) = zexpl *  zts_road(jj) + zimpl * pt_road(jj,1)
  pabs_lw_road(jj) = plw_s_to_r(jj) * (zt_sky(jj)     - zts_road(jj)) + &
                     plw_wa_to_r(jj) * (pts_wall_a(jj) - zts_road(jj)) + &
                     plw_wb_to_r(jj) * (pts_wall_b(jj) - zts_road(jj)) + &
                     plw_win_to_r(jj) * (pts_win(jj)    - zts_road(jj))
  !
  !*     9.    Road emitted LW radiation on snow-free surfaces
  !            -----------------------------------------------
  pemit_lw_road(jj) = xstefan * pt_road(jj,1)**4 + &
                      (1 - pemis_road(jj))/pemis_road(jj) * pabs_lw_road(jj)
  !
  !*      10.     road and wall sensible heat flux
  !              --------------------------------
  !
  phfree_road(jj) = zrho_acf_r(jj) * xcpd/pexns(jj) * &
                   ( zimpl*pt_road(jj,1) + zexpl*zts_road(jj) - pt_lowcan(jj) )
  !
  !*      11     road latent heat flux
  !              ---------------------
  !
  plefree_road(jj) = zrho_acf_r_wat(jj) * xlvtt * pdelt_road(jj) * &
                    ( pqsat_road(jj) - pq_lowcan(jj) +             &
                     zimpl * zdqsat_road(jj) * (pt_road(jj,1) - zts_road(jj)) )
  zheat_rr(jj) = prr(jj) * xcl * (zts_road(jj) - pt_lowcan(jj))
  !
  !*      12     heat storage inside roads
  !              -------------------------
  !
  !*      13     road energy residual imbalance for verification
  !              -----------------------------------------------
  !
  pimb_road(jj) = pabs_sw_road(jj) + pabs_lw_road(jj) - pdqs_road(jj) &
               - zdf_road(jj) * ( phfree_road(jj) + plefree_road(jj)) &
               - zdn_road(jj) *   pgsnow_road(jj)
  !
ENDDO
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ROAD_LAYER_E_BUDGET',1,zhook_handle)
!
END SUBROUTINE road_layer_e_budget