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(                                                 &
                       pt_lowcan, pq_lowcan, pu_lowcan,                         &
                       pts_roof,pts_road,pts_wall_a, pts_wall_b,                &
                       pt_roof, pd_roof, ptc_roof, phc_roof,                    &
                       hsnow_roof,                                              &
                       pwsnow_roof, ptsnow_roof, prsnow_roof, pasnow_roof,      &
                       ptssnow_roof, pesnow_roof,                               &
                       hsnow_road,                                              &
                       pwsnow_road, ptsnow_road, prsnow_road, pasnow_road,      &
                       ptssnow_road, pesnow_road,                               &
                       pps, pta, pqa, prhoa,                                    &
                       plw_rad,                                                 &
                       psr, pzref, puref, pvmod,                                &
                       ptstep,                                                  &
                       pz_lowcan,                                               &
                       pdn_roof, pabs_sw_snow_roof, pabs_lw_snow_roof,          &
                       pdn_road, pabs_sw_snow_road, pabs_lw_snow_road,          &
                       prnsnow_roof, phsnow_roof, plesnow_roof, pgsnow_roof,    &
                       pmelt_roof,                                              &
                       prnsnow_road, phsnow_road, plesnow_road, pgsnow_road,    &
                       pmelt_road,                                              &
                       plw_wa_to_nr , plw_wb_to_nr, plw_s_to_nr, plw_win_to_nr, &
                       pdqs_snow_roof, pdqs_snow_road, pt_win1                  )  
!   ##########################################################################
!
!!****  *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_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
!
!
REAL, DIMENSION(:),   INTENT(IN)    :: pt_lowcan  ! LOWCAN air temperature
REAL, DIMENSION(:),   INTENT(IN)    :: pq_lowcan  ! LOWCAN air specific humidity
REAL, DIMENSION(:),   INTENT(IN)    :: pu_lowcan  ! LOWCAN hor. wind
REAL, DIMENSION(:),   INTENT(IN)    :: pts_roof   ! roof surface temperature
REAL, DIMENSION(:),   INTENT(IN)    :: pts_road   ! road surface 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)    :: pt_roof    ! roof temperature profile
REAL, DIMENSION(:,:), INTENT(IN)    :: pd_roof    ! roof layer thickness
REAL, DIMENSION(:,:), INTENT(IN)    :: ptc_roof   ! roof layer thermal conductivity
REAL, DIMENSION(:,:), INTENT(IN)    :: phc_roof   ! roof layer heat capacity
 CHARACTER(LEN=*),     INTENT(IN)    :: hsnow_roof ! snow roof scheme
!                                                 ! 'NONE'
!                                                 ! 'D95 '
!                                                 ! '1-L '
 CHARACTER(LEN=*),     INTENT(IN)    :: hsnow_road ! snow road scheme
