-
Notifications
You must be signed in to change notification settings - Fork 0
/
cal_parmchg_read.f90
157 lines (137 loc) · 6.1 KB
/
cal_parmchg_read.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
154
155
156
157
subroutine cal_parmchg_read
!! ~ ~ ~ PURPOSE ~ ~ ~
!! this function computes new paramter value based on
!! user defined change
!! ~ ~ ~ INCOMING VARIABLES ~ ~ ~
!! name |units |definition
!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!! val_cur |variable |current parameter value
!! |the standard temperature (20 degrees C)
!! chg |data type |contains information on variable change
!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~
!! name |units |definition
!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!! chg_par |variable |new parameter value
!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
use input_file_module
use maximum_data_module
use calibration_data_module
use hydrograph_module
implicit none
!integer, dimension (:), allocatable :: elem_cnt1 ! |
character (len=80) :: titldum ! |title of file
character (len=80) :: header ! |header of file
integer :: eof ! |end of file
integer :: imax !none |determine max number for array (imax) and total number in file
integer :: nspu ! |
logical :: i_exist !none |check to determine if file exists
integer :: i !none |counter
integer :: ie !none |counter
integer :: mcal ! |
integer :: isp !none |counter
integer :: ical !none |counter
integer :: ipar ! |
integer :: ielem1 !none |counter
integer :: nconds !none |counter
integer :: icond !none |counter
imax = 0
mcal = 0
!!read parameter change values for calibration
inquire (file=in_chg%cal_upd, exist=i_exist)
if (.not. i_exist .or. in_chg%cal_upd == "null") then
allocate (cal_upd(0:0))
else
do
open (107,file=in_chg%cal_upd)
read (107,*,iostat=eof) titldum
if (eof < 0) exit
read (107,*,iostat=eof) mcal
allocate (cal_upd(mcal))
if (eof < 0) exit
read (107,*,iostat=eof) header
if (eof < 0) exit
do i = 1, mcal
read (107,*,iostat=eof) cal_upd(i)%name, cal_upd(i)%chg_typ, cal_upd(i)%val, cal_upd(i)%conds, &
cal_upd(i)%lyr1, cal_upd(i)%lyr2, cal_upd(i)%year1, cal_upd(i)%year2, cal_upd(i)%day1, &
cal_upd(i)%day2, nspu
if (eof < 0) exit
if (nspu > 0) then
backspace (107)
allocate (elem_cnt(nspu))
read (107,*,iostat=eof) cal_upd(i)%name, cal_upd(i)%chg_typ, cal_upd(i)%val, cal_upd(i)%conds, &
cal_upd(i)%lyr1, cal_upd(i)%lyr2, cal_upd(i)%year1, cal_upd(i)%year2, cal_upd(i)%day1, &
cal_upd(i)%day2, cal_upd(i)%num_tot, (elem_cnt(isp), isp = 1, nspu)
if (eof < 0) exit
end if
!! crosswalk name with calibration parameter db
do ical = 1, db_mx%cal_parms
if (cal_upd(i)%name == cal_parms(ical)%name) then
cal_upd(i)%num_db = ical
exit
end if
end do
!! allocate and read the conditions
nconds = cal_upd(i)%conds
if (nconds > 0) then
allocate (cal_upd(i)%cond(nconds))
do icond = 1, nconds
read (107,*,iostat=eof) cal_upd(i)%cond(icond)
end do
end if
!!if no objects are specified - check all of them
if (cal_upd(i)%num_tot == 0) then
ipar = cal_upd(i)%num_db
select case (cal_parms(ipar)%ob_typ)
case ("hru")
cal_upd(i)%num_elem = sp_ob%hru
case ("rdt")
cal_upd(i)%num_elem = db_mx%dtbl_res
case ("plt")
cal_upd(i)%num_elem = sp_ob%hru
case ("lyr")
cal_upd(i)%num_elem = sp_ob%hru
case ("sol")
cal_upd(i)%num_elem = sp_ob%hru
case ("hlt")
cal_upd(i)%num_elem = sp_ob%hru_lte
case ("ru")
cal_upd(i)%num_elem = sp_ob%ru
case ("aqu")
cal_upd(i)%num_elem = sp_ob%aqu
case ("cha")
cal_upd(i)%num_elem = sp_ob%chan
case ("swq")
cal_upd(i)%num_elem = sp_ob%chan
case ("res")
cal_upd(i)%num_elem = sp_ob%res
case ("sdc")
cal_upd(i)%num_elem = sp_ob%chandeg
case ("rte")
cal_upd(i)%num_elem = sp_ob%chandeg
case ("bsn")
cal_upd(i)%num_elem = 1
case ("pcp")
cal_upd(i)%num_elem = db_mx%pcpfiles
case ("tmp")
cal_upd(i)%num_elem = db_mx%tmpfiles
end select
allocate (cal_upd(i)%num(cal_upd(i)%num_elem))
do ie = 1, cal_upd(i)%num_elem
cal_upd(i)%num(ie) = ie
end do
else
call define_unit_elements (nspu, ielem1)
allocate (cal_upd(i)%num(ielem1))
cal_upd(i)%num = defunit_num
cal_upd(i)%num_elem = ielem1
deallocate (defunit_num)
end if
end do
exit
end do
end if
db_mx%cal_upd = mcal
return
end subroutine cal_parmchg_read