Skip to content

Loadtxt real format update to list directed #805

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
jvdp1 merged 8 commits into from
May 13, 2024
Merged

Loadtxt real format update to list directed #805

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
6a895e1
Loadtxt real format update
chuckyvt Apr 25, 2024
abba1f1
Fmt identifier for loadtxt
chuckyvt Apr 28, 2024
06afebe
loadtxt format update
chuckyvt Apr 30, 2024
4252714
Update test/io/test_loadtxt.f90
chuckyvt Apr 30, 2024
a0d5fcc
Update test/io/test_loadtxt.f90
chuckyvt Apr 30, 2024
aff8fdf
Merge branch 'master' into loadtxt-real-format-update
chuckyvt May 9, 2024
416e163
Spec and example update.
chuckyvt May 9, 2024
285cbae
Merge branch 'loadtxt-real-format-update' of https://github.com/chuck…
chuckyvt May 9, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 27 additions & 2 deletions src/stdlib_io.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ module stdlib_io
contains

#:for k1, t1 in KINDS_TYPES
subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows)
subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows, fmt)
!! version: experimental
!!
!! Loads a 2D array from a text file.
Expand All @@ -100,6 +100,7 @@ contains
!! A value of zero results in no lines to be read.
!! The default value is -1.
integer, intent(in), optional :: max_rows
character(len=*), optional :: fmt
!!
!! Example
!! -------
Expand Down Expand Up @@ -145,11 +146,35 @@ contains

do i = 1, max_rows_
#:if 'real' in t1
read(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
if ( present( fmt ) ) then
if ( fmt == '*' ) then
read (s,*) d(i, :)
else
read (s,fmt) d(i, :)
endif
else
read (s,"(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
end if
Copy link
Member

@jvdp1 jvdp1 Apr 28, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Checking the same if statement at every iteration would be quite slow. So I suggest to move this if statement outside the loop.
Could something like this work:

fmt_ = optval('*('//fmt//',1x)', '*', fmt)

do i = 1, max_rows_
  read (s, fmt_) d(i,:)
enddo

#:elif 'complex' in t1
if ( present( fmt ) ) then
if ( fmt == '*' ) then
read (s,*) d(i, :)
else
read (s,fmt) d(i, :)
endif
else
read(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
end if
#:else
if ( present( fmt ) ) then
if ( fmt == '*' ) then
read (s,*) d(i, :)
else
read (s,fmt) d(i, :)
endif
else
read(s, *) d(i, :)
end if
#:endif
end do
close(s)
Expand Down
50 changes: 44 additions & 6 deletions test/io/test_loadtxt.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,17 +34,18 @@ subroutine test_loadtxt_int32(error)
integer(int32), allocatable :: input(:,:), expected(:,:)
real(sp), allocatable :: harvest(:,:)
integer :: n

allocate(harvest(10,10))
allocate(input(10,10))
allocate(expected(10,10))

do n = 1, 10
call random_number(harvest)
input = int(harvest * 100)
call savetxt('test_int32.txt', input)
call loadtxt('test_int32.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_int32.txt', expected, fmt='*')
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

allocate(input(10,10))
allocate(expected(10,10))

do n = 1, 10
call random_number(input)
input = input - 0.5
call savetxt('test_sp.txt', input)
call loadtxt('test_sp.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_sp.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_sp.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

Expand All @@ -77,7 +83,8 @@ subroutine test_loadtxt_sp_huge(error)
type(error_type), allocatable, intent(out) :: error
real(sp), allocatable :: input(:,:), expected(:,:)
integer :: n

character(len=*), parameter :: FMT_REAL_SP = '(es15.8e2)'

allocate(input(10,10))
allocate(expected(10,10))

Expand All @@ -87,6 +94,10 @@ subroutine test_loadtxt_sp_huge(error)
call savetxt('test_sp_huge.txt', input)
call loadtxt('test_sp_huge.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_sp_huge.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_sp_huge.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

allocate(input(10,10))
allocate(expected(10,10))
Expand All @@ -108,6 +120,10 @@ subroutine test_loadtxt_sp_tiny(error)
call savetxt('test_sp_tiny.txt', input)
call loadtxt('test_sp_tiny.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_sp_tiny.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_sp_tiny.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

allocate(input(10,10))
allocate(expected(10,10))
Expand All @@ -129,6 +146,10 @@ subroutine test_loadtxt_dp(error)
call savetxt('test_dp.txt', input)
call loadtxt('test_dp.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_dp.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_dp.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

allocate(input(10,10))

Expand All @@ -150,6 +172,10 @@ subroutine test_loadtxt_dp_max_skip(error)
call savetxt('test_dp_max_skip.txt', input)
call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n)
call check(error, all(input(m+1:min(n+m,10),:) == expected))
call loadtxt('test_dp_max_skip.txt', expected, skiprows=m, max_rows=n, fmt='*')
call check(error, all(input(m+1:min(n+m,10),:) == expected))
call loadtxt('test_dp_max_skip.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
call check(error, all(input == expected))
deallocate(expected)
if (allocated(error)) return
end do
Expand All @@ -163,6 +189,7 @@ subroutine test_loadtxt_dp_huge(error)
type(error_type), allocatable, intent(out) :: error
real(dp), allocatable :: input(:,:), expected(:,:)
integer :: n
character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'

allocate(input(10,10))
allocate(expected(10,10))
Expand All @@ -173,6 +200,10 @@ subroutine test_loadtxt_dp_huge(error)
call savetxt('test_dp_huge.txt', input)
call loadtxt('test_dp_huge.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_dp_huge.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_dp_huge.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

Expand All @@ -184,7 +215,8 @@ subroutine test_loadtxt_dp_tiny(error)
type(error_type), allocatable, intent(out) :: error
real(dp), allocatable :: input(:,:), expected(:,:)
integer :: n

character(len=*), parameter :: FMT_REAL_DP = '(es24.16e3)'

allocate(input(10,10))
allocate(expected(10,10))

Expand All @@ -194,6 +226,10 @@ subroutine test_loadtxt_dp_tiny(error)
call savetxt('test_dp_tiny.txt', input)
call loadtxt('test_dp_tiny.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_dp_tiny.txt', expected, fmt='*')
call check(error, all(input == expected))
call loadtxt('test_dp_tiny.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

allocate(re(10,10))
allocate(im(10,10))
Expand All @@ -219,6 +256,8 @@ subroutine test_loadtxt_complex(error)
call savetxt('test_complex.txt', input)
call loadtxt('test_complex.txt', expected)
call check(error, all(input == expected))
call loadtxt('test_complex.txt', expected, fmt="(*"//FMT_COMPLEX_dp(1:len(FMT_COMPLEX_dp)-1)//",1x))")
call check(error, all(input == expected))
if (allocated(error)) return
end do

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

stat = 0

testsuites = [ &
new_testsuite("loadtxt", collect_loadtxt) &
]
Expand Down