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(PK, PEK, DEK, PTSTEP, PSR, PWRVNMAX, PKVN, PCHEATV, PMELTVN, &
                         PVELC, PSUBVCOR)
!   ############################################################################
!
!!****  *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_isba_n, ONLY : isba_pe_t, isba_p_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
!
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
!
TYPE(isba_p_t), INTENT(INOUT) :: PK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEK
!
REAL,               INTENT(IN)    :: PTSTEP
!
REAL, DIMENSION(:), INTENT(IN)    :: PSR, PCHEATV, PVELC, PMELTVN, PWRVNMAX, PKVN
!
REAL, DIMENSION(:), INTENT(OUT)   :: 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)
!
   dek%XSR_GN(:) = pek%XWRVN(:)/ptstep    ! kg m-2 s-1
   pek%XWRVN(:)    = 0.0

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

   dek%XMELT_CV(:) = 0.0
   dek%XFRZ_CV(:)  = 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(:)-pek%XWRVN(:))*(1.0-exp(-pkvn(:)*psr(:)*ptstep)) ! kg m-2
   zsrint(:)      = min(psr(:)*ptstep, zsrint(:))  ! kg m-2 
   zwrvn(:)       = pek%XWRVN(:) + zsrint(:)           ! kg m-2 

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

END WHERE

      WHERE(pwrvnmax(:) /= 0.0)

! 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(:)        = dek%XLES_CV(:)*(ptstep/pk%XLSTT(:))    ! 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)

   dek%XMELT_CV(:) = ptstep*max(0.0, pmeltvn(:))         ! kg m-2  
   dek%XMELT_CV(:) = min(dek%XMELT_CV(:), zwrvn(:))
   zwrvn(:)        = zwrvn(:)    - dek%XMELT_CV(:)
   pek%XWR(:)      = pek%XWR(:)  + dek%XMELT_CV(:)        ! 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:

   dek%XFRZ_CV(:) = ptstep*max(0.0, -pmeltvn(:))        ! kg m-2  
   dek%XFRZ_CV(:) = min(dek%XFRZ_CV(:), max(0.0,pek%XWR(:)-dek%XLER_CV(:)*(ptstep/pk%XLVTT(:))))
   zwrvn(:)       = zwrvn(:)   + dek%XFRZ_CV(:)
   pek%XWR(:)     = pek%XWR(:) - dek%XFRZ_CV(:)

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

   zunload(:)    = min(zwrvn(:), pek%XWRVN(:)*( pvelc(:)*(ptstep/zunload_v)          &
                     + max(0.0, pek%XTV(:)-zunload_tt)*(ptstep/zunload_t) ))            ! kg m-2 
   zwrvn(:)      = zwrvn(:) - zunload(:)                                           ! kg m-2 
   dek%XSR_GN(:) = dek%XSR_GN(:) + zunload(:)/ptstep

! Diagnostic updates:
! final phase change (units)

   dek%XMELT_CV(:) = dek%XMELT_CV(:)/ptstep ! kg m-2 s-1
   dek%XFRZ_CV(:)  = dek%XFRZ_CV(:) /ptstep ! kg m-2 s-1

! Prognostic Updates:

   pek%XWRVN(:)       = zwrvn(:)

   pek%XTV(:)         = pek%XTV(:) + (dek%XFRZ_CV(:) - dek%XMELT_CV(:))*(xlmtt*ptstep)/pcheatv(:) ! K

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