urban_snow_evol.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_snow_evol(T, B, PT_LWCN, PQ_LWCN, PU_LWCN, PTS_RF, PTS_RD, PTS_WL_A,   &
                               PTS_WL_B, PPS, PTA, PQA, PRHOA, PLW_RAD, PSR, PZREF, PUREF,  &
                               PVMOD, PTSTEP, PZ_LWCN, PDN_RF, PABS_SW_SN_RF, PABS_LW_SN_RF,& 
                               PDN_RD, PABS_SW_SN_RD, PABS_LW_SN_RD, PRNSN_RF, PHSN_RF,     &
                               PLESN_RF, PGSN_RF, PMELT_RF, PRNSN_RD, PHSN_RD, PLESN_RD,    &
                               PGSN_RD, PMELT_RD, PLW_WA_TO_NR , PLW_WB_TO_NR, PLW_S_TO_NR, &
                               PLW_WIN_TO_NR, PDQS_SN_RF, PDQS_SN_RD   )  
!   ##########################################################################
!
!!****  *URBAN_SNOW_EVOL*  
!!
!!    PURPOSE
!!    -------
!
!     
!!**  METHOD
!     ------
!
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    MODD_CST
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    23/01/98 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_teb_n, ONLY : teb_t
USE modd_bem_n, ONLY : bem_t
!
USE modd_snow_par, ONLY : xz0sn, xz0hsn,                                    &
                            xansmin_roof, xansmax_roof, xans_todry_roof,      &
                            xans_t_roof, xrhosmin_roof, xrhosmax_roof,        &
                            xwcrn_roof,                                       &
                            xansmin_road, xansmax_road, xans_todry_road,      &
                            xans_t_road, xrhosmin_road, xrhosmax_road,        &
                            xwcrn_road  
USE modd_csts,     ONLY : xstefan
!
USE mode_surf_snow_frac
!
USE modi_roof_impl_coef
USE modi_snow_cover_1layer
!
USE modd_surf_par, ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(teb_t), INTENT(INOUT) :: T
TYPE(bem_t), INTENT(INOUT) :: B
!
REAL, DIMENSION(:),   INTENT(IN)    :: PT_LWCN  ! LWCN air temperature
REAL, DIMENSION(:),   INTENT(IN)    :: PQ_LWCN  ! LWCN air specific humidity
REAL, DIMENSION(:),   INTENT(IN)    :: PU_LWCN  ! LWCN hor. wind
REAL, DIMENSION(:),   INTENT(IN)    :: PTS_RF   ! roof surface temperature
REAL, DIMENSION(:),   INTENT(IN)    :: PTS_RD   ! road surface temperature
REAL, DIMENSION(:),   INTENT(IN)    :: PTS_WL_A ! wall surface temperature
REAL, DIMENSION(:),   INTENT(IN)    :: PTS_WL_B ! wall surface temperature
!
REAL, DIMENSION(:), INTENT(IN)    :: PPS      ! pressure at the surface
REAL, DIMENSION(:), INTENT(IN)    :: PTA      ! temperature at the lowest level
REAL, DIMENSION(:), INTENT(IN)    :: PQA      ! specific humidity
                                              ! at the lowest level
REAL, DIMENSION(:), INTENT(IN)    :: PVMOD    ! module of the horizontal wind
REAL, DIMENSION(:), INTENT(IN)    :: PRHOA    ! air density at the lowest level
REAL, DIMENSION(:), INTENT(IN)    :: PLW_RAD  ! atmospheric infrared radiation
REAL, DIMENSION(:), INTENT(IN)    :: PSR      ! snow rate
REAL, DIMENSION(:), INTENT(IN)    :: PZREF    ! reference height of the first
                                              ! atmospheric level (temperature)
REAL, DIMENSION(:), INTENT(IN)    :: PUREF    ! reference height of the first
                                              ! atmospheric level (wind)
                                              ! at first atmospheric level
