mode_surf_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.
!     ##########################
      MODULE mode_surf_snow_frac
!     ##########################
!
!!****  *MODE_SURF_SNOW_FRAC* -  module for routines to compute snow fraction
!!                               for surface schemes
!!
!!    PURPOSE
!!    -------
!    
!      The purpose of this routine is to store here all routines to compute
!     snow fractions for the TEB scheme. This allows to insure a coherent
!     way in retrieving snow fraction or snow contents.
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!       NONE          
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    15/03/99
!!     (B.Decharme) 12/03/08  Make sure PPSNV <= PPSNG
!--------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!-------------------------------------------------------------------------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
 CONTAINS
!-------------------------------------------------------------------------------
!
!     ###############################################
      FUNCTION snow_frac_ground(PWSNOW) RESULT(PPSNG)
!     ###############################################
!
USE modd_snow_par, ONLY : xwcrn
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL, DIMENSION(SIZE(PWSNOW))   :: ppsng  ! snow fraction over bare ground
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND',0,zhook_handle)
ppsng(:) = pwsnow(:) / (pwsnow(:)+xwcrn)       ! fraction of ground covered
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND',1,zhook_handle)
!
END FUNCTION snow_frac_ground
!
!-------------------------------------------------------------------------------
!
!     ##########################################################
      FUNCTION wsnow_from_snow_frac_ground(PPSNG) RESULT(PWSNOW)
!     ##########################################################
!
USE modd_snow_par, ONLY : xwcrn
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN)  :: ppsng  ! snow fraction over bare ground
REAL, DIMENSION(SIZE(PPSNG))    :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:WSNOW_FROM_SNOW_FRAC_GROUND',0,zhook_handle)
pwsnow(:) = xwcrn * ppsng(:) / (1. - ppsng(:))
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:WSNOW_FROM_SNOW_FRAC_GROUND',1,zhook_handle)
!
END FUNCTION wsnow_from_snow_frac_ground
!-------------------------------------------------------------------------------
!
!     #########################################################
      FUNCTION snow_frac_veg(PPSNG,PWSNOW,PZ0VEG,PRHOS) RESULT(PPSNV)
!     #########################################################
!
USE modd_snow_par, ONLY : xwsnv
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN)  :: ppsng  ! snow fraction over bare ground
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL, DIMENSION(:), INTENT(IN)  :: pz0veg ! vegetation roughness length for momentum
REAL, DIMENSION(:), INTENT(IN)  :: prhos  ! snow density (kg/m3)
REAL, DIMENSION(SIZE(PWSNOW))   :: ppsnv  ! snow fraction over vegetation
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG',0,zhook_handle)
ppsnv(:) = pwsnow(:) / (pwsnow(:)+prhos(:)*xwsnv*pz0veg(:))
! Make sure PPSNV <= PPSNG
ppsnv(:) = min(ppsnv(:),ppsng(:))
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG',1,zhook_handle)
!
END FUNCTION snow_frac_veg
!
!-------------------------------------------------------------------------------
!     **********************************************************
      FUNCTION snow_frac_veg_a(P_PSNG,P_LAI,P_SNOWALB) RESULT(PPSNV)
!     **********************************************************
!
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN)  :: p_lai ! leaf area index
REAL, DIMENSION(:), INTENT(IN)  :: p_snowalb ! snow albedo
REAL, DIMENSION(:), INTENT(IN)  :: p_psng ! snow fraction over bare ground
REAL, DIMENSION(SIZE(P_LAI))    :: ppsnv  ! snow fraction over vegetation
!
!
!
! Definition of local variables
REAL, DIMENSION(SIZE(P_LAI))   :: flai  ! snow fraction over vegetation
REAL  rlaimax,rlai,a1,a2
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_A',0,zhook_handle)
rlaimax=7.
rlai=3.
a1=0.87
a2=0.84
flai(:)=1.
WHERE(p_lai(:)>rlai)
 flai(:)=1.-(p_lai(:)/rlaimax)*(max(0.0,(a1-max(a2,p_snowalb(:))))/(a1-a2))
END WHERE
ppsnv(:)=p_psng(:)*flai(:)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_A',1,zhook_handle)
!
END FUNCTION snow_frac_veg_a

!-------------------------------------------------------------------------------
!
!     ############################################################
      FUNCTION snow_frac_nat(PWSNOW,PPSNG,PPSNV,PVEG) RESULT(PPSN)
!     ############################################################
!
IMPLICIT NONE
!
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL, DIMENSION(:), INTENT(IN)  :: ppsng  ! snow fraction over bare ground
REAL, DIMENSION(:), INTENT(IN)  :: ppsnv  ! snow fraction over vegetation
REAL, DIMENSION(:), INTENT(IN)  :: pveg   ! vegetation fraction
REAL, DIMENSION(SIZE(PWSNOW))   :: ppsn   ! snow fraction over natural areas
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT',0,zhook_handle)
ppsn(:) = (1-pveg(:))*ppsng(:) + pveg(:)*ppsnv(:)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT',1,zhook_handle)
!
END FUNCTION snow_frac_nat
!
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
!
!     ##############################################################
      SUBROUTINE snow_frac_road(PWSNOW_ROAD,OSNOW,PDN_ROAD,PDF_ROAD)
