From 6a895e1cbae26dfc0530db6bf6b49e810a7fec2f Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Wed, 24 Apr 2024 22:14:38 -0400 Subject: [PATCH 1/6] Loadtxt real format update Change loadtxt format for real numbers to list directed. --- src/stdlib_io.fypp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index c0f84932e..788ec33a1 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -144,9 +144,7 @@ contains 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 + #:if 'complex' in t1 read(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :) #:else read(s, *) d(i, :) From abba1f173bb8f3eb55f297a573b246e7448755fc Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Sat, 27 Apr 2024 22:21:54 -0400 Subject: [PATCH 2/6] Fmt identifier for loadtxt Add format field to loadtxt function to allow user to specify the format string. Also update loadtxt test suite. --- src/stdlib_io.fypp | 31 +++++++++++++++++++++++-- test/io/test_loadtxt.f90 | 50 +++++++++++++++++++++++++++++++++++----- 2 files changed, 73 insertions(+), 8 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 788ec33a1..0574dd3ec 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,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 !! ------- @@ -144,10 +145,36 @@ contains end do do i = 1, max_rows_ - #:if 'complex' in t1 + #:if 'real' in t1 + 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 + #: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) diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index a75c63e49..4d80103bd 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 loadtxt('test_int32.txt', expected, fmt='*') + call check(error, all(input == expected)) if (allocated(error)) return end do @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -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)) @@ -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 @@ -237,7 +276,6 @@ program tester character(len=*), parameter :: fmt = '("#", *(1x, a))' stat = 0 - testsuites = [ & new_testsuite("loadtxt", collect_loadtxt) & ] From 06afebe69fbf918e78f7e8abdfdc3dfe2d0a1e7c Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Mon, 29 Apr 2024 21:49:27 -0400 Subject: [PATCH 3/6] loadtxt format update Update read loop structure. Added optval formatting. Additional messages added to test cases to better understand which read type failed. --- src/stdlib_io.fypp | 82 +++++++++++++++++++++++----------------- test/io/test_loadtxt.f90 | 61 +++++++++++++++++++----------- 2 files changed, 86 insertions(+), 57 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 0574dd3ec..7aceae2e2 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -100,7 +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=*), optional :: fmt + character(len=*), intent(in), optional :: fmt + character(len=:), allocatable :: fmt_ !! !! Example !! ------- @@ -144,39 +145,52 @@ contains read(s, *) end do - do i = 1, max_rows_ - #:if 'real' in t1 - 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 - #: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 + #: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 4d80103bd..81ba60d5b 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -43,9 +43,10 @@ subroutine test_loadtxt_int32(error) 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)) + call check(error, all(input == expected),'User specified list directed read faile') if (allocated(error)) return end do @@ -67,11 +68,13 @@ subroutine test_loadtxt_sp(error) 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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -93,11 +96,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -119,11 +124,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -145,11 +152,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -171,11 +180,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') deallocate(expected) if (allocated(error)) return end do @@ -199,11 +210,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do @@ -225,11 +238,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)) + 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)) + call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return end do From 4252714bee9c87133014556f415727cea71857ad Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 30 Apr 2024 06:44:17 -0400 Subject: [PATCH 4/6] Update test/io/test_loadtxt.f90 Co-authored-by: Jeremie Vandenplas --- test/io/test_loadtxt.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index 81ba60d5b..3642379ed 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -62,7 +62,6 @@ subroutine test_loadtxt_sp(error) allocate(input(10,10)) allocate(expected(10,10)) - do n = 1, 10 call random_number(input) input = input - 0.5 From a0d5fccb8c2693f83917071b646e6bc673b049c0 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Tue, 30 Apr 2024 06:44:32 -0400 Subject: [PATCH 5/6] Update test/io/test_loadtxt.f90 Co-authored-by: Jeremie Vandenplas --- test/io/test_loadtxt.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index 3642379ed..3234c2533 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -34,7 +34,6 @@ 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)) From 416e1632b3649b0a4e4d6bffc0c2ccdd78c77c44 Mon Sep 17 00:00:00 2001 From: chuckyvt <138633930+chuckyvt@users.noreply.github.com> Date: Thu, 9 May 2024 08:15:06 -0400 Subject: [PATCH 6/6] Spec and example update. --- doc/specs/stdlib_io.md | 6 +++++- example/io/example_loadtxt.f90 | 3 +++ 2 files changed, 8 insertions(+), 1 deletion(-) 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