UPP  V11.0.0
 All Data Structures Files Functions Pages
SNFRAC.f
1  SUBROUTINE snfrac (SNEQV,IVEGx,SNCOVR)
2 
3 !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4  implicit none
5  include 'mpif.h'
6 
7 ! ----------------------------------------------------------------------
8 ! SUBROUTINE SNFRAC
9 ! ----------------------------------------------------------------------
10 ! CALCULATE SNOW FRACTION (0 -> 1)
11 ! SNEQV SNOW WATER EQUIVALENT (M)
12 ! IVEG VEGETATION TYPE
13 ! SNCOVR FRACTIONAL SNOW COVER
14 ! SNUP THRESHOLD SNEQV DEPTH ABOVE WHICH SNCOVR=1
15 ! SALP TUNING PARAMETER
16 ! ----------------------------------------------------------------------
17  integer,intent(in) :: ivegx
18  REAL,intent(in) :: sneqv
19  REAL,intent(out) :: sncovr
20  REAL salp,snup(20),rsnow
21  integer iveg
22 
23  DATA salp /4.0/
24  DATA snup /0.080, 0.080, 0.080, 0.080, 0.080, 0.020, &
25  & 0.020, 0.060, 0.040, 0.020, 0.010, 0.020, &
26  & 0.020, 0.020, 0.013, 0.013, 0.010, 0.020, &
27  & 0.020, 0.020/
28 
29 ! ----------------------------------------------------------------------
30 ! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD ABOVE WHICH SNOCVR=1.
31 ! ----------------------------------------------------------------------
32 !jjt
33  iveg = ivegx
34  IF ( iveg > 20 .or. iveg < 1 ) then
35 ! print *, ' PROBLEM in SNFRAC, IVEG = ',iveg
36  iveg = 1
37  END IF
38  IF (sneqv < snup(iveg)) THEN
39  rsnow = sneqv/snup(iveg)
40  sncovr = 1. - (exp(-salp*rsnow) - rsnow*exp(-salp))
41  ELSE
42  sncovr = 1.0
43  ENDIF
44  sncovr = max(0.,min(sncovr,1.))
45 
46  RETURN
47  END