Added support for complex numbers in loadtxt and savetxt

Author: fiolj

src/common.fypp

@@ -9,6 +9,14 @@
 #! Collected (kind, type) tuples for real types
 #:set REAL_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES))
 
+#! Complex kinds to be considered during templating
+#:set CMPLX_KINDS = ["sp", "dp", "qp"]
+
+#! Complex types to be considere during templating
+#:set CMPLX_TYPES = ["complex({})".format(k) for k in CMPLX_KINDS]
+
+#! Collected (kind, type) tuples for complex types
+#:set CMPLX_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES))
 
 #! Integer kinds to be considered during templating
 #:set INT_KINDS = ["int8", "int16", "int32", "int64"]

src/stdlib_experimental_io.fypp

@@ -1,6 +1,6 @@
 #:include "common.fypp"
 
-#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES
+#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES
 
 module stdlib_experimental_io
 
@@ -18,21 +18,22 @@ module stdlib_experimental_io
   public :: parse_mode
 
   interface loadtxt
-    #:for k1, _ in KINDS_TYPES
-      module procedure loadtxt_${k1}$
+    #:for k1, t1 in KINDS_TYPES
+      module procedure loadtxt_${t1[0]}$${k1}$
+! loadtxt_${k1}$
     #:endfor
   end interface loadtxt
 
   interface savetxt
-    #:for k1, _ in KINDS_TYPES
-      module procedure savetxt_${k1}$
+    #:for k1, t1 in KINDS_TYPES
+      module procedure savetxt_${t1[0]}$${k1}$
     #:endfor
   end interface
 
 contains
 
   #:for k1, t1 in KINDS_TYPES
-    subroutine loadtxt_${k1}$(filename, d)
+    subroutine  loadtxt_${t1[0]}$${k1}$(filename, d)
       ! Loads a 2D array from a text file.
       !
       ! Arguments
@@ -74,12 +75,12 @@ contains
       end do
       close(s)
 
-    end subroutine loadtxt_${k1}$
+    end subroutine loadtxt_${t1[0]}$${k1}$
   #:endfor
 
 
   #:for k1, t1 in KINDS_TYPES
-    subroutine savetxt_${k1}$(filename, d)
+    subroutine savetxt_${t1[0]}$${k1}$(filename, d)
       ! Saves a 2D array into a text file.
       !
       ! Arguments
@@ -100,7 +101,7 @@ contains
         write(s, *) d(i, :)
       end do
       close(s)
-    end subroutine savetxt_${k1}$
+    end subroutine savetxt_${t1[0]}$${k1}$
   #:endfor
 
 
@@ -126,23 +127,33 @@ contains
   end function number_of_columns
 
 
-  integer function number_of_rows_numeric(s)
+  integer function number_of_rows_numeric(s) result(nrows)
     ! determine number or rows
     integer,intent(in)::s
     integer :: ios
 
-    real::r
+    real :: r
+    complex :: z
 
     rewind(s)
-    number_of_rows_numeric = 0
+    nrows = 0
     do
       read(s, *, iostat=ios) r
       if (ios /= 0) exit
-      number_of_rows_numeric = number_of_rows_numeric + 1
+      nrows = nrows + 1
     end do
 
     rewind(s)
 
+    ! If there are no rows of real numbers, it may be that they are complex
+    if( nrows == 0) then
+      do
+        read(s, *, iostat=ios) z
+        if (ios /= 0) exit
+        nrows = nrows + 1
+      end do
+      rewind(s)
+    end if
   end function number_of_rows_numeric
 
 

src/tests/io/test_savetxt.f90

@@ -9,8 +9,10 @@ program test_savetxt
 outpath = get_outpath() // "/tmp.dat"
 
 call test_int32(outpath)
-call test_sp(outpath)
-call test_dp(outpath)
+call test_rsp(outpath)
+call test_rdp(outpath)
+call test_csp(outpath)
+call test_cdp(outpath)
 
 contains
 
@@ -45,7 +47,7 @@ subroutine test_int32(outpath)
     end subroutine
 
 
-    subroutine test_sp(outpath)
+    subroutine test_rsp(outpath)
     character(*), intent(in) :: outpath
     real(sp) :: d(3, 2), e(2, 3)
     real(sp), allocatable :: d2(:, :)
@@ -63,7 +65,7 @@ subroutine test_sp(outpath)
     end subroutine
 
 
-    subroutine test_dp(outpath)
+    subroutine test_rdp(outpath)
     character(*), intent(in) :: outpath
     real(dp) :: d(3, 2), e(2, 3)
     real(dp), allocatable :: d2(:, :)
@@ -80,4 +82,38 @@ subroutine test_dp(outpath)
     call assert(all(abs(e-d2) < epsilon(1._dp)))
     end subroutine
 
+    subroutine test_csp(outpath)
+    character(*), intent(in) :: outpath
+    complex(sp) :: d(3, 2), e(2, 3)
+    complex(sp), allocatable :: d2(:, :)
+    d = cmplx(1, 1)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
+    call savetxt(outpath, d)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [3, 2]))
+    call assert(all(abs(d-d2) < epsilon(1._sp)))
+
+    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+    call savetxt(outpath, e)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [2, 3]))
+    call assert(all(abs(e-d2) < epsilon(1._sp)))
+    end subroutine
+
+    subroutine test_cdp(outpath)
+    character(*), intent(in) :: outpath
+    complex(dp) :: d(3, 2), e(2, 3)
+    complex(dp), allocatable :: d2(:, :)
+    d = cmplx(1._dp, 1._dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
+    call savetxt(outpath, d)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [3, 2]))
+    call assert(all(abs(d-d2) < epsilon(1._dp)))
+
+    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
+    call savetxt(outpath, e)
+    call loadtxt(outpath, d2)
+    call assert(all(shape(d2) == [2, 3]))
+    call assert(all(abs(e-d2) < epsilon(1._dp)))
+    end subroutine
+
 end program