-
Notifications
You must be signed in to change notification settings - Fork 3
/
read_config.f90
executable file
·366 lines (292 loc) · 7.4 KB
/
read_config.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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
!***************************************************************
! Copyright (c) 2017 Battelle Memorial Institute
! Licensed under modified BSD License. A copy of this license can be
! found in the LICENSE file in the top level directory of this
! distribution.
!***************************************************************
!
! NAME: mass1
!
! VERSION and DATE: MASS1 v0.75 3/25/1998
!
! PURPOSE: manages mass1 model startup and run for non-dll use
!
! RETURNS:
!
! REQUIRED:
!
! LOCAL VARIABLES:
!
! COMMENTS:
!
!
! MOD HISTORY:
! added read for print_freq; mcr 1/7/98
! added stuff laterla inflows; mcr 3/25/98
!
!
!***************************************************************
!
SUBROUTINE read_config
USE utility
USE file_vars
USE general_vars
USE section_vars
USE point_vars
USE date_vars
USE logicals
IMPLICIT NONE
CHARACTER(LEN=*), PARAMETER :: config_name = 'mass1.cfg'
CHARACTER(LEN=1024) :: msg
INTEGER :: dumlog, dumlog0
INTEGER :: ignored
INTEGER :: line
do_accumulate = .FALSE.
CALL open_existing(config_name, 10, fatal=.TRUE.)
line = 0
READ(10,1000, ERR=110) msg
line = line + 1
1000 FORMAT(a100)
WRITE(*,*) TRIM(msg)
READ(10,*, ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_flow = .true.
ELSE
do_flow = .false.
ENDIF
READ(10,*, ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_latflow = .true.
ELSE
do_latflow = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_gas = .true.
ELSE
do_gas = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_temp = .true.
ELSE
do_temp = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_printout = .true.
ELSE
do_printout = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_gageout = .true.
ELSE
do_gageout = .false.
ENDIF
dumlog0 = 0
READ(10,*,ERR=110)dumlog, dumlog0
line = line + 1
IF(dumlog == 1)THEN
do_profileout = .true.
ELSE
do_profileout = .false.
ENDIF
IF(dumlog0 == 1)THEN
do_accumulate = .true.
ELSE
do_accumulate = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
gas_diffusion = .true.
ELSE
gas_diffusion = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
gas_exchange = .true.
ELSE
gas_exchange = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
temp_diffusion = .true.
ELSE
temp_diffusion = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
temp_exchange = .true.
ELSE
temp_exchange = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_hotstart = .true.
ELSE
do_hotstart = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
do_restart = .true.
ELSE
do_restart = .false.
ENDIF
READ(10,*,ERR=110)dumlog
line = line + 1
IF(dumlog == 1)THEN
print_sections = .true.
ELSE
print_sections = .false.
ENDIF
READ(10,*,ERR=110) ignored ! write_sections
line = line + 1
READ(10,*,ERR=110) ignored ! read_sections
line = line + 1
READ(10,*,ERR=110)units
line = line + 1
units = units + 1
READ(10,*,ERR=110)time_option
line = line + 1
time_option = time_option + 1
READ(10,*,ERR=110)time_units
line = line + 1
time_units = time_units + 1
READ(10,*,ERR=110)channel_length_units
line = line + 1
channel_length_units = channel_length_units + 1
READ(10,*,ERR=110)dsbc_type
line = line + 1
dsbc_type = dsbc_type + 1
READ(10,*,ERR=110)maxlinks
line = line + 1
READ(10,*,ERR=110)maxpoint
line = line + 1
READ(10,*,ERR=110) ignored ! maxtable
line = line + 1
READ(10,*,ERR=110) ignored ! maxtimes
line = line + 1
READ(10,*,ERR=110)total_sections ! overwritten by section_data_count()
line = line + 1
READ(10,*,ERR=110)scalar_steps
line = line + 1
READ(10,*,ERR=110)debug_print
line = line + 1
READ(10,*,ERR=110)filename(2) ! links
line = line + 1
READ(10,*,ERR=110)filename(3) ! points
line = line + 1
READ(10,*,ERR=110)filename(4) ! sections
line = line + 1
READ(10,*,ERR=110)filename(5) ! link BC
line = line + 1
READ(10,*,ERR=110)filename(6) ! initial conditions
line = line + 1
READ(10,*,ERR=110)filename(7) ! output.out
line = line + 1
READ(10,*,ERR=110)filename(9) ! gas transport bc file
line = line + 1
READ(10,*,ERR=110)filename(17) ! temperature bc file
line = line + 1
READ(10,*,ERR=110)filename(18) ! weather bc file
line = line + 1
READ(10,*,ERR=110)filename(10) ! hydro BC file
line = line + 1
READ(10,*,ERR=110)filename(11) ! TDG coefficients
line = line + 1
READ(10,*,ERR=110)filename(12) ! restart file to read
line = line + 1
READ(10,*,ERR=110)filename(13) ! hotstart file to write
line = line + 1
READ(10,*,ERR=110)filename(14) ! gage control
line = line + 1
READ(10,*,ERR=110)filename(15) ! profile control
line = line + 1
READ(10,*,ERR=110)filename(16) ! lateral inflow data file
line = line + 1
READ(10,*,ERR=110)date_run_begins
line = line + 1
READ(10,*,ERR=110)time_run_begins
line = line + 1
READ(10,*,ERR=110)date_run_ends
line = line + 1
READ(10,*,ERR=110)time_run_ends
line = line + 1
msg = ""
READ(10,*,ERR=110) delta_t, msg
line = line + 1
! make sure delta_t is in hours
IF (LEN(TRIM(msg)) .EQ. 0) THEN
! assume it's in hours
ELSE IF (msg(1:2) .EQ. 'hr') THEN
! assume it's in hours
ELSE IF (msg(1:3) .EQ. 'min') THEN
delta_t = delta_t / 60.0
ELSE IF (msg(1:3) .EQ. 'day') THEN
delta_t = delta_t * 24.0
ELSE IF (msg(1:3) .EQ. 'sec') THEN
delta_t = delta_t / 3600.0
ELSE
WRITE(msg, *) 'time step units (', TRIM(msg), ') not understood'
CALL error_message(msg, fatal=.FALSE.)
GOTO 110
END IF
READ(10,*,ERR=110)print_freq
line = line + 1
CLOSE(10)
! Some things that need to be set, but are not read (yet)
depth_minimum = 0.005 ! m
depth_threshold = 0.0500 ! m
depth_minimum = 0.003 ! m
depth_threshold = 0.100 ! m
IF(debug_print == 1)THEN
OPEN(11,file='debug.txt')
WRITE(11,*)'units : ',units
WRITE(11,*)'time_option : ',time_option
WRITE(11,*)time_units
WRITE(11,*)channel_length_units
WRITE(11,*)dsbc_type
WRITE(11,*)maxlinks
WRITE(11,*)maxpoint
WRITE(11,*)'maxtable ignored'
WRITE(11,*)'maxtimes ignored'
WRITE(11,*)total_sections
WRITE(11,*)scalar_steps
WRITE(11,*)debug_print
WRITE(11,*)'accumulate: ', do_accumulate
WRITE(11,*)'done reading logicals and ints'
WRITE(11,*)filename(2)
WRITE(11,*)filename(3)
WRITE(11,*)filename(4)
WRITE(11,*)filename(5)
WRITE(11,*)filename(6)
WRITE(11,*)filename(7)
WRITE(11,*)filename(9)
WRITE(11,*)filename(10)
WRITE(11,*)filename(11)
WRITE(11,*)filename(12)
WRITE(11,*)filename(13)
WRITE(11,*)filename(14)
WRITE(11,*)filename(15)
WRITE(11,*)filename(16)
WRITE(11,*)'delta_t : ',delta_t
ENDIF
RETURN
110 CONTINUE
WRITE (msg, *) TRIM(config_name), ': line ', line, ': read error'
CALL error_message(msg, .TRUE.)
RETURN
END SUBROUTINE read_config