urban_snow_evol.F90 Source File


Contents

Source Code


Source Code

!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 version 2.1
!SFX_LIC version 1. See LICENSE, Licence_CeCILL_V2.1-en.txt and Licence_CeCILL_V2.1-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