Savetxt unit

doc/specs/stdlib_io.md

@@ -106,15 +106,25 @@ Saves a rank-2 `array` into a text file.
 
 ### Syntax
 
-`call ` [[stdlib_io(module):savetxt(interface)]] `(filename, array [, delimiter])`
+`call ` [[stdlib_io(module):savetxt(interface)]] `(filename, array [,  delimiter] [, fmt] [, header] [, footer] [, comments])`
+
+`call ` [[stdlib_io(module):savetxt(interface)]] `(unit, array[,  delimiter] [, fmt] [, header] [, footer] [, comments])`
 
 ### Arguments
 
-`filename`: Shall be  a character expression containing the name of the file that will contain the 2D `array`.
+`filename or unit`: Shall be either a character expression containing the name of the file or an integer containing the unit of an already open file, that will contain the 2D `array`. Setting the two of them shall give an error.
 
 `array`: Shall be a rank-2 array of type `real`, `complex` or `integer`.
 
-`delimiter` (optional): Shall be a character expression of length 1 that contains the delimiter used to separate the columns. The default is `' '`.
+`delimiter` (optional): Shall be a character expression of any length that contains the delimiter used to separate the columns. The default is a single space `' '`.
+
+`fmt`: (optional): Fortran format specifier for the text save. Defaults to the write format for the data type.
+
+`header`: (optional) Shall be a character expression that will be written at the beginning of the file.
+
+`footer`: (optional) Shall be a character expression that will be written at the end of the file.
+
+`comments`: (optional) : Shall  be a character expression that will be prepended to the ``header`` and ``footer`` strings to mark them as comments. Default: `#`.
 
 ### Output
 

example/io/example_savetxt.f90

@@ -1,7 +1,12 @@
 program example_savetxt
   use stdlib_io, only: savetxt
+  use, intrinsic :: iso_fortran_env, only: output_unit
   implicit none
   real :: x(3, 2) = 1
   call savetxt('example.dat', x)
   call savetxt('example.csv', x, delimiter=',')
+  call savetxt('example1.dat', x, header='x  (x-units)   y  (y-units)')
+  call savetxt('example2.dat', x, header='x  (x-units)   y  (y-units)', comments='! ', footer='This is all data')
+  call savetxt('example3.dat', x, fmt='g0.7')
+  call savetxt(output_unit, x, header='x  (x-units)   y  (y-units)')
 end program example_savetxt

src/stdlib_io.fypp

@@ -68,6 +68,8 @@ module stdlib_io
     FMT_COMPLEX_QP = '(es44.35e4,1x,es44.35e4)'
   !> Default delimiter for loadtxt, savetxt and number_of_columns
   character(len=1), parameter :: delimiter_default = " "
+  character(len=1), parameter :: comment_default = "#"
+  character(len=1), parameter :: nl = new_line('a')
 
   public :: FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_REAL_XDP, FMT_REAL_QP
   public :: FMT_COMPLEX_SP, FMT_COMPLEX_DP, FMT_COMPLEX_XDP, FMT_COMPLEX_QP