!                                                 ! 'NONE'
!                                                 ! 'D95 '
!                                                 ! '1-L '
REAL, DIMENSION(:,:), INTENT(INOUT) :: pwsnow_roof ! snow layers reservoir
REAL, DIMENSION(:,:), INTENT(INOUT) :: ptsnow_roof ! snow layers temperature
REAL, DIMENSION(:,:), INTENT(INOUT) :: prsnow_roof ! snow layers density
REAL, DIMENSION(:),   INTENT(INOUT) :: pasnow_roof ! snow albedo
REAL, DIMENSION(:),   INTENT(INOUT) :: pesnow_roof ! snow emissivity
REAL, DIMENSION(:),   INTENT(INOUT) :: ptssnow_roof! snow surface temperature
REAL, DIMENSION(:,:), INTENT(INOUT) :: pwsnow_road ! snow layers reservoir
REAL, DIMENSION(:,:), INTENT(INOUT) :: ptsnow_road ! snow layers temperature
REAL, DIMENSION(:,:), INTENT(INOUT) :: prsnow_road ! snow layers density
REAL, DIMENSION(:),   INTENT(INOUT) :: pasnow_road ! snow albedo
REAL, DIMENSION(:),   INTENT(INOUT) :: pesnow_road ! snow emissivity
REAL, DIMENSION(:),   INTENT(INOUT) :: ptssnow_road! snow 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_lowcan  ! height of forcing
!
REAL, DIMENSION(:), INTENT(IN)    :: pdn_roof          ! snow-covered roof frac.
REAL, DIMENSION(:), INTENT(IN)    :: pabs_sw_snow_roof ! SW absorbed by roof snow
REAL, DIMENSION(:), INTENT(OUT)   :: pabs_lw_snow_roof ! absorbed IR rad by snow on roof
REAL, DIMENSION(:), INTENT(INOUT) :: pdn_road          ! snow-covered road frac.
REAL, DIMENSION(:), INTENT(IN)    :: pabs_sw_snow_road ! SW absorbed by road snow
REAL, DIMENSION(:), INTENT(OUT)   :: pabs_lw_snow_road ! absorbed IR rad by snow on road
!
REAL, DIMENSION(:), INTENT(OUT)   :: prnsnow_roof ! net radiation over snow
REAL, DIMENSION(:), INTENT(OUT)   :: phsnow_roof  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: plesnow_roof ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: pgsnow_roof  ! flux under the snow
REAL, DIMENSION(:), INTENT(OUT)   :: pmelt_roof   ! snow melt
REAL, DIMENSION(:), INTENT(OUT)   :: prnsnow_road ! net radiation over snow
REAL, DIMENSION(:), INTENT(OUT)   :: phsnow_road  ! sensible heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: plesnow_road ! latent heat flux over snow
REAL, DIMENSION(:), INTENT(OUT)   :: pgsnow_road  ! flux under the snow
REAL, DIMENSION(:), INTENT(OUT)   :: pmelt_road   ! 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_snow_roof ! Heat storage in snowpack on roofs
REAL, DIMENSION(:), INTENT(OUT)   :: pdqs_snow_road ! Heat storage in snowpack on roads
REAL, DIMENSION(:), INTENT(IN)    :: pt_win1        ! Window surface temperature
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(SIZE(PTA)) :: zlw1_road   ! independant from
REAL, DIMENSION(SIZE(PTA)) :: zlw1_roof   ! surface temperature
!
REAL, DIMENSION(SIZE(PTA)) :: zlw2_road   ! to be multiplied by
REAL, DIMENSION(SIZE(PTA)) :: zlw2_roof   ! 4th power of
!                                         ! surface temperature

REAL, DIMENSION(SIZE(PTA)) :: zsr_roof    ! snow fall on roof snow (kg/s/m2 of snow)
REAL, DIMENSION(SIZE(PTA)) :: zsr_road    ! 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 :: gsnow_roof, gsnow_road
!
! loop counters
!
INTEGER :: jl
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('URBAN_SNOW_EVOL',0,zhook_handle)
prnsnow_roof(:)=0.
phsnow_roof(:)=0.
plesnow_roof(:)=0.
pgsnow_roof(:)=0.
pmelt_roof(:)=0.
prnsnow_road(:)=0.
phsnow_road(:)=0.
plesnow_road(:)=0.
pgsnow_road(:)=0.
pmelt_road(:)=0.
pabs_lw_snow_roof(:)=0.
pabs_lw_snow_road(:)=0.
!
!-------------------------------------------------------------------------------
!
gsnow_roof = any( psr(:)>0. .OR. pwsnow_roof(:,1)>0. )
gsnow_road = any( psr(:)>0. .OR. pwsnow_road(:,1)>0. )
!
!-------------------------------------------------------------------------------
!
!*      5.     Snow mantel model
!              -----------------
!
!*      5.1    roofs
!              -----
!
IF ( gsnow_roof ) THEN
!
!* initializes LW radiative coefficients
!
  zlw1_roof(:) =   pesnow_roof(:) * plw_rad(:)
  zlw2_roof(:) = - pesnow_roof(:) * 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(pwsnow_roof,2)
    WHERE (pdn_roof(:)>0.) pwsnow_roof(:,jl) = pwsnow_roof(:,jl) / pdn_roof(:)
  END DO
  zsr_roof=0.
  WHERE (pdn_roof(:)>0.) zsr_roof(:) = psr(:) / pdn_roof(:)
