diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 8c868802a..ce6f5b9c5 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -6,36 +6,37 @@ title: io [TOC] -## `loadtxt` - load a 2D array from a text file +## `loadtxt` - load a 2D array or 1D character array from a text file ### Status Experimental ### Description -Loads a rank-2 `array` from a text file. +Loads a rank-2 `array` or rank-1 `character array` from a text file. ### Syntax -`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows] [, fmt])` +`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows] [, fmt], [,skip_blank_lines])` ### Arguments `filename`: Shall be a character expression containing the file name from which to load the rank-2 `array`. -`array`: Shall be an allocatable rank-2 array of type `real`, `complex` or `integer`. +`array`: Shall be an allocatable rank-2 array of type `real`, `complex` or `integer` or a allocatable rank-1 `character` array. `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. 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. +`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. Valid only for `real`, `complex` and `integer`. +`skip_blank_lines` (optional): Will ignore blank lines in the text file. Valid only for `character` array. ### Return value -Returns an allocated rank-2 `array` with the content of `filename`. +Returns an allocated rank-2 `array` with the content of `filename`, or a rank-1 `character` array where the length is the longest line of the file. ### Example diff --git a/example/io/example_loadtxt.f90 b/example/io/example_loadtxt.f90 index fa4091c2f..b742fbebe 100644 --- a/example/io/example_loadtxt.f90 +++ b/example/io/example_loadtxt.f90 @@ -2,8 +2,12 @@ program example_loadtxt use stdlib_io, only: loadtxt implicit none real, allocatable :: x(:, :) + character(len=:), allocatable :: text(:) call loadtxt('example.dat', x) ! Can also use list directed format if the default read fails. call loadtxt('example.dat', x, fmt='*') + + ! Load as a character array. Character len will be equal to the largest line length. + call loadtxt('example.dat', text) end program example_loadtxt diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 2a96f1a61..2719f5ac3 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -66,6 +66,7 @@ module stdlib_io #:for k1, t1 in KINDS_TYPES module procedure loadtxt_${t1[0]}$${k1}$ #:endfor + module procedure :: loadtxt_char end interface loadtxt interface savetxt @@ -192,6 +193,119 @@ contains end subroutine loadtxt_${t1[0]}$${k1}$ #:endfor + subroutine loadtxt_char(filename, d, skiprows, max_rows, skip_blank_lines) + !! + !! Loads a text file into a 1D character array. + !! + character(len=*), intent(in) :: filename + character(len=:), intent(out), allocatable :: d(:) + integer, intent(in), optional :: skiprows, max_rows + logical, intent(in), optional :: skip_blank_lines + + logical :: skip_blank_lines_, read_line + + integer :: i, u, len_text, max_line_length, line_length, start_pos, end_pos, & + current_line, next_line_pos, step, max_rows_, skiprows_ + + character(len=:), allocatable :: text + + ! Set default optional values + skiprows_ = optval(skiprows, 0) + max_rows_ = optval(max_rows, -1) + skip_blank_lines_ = optval(skip_blank_lines, .false.) + + !! Open and store all of file contents. + open (newunit=u, file=filename, action='read', form='unformatted', access='stream') + inquire(unit=u, size=len_text) ! Get total character count of file. + allocate(character(len=len_text) :: text) + read(u) text + close(u) + + ! Loop through file twice. + ! step = 1 loop will get line count, max line size and allocate character array. + ! step = 2 will fill the array. + do step = 1, 2 + max_line_length = 0 + ! Will skip skiprow lines if specified, since will only read line if current_line is positive. + current_line = -skiprows_ + next_line_pos = 1 + do while (next_line_pos > 0) + + start_pos = next_line_pos + + ! Search text starting at start_pos for end of line. end_pos will exclude CRLR or LR characters. + ! next line idx is the start of the next line. Will be 0 if last line in text. + call get_line(text, start_pos, end_pos, next_line_pos) + + ! Check for and skip blank lines if requested. + read_line = .true. + if (skip_blank_lines_) then + if (len_trim(text(start_pos:end_pos)) == 0) read_line = .false. + endif + + if (read_line) then + current_line = current_line + 1 + if (step == 1) then + line_length = end_pos - start_pos + 1 + if ((line_length > max_line_length) .and. (current_line > 0)) max_line_length = line_length + else + if (current_line > 0) d(current_line) = text(start_pos:end_pos) + endif + endif + + if ((max_rows_ >= 0) .and. (current_line == max_rows_)) exit ! Check max_row input if user has specified that. + enddo + + if (step == 1) then + ! Allocate character array with max line size and line count. + ! If skip rows higher than lines found, allocate to size 0 array. + allocate( character(max_line_length) :: d(max(0,current_line))) + endif + enddo + + contains + + pure subroutine get_line(text, start_idx, end_idx, next_line_idx) + ! Search ftext for line returns. Start_idx:end_idx will be the character variables of the line. + ! next_line_idx is the start of the next line. Will be 0 if last line in text. + character(len=*), intent(in) :: text + integer, intent(in) :: start_idx + integer, intent(out) :: end_idx, next_line_idx + + integer :: idx, ascii_idx + + idx = start_idx + + !If no line ending found, will return end pos of text and next_line_idx = 0. + next_line_idx = 0 + end_idx = len(text) + + do while (idx <= len(text)) + !! Find line end + ! Look for either CR or LR + ascii_idx = iachar(text(idx:idx)) + + if (ascii_idx == 13) then + ! Found CR return. Check for LR + if (iachar(text(idx+1:idx+1)) == 10) then + end_idx = idx - 1 + next_line_idx = idx + 2 + return + endif + + ! Check for standalone LR + elseif (ascii_idx == 10) then + end_idx = idx - 1 + next_line_idx = idx + 1 + return + endif + + ! Go to next line + idx = idx + 1 + enddo + end subroutine get_line + end subroutine loadtxt_char + #:for k1, t1 in KINDS_TYPES subroutine savetxt_${t1[0]}$${k1}$(filename, d) diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index 3234c2533..45f539da1 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -22,7 +22,8 @@ subroutine collect_loadtxt(testsuite) 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) & + new_unittest("loadtxt_complex", test_loadtxt_complex), & + new_unittest("loadtxt_char", test_loadtxt_char) & ] end subroutine collect_loadtxt @@ -275,6 +276,31 @@ subroutine test_loadtxt_complex(error) end do end subroutine test_loadtxt_complex + + subroutine test_loadtxt_char(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + character(len=5) :: input(3) + character(len=:), allocatable :: expected(:) + integer :: u, n + + open(newunit=u, file="test_char.txt") + write(u,'(A)') 'skipped' + write(u,'(A)') 'skipped' + write(u,'(A)') ' ' + write(u,'(A)') 'line' + write(u,'(A)') 'line' + write(u,'(A)') 'char length should be 23' + write(u,'(A)') 'skipped' + write(u,'(A)') 'skipped' + close(u) + + call loadtxt('test_char.txt', expected, skip_blank_lines=.true., skiprows=2, max_rows=3) + + call check(error, size(expected) == 3,'loadtxt_char returns incorrect line count.') + call check(error, len(expected) == 24,'loadtxt_char returns incorrect line size.') + + end subroutine test_loadtxt_char end module test_loadtxt