Loadtxt real format update to list directed

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`.

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

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}$

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) &
         ]