GCC Code Coverage Report


Directory: src/athena/
File: src/athena/athena_tools_infile.f90
Date: 2026-04-15 16:08:59
Exec Total Coverage
Lines: 145 177 81.9%
Functions: 0 0 -%
Branches: 267 487 54.8%

Line Branch Exec Source
1 module athena__tools_infile
2 !! Module containing custom input file reading functions and subroutines
3 !!
4 !! This module contains custom input file reading functions and subroutines
5 !! for reading and assigning values from a file.
6 !! Code copied from ARTEMIS with permission of the authors
7 !! Ned Thaddeus Taylor and Francis Huw Davies
8 !! https://github.com/ExeQuantCode/ARTEMIS
9 use coreutils, only: real32, grep, icount, stop_program
10 implicit none
11
12
13 private
14
15 public :: get_val
16 public :: assign_val, assign_vec, allocate_and_assign_vec
17 public :: getline, rm_comments
18 public :: stop_check
19 public :: move
20
21
22 interface assign_val
23 !! Interface for assigning a value to a variable
24 procedure assignI, assignR, assignS, assignL
25 end interface assign_val
26
27 interface assign_vec
28 !! Interface for assigning a vector to a variable
29 procedure assignIvec, assignRvec
30 end interface assign_vec
31
32 interface allocate_and_assign_vec
33 !! Interface for allocating and assigning a vector to a variable
34 procedure allocate_and_assignRvec
35 end interface allocate_and_assign_vec
36
37
38 contains
39
40 !###############################################################################
41 function get_val(buffer, fs) result(output)
42 !! Extract the section of buffer that occurs after the field separator fs
43 implicit none
44
45 ! Arguments
46 character(*), intent(in) :: buffer
47 !! Input buffer
48 character(1), intent(in), optional :: fs
49 !! Field separator
50
51 ! Local variables
52 character(:), allocatable :: output
53 !! Extracted value
54 character(1) :: fs_
55 !! Field separator
56
57 171 fs_ = '='
58
2/2
✓ Branch 0 taken 161 times.
✓ Branch 1 taken 10 times.
171 if(present(fs)) fs_ = fs
59
60
6/14
✓ Branch 0 taken 171 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 171 times.
✓ Branch 7 taken 171 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✓ Branch 11 taken 171 times.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✓ Branch 14 taken 171 times.
✓ Branch 15 taken 171 times.
✗ Branch 16 not taken.
171 output = trim(adjustl(buffer((scan(buffer, fs_) + 1):)))
61 342 end function get_val
62 !###############################################################################
63
64
65 !###############################################################################
66 1 subroutine getline(unit, pattern, buffer)
67 !! Get the line from a grep and assign it to buffer
68 implicit none
69
70 ! Arguments
71 integer, intent(in) :: unit
72 !! Unit to read from
73 character(*), intent(in) :: pattern
74 !! Pattern to grep for
75 character(*), intent(out) :: buffer
76 !! Buffer to assign line to
77
78 ! Local variables
79 integer :: iostat
80 !! I/O status
81
82 1 call grep(unit, pattern)
83 1 backspace(unit)
84 1 read(unit, '(A)', iostat=iostat) buffer
85
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 171 times.
172 end subroutine getline
86 !###############################################################################
87
88
89 !###############################################################################
90 subroutine assignI(buffer, variable, found, keyword, fs)
91 !! Assign an integer to variable
92 implicit none
93
94 ! Arguments
95 character(*), intent(inout) :: buffer
96 !! Input buffer
97 integer, intent(out) :: variable
98 !! Variable to assign data to
99 integer, intent(inout) :: found
100 !! Count for finding variable
101 character(*), optional, intent(in) :: keyword
102 !! Keyword to start from
103 character(1), optional, intent(in) :: fs
104 !! Field separator
105
106 ! Local variables
107 character(1024) :: buffer2
108 !! Temporary buffer
109 character(1) :: fs_
110 !! Field separator
111
112 50 fs_ = '='
113
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 50 times.
50 if(present(fs)) fs_ = fs
114
115
6/10
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 49 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 7 taken 1 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
50 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
116
2/4
✓ Branch 0 taken 50 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 50 times.
✗ Branch 4 not taken.
50 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
117
2/4
✓ Branch 2 taken 50 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 50 times.
✗ Branch 5 not taken.
50 if(trim(adjustl(buffer2)) .ne. '')then
118 50 found = found + 1
119 50 read(buffer2, *) variable
120 end if
121 100 end subroutine assignI
122 !###############################################################################
123
124
125 !###############################################################################
126 54 subroutine assignIvec(buffer, variable, found, keyword, fs)
127 !! Assign an arbitrary length vector of integers to variable
128 implicit none
129
130 ! Arguments
131 character(*), intent(inout) :: buffer
132 !! Input buffer
133 integer, dimension(:), intent(out) :: variable
134 !! Variable to assign data to
135 integer, intent(inout) :: found
136 !! Count for finding variable
137 character(*), optional, intent(in) :: keyword
138 !! Keyword to start from
139 character(1), optional, intent(in) :: fs
140 !! Field separator
141
142 ! Local variables
143 integer :: i
144 !! Loop index
145 character(1024) :: buffer2
146 !! Temporary buffer
147 character(1) :: fs_
148 !! Field separator
149
150 54 fs_ = '='
151
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
54 if(present(fs)) fs_ = fs
152
153
6/10
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 52 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
54 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
154
2/4
✓ Branch 0 taken 54 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 54 times.
✗ Branch 4 not taken.
54 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
155
2/4
✓ Branch 2 taken 54 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54 times.
✗ Branch 5 not taken.
54 if(trim(adjustl(buffer2)) .ne. '')then
156 54 found = found + 1
157
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 54 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 54 times.
✓ Branch 9 taken 16 times.
✓ Branch 10 taken 38 times.
54 if(icount(buffer2) .eq. 1 .and. icount(buffer2) .ne. size(variable))then
158
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 16 times.
16 read(buffer2, *) variable(1)
159
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 16 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 16 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 16 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 16 times.
✓ Branch 12 taken 41 times.
✓ Branch 13 taken 16 times.
57 variable = variable(1)
160 else
161
8/14
✗ Branch 1 not taken.
✓ Branch 2 taken 38 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 38 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 38 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 124 times.
✓ Branch 12 taken 86 times.
✓ Branch 13 taken 38 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 86 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 86 times.
124 read(buffer2, *) (variable(i), i = 1, size(variable))
162 end if
163 end if
164
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 50 times.
✓ Branch 2 taken 54 times.
✗ Branch 3 not taken.
104 end subroutine assignIvec
165 !###############################################################################
166
167
168 !###############################################################################
169 subroutine assignR(buffer, variable, found, keyword, fs)
170 !! Assign a real to variable
171 implicit none
172
173 ! Arguments
174 character(*), intent(inout) :: buffer
175 !! Input buffer
176 real(real32), intent(out) :: variable
177 !! Variable to assign data to
178 integer, intent(inout) :: found
179 !! Count for finding variable
180 character(*), optional, intent(in) :: keyword
181 !! Keyword to start from
182 character(1), optional, intent(in) :: fs
183 !! Field separator
184
185 ! Local variables
186 character(1024) :: buffer2
187 !! Temporary buffer
188 character(1) :: fs_
189 !! Field separator
190
191 13 fs_ = '='
192
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 13 times.
13 if(present(fs)) fs_ = fs
193
194
6/10
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 12 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 7 taken 1 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
13 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
195
2/4
✓ Branch 0 taken 13 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 13 times.
✗ Branch 4 not taken.
13 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
196
2/4
✓ Branch 2 taken 13 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 13 times.
✗ Branch 5 not taken.
13 if(trim(adjustl(buffer2)) .ne. '')then
197 13 found = found + 1
198 13 read(buffer2, *) variable
199 end if
200
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
54 end subroutine assignR
201 !###############################################################################
202
203
204 !###############################################################################
205 2 subroutine assignRvec(buffer, variable, found, keyword, fs)
206 !! Assign an arbitrary length vector of reals to variable
207 implicit none
208
209 ! Arguments
210 character(*), intent(inout) :: buffer
211 !! Input buffer
212 real(real32), dimension(:), intent(out) :: variable
213 !! Variable to assign data to
214 integer, intent(inout) :: found
215 !! Count for finding variable
216 character(*), optional, intent(in) :: keyword
217 !! Keyword to start from
218 character(1), optional, intent(in) :: fs
219 !! Field separator
220
221 ! Local variables
222 integer :: i
223 !! Loop index
224 character(1024) :: buffer2
225 !! Temporary buffer
226 character(1) :: fs_
227 !! Field separator
228
229 2 fs_ = '='
230
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
2 if(present(fs)) fs_ = fs
231
232
5/10
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
2 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
233
2/4
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 2 times.
✗ Branch 4 not taken.
2 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
234
2/4
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
2 if(trim(adjustl(buffer2)) .ne. '')then
235 2 found = found + 1
236
5/8
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 2 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2 times.
✓ Branch 9 taken 1 times.
✓ Branch 10 taken 1 times.
2 if(icount(buffer2) .eq. 1 .and. icount(buffer2) .ne. size(variable))then
237
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
1 read(buffer2, *) variable(1)
238
6/10
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 1 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✓ Branch 12 taken 3 times.
✓ Branch 13 taken 1 times.
4 variable = variable(1)
239 else
240
8/14
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 4 times.
✓ Branch 12 taken 3 times.
✓ Branch 13 taken 1 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 3 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 3 times.
4 read(buffer2, *) (variable(i), i = 1, size(variable))
241 end if
242 end if
243
2/4
✗ Branch 0 not taken.
✓ Branch 1 taken 13 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
15 end subroutine assignRvec
244 !###############################################################################
245
246
247 !###############################################################################
248 subroutine allocate_and_assignRvec(buffer, variable, keyword, fs)
249 !! Allocate and assign an arbitrary length vector of reals to variable
250 implicit none
251
252 ! Arguments
253 character(*), intent(inout) :: buffer
254 !! Input buffer
255 real(real32), dimension(:), allocatable, intent(out) :: variable
256 !! Variable to assign data to
257 character(*), optional, intent(in) :: keyword
258 !! Keyword to start from
259 character(1), optional, intent(in) :: fs
260 !! Field separator
261
262 ! Local variables
263 integer :: i
264 !! Number of values and loop index
265 character(1024) :: buffer2
266 !! Temporary buffer
267 character(1) :: fs_
268 !! Field separator
269 character(1), parameter :: open_brackets(3) = ['[', '(', '{']
270 character(1), parameter :: close_brackets(3) = [']', ')', '}']
271
272 2 fs_ = '='
273
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1 times.
2 if(present(fs)) fs_ = fs
274
275
5/10
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
2 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
276
1/2
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
2 if(scan(buffer, fs_) .ne. 0)then
277
1/2
✓ Branch 1 taken 2 times.
✗ Branch 2 not taken.
2 buffer2 = get_val(buffer, fs_)
278 else
279 buffer2 = buffer
280 end if
281 2 buffer2 = adjustl(buffer2)
282
6/6
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 3 times.
✓ Branch 4 taken 1 times.
✓ Branch 5 taken 1 times.
5 if(any(index(buffer2,open_brackets).eq.1))then
283
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 1 times.
4 do i = 1, size(open_brackets)
284
4/6
✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 3 times.
✓ Branch 6 taken 1 times.
✓ Branch 7 taken 2 times.
4 if(index(buffer2, open_brackets(i)) .eq. 1)then
285 1 buffer2 = buffer2(2:)
286 end if
287 end do
288 end if
289
8/10
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✓ Branch 5 taken 1 times.
✓ Branch 6 taken 1 times.
✓ Branch 7 taken 3 times.
✓ Branch 8 taken 2 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1 times.
✓ Branch 11 taken 1 times.
5 if(any(index(trim(buffer2),close_brackets).eq.len(trim(buffer2))))then
290
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 1 times.
4 do i = 1, size(close_brackets)
291
6/10
✗ Branch 1 not taken.
✓ Branch 2 taken 3 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 3 times.
✓ Branch 8 taken 3 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 3 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1 times.
✓ Branch 13 taken 2 times.
4 if(index(trim(buffer2), close_brackets(i)) .eq. len(trim(buffer2)))then
292
4/8
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
1 buffer2 = buffer2(:len(trim(buffer2))-1)
293 end if
294 end do
295 end if
296 ! count number of values
297 2 i = icount(buffer2)
298
7/14
✓ Branch 0 taken 2 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 2 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✗ Branch 6 not taken.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 2 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 2 times.
✗ Branch 14 not taken.
✓ Branch 15 taken 2 times.
2 allocate(variable(i))
299
5/8
✗ Branch 1 not taken.
✓ Branch 2 taken 7 times.
✓ Branch 3 taken 5 times.
✓ Branch 4 taken 2 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 5 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 5 times.
7 read(buffer2, *) (variable(i), i = 1, size(variable))
300
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
2 end subroutine allocate_and_assignRvec
301 !###############################################################################
302
303
304 !###############################################################################
305 subroutine assignS(buffer, variable, found, keyword, fs)
306 !! Assign a string to variable
307 implicit none
308
309 ! Arguments
310 character(*), intent(inout) :: buffer
311 !! Input buffer
312 character(*), intent(out) :: variable
313 !! Variable to assign data to
314 integer, intent(inout) :: found
315 !! Count for finding variable
316 character(*), optional, intent(in) :: keyword
317 !! Keyword to start from
318 character(1), optional, intent(in) :: fs
319 !! Field separator
320
321 ! Local variables
322 character(1024) :: buffer2
323 !! Temporary buffer
324 character(1) :: fs_
325 !! Field separator
326
327 21 fs_ = '='
328
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21 times.
21 if(present(fs)) fs_ = fs
329
330
6/10
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 19 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
21 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
331
2/4
✓ Branch 0 taken 21 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 21 times.
✗ Branch 4 not taken.
21 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
332
2/4
✓ Branch 2 taken 21 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 21 times.
✗ Branch 5 not taken.
21 if(trim(adjustl(buffer2)) .ne. '')then
333 21 found = found + 1
334 if( &
335 ( &
336
1/2
✓ Branch 1 taken 21 times.
✗ Branch 2 not taken.
21 buffer2(1:1) .eq. '"' .and. &
337 buffer2(len(trim(buffer2)):len(trim(buffer2))) .eq. '"' &
338
11/20
✓ Branch 1 taken 21 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 21 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 21 times.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✓ Branch 9 taken 21 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 21 times.
✓ Branch 13 taken 21 times.
✗ Branch 14 not taken.
✓ Branch 16 taken 21 times.
✗ Branch 17 not taken.
✗ Branch 18 not taken.
✓ Branch 19 taken 21 times.
✗ Branch 20 not taken.
✓ Branch 21 taken 21 times.
✓ Branch 22 taken 1 times.
✓ Branch 23 taken 20 times.
84 ) .or. ( &
339
2/4
✓ Branch 0 taken 21 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 21 times.
✗ Branch 4 not taken.
42 buffer2(1:1) .eq. '''' .and. &
340 buffer2(len(trim(buffer2)):len(trim(buffer2))) .eq. '''' &
341 ) &
342 )then
343
4/8
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
1 buffer2 = buffer2(2:len(trim(buffer2))-1)
344 end if
345 21 read(buffer2, '(A)') variable
346 end if
347
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
2 end subroutine assignS
348 !###############################################################################
349
350
351 !###############################################################################
352 subroutine assignL(buffer, variable, found, keyword, fs)
353 !! Assign a logical to variable (T/t/1 and F/f/0 accepted)
354 implicit none
355
356 ! Arguments
357 character(*), intent(inout) :: buffer
358 !! Input buffer
359 logical, intent(out) :: variable
360 !! Variable to assign data to
361 integer, intent(inout) :: found
362 !! Count for finding variable
363 character(*), optional, intent(in) :: keyword
364 !! Keyword to start from
365 character(1), optional, intent(in) :: fs
366 !! Field separator
367
368 ! Local variables
369 character(1024) :: buffer2
370 !! Temporary buffer
371 character(1) :: fs_
372 !! Field separator
373
374 19 fs_ = '='
375
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 19 times.
19 if(present(fs)) fs_ = fs
376
377
6/10
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 17 times.
✓ Branch 2 taken 2 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 2 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✓ Branch 10 taken 2 times.
19 if(present(keyword)) buffer = buffer(index(buffer, keyword):)
378
2/4
✓ Branch 0 taken 19 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 19 times.
✗ Branch 4 not taken.
19 if(scan(buffer, fs_) .ne. 0) buffer2 = get_val(buffer, fs_)
379
2/4
✓ Branch 2 taken 19 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 19 times.
✗ Branch 5 not taken.
19 if(trim(adjustl(buffer2)) .ne. '')then
380 19 found = found + 1
381 if( &
382 index(buffer2, "T") .ne. 0 .or. &
383
2/2
✓ Branch 0 taken 16 times.
✓ Branch 1 taken 3 times.
19 index(buffer2, "t") .ne. 0 .or. &
384 index(buffer2, "1") .ne. 0 &
385 )then
386 16 variable = .TRUE.
387 end if
388 if( &
389 index(buffer2, "F") .ne. 0 .or. &
390
2/2
✓ Branch 0 taken 3 times.
✓ Branch 1 taken 16 times.
19 index(buffer2, "f") .ne. 0 .or. &
391 index(buffer2, "0") .ne. 0 &
392 )then
393 3 variable = .FALSE.
394 end if
395 end if
396
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21 times.
21 end subroutine assignL
397 !###############################################################################
398
399
400 !###############################################################################
401 4 subroutine rm_comments(buffer, iline)
402 !! Remove comment from a string (anything after ! or #)
403 implicit none
404
405 ! Arguments
406 character(*), intent(inout) :: buffer
407 !! Input buffer
408 integer, optional, intent(in) :: iline
409 !! Line number
410
411 ! Local variables
412 integer :: lbracket, rbracket, iline_
413 !! Bracket positions and line number
414
415 4 iline_ = 0
416 1 if(present(iline)) iline_ = iline
417
418
6/10
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 3 times.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 7 taken 1 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 1 times.
✗ Branch 10 not taken.
4 if(scan(buffer, '!') .ne. 0) buffer = buffer(:(scan(buffer, '!') - 1))
419
7/10
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 2 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✓ Branch 7 taken 2 times.
✗ Branch 8 not taken.
✓ Branch 9 taken 2 times.
✗ Branch 10 not taken.
4 if(scan(buffer, '#') .ne. 0) buffer = buffer(:(scan(buffer, '#') - 1))
420
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1 times.
5 do while(scan(buffer, '(') .ne. 0 .or. scan(buffer, ')') .ne. 0)
421 1 lbracket = scan(buffer, '(', back = .true.)
422
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 rbracket = scan(buffer(lbracket:), ')')
423
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if(lbracket .eq. 0 .or. rbracket .eq. 0)then
424 write(6, '(A,I0)') &
425 ' NOTE: a bracketing error was encountered on line ', iline_
426 buffer = ""
427 return
428 end if
429 1 rbracket = rbracket + lbracket - 1
430
6/12
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✓ Branch 5 taken 1 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✓ Branch 11 taken 1 times.
✗ Branch 12 not taken.
✓ Branch 13 taken 1 times.
✗ Branch 14 not taken.
1 buffer = buffer(:(lbracket - 1)) // buffer((rbracket + 1):)
431 end do
432
3/4
✗ Branch 0 not taken.
✓ Branch 1 taken 19 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 3 times.
23 end subroutine rm_comments
433 !###############################################################################
434
435
436 !###############################################################################
437 1113 function stop_check(file) result(output)
438 !! Logical check for stop file
439 implicit none
440
441 ! Arguments
442 character(*), optional, intent(in) :: file
443 !! File to check for
444
445 ! Local variables
446 integer :: Reason, itmp1, unit
447 !! I/O status, temporary integer, and unit
448 logical :: lfound, output
449 !! File found flag and output
450 character(248) :: file_
451 !! File name
452 character(128) :: buffer, tagname
453 !! Buffer and tag name
454
455 1113 unit = 999
456 1113 file_ = "STOPCAR"
457
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if(present(file)) file_ = file
458
459 1113 output = .false.
460 !! Check if file exists
461
1/2
✓ Branch 2 taken 1113 times.
✗ Branch 3 not taken.
1113 inquire(file = trim(file_), exist = lfound)
462
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1112 times.
1113 if(lfound)then
463 1 itmp1 = 0
464
1/2
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
1 open(unit = unit, file = trim(file_))
465 !! Read line-by-line
466 1 do
467 2 read(unit, '(A)', iostat = Reason) buffer
468
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2 times.
2 if(Reason .ne. 0) exit
469 2 call rm_comments(buffer)
470
4/4
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 1 times.
✓ Branch 3 taken 1 times.
✓ Branch 4 taken 1 times.
2 if(trim(buffer) .eq. "") cycle
471
2/4
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
✗ Branch 5 not taken.
1 tagname = trim(adjustl(buffer))
472
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if(scan(buffer, "=") .ne. 0) &
473
4/8
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✓ Branch 6 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 9 not taken.
1 tagname = trim(tagname(:scan(tagname, "=") - 1))
474 2 select case(trim(tagname))
475 case("LSTOP")
476 1 call assignL(buffer, output, itmp1)
477 1 exit
478 case("LABORT")
479 call assignL(buffer, output, itmp1)
480
2/7
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
2 if(output)then
481 close(unit, status = 'delete')
482 stop "LABORT ENCOUNTERED IN STOP FILE (" // trim(file_) // ")"
483 end if
484 end select
485 end do
486 1 close(unit, status = 'delete')
487 end if
488
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 1112 times.
2226 end function stop_check
489 !###############################################################################
490
491
492 !###############################################################################
493 42 subroutine move(unit, change, iostat, err_msg)
494 !! Move current position in file based on relative change
495 implicit none
496
497 ! Arguments
498 integer, intent(in) :: unit
499 !! Unit to read from
500 integer, intent(in) :: change
501 !! Relative change in position
502 integer, intent(out), optional :: iostat
503 !! I/O status
504 character(*), intent(out), optional :: err_msg
505 !! Error message
506
507 ! Local variables
508 integer :: iostat_
509 !! I/O status
510 integer :: i
511 !! Loop index
512 character(256) :: err_msg_
513 !! Error message
514 logical :: opened
515 !! File existence check
516
517 42 if(present(iostat)) iostat = 0
518
4/6
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 38 times.
✓ Branch 2 taken 4 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 4 times.
✗ Branch 5 not taken.
42 if(present(err_msg)) err_msg = ""
519
2/2
✓ Branch 0 taken 15 times.
✓ Branch 1 taken 27 times.
43 if(change.eq.0) return
520 27 inquire(unit = unit, iostat = iostat_, opened = opened)
521
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 27 times.
27 if(iostat_ .ne. 0)then
522 write(err_msg_, '(A,I0)') &
523 'Cannot move in file, unit ', unit
524 if(present(iostat)) iostat = iostat_
525 if(present(err_msg))then
526 err_msg = err_msg_
527 else
528 call stop_program(err_msg_)
529 end if
530 return
531
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 26 times.
27 elseif( .not.opened)then
532 write(err_msg_, '(A,I0)') &
533 1 'File is not opened, unit ', unit
534
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if(present(iostat)) iostat = 44
535
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if(present(err_msg))then
536
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 err_msg = err_msg_
537 else
538 call stop_program(err_msg_)
539 end if
540 1 return
541 end if
542
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 22 times.
26 if(change.gt.0)then
543
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 4 times.
16 do i = 1, change
544 12 read(unit, '(A)', iostat = iostat_)
545
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 12 times.
16 if(iostat_ .ne. 0)then
546 write(err_msg_, '(A,I0)') &
547 'Cannot move forward in file, unit ', unit
548 if(present(iostat)) iostat = iostat_
549 if(present(err_msg))then
550 err_msg = err_msg_
551 else
552 call stop_program(err_msg_)
553 end if
554 return
555 end if
556 end do
557 else
558
2/2
✓ Branch 0 taken 183 times.
✓ Branch 1 taken 22 times.
205 do i = 1, abs(change)
559 183 backspace(unit)
560
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 183 times.
205 if(iostat .ne. 0)then
561 write(err_msg_, '(A,I0)') &
562 'Cannot move backward in file, unit ', unit
563 if(present(iostat)) iostat = iostat_
564 if(present(err_msg))then
565 err_msg = err_msg_
566 else
567 call stop_program(err_msg_)
568 end if
569 return
570 end if
571 end do
572 end if
573
574
1/2
✓ Branch 0 taken 42 times.
✗ Branch 1 not taken.
42 end subroutine move
575 !###############################################################################
576
577 end module athena__tools_infile
578