7 snowUse, qn1, qf, qs, Qm, Temp_C, Veg_Fr, avcp, Press_hPa, lv_J_kg, &
8 tstep_real, DRAINRT, nsh_real, &
9 Precip, RainMaxRes, RAINCOVER, sfr, LAI_id_prev, LAImax, LAImin, &
11 QE_LUMPS, psyc_hPa, s_hPa, sIce_hpa, Veg_Fr_temp, VegPhenLumps)
27 INTEGER,
PARAMETER::ndays = 366
28 INTEGER,
PARAMETER::NSurf = 7
29 INTEGER,
PARAMETER::NVegSurf = 3
30 INTEGER,
PARAMETER::ivConif = 1
31 INTEGER,
PARAMETER::ivGrass = 3
33 INTEGER,
INTENT(in) :: veg_type
34 INTEGER,
INTENT(in) :: snowUse
36 REAL(KIND(1d0)),
INTENT(in) :: qn1
37 REAL(KIND(1d0)),
INTENT(in) :: qf
38 REAL(KIND(1d0)),
INTENT(in) :: qs
39 REAL(KIND(1d0)),
INTENT(in) :: Qm
40 REAL(KIND(1d0)),
INTENT(in) :: Temp_C
41 REAL(KIND(1d0)),
INTENT(in) :: Veg_Fr
42 REAL(KIND(1d0)),
INTENT(in) :: avcp
43 REAL(KIND(1d0)),
INTENT(in) :: Press_hPa
44 REAL(KIND(1d0)),
INTENT(in) :: lv_J_kg
45 REAL(KIND(1d0)),
INTENT(in) :: tstep_real
46 REAL(KIND(1d0)),
INTENT(in) :: DRAINRT
47 REAL(KIND(1d0)),
INTENT(in) :: nsh_real
48 REAL(KIND(1d0)),
INTENT(in) :: Precip
49 REAL(KIND(1d0)),
INTENT(in) :: RainMaxRes
50 REAL(KIND(1d0)),
INTENT(in) :: RAINCOVER
52 REAL(KIND(1d0)),
DIMENSION(nsurf),
INTENT(in) :: sfr
53 REAL(KIND(1D0)),
DIMENSION(NVEGSURF),
INTENT(in) :: LAI_id_prev
54 REAL(KIND(1d0)),
DIMENSION(3),
INTENT(in) :: LAImax
55 REAL(KIND(1d0)),
DIMENSION(3),
INTENT(in) :: LAImin
57 REAL(KIND(1d0)),
INTENT(out) ::QH_LUMPS
58 REAL(KIND(1d0)),
INTENT(out) ::QE_LUMPS
59 REAL(KIND(1d0)),
INTENT(out) ::psyc_hPa
60 REAL(KIND(1d0)),
INTENT(out) ::s_hPa
61 REAL(KIND(1d0)),
INTENT(out) ::sIce_hpa
62 REAL(KIND(1d0)),
INTENT(out) ::Veg_Fr_temp
63 REAL(KIND(1d0)),
INTENT(out) ::VegPhenLumps
66 REAL(KIND(1d0)),
DIMENSION(3) :: sfrVeg
67 REAL(KIND(1d0))::VegPhen, VegMax, VegMin, &
71 alpha_qhqe, RAINRES, RainBucket, tlv
72 REAL(KIND(1d0)),
PARAMETER::NAN = -999
74 tlv = lv_j_kg/tstep_real
82 sfrveg = sfr(ivconif + 2:ivgrass + 2)
86 psyc_hpa =
psyc_const(avcp, press_hpa, lv_j_kg)
87 psyc_s = psyc_hpa/s_hpa
91 IF (snowuse == 1)
THEN 97 psyc_s = psyc_hpa/sice_hpa
120 vegphen = dot_product(sfrveg, lai_id_prev)
121 vegmax = dot_product(sfrveg, laimax)
122 vegmin = dot_product(sfrveg, laimin)
130 IF (vegmax <= 0.01000)
THEN 133 vegphenlumps = (vegphen)/(vegmax)
134 veg_fr_temp = veg_fr*vegphenlumps
141 IF (veg_fr_temp > 0.9000)
THEN 142 beta = (20 - 3)*veg_fr_temp + 3
143 alpha_qhqe = veg_fr_temp*0.8 + 0.2
146 IF (veg_type == 1)
THEN 149 ELSEIF (veg_type == 2)
THEN 153 alpha_qhqe = veg_fr_temp*alpha_sl + alpha_in
157 qh_lumps = ((1 - alpha_qhqe) + psyc_s)/(1 + psyc_s)*(qn1 + qf - qs - qm) - beta
159 if (qh_lumps == nan) qh_lumps = qn1*0.2
160 qe_lumps = (alpha_qhqe/(1 + psyc_s)*(qn1 + qf - qs - qm)) + beta
164 IF (qe_lumps > 0.) rainbucket = rainbucket - qe_lumps/tlv
165 IF (temp_c > 0.) rainbucket = rainbucket - drainrt/nsh_real
166 IF (rainbucket < 0.) rainbucket = 0.
167 IF (precip > 0) rainbucket = min(rainmaxres, rainbucket + precip)
170 IF (rainres > raincover) rainres = raincover
real(kind(1d0)) function slope_svp(temp_C)
subroutine lumps_cal_qhqe(veg_type, snowUse, qn1, qf, qs, Qm, Temp_C, Veg_Fr, avcp, Press_hPa, lv_J_kg, tstep_real, DRAINRT, nsh_real, Precip, RainMaxRes, RAINCOVER, sfr, LAI_id_prev, LAImax, LAImin, QH_LUMPS, QE_LUMPS, psyc_hPa, s_hPa, sIce_hpa, Veg_Fr_temp, VegPhenLumps)
real(kind(1d0)) function slopeice_svp(temp_C)
real(kind(1d0)) function psyc_const(cp, Press_hPa, lv_J_kg)