@@ -97,8 +99,10 @@ module stdlib_io
     !!
     !! Saves a 2D array into a text file
     !! ([Specification](../page/specs/stdlib_io.html#description_2))
+    #:for a1 in ['f', 'u']
     #:for k1, t1 in KINDS_TYPES
-      module procedure savetxt_${t1[0]}$${k1}$
+      module procedure savetxt_${t1[0]}$${k1}$${a1}$
+    #:endfor
     #:endfor
   end interface
 
@@ -251,19 +255,27 @@ contains
     end subroutine loadtxt_${t1[0]}$${k1}$
   #:endfor
 
-
+  #:for arg1 in ['filename', 'unit']
   #:for k1, t1 in KINDS_TYPES
-    subroutine savetxt_${t1[0]}$${k1}$(filename, d, delimiter)
+    subroutine savetxt_${t1[0]}$${k1}$${arg1[0]}$ (${arg1}$, d, delimiter, fmt, header, footer, comments)
       !! version: experimental
       !!
       !! Saves a 2D array into a text file.
       !!
       !! Arguments
       !! ---------
       !!
+      #:if 'filename' in arg1
       character(len=*), intent(in) :: filename  ! File to save the array to
+      #:elif 'unit' in arg1
+      integer, intent(in) :: unit
+      #:endif
       ${t1}$, intent(in) :: d(:,:)           ! The 2D array to save
-      character(len=1), intent(in), optional :: delimiter  ! Column delimiter. Default is a space.
+      character(len=1), intent(in), optional :: delimiter  ! Column delimiter. Default is a space ' '.
+      character(len=*), intent(in), optional :: fmt  !< Fortran format specifier. Defaults to the write format for the data type.
+      character(len=*), intent(in), optional :: header  !< If present, text to write before data.
+      character(len=*), intent(in), optional :: footer  !< If present, text to write after data.
+      character(len=*), intent(in), optional :: comments  !< Comment character. Default "#".
       !!
       !! Example
       !! -------
@@ -276,40 +288,101 @@ contains
       integer :: s, i, ios
       character(len=1) :: delimiter_
       character(len=3) :: delim_str
+      character(len=:), allocatable :: default_fmt
       character(len=:), allocatable :: fmt_
+      character(len=:), allocatable :: comments_
+      character(len=:), allocatable :: header_
+      character(len=:), allocatable :: footer_
       character(len=1024) :: iomsg, msgout
+      #:if 'filename' in arg1
+      integer :: unit
+      #:else
+      logical :: opened
+      #:endif
 
       delimiter_ = optval(delimiter, delimiter_default)
       delim_str = "'"//delimiter_//"'"
+      comments_ = optval(comments, comment_default)
+      header_ = optval(header, '')
+      footer_ = optval(footer, '')
+
       #:if 'real' in t1
-        fmt_ = "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,"//delim_str//"))"
+        default_fmt = FMT_REAL_${k1}$(2:len(FMT_REAL_${k1}$)-1)
       #:elif 'complex' in t1
-        fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:11)//delim_str//FMT_COMPLEX_${k1}$(14:23)//",:,"//delim_str//"))"
+        default_fmt = FMT_COMPLEX_${k1}$(2:11)//delim_str//FMT_COMPLEX_${k1}$ (14:23)
       #:elif 'integer' in t1
-        fmt_ = "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,"//delim_str//"))"
+        default_fmt = FMT_INT(2:len(FMT_INT)-1)
+      #:endif
+      fmt_ = "(*("//optval(fmt, default_fmt)//",:,"//delim_str//"))"
+
+      #:if 'filename' in arg1
+      unit = open (filename, "w")
+      #:else
+      inquire (unit=unit, opened=opened)
+      if(.not. opened) then
+           write (msgout,'(a,i0,a)') 'savetxt error: unit ',unit,' not open'
+      end if
       #:endif
 
-      s = open(filename, "w")
+      !! Write the header if non-empty
+      ! prepend function may be replaced by use of replace_all but currently stdlib_strings
+      ! is being compiled after stdlib_io
+      ! if (header_ /= '') write (unit, '(A)') comments_//replace_all(header_, nl, nl//comments_)
+      if (header_ /= '') write (unit, '(A)', iostat=ios, iomsg=iomsg) prepend(header_, comments_)
       do i = 1, size(d, 1)
         #:if 'real' in t1 or 'complex' in t1 or 'integer' in t1
-          write(s, fmt_, &
+          write(unit, fmt_, &
         #:else
-          write(s, *, &
+          write(unit, *, &
         #:endif
                 iostat=ios,iomsg=iomsg) d(i, :)
 
         if (ios/=0) then 
-           write(msgout,1) trim(iomsg),size(d,2),i,trim(filename) 
+            write (msgout,1) trim(iomsg),size(d,2),i,&
+            #:if 'filename' in arg1
+              trim(filename)
+            #:else
+              unit
+            #:endif
            call error_stop(msg=trim(msgout))
         end if           
 
       end do
-      close(s)
-
+      ! if (footer_ /= '') write (unit, '(A)') comments_//replace_all(footer_, nl, nl//comments_)
+      if (footer_ /= '') write (unit, '(A)') prepend(footer_, comments_)
+      #:if 'filename' in arg1
+      close (unit)
+      #:endif
+
+      #:if 'filename' in arg1
       1 format('savetxt: error <',a,'> writing ',i0,' values to line ',i0,' of ',a,'.')
+      #:else
+      1 format('savetxt: error <',a,'> writing ',i0,' values to line ',i0,' of unit ',i0,'.')
+      #:endif
 
-    end subroutine savetxt_${t1[0]}$${k1}$
+    end subroutine savetxt_${t1[0]}$${k1}$${arg1[0]}$
+  #:endfor
   #:endfor
+  pure function prepend(Sin, comment) result(Sout)
+    character(len=*), intent(in) :: Sin
+    character(len=:), allocatable :: Sout
+    character(len=*), intent(in) :: comment 
+    character(len=len(comment)+2) :: com_
+    integer :: bol, eol       ! indexes of beginning and end of line
+
+    ! IF (trim(Sin) == '') return
+    com_ = comment//" "
+    bol = 1
+    Sout = com_              ! Initialize to comment the first line
+    do
+      eol = index(Sin(bol:), nl) + bol - 1 ! position of end of line in original string
+      if (eol == bol - 1) exit             ! index returned 0
+      Sout = Sout//Sin(bol:eol)//com_
+      bol = eol + 1
+    end do
+    if (eol < len(Sin)) Sout = Sout//Sin(eol + 1:) ! Add last line if not newline present
+
+  end function prepend
 
 
   integer function number_of_columns(s, skiprows, delimiter)

test/io/test_savetxt.f90

@@ -48,15 +48,15 @@ subroutine test_iint32(error)
         outpath = get_outpath() // "/tmp_test_iint32.dat"
 
         d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
-        call savetxt(outpath, d)
-        call loadtxt(outpath, d2)
+        call savetxt(outpath, d, delimiter=',')
+        call loadtxt(outpath, d2, delimiter=',')
         call check(error, all(shape(d2) == [3, 2]))
         if (allocated(error)) return
         call check(error, all(d == d2))
         if (allocated(error)) return
 
         e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
-        call savetxt(outpath, e)
+        call savetxt(outpath, e, fmt='(I2)')
         call loadtxt(outpath, d2)
         call check(error, all(shape(d2) == [2, 3]))
         if (allocated(error)) return
@@ -110,8 +110,8 @@ subroutine test_rdp(error)
         if (allocated(error)) return
 
         e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
-        call savetxt(outpath, e)
-        call loadtxt(outpath, d2)
+        call savetxt(outpath, e, fmt='(g0.7)', header="Three values per line", footer="Total size = 6", comments='#!')
+        call loadtxt(outpath, d2, fmt='*', skiprows=1, max_rows=2)
         call check(error, all(shape(d2) == [2, 3]))
         if (allocated(error)) return
         call check(error, all(e == d2))