isba_snow_frac.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 isba_snow_frac(HSNOW, PWSNOW, PRSNOW, PASNOW,       &
                                PVEG, PLAI, PZ0, PPSN, PPSNV_A, PPSNG, PPSNV )  
!     ##########################################################################
!
!!****  *ISBA_SNOW_FRAC*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates grid-averaged albedo and emissivity (according to snow scheme)
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!      S. Belair           * Meteo-France *
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_snow_par   , ONLY : xemissn, xemcrin, xsnowdmin, &
                             xrhosmax_es, xrhosmin_es, &
                             xwcrn_expl, xdcrn_expl
!
USE modd_prep_snow, ONLY : lsnow_frac_tot
!
USE mode_surf_snow_frac
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=*)    , INTENT(IN)   :: HSNOW      ! ISBA snow scheme
!
REAL, DIMENSION(:,:), INTENT(IN)   :: PWSNOW     ! snow reservoir
REAL, DIMENSION(:,:), INTENT(IN)   :: PRSNOW     ! snow density
REAL, DIMENSION(:)  , INTENT(IN)   :: PASNOW     ! snow albedo
REAL, DIMENSION(:)  , INTENT(IN)   :: PVEG
REAL, DIMENSION(:)  , INTENT(IN)   :: PLAI
REAL, DIMENSION(:)  , INTENT(IN)   :: PZ0
REAL, DIMENSION(:)  , INTENT(INOUT):: PPSN
REAL, DIMENSION(:)  , INTENT(INOUT):: PPSNV_A
REAL, DIMENSION(:)  , INTENT(INOUT):: PPSNG
REAL, DIMENSION(:)  , INTENT(INOUT):: PPSNV
!                                     PVEG = fraction of vegetation
!                                     PLAI = leaf area index
!                                     PZ0  = roughness length for momentum
!                                     PPSN = grid fraction covered by snow
!                                     PPSNG = fraction of the ground covered by snow 
!                                     PPSNV = fraction of the veg covered by snow 
!
!-------------------------------------------------------------------------------
!
!*      0.     Local variables
!              ---------------
!
INTEGER                          :: JLAYER
REAL, DIMENSION(SIZE(PVEG))      :: ZSNOWSWE
REAL, DIMENSION(SIZE(PVEG))      :: ZSNOWD
REAL, DIMENSION(SIZE(PVEG))      :: ZSNOWRHO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ISBA_SNOW_FRAC',0,zhook_handle)
!
!*      1.     Compute Total SWE (kg m-2) and snowpack average density (kg m-3)
!              ----------------------------------------------------------------
!
zsnowswe(:) = 0.
!
DO jlayer=1,SIZE(pwsnow,2)
  zsnowswe(:) = zsnowswe(:) + pwsnow(:,jlayer)
END DO
!
IF (hsnow == '3-L' .OR. hsnow == 'CRO') THEN                  
   zsnowd(:) = 0.
   DO jlayer=1,SIZE(pwsnow,2)
     zsnowd  (:) = zsnowd(:) + pwsnow(:,jlayer) / prsnow(:,jlayer)
   END DO
   zsnowrho(:) = zsnowswe(:)/max(xsnowdmin,zsnowd(:))
   zsnowrho(:) = max(xrhosmin_es,min(xrhosmax_es,zsnowrho(:)))
ELSE
   zsnowrho(:) = prsnow(:,1)
END IF
!
!*      2.     Snow fraction over ground
!              -------------------------
!
IF (hsnow == 'CRO' .OR. hsnow == '3-L') THEN
   ppsng(:) = min(1.0, zsnowd(:)/xdcrn_expl)
ELSE
   ppsng(:) = snow_frac_ground(zsnowswe)
ENDIF
!
!*      3.     Snow fraction over vegetation
!              -----------------------------
!
IF (hsnow == 'EBA' ) THEN
   ppsnv_a(:) = snow_frac_veg_a(ppsng,plai,pasnow)
   ppsnv(:) = ppsnv_a(:)
ELSE
   ppsnv(:) = snow_frac_veg(ppsng,zsnowswe,pz0,zsnowrho)
ENDIF
!
!*      4.     Total snow fraction
!              -------------------
!
ppsn(:)       = snow_frac_nat(zsnowswe,ppsng,ppsnv,pveg)
!
IF (lsnow_frac_tot) THEN
  ppsn(:) = min(1.0, zsnowswe(:)/xwcrn_expl)      
  ppsng(:) = ppsn(:)
  ppsnv(:) = ppsn(:)
ENDIF
!
IF (lhook) CALL dr_hook('ISBA_SNOW_FRAC',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE isba_snow_frac