Implement loadtxt and savetxt

CMakeLists.txt

@@ -0,0 +1,9 @@
+cmake_minimum_required(VERSION 3.5.0 FATAL_ERROR)
+
+enable_language(Fortran)
+
+project(stdlib)
+
+enable_testing()
+
+add_subdirectory(src)

Makefile.manual

@@ -0,0 +1,18 @@
+# Fortran stdlib Makefile
+
+FC = gfortran
+FCFLAGS=-O0
+
+.PHONY: all clean
+
+all: stdlib tests 
+
+stdlib:
+	$(MAKE) -f Makefile.manual FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/lib
+
+tests: stdlib
+	$(MAKE) -f Makefile.manual FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/tests
+
+clean:
+	$(MAKE) -f Makefile.manual clean --directory=src/lib
+	$(MAKE) -f Makefile.manual clean --directory=src/tests

src/CMakeLists.txt

@@ -0,0 +1,14 @@
+set(SRC
+    stdlib_experimental_io.f90
+    stdlib_experimental_error.f90
+)
+
+add_library(fortran_stdlib ${SRC})
+
+add_subdirectory(tests)
+
+install(TARGETS fortran_stdlib
+        RUNTIME DESTINATION bin
+        ARCHIVE DESTINATION lib
+        LIBRARY DESTINATION lib
+    )

src/stdlib_experimental_error.f90

@@ -0,0 +1,41 @@
+module stdlib_experimental_error
+implicit none
+private
+public :: assert, error_stop
+
+contains
+
+subroutine assert(condition)
+! If condition == .false., it aborts the program.
+!
+! Arguments
+! ---------
+!
+logical, intent(in) :: condition
+!
+! Example
+! -------
+!
+! call assert(a == 5)
+
+if (.not. condition) call error_stop("Assert failed.")
+end subroutine
+
+subroutine error_stop(msg)
+! Aborts the program with nonzero exit code
+!
+! The statement "stop msg" will return 0 exit code when compiled using
+! gfortran. error_stop() uses the statement "stop 1" which returns an exit code
+! 1 and a print statement to print the message.
+!
+! Example
+! -------
+!
+! call error_stop("Invalid argument")
+
+character(len=*) :: msg ! Message to print on stdout
+print *, msg
+stop 1
+end subroutine
+
+end module

src/stdlib_experimental_io.f90

@@ -0,0 +1,129 @@
+module stdlib_experimental_io
+use iso_fortran_env, only: sp=>real32, dp=>real64
+implicit none
+private
+public :: loadtxt, savetxt
+
+interface loadtxt
+    module procedure sloadtxt
+    module procedure dloadtxt
+end interface
+
+interface savetxt
+    module procedure ssavetxt
+    module procedure dsavetxt
+end interface
+
+contains
+
+subroutine sloadtxt(filename, d)
+character(len=*), intent(in) :: filename
+real(sp), allocatable, intent(out) :: d(:,:)
+real(dp), allocatable :: tmp(:,:)
+call dloadtxt(filename, tmp)
+allocate(d(size(tmp,1),size(tmp,2)))
+d = real(tmp,sp)
+end subroutine
+
+subroutine dloadtxt(filename, d)
+! Loads a 2D array from a text file.
+!
+! Arguments
+! ---------
+!
+! Filename to load the array from
+character(len=*), intent(in) :: filename
+! The array 'd' will be automatically allocated with the correct dimensions
+real(dp), allocatable, intent(out) :: d(:,:)
+!
+! Example
+! -------
+!
+! real(dp), allocatable :: data(:, :)
+! call loadtxt("log.txt", data)  ! 'data' will be automatically allocated
+!
+! Where 'log.txt' contains for example::
+!
+!     1 2 3
+!     2 4 6
+!     8 9 10
+!     11 12 13
+!     ...
+!
+character :: c
+integer :: s, ncol, nrow, ios, i
+logical :: lastwhite
+real(dp) :: r
+
+open(newunit=s, file=filename, status="old")
+
+! determine number of columns
+ncol = 0
+lastwhite = .true.
+do
+   read(s, '(a)', advance='no', iostat=ios) c
+   if (ios /= 0) exit
+   if (lastwhite .and. .not. whitechar(c)) ncol = ncol + 1
+   lastwhite = whitechar(c)
+end do
+
+rewind(s)
+
+! determine number or rows
+nrow = 0
+do
+   read(s, *, iostat=ios) r
+   if (ios /= 0) exit
+   nrow = nrow + 1
+end do
+
+rewind(s)
+
+allocate(d(nrow, ncol))
+do i = 1, nrow
+    read(s, *) d(i, :)
+end do
+close(s)
+end subroutine
+
+subroutine ssavetxt(filename, d)
+character(len=*), intent(in) :: filename
+real(sp), intent(in) :: d(:,:)
+call dsavetxt(filename, real(d,dp))
+end subroutine
+
+subroutine dsavetxt(filename, d)
+! Saves a 2D array into a textfile.
+!
+! Arguments
+! ---------
+!
+character(len=*), intent(in) :: filename  ! File to save the array to
+real(dp), intent(in) :: d(:,:)           ! The 2D array to save
+!
+! Example
+! -------
+!
+! real(dp) :: data(3, 2)
+! call savetxt("log.txt", data)
+
+integer :: s, i
+open(newunit=s, file=filename, status="replace")
+do i = 1, size(d, 1)
+    write(s, *) d(i, :)
+end do
+close(s)
+end subroutine
+
+
+logical function whitechar(char) ! white character
+! returns .true. if char is space (32) or tab (9), .false. otherwise
+character, intent(in) :: char
+if (iachar(char) == 32 .or. iachar(char) == 9) then
+    whitechar = .true.
+else
+    whitechar = .false.
+end if
+end function
+
+end module

