UPP  V11.0.0
 All Data Structures Files Functions Pages
ETCALC.f
1  SUBROUTINE etcalc(ETA,ETP,ESD,VEGFAC,ISOIL,SMC,CMC, &
2  & ec,edir,etrans,esnow,smcdry,smcmax)
3 ! ----------------------------------------------------------------------
4 ! PROGRAM HISTORY LOG:
5 ! 03-01-17 M EK AND H CHUANG - LIFTED IT FROM MODEL FOR POST
6 ! ----------------------------------------------------------------------
7 ! DETERMINE INDIVIDUAL COMPONENTS OF SURFACE EVAPORATION
8 ! INPUT:
9 ! ETA = TOTAL SURFACE EVAPORATION (W/m2)
10 ! ETP = POTENTIAL EVAPORATION (W/m2)
11 ! ESD = WATER EQUIVALENT SNOW DEPTH (m)
12 ! VEGFAC = GREEN VEGETATION FRACTION (fraction ...or percent?)
13 ! ISOIL = SOIL TYPE (1-19)
14 ! SMC = UPPER SOIL LAYER (0-10 CM) SOIL MOISTURE (VOLUMETRIC)
15 ! CMC = CANOPY WATER CONTENT (m)
16 ! OUTPUT:
17 ! EC = EVAPORATION OF CANOPY WATER (W/m2)
18 ! EDIR = DIRECT SOIL EVAPORATION (W/m2)
19 ! ETRANS = TRANSPIRATION (W/m2)
20 ! ESNOW = SNOW SUBLIMATION (W/m2)
21 ! ----------------------------------------------------------------------
22  implicit none
23 !
24  integer,parameter :: nosoiltype=19
25 !jw
26  integer,intent(in) :: isoil
27  real,intent(in) :: eta,etp,esd,vegfac,smc
28  real,intent(inout) :: cmc
29  real,intent(out) :: ec,edir,etrans,esnow
30  real smcdry,smcmax,sratio,cmcmax,cfactr
31  real fx,fxexp,spatio
32  REAL smdry(nosoiltype),smmax(nosoiltype)
33 
34  DATA cfactr,cmcmax /0.5,0.5e-3/
35 ! ----------------------------------------------------------------------
36 ! SOIL TYPES ZOBLER (1986), COSBY ET AL (1984)
37 ! 1 SAND
38 ! 2 LOAMY SAND
39 ! 3 SANDY LOAM
40 ! 4 SILT LOAM
41 ! 5 SILT
42 ! 6 LOAM
43 ! 7 SANDY CLAY LOAM
44 ! 8 SILTY CLAY LOAM
45 ! 9 CLAY LOAM
46 ! 10 SANDY CLAY
47 ! 11 SILTY CLAY
48 ! 12 CLAY
49 ! 13 ORGANIC MATERIAL
50 ! 14 WATER
51 ! 15 BEDROCK
52 ! 16 OTHER(land-ice)
53 ! 17 PLAYA
54 ! 18 LAVA
55 ! 19 WHITE SAND
56 ! ----------------------------------------------------------------------
57  DATA smdry /0.023, 0.028, 0.047, 0.084, 0.084, 0.066, &
58  & 0.069, 0.120, 0.103, 0.100, 0.126, 0.135, &
59  & 0.069, 0.000, 0.012, 0.028, 0.135, 0.012, &
60  & 0.023/
61 !
62  DATA smmax /0.395, 0.421, 0.434, 0.476, 0.476, 0.439, &
63  & 0.404, 0.464, 0.465, 0.406, 0.468, 0.457, &
64  & 0.464, 0.000, 0.200, 0.421, 0.457, 0.200, &
65  & 0.395/
66 !
67  DATA fxexp /2.0/
68 
69 ! ----------------------------------------------------------------------
70 ! INITIALIZE EVAPORATION COMPONENTS
71 ! ----------------------------------------------------------------------
72  ec = 0.0
73  edir = 0.0
74  etrans = 0.0
75  esnow = 0.0
76 
77 ! ----------------------------------------------------------------------
78 ! SET SMCDRY AND SMCMAX VALUES
79 ! ----------------------------------------------------------------------
80  smcdry = smdry(isoil)
81  smcmax = smmax(isoil)
82 
83 ! ----------------------------------------------------------------------
84 ! DETERMINE INDIVIDUAL COMPONENTS OF EVAPORATION
85 ! NO SURFACE EVAPORATION COMPONENTS IF POTENTIAL (ETP)<0
86 ! IF SNOW ON THE GROUND (ESD>0), ALL EVAPORATION IS SNOW SUBLIMATION,
87 ! ELSE IT IT A SUM OF CANOPY EVAP, DIRECT SOIL EVAP AND TRANSPIRATION
88 ! ----------------------------------------------------------------------
89  IF (etp > 0.) THEN
90  IF (esd > 0.) THEN
91  esnow = eta
92  ELSE
93 
94 ! ----------------------------------------------------------------------
95 ! CANOPY EVAPORATION
96 ! ----------------------------------------------------------------------
97  IF (cmc > 0) THEN
98  IF (cmc > cmcmax) cmc = cmcmax
99  ec = vegfac*((cmc/cmcmax)**cfactr)*etp
100  ENDIF
101 
102 ! ----------------------------------------------------------------------
103 ! DIRECT SOIL EVAPORATION A FUNCTION OF RELATIVE SOIL MOISTURE
104 ! AVAILABILITY, LINEAR WHEN FXEXP=1.
105 ! ----------------------------------------------------------------------
106  sratio = (smc-smcdry)/(smcmax-smcdry)
107  IF (sratio > 0.) THEN
108  fx = sratio**fxexp
109  fx = max(0.,min(fx,1.))
110  ELSE
111  fx = 0.
112  ENDIF
113  edir = fx*(1.0-vegfac)*etp
114 
115 ! ----------------------------------------------------------------------
116 ! CALCULATE TRANSPIRATION AS A RESIDUAL OF THE TOTAL MINUS EDIR AND EC
117 ! ----------------------------------------------------------------------
118  etrans = eta - edir - ec
119  ENDIF
120  IF (etrans < 0.) etrans = 0.
121 
122  ENDIF
123 
124  RETURN
125  END