-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathch_read_orders_cal.f90
153 lines (139 loc) · 5.46 KB
/
ch_read_orders_cal.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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
subroutine ch_read_orders_cal
use input_file_module
use maximum_data_module
use calibration_data_module
use hydrograph_module
use sd_channel_module
implicit none
character (len=80) :: titldum ! |title of file
character (len=80) :: header ! |header of file
integer :: eof ! |end of file
integer :: ihru ! |number of hrus
logical :: i_exist ! |check to determine if file exists
integer :: imax ! |determine max number for array (imax) and total number in file
integer :: mcal !units |description
integer :: mreg !units |description
integer :: i !none |counter
integer :: nspu !units |description
integer :: isp !none |counter
integer :: ielem !none |counter
integer :: ii !none |counter
integer :: ie !none |counter
integer :: ie1 !beginning of loop
integer :: ie2 !ending of loop
integer :: iord_mx !ending of loop
integer :: iord !none |counter
integer :: ich_s !none |counter
imax = 0
mcal = 0
mreg = 0
inquire (file=in_chg%ch_sed_budget_sft, exist=i_exist)
if (.not. i_exist .or. in_chg%ch_sed_budget_sft == "null") then
allocate (chcal(0:0))
else
do
open (107,file=in_chg%ch_sed_budget_sft)
read (107,*,iostat=eof) titldum
if (eof < 0) exit
read (107,*,iostat=eof) mreg
if (eof < 0) exit
read (107,*,iostat=eof) header
if (eof < 0) exit
allocate (chcal(mreg))
do i = 1, mreg
read (107,*,iostat=eof) chcal(i)%name, chcal(i)%ord_num, nspu
if (eof < 0) exit
if (nspu > 0) then
allocate (elem_cnt(nspu))
backspace (107)
read (107,*,iostat=eof) chcal(i)%name, chcal(i)%ord_num, nspu, (elem_cnt(isp), isp = 1, nspu)
if (eof < 0) exit
!!save the object number of each defining unit
ielem = 0
do ii = 1, nspu
ie1 = elem_cnt(ii)
if (ii == nspu) then
ielem = ielem + 1
else
if (elem_cnt(ii+1) < 0) then
ie2 = abs(elem_cnt(ii+1))
do ie = ie1, ie2
ielem = ielem + 1
end do
if (ii+1 == nspu) exit
else
ielem = ielem + 1
end if
end if
if (ii == nspu .and. elem_cnt(ii) < 0) exit
end do
allocate (chcal(i)%num(ielem))
chcal(i)%num_tot = ielem
ielem = 0
ii = 1
do while (ii <= nspu)
ie1 = elem_cnt(ii)
if (ii == nspu) then
ielem = ielem + 1
ii = ii + 1
chcal(i)%num(ielem) = ie1
else
ie2 = elem_cnt(ii+1)
if (ie2 > 0) then
ielem = ielem + 1
chcal(i)%num(ielem) = ie1
ielem = ielem + 1
chcal(i)%num(ielem) = ie2
else
ie2 = abs(ie2)
do ie = ie1, ie2
ielem = ielem + 1
chcal(i)%num(ielem) = ie
end do
end if
ii = ii + 2
end if
end do
deallocate (elem_cnt)
else
!!all channels are in region
allocate (chcal(i)%num(sp_ob%chandeg))
chcal(i)%num_tot = sp_ob%chandeg
do ich = 1, sp_ob%chandeg
chcal(i)%num(ich) = ich
end do
end if
!! read channel soft calibration data for each land use
read (107,*,iostat=eof) header
if (eof < 0) exit
if (chcal(i)%ord_num > 0) then
iord_mx = chcal(i)%ord_num
allocate (chcal(i)%ord(iord_mx))
do iord = 1, iord_mx
read (107,*,iostat=eof) chcal(i)%ord(iord)%meas
if (eof < 0) exit
! set hru number from element number and set hru areas in the region
if (db_mx%cha_reg > 0) then
do ihru = 1, ccu_reg(i)%num_tot !elements have to be hru or hru_lte
ielem = ccu_reg(i)%num(ihru)
!switch %num from element number to hru number
ccu_cal(i)%num(ihru) = ccu_elem(ielem)%obtypno
ccu_cal(i)%hru_ha(ihru) = ccu_elem(ielem)%ru_frac * ccu_cal(i)%area_ha
end do
end if
!! sum total channel length for
do ich_s = 1, chcal(i)%num_tot
ich = chcal(i)%num(ich_s)
if (chcal(i)%ord(iord)%meas%name == sd_ch(ich)%order) then
chcal(i)%ord(iord)%length = chcal(i)%ord(iord)%length + sd_ch(ich)%chl
end if
end do
end do
end if
end do
exit
end do
end if
db_mx%ch_reg = mreg
return
end subroutine ch_read_orders_cal