Optval

src/CMakeLists.txt

@@ -3,6 +3,7 @@
 # Create a list of the files to be preprocessed
 set(fppFiles
     stdlib_experimental_io.fypp
+    stdlib_experimental_optval.fypp
     stdlib_experimental_stats.fypp
     stdlib_experimental_stats_mean.fypp
 )
@@ -25,6 +26,7 @@ set(SRC
     stdlib_experimental_error.f90
     stdlib_experimental_kinds.f90
     stdlib_experimental_optval.f90
+    stdlib_experimental_stats.f90
     stdlib_experimental_system.F90
     ${outFiles}
 )

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,21 @@ 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}$
     #: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
@@ -58,7 +58,7 @@ contains
       !     ...
       !
       integer :: s
-      integer :: nrow,ncol,i
+      integer :: nrow, ncol, i
 
       s = open(filename)
 
@@ -74,12 +74,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,13 +100,13 @@ contains
         write(s, *) d(i, :)
       end do
       close(s)
-    end subroutine savetxt_${k1}$
+    end subroutine savetxt_${t1[0]}$${k1}$
   #:endfor
 
 
   integer function number_of_columns(s)
     ! determine number of columns
-    integer,intent(in)::s
+    integer,intent(in) :: s
 
     integer :: ios
     character :: c
@@ -126,23 +126,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/stdlib_experimental_optval.fypp

@@ -0,0 +1,62 @@
+#:include "common.fypp"
+
+#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + &
+  & [('l1','logical')]
+
+module stdlib_experimental_optval
+  !!
+  !! Provides a generic function `optval`, which can be used to
+  !! conveniently implement fallback values for optional arguments
+  !! to subprograms. If `x` is an `optional` parameter of a
+  !! subprogram, then the expression `optval(x, default)` inside that
+  !! subprogram evaluates to `x` if it is present, otherwise `default`.
+  !!
+  !! It is an error to call `optval` with a single actual argument.
+  !!
+  use stdlib_experimental_kinds, only: sp, dp, qp, int8, int16, int32, int64
+  implicit none
+
+
+  private
+  public :: optval
+
+
+  interface optval
+    #:for k1, t1 in KINDS_TYPES
+      module procedure optval_${t1[0]}$${k1}$
+    #:endfor
+    module procedure optval_character
+     ! TODO: differentiate ascii & ucs char kinds
+  end interface optval
+
+
+contains
+
+  #:for k1, t1 in KINDS_TYPES
+    pure elemental function optval_${t1[0]}$${k1}$(x, default) result(y)
+    ${t1}$, intent(in), optional :: x
+    ${t1}$, intent(in) :: default
+    ${t1}$ :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_${t1[0]}$${k1}$
+  #:endfor
+
+  ! Cannot be made elemental
+  pure function optval_character(x, default) result(y)
+    character(len=*), intent(in), optional :: x
+    character(len=*), intent(in) :: default
+    character(len=:), allocatable :: y
+
+    if (present(x)) then
+       y = x
+    else
+       y = default
+    end if
+  end function optval_character
+
+end module stdlib_experimental_optval

src/tests/io/array5.dat

@@ -0,0 +1,2 @@
+               (1.0000000000000000,0.0000000000000000)               (3.0000000000000000,0.0000000000000000)               (5.0000000000000000,0.0000000000000000)
+               (2.0000000000000000,0.0000000000000000)               (4.0000000000000000,0.0000000000000000)               (6.0000000000000000,0.0000000000000000)