-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathres_weir_release.f90
122 lines (109 loc) · 4.53 KB
/
res_weir_release.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
subroutine res_weir_release (jres, id, ihyd, pvol_m3, evol_m3, dep, weir_hgt)
use reservoir_data_module
use reservoir_module
use conditional_module
use climate_module
use time_module
use hydrograph_module
use water_body_module
use soil_module
use hru_module
use water_allocation_module
use basin_module
implicit none
real, intent (in) :: pvol_m3
real, intent (in) :: evol_m3
real, intent (in) :: dep !m
real, intent (in) :: weir_hgt !m |height of weir overflow crest from reservoir bottom
integer, intent (in) :: jres !none |hru number
integer :: iweir !none |weir ID
integer :: nstep !none |counter
integer :: tstep !none |hru number
integer :: iac !none |counter
integer :: ic !none |counter
integer :: weir_flg=0 !none |counter
integer, intent (in) :: id !none |hru number
integer :: ial !none |counter
integer :: irel ! |
integer :: iob !none |hru or wro number
integer, intent (in) :: ihyd ! |
real :: vol ! |
real :: b_lo ! |
character(len=1) :: action ! |
real :: res_h !m |water depth
real :: demand !m3 |irrigation demand by hru or wro
real :: wsa1 !m2 |water surface area
real :: qout !m3 |weir discharge during short time step
real :: hgt !m |height of bottom of weir above bottom of impoundment
real :: hgt_above !m |height of water above the above bottom of weir
real :: sto_max !m3 |maximum storage volume at the bank top
!! store initial values
vol = wbody%flo
nstep = 1
iweir = bsn_cc%cn
if (wet_hyd(ihyd)%name=='paddy') then
!paddy
wsa1 = hru(jres)%area_ha * 10000.
else
!wetland
wsa1 = wbody_wb%area_ha * 10000. !m2
endif
hgt_above = max(0., dep - weir_hgt) !m ponding depth above weir crest
!sto_max = wsa1 * weir_hgt !m3
!if (vol > sto_max) then
! ht2%flo = vol - sto_max
! vol = sto_max
!endif
!write(*,'(10f10.1)') w%precip,vol/wsa1*1000,ht2%flo/wsa1*1000,hru(jres)%water_seep,soil(jres)%sw
!! check if reservoir decision table has a weir discharge command
do iac = 1, dtbl_res(id)%acts
if (dtbl_res(id)%act(iac)%option == "weir") then
weir_flg = 1
exit
endif
end do
do tstep = 1, nstep
!emergency spillway discharge Jaehak 2023
if (vol>evol_m3) then
ht2%flo = ht2%flo + (wbody%flo - evol_m3)
ht2%flo = max(0.,ht2%flo)
vol = evol_m3
res_h = vol / wsa1 !m
hgt_above = max(0.,res_h - weir_hgt) !m
endif
if (nstep>1) then !revised by Jaehak 2023
qout = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s
qout = max(0.,86400. / nstep * qout) !m3
if (qout > vol) then
ht2%flo = ht2%flo + vol !weir discharge volume for the day, m3
vol = 0.
else
ht2%flo = ht2%flo + qout
vol = vol - qout
end if
res_h = vol / wsa1 !m
hgt_above = max(0.,res_h - weir_hgt) !m Jaehak 2022
if (vol==0.or.hgt_above==0) exit
else
do ic = 1, 24
qout = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s
qout = 3600. * qout !m3
if (qout > vol) then
ht2%flo = ht2%flo + vol !weir discharge volume for the day, m3
vol = 0.
else
ht2%flo = ht2%flo + qout
vol = vol - qout
end if
if (wsa1 > 1.e-6) then
res_h = vol / wsa1 !m
else
res_h = 0.
end if
hgt_above = max(0.,res_h - weir_hgt) !m Jaehak 2022
if (vol==0.or.hgt_above==0) exit
end do
endif
end do
return
end subroutine res_weir_release