!     ##############################################################
!
USE modd_snow_par, ONLY : xwcrn
!
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow_road ! snow amount over roads (kg/m2) 
LOGICAL, DIMENSION(:), INTENT(IN)  :: osnow    ! T: snow-fall is occuring
REAL, DIMENSION(:), INTENT(OUT) :: pdn_road    ! snow fraction over roads
REAL, DIMENSION(:), INTENT(OUT) :: pdf_road    ! snow-free fraction over roads
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROAD',0,zhook_handle)
pdf_road(:)     = 1.
pdn_road(:)     = 0.
!
! due to the flatness of horizontal surfaces (compared to landscape and
! vegetation), the amount of snow necessary to cover the entire surface XWCRN
! is reduced (equal to 1kg/m2 instead of 10).
!
WHERE (pwsnow_road(:)>0. .OR. osnow)
  pdn_road(:)     = max(min(pwsnow_road(:)/(pwsnow_road(:) + xwcrn*0.1) , 0.7), 0.01)
  pdf_road(:)     = 1.-pdn_road(:)
END WHERE
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROAD',1,zhook_handle)
!
END SUBROUTINE snow_frac_road
!
!-------------------------------------------------------------------------------
!
!     ##############################################################
      SUBROUTINE snow_frac_roof(PWSNOW_ROOF,OSNOW,PDN_ROOF,PDF_ROOF)
!     ##############################################################
!
USE modd_snow_par, ONLY : xwcrn
!
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow_roof ! snow amount over roofs (kg/m2) 
LOGICAL, DIMENSION(:), INTENT(IN)  :: osnow    ! T: snow-fall is occuring
REAL, DIMENSION(:), INTENT(OUT) :: pdn_roof    ! snow fraction over roofs
REAL, DIMENSION(:), INTENT(OUT) :: pdf_roof    ! snow-free fraction over roofs
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROOF',0,zhook_handle)
pdf_roof(:)     = 1.
pdn_roof(:)     = 0.
!
! due to the flatness of horizontal surfaces (compared to landscape and
! vegetation), the amount of snow necessary to cover the entire surface XWCRN
! is reduced (equal to 1kg/m2 instead of 10).
!
WHERE (pwsnow_roof(:)>0. .OR. osnow)
  pdn_roof(:)     = max(pwsnow_roof(:)/(pwsnow_roof(:) + xwcrn*0.1),0.01)
  pdf_roof(:)     = 1.-pdn_roof(:)
END WHERE
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROOF',1,zhook_handle)
!
END SUBROUTINE snow_frac_roof
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
! routines bidon pour tora
!
!     ########################################################
      FUNCTION snow_frac_nat_1d(PWSNOW)RESULT(BIDON)
!     ########################################################
!
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL :: bidon
REAL(KIND=JPRB) :: zhook_handle
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_1D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_1D',1,zhook_handle)
!
END FUNCTION snow_frac_nat_1d
!
!-------------------------------------------------------------------------------
!
!     ########################################################
      FUNCTION snow_frac_nat_2d(PWSNOW) RESULT(BIDON)
!     ########################################################

REAL :: bidon
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_2D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_2D',1,zhook_handle)

END FUNCTION snow_frac_nat_2d

!----------------------------------------------------------------------------------
!     ############################################################
      FUNCTION snow_frac_veg_1d(PWSNOW) RESULT(BIDON)
!     ############################################################
REAL :: bidon
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_1D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_1D',1,zhook_handle)
END FUNCTION snow_frac_veg_1d
!
!-------------------------------------------------------------------------------
!
!     ############################################################
      FUNCTION snow_frac_veg_2d(PWSNOW) RESULT(BIDON)
!     ############################################################

REAL :: bidon
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_2D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_2D',1,zhook_handle)
!
END FUNCTION snow_frac_veg_2d
!
!-------------------------------------------------------------------------------
!     ##################################################
      FUNCTION snow_frac_ground_1d(PWSNOW) RESULT(BIDON)
!     ##################################################
!
REAL :: bidon      
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_1D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_1D',1,zhook_handle)
!
END FUNCTION snow_frac_ground_1d
!
!-------------------------------------------------------------------------------
!
!     ##################################################
      FUNCTION snow_frac_ground_2d(PWSNOW) RESULT(BIDON)
!     ##################################################
!
REAL :: bidon
REAL, DIMENSION(:), INTENT(IN)  :: pwsnow ! snow amount over natural areas (kg/m2)
REAL(KIND=JPRB) :: zhook_handle
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_2D',0,zhook_handle)
bidon=pwsnow(1)
IF (lhook) CALL dr_hook('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_2D',1,zhook_handle)

!
END FUNCTION snow_frac_ground_2d
!

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
END MODULE mode_surf_snow_frac