Skip to content

Commit abba1f1

Browse files
chuckyvtchuckyvt
committed
Fmt identifier for loadtxt
Add format field to loadtxt function to allow user to specify the format string. Also update loadtxt test suite.
1 parent 6a895e1 commit abba1f1

File tree

2 files changed

+73
-8
lines changed

2 files changed

+73
-8
lines changed

‎src/stdlib_io.fypp‎

Lines changed: 29 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,7 @@ module stdlib_io
8181
contains
8282

8383
#:for k1, t1 in KINDS_TYPES
84-
subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows)
84+
subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows, fmt)
8585
!! version: experimental
8686
!!
8787
!! Loads a 2D array from a text file.
@@ -100,6 +100,7 @@ contains
100100
!! A value of zero results in no lines to be read.
101101
!! The default value is -1.
102102
integer, intent(in), optional :: max_rows
103+
character(len=*), optional :: fmt
103104
!!
104105
!! Example
105106
!! -------
@@ -144,10 +145,36 @@ contains
144145
end do
145146

146147
do i = 1, max_rows_
147-
#:if 'complex' in t1
148+
#:if 'real' in t1
149+
if ( present( fmt ) ) then
150+
if ( fmt == '*' ) then
151+
read (s,*) d(i, :)
152+
else
153+
read (s,fmt) d(i, :)
154+
endif
155+
else
156+
read (s,"(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
157+
end if
158+
#:elif 'complex' in t1
159+
if ( present( fmt ) ) then
160+
if ( fmt == '*' ) then
161+
read (s,*) d(i, :)
162+
else
163+
read (s,fmt) d(i, :)
164+
endif
165+
else
148166
read(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
167+
end if
149168
#:else
169+
if ( present( fmt ) ) then
170+
if ( fmt == '*' ) then
171+
read (s,*) d(i, :)
172+
else
173+
read (s,fmt) d(i, :)
174+
endif
175+
else
150176
read(s, *) d(i, :)
177+
end if
151178
#:endif
152179
end do
153180
close(s)

‎test/io/test_loadtxt.f90‎

Lines changed: 44 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -34,17 +34,18 @@ subroutine test_loadtxt_int32(error)
3434
integer(int32), allocatable :: input(:,:), expected(:,:)
3535
real(sp), allocatable :: harvest(:,:)
3636
integer :: n
37-
37+
3838
allocate(harvest(10,10))
3939
allocate(input(10,10))
4040
allocate(expected(10,10))
41-
4241
do n = 1, 10
4342
call random_number(harvest)
4443
input = int(harvest * 100)
4544
call savetxt('test_int32.txt', input)
4645
call loadtxt('test_int32.txt', expected)
4746
call check(error, all(input == expected))
47+
call loadtxt('test_int32.txt', expected, fmt='*')
48+
call check(error, all(input == expected))
4849
if (allocated(error)) return
4950
end do
5051

@@ -55,17 +56,22 @@ subroutine test_loadtxt_sp(error)
5556
!> Error handling
5657
type(error_type), allocatable, intent(out) :: error
5758
real(sp), allocatable :: input(:,:), expected(:,:)
59+
character(len=*), parameter :: FMT_REAL_SP = '(es15.8e2)'
5860
integer :: n
5961

6062
allocate(input(10,10))
6163
allocate(expected(10,10))
62-
64+
6365
do n = 1, 10
6466
call random_number(input)
6567
input = input - 0.5
6668
call savetxt('test_sp.txt', input)
6769
call loadtxt('test_sp.txt', expected)
6870
call check(error, all(input == expected))
71+
call loadtxt('test_sp.txt', expected, fmt='*')
72+
call check(error, all(input == expected))
73+
call loadtxt('test_sp.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
74+
call check(error, all(input == expected))
6975
if (allocated(error)) return
7076
end do
7177

@@ -77,7 +83,8 @@ subroutine test_loadtxt_sp_huge(error)
7783
type(error_type), allocatable, intent(out) :: error
7884
real(sp), allocatable :: input(:,:), expected(:,:)
7985
integer :: n
80-
86+
character(len=*), parameter :: FMT_REAL_SP = '(es15.8e2)'
87+
8188
allocate(input(10,10))
8289
allocate(expected(10,10))
8390

@@ -87,6 +94,10 @@ subroutine test_loadtxt_sp_huge(error)
8794
call savetxt('test_sp_huge.txt', input)
8895
call loadtxt('test_sp_huge.txt', expected)
8996
call check(error, all(input == expected))
97+
call loadtxt('test_sp_huge.txt', expected, fmt='*')
98+
call check(error, all(input == expected))
99+
call loadtxt('test_sp_huge.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
100+
call check(error, all(input == expected))
90101
if (allocated(error)) return
91102
end do
92103

@@ -98,6 +109,7 @@ subroutine test_loadtxt_sp_tiny(error)
98109
type(error_type), allocatable, intent(out) :: error
99110
real(sp), allocatable :: input(:,:), expected(:,:)
100111
integer :: n
112+
character(len=*), parameter :: FMT_REAL_SP = '(es15.8e2)'
101113

102114
allocate(input(10,10))
103115
allocate(expected(10,10))
@@ -108,6 +120,10 @@ subroutine test_loadtxt_sp_tiny(error)
108120
call savetxt('test_sp_tiny.txt', input)
109121
call loadtxt('test_sp_tiny.txt', expected)
110122
call check(error, all(input == expected))
123+
call loadtxt('test_sp_tiny.txt', expected, fmt='*')
124+
call check(error, all(input == expected))
125+
call loadtxt('test_sp_tiny.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
126+
call check(error, all(input == expected))
111127
if (allocated(error)) return
112128
end do
113129

@@ -119,6 +135,7 @@ subroutine test_loadtxt_dp(error)
119135
type(error_type), allocatable, intent(out) :: error
120136
real(dp), allocatable :: input(:,:), expected(:,:)
121137
integer :: n
138+
character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'
122139

123140
allocate(input(10,10))
124141
allocate(expected(10,10))
@@ -129,6 +146,10 @@ subroutine test_loadtxt_dp(error)
129146
call savetxt('test_dp.txt', input)
130147
call loadtxt('test_dp.txt', expected)
131148
call check(error, all(input == expected))
149+
call loadtxt('test_dp.txt', expected, fmt='*')
150+
call check(error, all(input == expected))
151+
call loadtxt('test_dp.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
152+
call check(error, all(input == expected))
132153
if (allocated(error)) return
133154
end do
134155

@@ -140,6 +161,7 @@ subroutine test_loadtxt_dp_max_skip(error)
140161
type(error_type), allocatable, intent(out) :: error
141162
real(dp), allocatable :: input(:,:), expected(:,:)
142163
integer :: n, m
164+
character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'
143165

144166
allocate(input(10,10))
145167

@@ -150,6 +172,10 @@ subroutine test_loadtxt_dp_max_skip(error)
150172
call savetxt('test_dp_max_skip.txt', input)
151173
call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n)
152174
call check(error, all(input(m+1:min(n+m,10),:) == expected))
175+
call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n, fmt='*')
176+
call check(error, all(input(m+1:min(n+m,10),:) == expected))
177+
call loadtxt('test_dp_max_skip.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
178+
call check(error, all(input == expected))
153179
deallocate(expected)
154180
if (allocated(error)) return
155181
end do
@@ -163,6 +189,7 @@ subroutine test_loadtxt_dp_huge(error)
163189
type(error_type), allocatable, intent(out) :: error
164190
real(dp), allocatable :: input(:,:), expected(:,:)
165191
integer :: n
192+
character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'
166193

167194
allocate(input(10,10))
168195
allocate(expected(10,10))
@@ -173,6 +200,10 @@ subroutine test_loadtxt_dp_huge(error)
173200
call savetxt('test_dp_huge.txt', input)
174201
call loadtxt('test_dp_huge.txt', expected)
175202
call check(error, all(input == expected))
203+
call loadtxt('test_dp_huge.txt', expected, fmt='*')
204+
call check(error, all(input == expected))
205+
call loadtxt('test_dp_huge.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
206+
call check(error, all(input == expected))
176207
if (allocated(error)) return
177208
end do
178209

@@ -184,7 +215,8 @@ subroutine test_loadtxt_dp_tiny(error)
184215
type(error_type), allocatable, intent(out) :: error
185216
real(dp), allocatable :: input(:,:), expected(:,:)
186217
integer :: n
187-
218+
character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'
219+
188220
allocate(input(10,10))
189221
allocate(expected(10,10))
190222

@@ -194,6 +226,10 @@ subroutine test_loadtxt_dp_tiny(error)
194226
call savetxt('test_dp_tiny.txt', input)
195227
call loadtxt('test_dp_tiny.txt', expected)
196228
call check(error, all(input == expected))
229+
call loadtxt('test_dp_tiny.txt', expected, fmt='*')
230+
call check(error, all(input == expected))
231+
call loadtxt('test_dp_tiny.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
232+
call check(error, all(input == expected))
197233
if (allocated(error)) return
198234
end do
199235

@@ -206,6 +242,7 @@ subroutine test_loadtxt_complex(error)
206242
complex(dp), allocatable :: input(:,:), expected(:,:)
207243
real(dp), allocatable :: re(:,:), im(:,:)
208244
integer :: n
245+
character(len=*), parameter :: FMT_COMPLEX_DP = '(es24.16e3,1x,es24.16e3)'
209246

210247
allocate(re(10,10))
211248
allocate(im(10,10))
@@ -219,6 +256,8 @@ subroutine test_loadtxt_complex(error)
219256
call savetxt('test_complex.txt', input)
220257
call loadtxt('test_complex.txt', expected)
221258
call check(error, all(input == expected))
259+
call loadtxt('test_complex.txt', expected, fmt="(*"//FMT_COMPLEX_dp(1:len(FMT_COMPLEX_dp)-1)//",1x))")
260+
call check(error, all(input == expected))
222261
if (allocated(error)) return
223262
end do
224263

@@ -237,7 +276,6 @@ program tester
237276
character(len=*), parameter :: fmt = '("#", *(1x, a))'
238277

239278
stat = 0
240-
241279
testsuites = [ &
242280
new_testsuite("loadtxt", collect_loadtxt) &
243281
]

0 commit comments

Comments
 (0)