SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
isba_snow_frac.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE isba_snow_frac(HSNOW, &
7  pwsnow, prsnow, pasnow, &
8  pveg, plai, pz0, &
9  ppsn, ppsnv_a, ppsng, ppsnv )
10 ! ##########################################################################
11 !
12 !!**** *ISBA_SNOW_FRAC*
13 !!
14 !! PURPOSE
15 !! -------
16 !
17 ! Calculates grid-averaged albedo and emissivity (according to snow scheme)
18 !
19 !! EXTERNAL
20 !! --------
21 !!
22 !! none
23 !!
24 !! IMPLICIT ARGUMENTS
25 !! ------------------
26 !!
27 !! AUTHOR
28 !! ------
29 !!
30 !! S. Belair * Meteo-France *
31 !-------------------------------------------------------------------------------
32 !
33 !* 0. DECLARATIONS
34 ! ------------
35 !
36 USE modd_snow_par , ONLY : xemissn, xemcrin, xsnowdmin, &
37  xrhosmax_es, xrhosmin_es, &
38  xwcrn_expl, xdcrn_expl
39 !
40 USE modd_prep_snow, ONLY : lsnow_frac_tot
41 !
43 !
44 !
45 USE yomhook ,ONLY : lhook, dr_hook
46 USE parkind1 ,ONLY : jprb
47 !
48 IMPLICIT NONE
49 !
50 !* 0.1 declarations of arguments
51 !
52  CHARACTER(LEN=*) , INTENT(IN) :: hsnow ! ISBA snow scheme
53 !
54 REAL, DIMENSION(:,:), INTENT(IN) :: pwsnow ! snow reservoir
55 REAL, DIMENSION(:,:), INTENT(IN) :: prsnow ! snow density
56 REAL, DIMENSION(:) , INTENT(IN) :: pasnow ! snow albedo
57 REAL, DIMENSION(:) , INTENT(IN) :: pveg
58 REAL, DIMENSION(:) , INTENT(IN) :: plai
59 REAL, DIMENSION(:) , INTENT(IN) :: pz0
60 REAL, DIMENSION(:) , INTENT(INOUT):: ppsn
61 REAL, DIMENSION(:) , INTENT(INOUT):: ppsnv_a
62 REAL, DIMENSION(:) , INTENT(INOUT):: ppsng
63 REAL, DIMENSION(:) , INTENT(INOUT):: ppsnv
64 ! PVEG = fraction of vegetation
65 ! PLAI = leaf area index
66 ! PZ0 = roughness length for momentum
67 ! PPSN = grid fraction covered by snow
68 ! PPSNG = fraction of the ground covered by snow
69 ! PPSNV = fraction of the veg covered by snow
70 !
71 !-------------------------------------------------------------------------------
72 !
73 !* 0. Local variables
74 ! ---------------
75 !
76 INTEGER :: jlayer
77 REAL, DIMENSION(SIZE(PVEG)) :: zsnowswe
78 REAL, DIMENSION(SIZE(PVEG)) :: zsnowd
79 REAL, DIMENSION(SIZE(PVEG)) :: zsnowrho
80 REAL(KIND=JPRB) :: zhook_handle
81 !
82 !-------------------------------------------------------------------------------
83 !
84 IF (lhook) CALL dr_hook('ISBA_SNOW_FRAC',0,zhook_handle)
85 !
86 !* 1. Compute Total SWE (kg m-2) and snowpack average density (kg m-3)
87 ! ----------------------------------------------------------------
88 !
89 zsnowswe(:) = 0.
90 !
91 DO jlayer=1,SIZE(pwsnow,2)
92  zsnowswe(:) = zsnowswe(:) + pwsnow(:,jlayer)
93 END DO
94 !
95 IF (hsnow == '3-L' .OR. hsnow == 'CRO') THEN
96  zsnowd(:) = 0.
97  DO jlayer=1,SIZE(pwsnow,2)
98  zsnowd(:) = zsnowd(:) + pwsnow(:,jlayer) / prsnow(:,jlayer)
99  END DO
100  zsnowrho(:) = zsnowswe(:)/max(xsnowdmin,zsnowd(:))
101  zsnowrho(:) = max(xrhosmin_es,min(xrhosmax_es,zsnowrho(:)))
102 ELSE
103  zsnowrho(:) = prsnow(:,1)
104 END IF
105 !
106 !* 2. Snow fraction over ground
107 ! -------------------------
108 !
109 IF (hsnow == 'CRO' .OR. hsnow == '3-L') THEN
110  ppsng(:) = min(1.0, zsnowd(:)/xdcrn_expl)
111 ELSE
112  ppsng(:) = snow_frac_ground(zsnowswe)
113 ENDIF
114 !
115 !* 3. Snow fraction over vegetation
116 ! -----------------------------
117 !
118 IF (hsnow == 'EBA' ) THEN
119  ppsnv_a(:) = snow_frac_veg_a(ppsng,plai,pasnow)
120  ppsnv(:) = ppsnv_a(:)
121 ELSE
122  ppsnv(:) = snow_frac_veg(ppsng,zsnowswe,pz0,zsnowrho)
123 ENDIF
124 !
125 !* 4. Total snow fraction
126 ! -------------------
127 !
128 ppsn(:) = snow_frac_nat(zsnowswe,ppsng,ppsnv,pveg)
129 !
130 IF (lsnow_frac_tot) THEN
131  ppsn(:) = min(1.0, zsnowswe(:)/xwcrn_expl)
132  ppsng(:) = ppsn(:)
133  ppsnv(:) = ppsn(:)
134 ENDIF
135 !
136 IF (lhook) CALL dr_hook('ISBA_SNOW_FRAC',1,zhook_handle)
137 !
138 !-------------------------------------------------------------------------------
139 !
140 END SUBROUTINE isba_snow_frac
real function, dimension(size(p_lai)) snow_frac_veg_a(P_PSNG, P_LAI, P_SNOWALB)
real function, dimension(size(pwsnow)) snow_frac_nat(PWSNOW, PPSNG, PPSNV, PVEG)
real function, dimension(size(pwsnow)) snow_frac_veg(PPSNG, PWSNOW, PZ0VEG, PRHOS)
real function, dimension(size(pwsnow)) snow_frac_ground(PWSNOW)
subroutine isba_snow_frac(HSNOW, PWSNOW, PRSNOW, PASNOW, PVEG, PLAI, PZ0, PPSN, PPSNV_A, PPSNG, PPSNV)