From d980c645140421622463d88a506793d74b207dc7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 13:06:58 +0200 Subject: [PATCH 01/15] stdlib_io: add skiprows to loadtxt --- src/stdlib_io.fypp | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 4909c550a..91f9248ba 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) + subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows) !! version: experimental !! !! Loads a 2D array from a text file. @@ -93,6 +93,8 @@ contains character(len=*), intent(in) :: filename !! The array 'd' will be automatically allocated with the correct dimensions ${t1}$, allocatable, intent(out) :: d(:,:) + !! Skip the first `skiprows` lines, default: 0. + integer, intent(in), optional :: skiprows !! !! Example !! ------- @@ -111,7 +113,9 @@ contains !! ... !! integer :: s - integer :: nrow, ncol, i + integer :: nrow, ncol, i, skiprows_ + + skiprows_ = optval(skiprows, 0) s = open(filename) @@ -122,7 +126,12 @@ contains #:endif ! determine number or rows - nrow = number_of_rows(s) + nrow = number_of_rows(s) - skiprows_ + + if ( nrow < 0 ) call error_stop("loadtxt: skipping more rows than present.") + do i = 1, skiprows_ + read(s, *) + end do allocate(d(nrow, ncol)) do i = 1, nrow From de74cd8142b950872a0a2250eb49ba6ef8898bc4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 13:14:51 +0200 Subject: [PATCH 02/15] Add test for skiprows in loadtxt --- src/tests/io/test_loadtxt.f90 | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/src/tests/io/test_loadtxt.f90 b/src/tests/io/test_loadtxt.f90 index cf2029ee7..7f97e1177 100644 --- a/src/tests/io/test_loadtxt.f90 +++ b/src/tests/io/test_loadtxt.f90 @@ -19,6 +19,7 @@ subroutine collect_loadtxt(testsuite) new_unittest("loadtxt_sp_huge", test_loadtxt_sp_huge), & new_unittest("loadtxt_sp_tiny", test_loadtxt_sp_tiny), & new_unittest("loadtxt_dp", test_loadtxt_dp), & + new_unittest("loadtxt_dp_skip", test_loadtxt_dp_skip), & new_unittest("loadtxt_dp_huge", test_loadtxt_dp_huge), & new_unittest("loadtxt_dp_tiny", test_loadtxt_dp_tiny), & new_unittest("loadtxt_complex", test_loadtxt_complex) & @@ -134,6 +135,27 @@ subroutine test_loadtxt_dp(error) end subroutine test_loadtxt_dp + subroutine test_loadtxt_dp_skip(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + real(dp), allocatable :: input(:,:), expected(:,:) + integer :: n + + allocate(input(10,10)) + + do n = 1, 5 + call random_number(input) + input = input - 0.5 + call savetxt('test_dp_skip.txt', input) + call loadtxt('test_dp_skip.txt', expected, skiprows=n) + call check(error, all(input(n+1:,:) == expected)) + deallocate(expected) + if (allocated(error)) return + end do + + end subroutine test_loadtxt_dp_skip + + subroutine test_loadtxt_dp_huge(error) !> Error handling type(error_type), allocatable, intent(out) :: error From ea80574298633808fcefca7d76c5ef5ad6006019 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 13:53:08 +0200 Subject: [PATCH 03/15] stdlib_io: add check for skiprows >= 0 --- src/stdlib_io.fypp | 1 + 1 file changed, 1 insertion(+) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 91f9248ba..daee7e9d0 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -116,6 +116,7 @@ contains integer :: nrow, ncol, i, skiprows_ skiprows_ = optval(skiprows, 0) + if ( skiprows_ < 0 ) call error_stop("loadtxt: skiprows needs to be non-negative.") s = open(filename) From bcc3f361fc587f5d85a88153551ea9fe651fb3e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 22:16:01 +0200 Subject: [PATCH 04/15] stdlib_io: add max_rows to loadtxt --- src/stdlib_io.fypp | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index daee7e9d0..c2ac5ac54 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) + subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows) !! version: experimental !! !! Loads a 2D array from a text file. @@ -95,6 +95,8 @@ contains ${t1}$, allocatable, intent(out) :: d(:,:) !! Skip the first `skiprows` lines, default: 0. integer, intent(in), optional :: skiprows + !! Read max_rows lines of content after skiprows lines. The default is -1, to read all the lines. + integer, intent(in), optional :: max_rows !! !! Example !! ------- @@ -113,11 +115,13 @@ contains !! ... !! integer :: s - integer :: nrow, ncol, i, skiprows_ + integer :: nrow, ncol, i, skiprows_, max_rows_ skiprows_ = optval(skiprows, 0) if ( skiprows_ < 0 ) call error_stop("loadtxt: skiprows needs to be non-negative.") + max_rows_ = optval(max_rows, -1) + s = open(filename) ! determine number of columns @@ -128,14 +132,16 @@ contains ! determine number or rows nrow = number_of_rows(s) - skiprows_ - if ( nrow < 0 ) call error_stop("loadtxt: skipping more rows than present.") + if ( max_rows_ < 0 .or. max_rows_ > nrow) max_rows_ = nrow + + allocate(d(max_rows_, ncol)) + do i = 1, skiprows_ read(s, *) end do - allocate(d(nrow, ncol)) - do i = 1, nrow + 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 From 3c66fccd0e53a99eb970a517e1e3d77cb7e69926 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 22:23:36 +0200 Subject: [PATCH 05/15] Update src/stdlib_io.fypp Co-authored-by: Ivan Pribec --- src/stdlib_io.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index c2ac5ac54..613eb3174 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -118,7 +118,7 @@ contains integer :: nrow, ncol, i, skiprows_, max_rows_ skiprows_ = optval(skiprows, 0) - if ( skiprows_ < 0 ) call error_stop("loadtxt: skiprows needs to be non-negative.") + if ( skiprows_ < 0 ) call error_stop("loadtxt: skiprows must be non-negative.") max_rows_ = optval(max_rows, -1) From 938ba8c4ce152fc45bc7bfa9b940b35722fc4bb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Tue, 19 Apr 2022 22:36:12 +0200 Subject: [PATCH 06/15] loadtxt: Add test for max_rows --- src/tests/io/test_loadtxt.f90 | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/src/tests/io/test_loadtxt.f90 b/src/tests/io/test_loadtxt.f90 index 7f97e1177..e5fdcc1bf 100644 --- a/src/tests/io/test_loadtxt.f90 +++ b/src/tests/io/test_loadtxt.f90 @@ -19,7 +19,7 @@ subroutine collect_loadtxt(testsuite) new_unittest("loadtxt_sp_huge", test_loadtxt_sp_huge), & new_unittest("loadtxt_sp_tiny", test_loadtxt_sp_tiny), & new_unittest("loadtxt_dp", test_loadtxt_dp), & - new_unittest("loadtxt_dp_skip", test_loadtxt_dp_skip), & + new_unittest("test_loadtxt_dp_max_skip", test_loadtxt_dp_max_skip), & new_unittest("loadtxt_dp_huge", test_loadtxt_dp_huge), & new_unittest("loadtxt_dp_tiny", test_loadtxt_dp_tiny), & new_unittest("loadtxt_complex", test_loadtxt_complex) & @@ -135,25 +135,27 @@ subroutine test_loadtxt_dp(error) end subroutine test_loadtxt_dp - subroutine test_loadtxt_dp_skip(error) + subroutine test_loadtxt_dp_max_skip(error) !> Error handling type(error_type), allocatable, intent(out) :: error real(dp), allocatable :: input(:,:), expected(:,:) - integer :: n + integer :: n, m allocate(input(10,10)) - do n = 1, 5 - call random_number(input) - input = input - 0.5 - call savetxt('test_dp_skip.txt', input) - call loadtxt('test_dp_skip.txt', expected, skiprows=n) - call check(error, all(input(n+1:,:) == expected)) - deallocate(expected) - if (allocated(error)) return + do m = 0, 5 + do n = 1, 11 + call random_number(input) + 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)) + deallocate(expected) + if (allocated(error)) return + end do end do - end subroutine test_loadtxt_dp_skip + end subroutine test_loadtxt_dp_max_skip subroutine test_loadtxt_dp_huge(error) From 5af87c6f19d707a510dbcb7d98f66432b0acc91f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Wed, 20 Apr 2022 10:52:56 +0200 Subject: [PATCH 07/15] loadtxt: treat negative skiprows as 0 (numpy like) --- 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 613eb3174..3de897e00 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -117,9 +117,7 @@ contains integer :: s integer :: nrow, ncol, i, skiprows_, max_rows_ - skiprows_ = optval(skiprows, 0) - if ( skiprows_ < 0 ) call error_stop("loadtxt: skiprows must be non-negative.") - + skiprows_ = max(optval(skiprows, 0), 0) max_rows_ = optval(max_rows, -1) s = open(filename) From ad2faa9a6d5b1284a4cb0c35b395b446a8dedabb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 5 May 2022 12:56:22 +0200 Subject: [PATCH 08/15] stdlib_io: cut off skiprows --- src/stdlib_io.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 3de897e00..ee2d4feb4 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -129,9 +129,9 @@ contains #:endif ! determine number or rows - nrow = number_of_rows(s) - skiprows_ - if ( nrow < 0 ) call error_stop("loadtxt: skipping more rows than present.") - if ( max_rows_ < 0 .or. max_rows_ > nrow) max_rows_ = nrow + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_)) max_rows_ = nrow - skiprows_ allocate(d(max_rows_, ncol)) From 6c019401148f30ceddf10f778eea6b5c904b01ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 5 May 2022 12:56:37 +0200 Subject: [PATCH 09/15] stdlib_io: docs for cut off skiprows --- src/stdlib_io.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index ee2d4feb4..8930ee39a 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -93,7 +93,7 @@ contains character(len=*), intent(in) :: filename !! The array 'd' will be automatically allocated with the correct dimensions ${t1}$, allocatable, intent(out) :: d(:,:) - !! Skip the first `skiprows` lines, default: 0. + !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. integer, intent(in), optional :: skiprows !! Read max_rows lines of content after skiprows lines. The default is -1, to read all the lines. integer, intent(in), optional :: max_rows From 93689c91fbd4e9205fa069d4d641b2e75dbc4356 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Thu, 5 May 2022 16:00:42 +0200 Subject: [PATCH 10/15] rename test in src/tests/io/test_loadtxt.f90 Co-authored-by: Ian Giestas Pauli --- src/tests/io/test_loadtxt.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/io/test_loadtxt.f90 b/src/tests/io/test_loadtxt.f90 index e5fdcc1bf..a75c63e49 100644 --- a/src/tests/io/test_loadtxt.f90 +++ b/src/tests/io/test_loadtxt.f90 @@ -19,7 +19,7 @@ subroutine collect_loadtxt(testsuite) new_unittest("loadtxt_sp_huge", test_loadtxt_sp_huge), & new_unittest("loadtxt_sp_tiny", test_loadtxt_sp_tiny), & new_unittest("loadtxt_dp", test_loadtxt_dp), & - new_unittest("test_loadtxt_dp_max_skip", test_loadtxt_dp_max_skip), & + new_unittest("loadtxt_dp_max_skip", test_loadtxt_dp_max_skip), & new_unittest("loadtxt_dp_huge", test_loadtxt_dp_huge), & new_unittest("loadtxt_dp_tiny", test_loadtxt_dp_tiny), & new_unittest("loadtxt_complex", test_loadtxt_complex) & From ec049eab909dcd3de9698dc01eec54f1f983b6fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Sun, 8 May 2022 16:11:04 +0200 Subject: [PATCH 11/15] update specs docs of loadtxt --- doc/specs/stdlib_io.md | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 61b6d9578..5cbe00796 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)` +`call [[stdlib_io(module):loadtxt(interface)]](filename, array [, skiprows] [, max_rows])` ### Arguments @@ -25,6 +25,10 @@ Loads a rank-2 `array` from a text file. `array`: Shall be an allocatable rank-2 array of type `real`, `complex` or `integer`. +`skiprows` (optional): Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. + +`max_rows` (optional): Read `max_rows` lines of content after `skiprows` lines. The default is -1, to read all the lines. + ### Return value Returns an allocated rank-2 `array` with the content of `filename`. @@ -314,4 +318,4 @@ program demo_fmt_constants print FMT_COMPLEX_DP, c64 ! outputs: 1.0000000000000000E+002 0.0000000000000000E+000 end program demo_fmt_constants -``` \ No newline at end of file +``` From c046e7ee610957aaef3a08f3791e8ae64292a083 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 13 Jun 2022 14:35:15 +0200 Subject: [PATCH 12/15] Update doc/specs/stdlib_io.md Co-authored-by: Milan Curcic --- doc/specs/stdlib_io.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 5cbe00796..971a8ee29 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -27,7 +27,7 @@ Loads a rank-2 `array` from a text file. `skiprows` (optional): Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. -`max_rows` (optional): Read `max_rows` lines of content after `skiprows` lines. The default is -1, to read all the lines. +`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. ### Return value From 764322ae1c8df063f5de8fcad92a44856ab7d3f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 13 Jun 2022 14:35:27 +0200 Subject: [PATCH 13/15] Update src/stdlib_io.fypp Co-authored-by: Milan Curcic --- src/stdlib_io.fypp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 8930ee39a..598946e73 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -95,7 +95,10 @@ contains ${t1}$, allocatable, intent(out) :: d(:,:) !! Skip the first `skiprows` lines. If skipping more rows than present, a 0-sized array will be returned. The default is 0. integer, intent(in), optional :: skiprows - !! Read max_rows lines of content after skiprows lines. The default is -1, to read all the lines. + !! 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. integer, intent(in), optional :: max_rows !! !! Example From 0f356db668fef2679b421de2aa3a806ae52c5f6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 13 Jun 2022 15:50:46 +0200 Subject: [PATCH 14/15] loadtxt: determine number of columns from first line to be read --- src/stdlib_io.fypp | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 598946e73..3546599c4 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -125,17 +125,18 @@ contains s = open(filename) + ! determine number or rows + nrow = number_of_rows(s) + skiprows_ = min(skiprows_, nrow) + if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_) ) max_rows_ = nrow - skiprows_ + ! determine number of columns - ncol = number_of_columns(s) + ncol = 0 + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) #:if 'complex' in t1 ncol = ncol / 2 #:endif - ! determine number or rows - nrow = number_of_rows(s) - skiprows_ = min(skiprows_, nrow) - if ( max_rows_ < 0 .or. max_rows_ > (nrow - skiprows_)) max_rows_ = nrow - skiprows_ - allocate(d(max_rows_, ncol)) do i = 1, skiprows_ @@ -196,17 +197,25 @@ contains #:endfor - integer function number_of_columns(s) + integer function number_of_columns(s, skiprows) !! version: experimental !! !! determine number of columns integer,intent(in) :: s + integer, intent(in), optional :: skiprows - integer :: ios + integer :: ios, skiprows_ character :: c logical :: lastblank + skiprows_ = optval(skiprows, 0) + rewind(s) + + do i = 1, skiprows_ + read(s, *) + end do + number_of_columns = 0 lastblank = .true. do From b428213d03307efabc32f1ded454b1a9f40bbc0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Sebastian=20M=C3=BCller?= Date: Mon, 13 Jun 2022 15:53:40 +0200 Subject: [PATCH 15/15] number_of_columns: bugfix for missing int --- src/stdlib_io.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 3546599c4..c0f84932e 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -204,7 +204,7 @@ contains integer,intent(in) :: s integer, intent(in), optional :: skiprows - integer :: ios, skiprows_ + integer :: ios, skiprows_, i character :: c logical :: lastblank