REAL,               INTENT(IN)    :: PTSTEP   ! time step
REAL, DIMENSION(:), INTENT(IN)    :: PZ_LWCN  ! height of forcing
!
REAL, DIMENSION(:), INTENT(IN)    :: PDN_RF          ! snow-covered roof frac.
REAL, DIMENSION(:), INTENT(IN)    :: PABS_SW_SN_RF ! SW absorbed by roof snow
REAL, DIMENSION(:), INTENT(OUT)   :: PABS_LW_SN_RF ! absorbed IR rad by snow on roof
REAL, DIMENSION(:), INTENT(INOUT) :: PDN_RD          ! snow-covered road frac.
REAL, DIMENSION(:), INTENT(IN)    :: PABS_SW_SN_RD ! SW absorbed by road snow
REAL, DIMENSION(:), INTENT(OUT)   :: PABS_LW_SN_RD ! absorbed IR rad by snow on road
!
REAL, DIMENSION(:), INTENT(OUT)   :: PRNSN_RF ! net radiation over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PHSN_RF  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PLESN_RF ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PGSN_RF  ! flux under the snow
REAL, DIMENSION(:), INTENT(OUT)   :: PMELT_RF   ! snow melt
REAL, DIMENSION(:), INTENT(OUT)   :: PRNSN_RD ! net radiation over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PHSN_RD  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PLESN_RD ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: PGSN_RD  ! flux under the snow
REAL, DIMENSION(:), INTENT(OUT)   :: PMELT_RD   ! snow melt
!
REAL, DIMENSION(:), INTENT(IN)    :: PLW_WA_TO_NR        ! LW contrib. wall       -> road(snow)
REAL, DIMENSION(:), INTENT(IN)    :: PLW_WB_TO_NR        ! LW contrib. wall       -> road(snow)
REAL, DIMENSION(:), INTENT(IN)    :: PLW_S_TO_NR         ! LW contrib. sky        -> road(snow)
REAL, DIMENSION(:), INTENT(IN)    :: PLW_WIN_TO_NR       ! LW contrib. win       -> road(snow)
REAL, DIMENSION(:), INTENT(OUT)   :: PDQS_SN_RF ! Heat storage in snowpack on roofs
REAL, DIMENSION(:), INTENT(OUT)   :: PDQS_SN_RD ! Heat storage in snowpack on roads
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PTA)) :: ZLW1_RD   ! independant from
REAL, DIMENSION(SIZE(PTA)) :: ZLW1_RF   ! surface temperature
!
REAL, DIMENSION(SIZE(PTA)) :: ZLW2_RD   ! to be multiplied by
REAL, DIMENSION(SIZE(PTA)) :: ZLW2_RF   ! 4th power of
!                                         ! surface temperature

REAL, DIMENSION(SIZE(PTA)) :: ZSR_RF    ! snow fall on roof snow (kg/s/m2 of snow)
REAL, DIMENSION(SIZE(PTA)) :: ZSR_RD    ! snow fall on road snow (kg/s/m2 of snow)
!
REAL, DIMENSION(SIZE(PTA)) :: ZT_SKY      ! sky temperature
REAL, DIMENSION(SIZE(PTA)) :: ZTS_COEFA   ! Coefficient A for implicit coupling
!                                         ! of snow with the underlying surface
REAL, DIMENSION(SIZE(PTA)) :: ZTS_COEFB   ! Coefficient B for implicit coupling
!                                         ! of snow with the underlying surface
!
! flags to call to snow routines
!
LOGICAL :: GSN_RF, GSN_RD
!
! loop counters
!
INTEGER :: JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('URBAN_SNOW_EVOL',0,zhook_handle)
prnsn_rf(:)=0.
phsn_rf(:)=0.
plesn_rf(:)=0.
pgsn_rf(:)=0.
pmelt_rf(:)=0.
prnsn_rd(:)=0.
phsn_rd(:)=0.
plesn_rd(:)=0.
pgsn_rd(:)=0.
pmelt_rd(:)=0.
pabs_lw_sn_rf(:)=0.
pabs_lw_sn_rd(:)=0.
!
!-------------------------------------------------------------------------------
!
gsn_rf = any( psr(:)>0. .OR. t%TSNOW_ROOF%WSNOW(:,1)>0. )
gsn_rd = any( psr(:)>0. .OR. t%TSNOW_ROAD%WSNOW(:,1)>0. )
!
!-------------------------------------------------------------------------------
!
!*      5.     Snow mantel model
!              -----------------
!
!*      5.1    roofs
!              -----
!
IF ( gsn_rf ) THEN
!
!* initializes LW radiative coefficients
!
  zlw1_rf(:) =   t%TSNOW_ROOF%EMIS(:) * plw_rad(:)
  zlw2_rf(:) = - t%TSNOW_ROOF%EMIS(:) * xstefan
!
!* The global amount of snow on roofs is supposed located on a
!  fraction of the roof surface. All computations are then
!  done only for each m2 of snow, and not for each m2 of roof.
!
  DO jl=1,SIZE(t%TSNOW_ROOF%WSNOW,2)
    WHERE (pdn_rf(:)>0.) t%TSNOW_ROOF%WSNOW(:,jl) = t%TSNOW_ROOF%WSNOW(:,jl) / pdn_rf(:)
  END DO
  zsr_rf=0.
  WHERE (pdn_rf(:)>0.) zsr_rf(:) = psr(:) / pdn_rf(:)
