diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index e63504623..8c868802a 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -17,7 +17,7 @@ Loads a rank-2 `array` from a text file. ### Syntax -`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows])` +`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows] [, fmt])` ### Arguments @@ -29,6 +29,10 @@ Loads a rank-2 `array` from a text file. `max_rows` (optional): Read `max_rows` lines of content after `skiprows` lines. A negative value results in reading all lines. A value of zero results in no lines to be read. The default value is -1. +`fmt` (optional): Fortran format specifier for the text read. Defaults to the write format for the data type. Setting fmt='*' will specify list directed read. + + + ### Return value Returns an allocated rank-2 `array` with the content of `filename`. diff --git a/example/io/example_loadtxt.f90 b/example/io/example_loadtxt.f90 index 5db4f02e2..fa4091c2f 100644 --- a/example/io/example_loadtxt.f90 +++ b/example/io/example_loadtxt.f90 @@ -3,4 +3,7 @@ program example_loadtxt implicit none real, allocatable :: x(:, :) call loadtxt('example.dat', x) + + ! Can also use list directed format if the default read fails. + call loadtxt('example.dat', x, fmt='*') end program example_loadtxt diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index c0f84932e..7aceae2e2 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -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. @@ -100,6 +100,8 @@ 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=*), intent(in), optional :: fmt + character(len=:), allocatable :: fmt_ !! !! Example !! ------- @@ -143,15 +145,52 @@ contains read(s, *) end do - do i = 1, max_rows_ - #:if 'real' in t1 - read(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :) - #:elif 'complex' in t1 - read(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :) - #:else - read(s, *) d(i, :) - #:endif - end do + #:if 'real' in t1 + ! Default to format used for savetxt if fmt not specified. + fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") + + if ( fmt_ == '*' ) then + ! Use list directed read if user has specified fmt='*' + do i = 1, max_rows_ + read (s,*) d(i, :) + enddo + else + ! Otherwise pass default or user specified fmt string. + do i = 1, max_rows_ + read (s,fmt_) d(i, :) + enddo + endif + #:elif 'complex' in t1 + ! Default to format used for savetxt if fmt not specified. + fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") + if ( fmt_ == '*' ) then + ! Use list directed read if user has specified fmt='*' + do i = 1, max_rows_ + read (s,*) d(i, :) + enddo + else + ! Otherwise pass default or user specified fmt string. + do i = 1, max_rows_ + read (s,fmt_) d(i, :) + enddo + endif + #:else + ! Default to list directed for integer + fmt_ = optval(fmt, "*") + ! Use list directed read if user has specified fmt='*' + if ( fmt_ == '*' ) then + do i = 1, max_rows_ + read (s,*) d(i, :) + enddo + else + ! Otherwise pass default user specified fmt string. + do i = 1, max_rows_ + read (s,fmt_) d(i, :) + enddo + endif + + #:endif + close(s) end subroutine loadtxt_${t1[0]}$${k1}$ diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index a75c63e49..3234c2533 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -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 check(error, all(input == expected),'Default list directed read failed') + if (allocated(error)) return + call loadtxt('test_int32.txt', expected, fmt='*') + call check(error, all(input == expected),'User specified list directed read faile') if (allocated(error)) return end do @@ -55,17 +56,23 @@ 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 check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_sp.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_sp.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -77,7 +84,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)) @@ -86,7 +94,13 @@ subroutine test_loadtxt_sp_huge(error) input = (input - 0.5) * huge(input) call savetxt('test_sp_huge.txt', input) call loadtxt('test_sp_huge.txt', expected) - call check(error, all(input == expected)) + call check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_sp_huge.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_sp_huge.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -98,6 +112,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)) @@ -107,7 +122,13 @@ subroutine test_loadtxt_sp_tiny(error) input = (input - 0.5) * tiny(input) call savetxt('test_sp_tiny.txt', input) call loadtxt('test_sp_tiny.txt', expected) - call check(error, all(input == expected)) + call check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_sp_tiny.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_sp_tiny.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -119,6 +140,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)) @@ -128,7 +150,13 @@ subroutine test_loadtxt_dp(error) input = input - 0.5 call savetxt('test_dp.txt', input) call loadtxt('test_dp.txt', expected) - call check(error, all(input == expected)) + call check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_dp.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_dp.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -140,6 +168,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)) @@ -149,7 +178,13 @@ subroutine test_loadtxt_dp_max_skip(error) input = input - 0.5 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 check(error, all(input(m+1:min(n+m,10),:) == expected),'Default format read failed') + if (allocated(error)) return + 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),'List directed read failed') + if (allocated(error)) return + 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),'User specified format failed') deallocate(expected) if (allocated(error)) return end do @@ -163,6 +198,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)) @@ -172,7 +208,13 @@ subroutine test_loadtxt_dp_huge(error) input = (input - 0.5) * huge(input) call savetxt('test_dp_huge.txt', input) call loadtxt('test_dp_huge.txt', expected) - call check(error, all(input == expected)) + call check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_dp_huge.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_dp_huge.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -184,7 +226,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)) @@ -193,7 +236,13 @@ subroutine test_loadtxt_dp_tiny(error) input = (input - 0.5) * tiny(input) call savetxt('test_dp_tiny.txt', input) call loadtxt('test_dp_tiny.txt', expected) - call check(error, all(input == expected)) + call check(error, all(input == expected),'Default format read failed') + if (allocated(error)) return + call loadtxt('test_dp_tiny.txt', expected, fmt='*') + call check(error, all(input == expected),'List directed read failed') + if (allocated(error)) return + call loadtxt('test_dp_tiny.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -206,6 +255,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)) @@ -219,6 +269,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 @@ -237,7 +289,6 @@ program tester character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 - testsuites = [ & new_testsuite("loadtxt", collect_loadtxt) & ]