!
!* Estimates implicit coupling between snow and roof
! (strictly equal to an implicit formulation for 100% snow coverage)
!
  CALL roof_impl_coef(ptstep, SIZE(pt_roof,2), pd_roof, ptc_roof, phc_roof, pt_roof, zts_coefa,zts_coefb)
!
!* call to snow mantel scheme
!
  IF (hsnow_roof=='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,                                        &
                           ptsnow_roof(:,1), pasnow_roof,                       &
                           prsnow_roof(:,1), pwsnow_roof(:,1), ptssnow_roof,    &
                           pesnow_roof,                                         &
                           pts_roof,  zts_coefa, zts_coefb, pabs_sw_snow_roof,  &
                           zlw1_roof, zlw2_roof,                                &
                           pta, pqa, pvmod, pps, prhoa, zsr_roof, pzref, puref, &
                           prnsnow_roof, phsnow_roof, plesnow_roof, pgsnow_roof,&
                           pmelt_roof, pdqs_snow_roof, pabs_lw_snow_roof        )  
!

!
!* The global amount of snow on roofs is reported to total roof surface.
!
  DO jl=1,SIZE(pwsnow_roof,2)
    pwsnow_roof(:,jl) = pwsnow_roof(:,jl) * pdn_roof(:)
  END DO
!           
END IF
!
!*      5.2    roads
!              -----
!
IF ( gsnow_road ) THEN
  !
  zt_sky(:) = (plw_rad(:)/xstefan)**0.25
!
  zlw1_road(:) = plw_s_to_nr(:) * (zt_sky(:) - ptssnow_road(:)) &
               + plw_wa_to_nr(:) * (pts_wall_a(:) - ptssnow_road(:)) &
               + plw_wb_to_nr(:) * (pts_wall_b(:) - ptssnow_road(:)) &
               + plw_win_to_nr(:) * (pt_win1(:) - ptssnow_road(:))
  zlw2_road(:) =  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(pwsnow_road,2)
    WHERE (pdn_road(:)>0.) pwsnow_road(:,jl) = pwsnow_road(:,jl) / pdn_road(:)
  END DO
  zsr_road=0.
  WHERE (pdn_road(:)>0.) zsr_road(:) = psr(:) / pdn_road(:)
  !
  !* no implicit coupling necessary with road
  !
  zts_coefa = 0.
  zts_coefb = pts_road
  !
  !* call to snow mantel scheme
  !
  IF (hsnow_road=='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,                                        &
                           ptsnow_road(:,1), pasnow_road,                       &
                           prsnow_road(:,1), pwsnow_road(:,1), ptssnow_road,    &
                           pesnow_road,                                         &
                           pts_road, zts_coefa, zts_coefb,                      &
                           pabs_sw_snow_road, zlw1_road, zlw2_road,             &
                           pt_lowcan, pq_lowcan, pu_lowcan, pps, prhoa,         &
                           zsr_road, pz_lowcan, pz_lowcan,                      &
                           prnsnow_road, phsnow_road, plesnow_road, pgsnow_road,&
                           pmelt_road, pdqs_snow_road ,pabs_lw_snow_road        )  
!
!* The global amount of snow on roads is reported to total road surface.
!
  DO jl=1,SIZE(pwsnow_road,2)
    pwsnow_road(:,jl) = pwsnow_road(:,jl) * pdn_road(:)
  END DO
!
  WHERE (ptsnow_road(:,1) .EQ. xundef) pdn_road(:) = 0.0
!
END IF
IF (lhook) CALL dr_hook('URBAN_SNOW_EVOL',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE urban_snow_evol