!
!* Estimates implicit coupling between snow and roof
! (strictly equal to an implicit formulation for 100% snow coverage)
!
  CALL roof_impl_coef(t, ptstep, zts_coefa, zts_coefb)
!
!* call to snow mantel scheme
!
  IF (t%TSNOW_ROOF%SCHEME=='1-L')  &
   CALL snow_cover_1layer(ptstep, xansmin_roof, xansmax_roof, xans_todry_roof,   &
                          xrhosmin_roof, xrhosmax_roof, xans_t_roof, .true., 0., &
                          xwcrn_roof, xz0sn, xz0hsn, t%TSNOW_ROOF, pts_rf,       &
                          zts_coefa, zts_coefb, pabs_sw_sn_rf, zlw1_rf,  zlw2_rf,&
                          pta, pqa, pvmod, pps, prhoa, zsr_rf, pzref, puref,     &
                          prnsn_rf, phsn_rf, plesn_rf, pgsn_rf, pmelt_rf,        &
                          pdqs_sn_rf, pabs_lw_sn_rf)  
!

!
!* The global amount of snow on roofs is reported to total roof surface.
!
  DO jl=1,SIZE(t%TSNOW_ROOF%WSNOW,2)
    t%TSNOW_ROOF%WSNOW(:,jl) = t%TSNOW_ROOF%WSNOW(:,jl) * pdn_rf(:)
  END DO
!           
END IF
!
!*      5.2    roads
!              -----
!
IF ( gsn_rd ) THEN
  !
  zt_sky(:) = (plw_rad(:)/xstefan)**0.25
!
  zlw1_rd(:) = plw_s_to_nr(:)   * (zt_sky(:) - t%TSNOW_ROAD%TS(:)) &
               + plw_wa_to_nr(:) * (pts_wl_a(:) - t%TSNOW_ROAD%TS(:)) &
               + plw_wb_to_nr(:) * (pts_wl_b(:) - t%TSNOW_ROAD%TS(:)) &
               + plw_win_to_nr(:) * (b%XT_WIN1(:) - t%TSNOW_ROAD%TS(:))
  zlw2_rd(:) =  0.0
  !
  !* The global amount of snow on roads is supposed located on a
  !  fraction of the road surface. All computations are then
  !  done only for each m2 of snow, and not for each m2 of road.
  !
  DO jl=1,SIZE(t%TSNOW_ROAD%WSNOW,2)
    WHERE (pdn_rd(:)>0.) t%TSNOW_ROAD%WSNOW(:,jl) = t%TSNOW_ROAD%WSNOW(:,jl) / pdn_rd(:)
  END DO
  zsr_rd=0.
  WHERE (pdn_rd(:)>0.) zsr_rd(:) = psr(:) / pdn_rd(:)
  !
  !* no implicit coupling necessary with road
  !
  zts_coefa = 0.
  zts_coefb = pts_rd
  !
  !* call to snow mantel scheme
  !
  IF (t%TSNOW_ROAD%SCHEME=='1-L')                &
    CALL snow_cover_1layer(ptstep, xansmin_road, xansmax_road, xans_todry_road,   &
                           xrhosmin_road, xrhosmax_road, xans_t_road, .false.,    &
                           0., xwcrn_road, xz0sn, xz0hsn, t%TSNOW_ROAD, pts_rd,   & 
                           zts_coefa, zts_coefb,  pabs_sw_sn_rd, zlw1_rd, zlw2_rd,&
                           pt_lwcn, pq_lwcn, pu_lwcn, pps, prhoa, zsr_rd, pz_lwcn,&
                           pz_lwcn, prnsn_rd, phsn_rd, plesn_rd, pgsn_rd,         &
                           pmelt_rd, pdqs_sn_rd, pabs_lw_sn_rd        )  
!
!* The global amount of snow on roads is reported to total road surface.
!
  DO jl=1,SIZE(t%TSNOW_ROAD%WSNOW,2)
    t%TSNOW_ROAD%WSNOW(:,jl) = t%TSNOW_ROAD%WSNOW(:,jl) * pdn_rd(:)
  END DO
!
  WHERE (t%TSNOW_ROAD%T(:,1) .EQ. xundef) pdn_rd(:) = 0.0
!
END IF
IF (lhook) CALL dr_hook('URBAN_SNOW_EVOL',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE urban_snow_evol