snow_load_meb.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 snow_load_meb(PTSTEP,PSR,PTV,PWRVNMAX,PKVN,PCHEATV,PLERCV,PLESC,PMELTVN, &
          pvelc,pmeltcv,pfrzcv,punloadsnow,pwrv,pwrvn,psubvcor,plvtt,plstt)
!   ############################################################################
!
!!****  *SNOW_LOAD_MEB*
!!
!!    PURPOSE
!!    -------
!
!     Calculate temporal evolution of canopy-intercepted intercepted snow
!     
!!**  METHOD
!!    ------
!
!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!
!!      P. Samuelsson           * SMHI *
!!      A. Boone                * CNRM-GAME, Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    02/2011
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_csts,     ONLY : xtt, xlmtt
!
USE modd_snow_par, ONLY : xrhosmax_es
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    Declaration of Arguments
!
REAL,               INTENT(IN)    :: ptstep
!
REAL, DIMENSION(:), INTENT(IN)    :: plvtt, plstt
REAL, DIMENSION(:), INTENT(IN)    :: psr,pcheatv, plercv, pvelc,              &
                                     plesc, pmeltvn, pwrvnmax, pkvn
!
REAL, DIMENSION(:), INTENT(INOUT) :: pwrvn, pwrv, ptv
!
REAL, DIMENSION(:), INTENT(OUT)   :: pmeltcv, pfrzcv, punloadsnow, psubvcor
!
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PSR))        :: zsrint, zunload, zwrvn, zsub
!
REAL(KIND=JPRB) :: zhook_handle
!
!*      0.3    declarations of local parameters
!
! Snow unloading parameters (Roesch el al., Clim. Dyn., 2001)
!
REAL, PARAMETER                   :: zunload_t     = 1.5e+5   ! K s
REAL, PARAMETER                   :: zunload_tt    = 270.15   ! K
REAL, PARAMETER                   :: zunload_v     = 1.87e+5  ! m 
!
!-------------------------------------------------
! 0) Initialization
!
IF (lhook) CALL dr_hook('SNOW_LOAD_MEB',0,zhook_handle)
!
zsrint(:)      = 0.0
zwrvn(:)       = 0.0
zsub(:)        = 0.0
zunload(:)     = 0.0
!
!
! 1) First consider the case when maximum interception is zero...
! this only occurs when vegetation canopy is *totally* buried. The follwing line
! results in non-zero snow loading (total removal of intercepted snow) 
! only during the timestep when vegetation has just been buried:
!
!
WHERE(pwrvnmax(:) == 0.0)
!
   punloadsnow(:) = pwrvn(:)/ptstep    ! kg m-2 s-1
   pwrvn(:)       = 0.0

! for a totally buried canopy, the following are zero:

   pmeltcv(:)     = 0.0
   pfrzcv(:)      = 0.0
   psubvcor(:)    = 0.0
!
!
ELSEWHERE
!
!
! 2) Case for snow beneath or only partially covering the vegetation canopy:
!
!
! The following are computed as steps to ensure mass conservation.
!
! Interception: gain

   zsrint(:)      = max(0.0,pwrvnmax(:)-pwrvn(:))*(1.0-exp(-pkvn(:)*psr(:)*ptstep)) ! kg m-2
   zsrint(:)      = min(psr(:)*ptstep, zsrint(:))  ! kg m-2 
   zwrvn(:)       = pwrvn(:) + zsrint(:)           ! kg m-2 

   punloadsnow(:) = max(0.0, psr(:) - zsrint(:)/ptstep) ! kg m-2 s-1

! Sublimation: gain or loss
! NOTE for the rare case that sublimation exceeds snow mass (possible as traces of snow disappear)
! compute a mass correction to be removed from soil (to conserve mass): PSUBVCOR

   zsub(:)        = plesc(:)*(ptstep/plstt(:))           ! kg m-2
   psubvcor(:)    = max(0.0, zsub(:) - zwrvn(:))/ptstep  ! kg m-2 s-1
   zwrvn(:)       = max(0.0, zwrvn(:) - zsub(:))         ! kg m-2

! Phase change: loss (melt of snow mass)

   pmeltcv(:)     = ptstep*max(0.0, pmeltvn(:))         ! kg m-2  
   pmeltcv(:)     = min(pmeltcv(:), zwrvn(:))
   zwrvn(:)       = zwrvn(:) - pmeltcv(:)
   pwrv(:)        = pwrv(:)  + pmeltcv(:)               ! NOTE...liq reservoir can exceed maximum holding
                                                        !        capacity here, but this is accounted for
                                                        !        in main prognostic PWRV routine.

! Phase change: gain (freeze of intercepted water) 
! Note, to get a better estimate of water available for freezing, remove Er in 
! estimation of water for freezing:
! Also, update liquid water stored on the canopy here:

   pfrzcv(:)      = ptstep*max(0.0, -pmeltvn(:))        ! kg m-2  
   pfrzcv(:)      = min(pfrzcv(:), max(0.0,pwrv(:)-plercv(:)*(ptstep/plvtt(:))))
   zwrvn(:)       = zwrvn(:) + pfrzcv(:)
   pwrv(:)        = pwrv(:)  - pfrzcv(:)

! Unloading (falling off branches, etc...): loss
! Note, the temperature effect is assumed to vanish for cold temperatures.

   zunload(:)     = min(zwrvn(:), pwrvn(:)*( pvelc(:)*(ptstep/zunload_v)          &
                     + max(0.0, ptv(:)-zunload_tt)*(ptstep/zunload_t) ))            ! kg m-2 
   zwrvn(:)       = zwrvn(:) - zunload(:)                                           ! kg m-2 
   punloadsnow(:) = punloadsnow(:) + zunload(:)/ptstep

! Diagnostic updates:
! final phase change (units)

   pmeltcv(:)     = pmeltcv(:)/ptstep ! kg m-2 s-1
   pfrzcv(:)      = pfrzcv(:) /ptstep ! kg m-2 s-1

! Prognostic Updates:

   pwrvn(:)       = zwrvn(:)

   ptv(:)         = ptv(:) + (pfrzcv(:) - pmeltcv(:))*(xlmtt*ptstep)/pcheatv(:) ! K

END WHERE
!
IF (lhook) CALL dr_hook('SNOW_LOAD_MEB',1,zhook_handle)
!
END SUBROUTINE snow_load_meb