Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Implement loadtxt and savetxt #23

Merged
merged 10 commits into from
Dec 21, 2019
Merged
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 9 additions & 0 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
cmake_minimum_required(VERSION 3.5.0 FATAL_ERROR)

enable_language(Fortran)

project(stdlib)

enable_testing()

add_subdirectory(src)
18 changes: 0 additions & 18 deletions Makefile

This file was deleted.

18 changes: 18 additions & 0 deletions Makefile.manual
Original file line number Diff line number Diff line change
@@ -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
15 changes: 15 additions & 0 deletions src/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
set(SRC
stdlib_types.f90
stdlib_io.f90
stdlib_error.f90
)

add_library(fortran_stdlib ${SRC})

add_subdirectory(tests)

install(TARGETS fortran_stdlib
RUNTIME DESTINATION bin
ARCHIVE DESTINATION lib
LIBRARY DESTINATION lib
)
File renamed without changes.
41 changes: 41 additions & 0 deletions src/stdlib_error.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
module stdlib_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
104 changes: 104 additions & 0 deletions src/stdlib_io.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,104 @@
module stdlib_io
use stdlib_types
implicit none
private
public loadtxt, savetxt

contains

subroutine loadtxt(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 savetxt(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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

stdlib_ascii module will be useful here to not use literal constants. Minot nitpick as ascii constants won't change any time soon, but nevertheless.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I intentionally didn't expose whitechar as public, as we might want to change the API. Once we implement stdlib_string we can put all these in it and polish it up.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We have a "circular dependency" here. I would like to submit a pull request for stdlib_ascii but I was waiting to have some CMake machinery set up and so I could use assert in the unit tests.

Copy link
Member

@ivan-pi ivan-pi Dec 21, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

stdlib_ascii module will be useful here to not use literal constants. Minot nitpick as ascii constants won't change any time soon, but nevertheless.

Internally in stdlib_ascii I am also using both literal character and hexadecimal constants for the symbols in the ascii table. I see no other portable way. Of course compiler vendors targeting specific processors with other default collating sequences could implement their own low-level versions. I guess another option would be to hack something up using the transfer intrinsic and bit-mask operations, but I see no benefit.

Edit: probably I misunderstood your comment, which was implying to use something like char == ascii_tab .and. char == ascii_space instead of cryptic ascii sequence integers. The stdlib_ascii module will have a is_blank function, which can be used instead of whitechar.

whitechar = .true.
else
whitechar = .false.
end if
end function

end module
10 changes: 10 additions & 0 deletions src/stdlib_types.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,10 @@
module stdlib_types
implicit none
private
public sp, dp, qp

integer, parameter :: sp=kind(0.), & ! single precision
dp=kind(0.d0), & ! double precision
qp=selected_real_kind(32) ! quadruple precision

end module
1 change: 1 addition & 0 deletions src/tests/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
add_subdirectory(loadtxt)
File renamed without changes.
12 changes: 12 additions & 0 deletions src/tests/loadtxt/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -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)
4 changes: 4 additions & 0 deletions src/tests/loadtxt/array1.dat
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
1 2
3 4
5 6
7 8
4 changes: 4 additions & 0 deletions src/tests/loadtxt/array2.dat
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
1 2 9
3 4 10
5 6 11
7 8 12
16 changes: 16 additions & 0 deletions src/tests/loadtxt/array3.dat
Original file line number Diff line number Diff line change
@@ -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
3 changes: 3 additions & 0 deletions src/tests/loadtxt/array4.dat
Original file line number Diff line number Diff line change
@@ -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
30 changes: 30 additions & 0 deletions src/tests/loadtxt/test_loadtxt.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
program test_loadtxt
use stdlib_types, only: dp
use stdlib_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
21 changes: 21 additions & 0 deletions src/tests/loadtxt/test_savetxt.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
program test_loadtxt
use stdlib_types, only: dp
use stdlib_io, only: loadtxt, savetxt
use stdlib_error, only: assert
implicit none

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 program