forked from BoxLib-Codes/BoxLib
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathbl_stream.f90
More file actions
178 lines (159 loc) · 4.64 KB
/
Copy pathbl_stream.f90
File metadata and controls
178 lines (159 loc) · 4.64 KB
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
!! Presents a model of stream I/O
!!
!! A unit consists of whitespace separated characters that can
!! be scanned. Single characters can be put back, enabling
!! primitive parsing.
module bl_stream_module
implicit none
type bl_stream
private
integer :: unit = -1
character :: pb
logical :: lpb = .False.
end type
character, private, parameter :: EOF = char(0)
interface bl_stream_expect
module procedure bl_stream_expect_str
module procedure bl_stream_expect_chr_v
end interface
interface build
module procedure bl_stream_build
end interface
interface destroy
module procedure bl_stream_destroy
end interface
contains
subroutine bl_stream_build(strm, unit)
use bl_IO_module
type(bl_stream), intent(out) :: strm
integer, intent(in), optional :: unit
if ( present(unit) ) then
strm%unit = unit
else
strm%unit = unit_new()
end if
end subroutine bl_stream_build
subroutine bl_stream_destroy(strm)
type(bl_stream), intent(inout) :: strm
strm%unit = -1
strm%pb = achar(0)
strm%lpb = .False.
end subroutine bl_stream_destroy
pure function bl_stream_the_unit(strm) result(r)
integer :: r
type(bl_stream), intent(in) :: strm
r = strm%unit
end function bl_stream_the_unit
subroutine bl_stream_eat_whitespace(strm)
use bl_string_module
type(bl_stream), intent(inout) :: strm
character :: c
do
if ( strm%lpb ) then
c = strm%pb
strm%lpb = .false.
else
read(unit=strm%unit, fmt='(a)', advance = 'no', eor = 100) c
end if
if ( is_space(c) ) cycle
call bl_stream_putback_chr(strm, c)
exit
100 continue
end do
end subroutine bl_stream_eat_whitespace
function bl_stream_peek_chr(strm, set) result(r)
character :: r
type(bl_stream), intent(inout) :: strm
character(len=*), intent(in), optional :: set
r = bl_stream_scan_chr(strm, set)
call bl_stream_putback_chr(strm, r)
end function bl_stream_peek_chr
function bl_stream_scan_int(strm) result(r)
use bl_error_module
use bl_string_module
integer :: r
type(bl_stream), intent(inout) :: strm
character :: c
logical :: started, negative
call bl_stream_eat_whitespace(strm)
r = 0
started = .false.
negative = .false.
do
if ( strm%lpb ) then
c = strm%pb
strm%lpb = .false.
else
read(unit=strm%unit, fmt='(a)', advance = 'no', eor = 100) c
end if
if ( .not. is_digit(c) .and. .not. c =="-") then
if ( .not. started ) call bl_error("BL_STREAM_SCAN_INT: first character in scan: ", c)
call bl_stream_putback_chr(strm, c)
exit
end if
started = .true.
if (c == "-") then
negative = .true.
cycle
endif
r = r*10 + (ichar(c)-ichar('0'))
end do
if (negative) r = -r
100 continue
end function bl_stream_scan_int
function bl_stream_scan_chr(strm, set) result(r)
use bl_string_module
type(bl_stream), intent(inout) :: strm
character(len=*), intent(in), optional :: set
character :: r
do
if ( strm%lpb ) then
r = strm%pb
strm%lpb = .FALSE.
else
read(unit=strm%unit, fmt='(a)', advance = 'NO', eor = 100, end = 200) r
end if
if ( present(set) ) then
if ( scan(r,set) == 0 ) exit
else
! skip whitespace
if ( is_space(r) ) cycle
exit
end if
200 r = EOF
exit
100 continue
end do
end function bl_stream_scan_chr
subroutine bl_stream_expect_str(strm, str)
use bl_error_module
type(bl_stream), intent(inout) :: strm
character(len=*), intent(in) :: str
character :: c
integer :: i
c = bl_stream_scan_chr(strm)
do i = 1, len(str)
if ( c /= str(i:i) ) then
call bl_error('expect_chr: expected "'// str// '" got: ', '"'//c//'"')
end if
if ( i == len(str) ) exit
c = bl_stream_scan_chr(strm)
end do
end subroutine bl_stream_expect_str
subroutine bl_stream_expect_chr_v(strm, chars)
type(bl_stream), intent(inout) :: strm
character, intent(in) :: chars(:)
integer :: i
do i = 1, len(chars)
call bl_stream_expect_str(strm, chars(i))
end do
end subroutine bl_stream_expect_chr_v
subroutine bl_stream_putback_chr(strm, char)
use bl_error_module
type(bl_stream), intent(inout) :: strm
character, intent(in) :: char
if ( strm%lpb ) call bl_error('PUTBACK_CHR: already pushed back')
strm%pb = char
strm%lpb = .TRUE.
end subroutine bl_stream_putback_chr
end module bl_stream_module