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