hydro_snow.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 hydro_snow(OGLACIER, PTSTEP, PVEGTYPE, PSR, PLES, PMELT, TPSNOW, PPG_MELT )  
!     #####################################################################
!
!!****  *HYDRO_SNOW*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates i) Snow water transfer to soil for both snow scheme options.
!     ii) the evolution of the snowpack using the Force-Restore
!     option of Douville et al. (1995): 'DEF'
!     Calculate the snow cover liquid water equivalent (Ws), the albedo and density of
!     the snow (i.e., SNOWALB and SNOWRHO).  Also determine the runoff and drainage
!     into the soil.
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!REAL, DIMENSION(:), INTENT(INOUT) :: PTG
!                                      PTG = surface temperature at 't'

!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    Noilhan and Planton (1989)
!!    Belair (1995)
!!      
!!    AUTHOR
!!    ------
!!
!!      S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original    14/03/95 
!!                  31/08/98 (V. Masson and F. Habets) add Dumenil et Todini
!!                           runoff scheme
!!                  31/08/98 (V. Masson and A. Boone) add the third soil-water
!!                           reservoir (WG3,D3)
!!                  14/05/02 (A. Boone) snow only, and skip code if '3-L' option in force
!!                   03/2009 (B. Decharme) Consistency with Arpege permanent snow/ice treatment
!!                                          (LGLACIER)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_type_snow, ONLY : surf_snow
!
USE modd_csts,        ONLY : xlstt, xlmtt, xday
USE modd_snow_par,    ONLY : xans_t, xans_todry, xansmin, xansmax, &
                               xrhosmax, xrhosmin, xwcrn, xaglamin,  &
                               xaglamax  
USE modd_surf_par,    ONLY : xundef
USE modd_data_cover_par, ONLY : nvt_snow
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
LOGICAL, INTENT(IN)               :: OGLACIER   ! True = Over permanent snow and ice, 
!                                                     initialise WGI=WSAT,
!                                                     Hsnow>=10m and allow 0.8<SNOALB<0.85
                                                ! False = No specific treatment
REAL, INTENT(IN)                  :: PTSTEP
!                                    timestep of the integration
REAL, DIMENSION(:,:), INTENT(IN)  :: PVEGTYPE ! fraction of each vegetation
REAL, DIMENSION(:), INTENT(IN)    :: PSR,  PLES, PMELT
!                                    PSR = snow rate
!                                    PLES = latent heat of sublimation over the snow
!                                    PMELT = melting rate of snow
TYPE(surf_snow), INTENT(INOUT) :: TPSNOW
REAL, DIMENSION(:), INTENT(INOUT) :: PPG_MELT
!                                    TPSNOW%WSNOW(:,1,1) = equivalent water content of the
!                                    PPG_MELT = total water reaching the ground
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PSR)) :: ZSNOWSWEM, ZWSX,  ZANSMIN, ZANSMAX
!                             Prognostic variables of ISBA at 't-dt'
!                             ZSNOWSWEM = equivalent water content of the
!                                         snow reservoir
!                             ZANSMIN = Minimum glacier albedo
!                             ZANSMAX = Maximum glacier albedo
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('HYDRO_SNOW',0,zhook_handle)                                                        
!-------------------------------------------------------------------------------
!
!*              Douville et al. (1995) 'DEF' snow option
!               ----------------------------------------
!        
!*       1.     Initialize:
!               -----------
!
zwsx(:)       = 0.0
zansmin(:)    = xansmin
zansmax(:)    = xansmax
!
!
!*       2.     Fields at time t-dt
!               -------------------
!
zsnowswem(:) = tpsnow%WSNOW(:,1)    
!
!*       3.     EVOLUTION OF THE SNOWPACK ('DEF' OPTION)
!               ----------------------------------------
!
!*       3.A    EVOLUTION OF THE EQUIVALENT WATER CONTENT snowSWE ('DEF' option)
!               --------------------------------------------------------------
!
!                                           evolution of Ws (without melting)
!
tpsnow%WSNOW(:,1) = zsnowswem(:) + ptstep * ( psr(:) - ples(:)/xlstt - pmelt(:))
!
!                                           melting of snow: more liquid water
!                                                            reaches the surface
!
ppg_melt(:)     = ppg_melt(:) + pmelt(:)  
!   
! removes very small values due to computation precision
!
WHERE(tpsnow%WSNOW(:,1) < 1.0e-10) tpsnow%WSNOW(:,1) = 0.
!
!-------------------------------------------------------------------------------
!
!*       3.B    EVOLUTION OF SNOW ALBEDO 
!               ------------------------
!
IF(oglacier)THEN
  zansmin(:) = xaglamin * pvegtype(:,nvt_snow) + xansmin * (1.0-pvegtype(:,nvt_snow))
  zansmax(:) = xaglamax * pvegtype(:,nvt_snow) + xansmax * (1.0-pvegtype(:,nvt_snow))
ELSE
  zansmin(:) = xansmin
  zansmax(:) = xansmax
ENDIF
!                                       the evolution of the snow albedo differs
!                                       if there is melting or not
!
WHERE (tpsnow%WSNOW(:,1) > 0.0 )
  !
  WHERE ( zsnowswem > 0.0)
    !
    ! when there is melting 
    WHERE ( pmelt > 0.0 )
      tpsnow%ALB(:) = (tpsnow%ALB(:)-zansmin(:))*exp(-xans_t*ptstep/xday) + zansmin(:) &
                       + psr(:)*ptstep/xwcrn*(zansmax(:)-zansmin(:))  
      ! when there is no melting
    ELSEWHERE 
      tpsnow%ALB(:) = tpsnow%ALB(:) - xans_todry*ptstep/xday   &
                       + psr(:)*ptstep/xwcrn*(zansmax(:)-zansmin(:))  
    END WHERE
    !
  ELSEWHERE (zsnowswem == 0.0)
    !
    ! new snow covered surface
    tpsnow%ALB(:) = zansmax(:)
  END WHERE
  !
  ! limits of the albedo
  tpsnow%ALB(:) = min( zansmax(:), tpsnow%ALB(:) )
  tpsnow%ALB(:) = max( zansmin(:), tpsnow%ALB(:) )
END WHERE
!
!-------------------------------------------------------------------------------
!
!*       3.C    EVOLUTION OF SNOW DENSITY 
!               -------------------------
!
!                                      as for the snow albedo, the density's
!                                      evolution will depend whether or not
!                                      the snow is melting
!
WHERE ( tpsnow%WSNOW(:,1) > 0.0 ) 
  WHERE ( zsnowswem > 0.0 ) 
    zwsx(:)     = max( tpsnow%WSNOW(:,1),psr(:)*ptstep)
    tpsnow%RHO(:,1) = (tpsnow%RHO(:,1)-xrhosmax)*exp(-xans_t*ptstep/xday) + xrhosmax
    tpsnow%RHO(:,1) = ( (zwsx(:)-psr(:)*ptstep) * tpsnow%RHO(:,1)     &
                         + (psr(:)*ptstep) * xrhosmin ) / zwsx(:)  
  ELSEWHERE ( zsnowswem == 0.0) 
    tpsnow%RHO(:,1) = xrhosmin
  END WHERE
END WHERE
!
!-------------------------------------------------------------------------------
!
!*       4.     No SNOW
!               -------
!
WHERE ( tpsnow%WSNOW(:,1) == 0.0 ) 
  tpsnow%RHO(:,1) = xundef 
  tpsnow%ALB(:) = xundef 
END WHERE
!
IF (lhook) CALL dr_hook('HYDRO_SNOW',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE hydro_snow