src/tests/CMakeLists.txt

@@ -0,0 +1 @@
+add_subdirectory(loadtxt)

src/tests/loadtxt/CMakeLists.txt

@@ -0,0 +1,12 @@
+include_directories(${PROJECT_BINARY_DIR}/src)
+
+project(loadtxt)
+
+add_executable(test_loadtxt test_loadtxt.f90)
+target_link_libraries(test_loadtxt fortran_stdlib)
+
+add_executable(test_savetxt test_savetxt.f90)
+target_link_libraries(test_savetxt fortran_stdlib)
+
+add_test(test_loadtxt ${PROJECT_BINARY_DIR}/test_loadtxt)
+add_test(test_savetxt ${PROJECT_BINARY_DIR}/test_savetxt)

src/tests/loadtxt/array1.dat

@@ -0,0 +1,4 @@
+1 2
+3 4
+5 6
+7 8

src/tests/loadtxt/array2.dat

@@ -0,0 +1,4 @@
+1 2 9
+3 4 10
+5 6 11
+7 8 12

src/tests/loadtxt/array3.dat

@@ -0,0 +1,16 @@
+1.000000000000000021e-08 9.199998759392489944e+01
+1.024113254885563425e-08 9.199998731474968849e+01
+1.048233721895820948e-08 9.199998703587728244e+01
+1.072361403187881949e-08 9.199998675729767683e+01
+1.096496300919481796e-08 9.199998647900135040e+01
+1.120638417249036630e-08 9.199998620097916557e+01
+1.144787754335570897e-08 9.199998592322251056e+01
+1.168944314338753750e-08 9.199998564572304360e+01
+1.193108099418952317e-08 9.199998536847290609e+01
+1.217279111737088596e-08 9.199998509146449521e+01
+1.241457353454836993e-08 9.199998481469057765e+01
+1.265642826734443823e-08 9.199998453814424693e+01
+1.289835533738818635e-08 9.199998426181879552e+01
+1.314035476631514857e-08 9.199998398570787117e+01
+1.338242657576766519e-08 9.199998370980536322e+01
+1.362457078739434161e-08 9.199998343410533153e+01

src/tests/loadtxt/array4.dat

@@ -0,0 +1,3 @@
+  1.56367173122998851E-010  4.51568171776229776E-007  4.96568621780730290E-006  5.01068666781180638E-005  5.01518671281225327E-004  5.01763629287519872E-003  5.58487648776459511E-002  0.32618374746711520        1.7639051761733842        9.4101331514118236
+  8.23481961129666271E-010  4.58239319656296504E-007  5.03239769660796763E-006  5.07739814661247314E-005  5.08189819161291786E-004  5.09287863145356859E-003  5.62489258981838380E-002  0.32831192218075922        1.7752234390209392        9.4703270222745211
+  2.02201163784892633E-009  4.70224616423489051E-007  5.15225066427989480E-006  5.19725111428439625E-005  5.20175115928484585E-004  5.22805802989171828E-003  5.69678499382489378E-002  0.33213537295325257        1.7955576815764616        9.5784705410250410

src/tests/loadtxt/test_loadtxt.f90

@@ -0,0 +1,30 @@
+program test_loadtxt
+use iso_fortran_env, only: dp=>real64
+use stdlib_experimental_io, only: loadtxt
+implicit none
+
+real(dp), allocatable :: d(:, :)
+call loadtxt("array1.dat", d)
+call print_array(d)
+
+call loadtxt("array2.dat", d)
+call print_array(d)
+
+call loadtxt("array3.dat", d)
+call print_array(d)
+
+call loadtxt("array4.dat", d)
+call print_array(d)
+
+contains
+
+subroutine print_array(a)
+real(dp) :: a(:, :)
+integer :: i
+print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
+do i = 1, size(a, 1)
+    print *, a(i, :)
+end do
+end subroutine
+
+end program

src/tests/loadtxt/test_savetxt.f90

@@ -0,0 +1,45 @@
+program test_loadtxt
+use iso_fortran_env, only: sp=>real32, dp=>real64
+use stdlib_experimental_io, only: loadtxt, savetxt
+use stdlib_experimental_error, only: assert
+implicit none
+
+call test_sp()
+call test_dp()
+
+contains
+
+    subroutine test_sp()
+    real(sp) :: d(3, 2), e(2, 3)
+    real(sp), allocatable :: d2(:, :)
+    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
+    call savetxt("tmp.dat", d)
+    call loadtxt("tmp.dat", 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("tmp.dat", e)
+    call loadtxt("tmp.dat", d2)
+    call assert(all(shape(d2) == [2, 3]))
+    call assert(all(abs(e-d2) < epsilon(1._sp)))
+    end subroutine
+
+
+    subroutine test_dp()
+    real(dp) :: d(3, 2), e(2, 3)
+    real(dp), allocatable :: d2(:, :)
+    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
+    call savetxt("tmp.dat", d)
+    call loadtxt("tmp.dat", 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("tmp.dat", e)
+    call loadtxt("tmp.dat", d2)
+    call assert(all(shape(d2) == [2, 3]))
+    call assert(all(abs(e-d2) < epsilon(1._dp)))
+    end subroutine
+
+end program