Skip to content

Commit bee64c5

Browse files
certikcertik
authored
Merge pull request #23 from certik/loadtxt
Implement loadtxt and savetxt
2 parents 9dfeec2 + 65301b9 commit bee64c5

16 files changed

+326
-18
lines changed

‎CMakeLists.txt

+9
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
cmake_minimum_required(VERSION 3.5.0 FATAL_ERROR)
2+
3+
enable_language(Fortran)
4+
5+
project(stdlib)
6+
7+
enable_testing()
8+
9+
add_subdirectory(src)

‎Makefile

-18
This file was deleted.

‎Makefile.manual

+18
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
# Fortran stdlib Makefile
2+
3+
FC = gfortran
4+
FCFLAGS=-O0
5+
6+
.PHONY: all clean
7+
8+
all: stdlib tests
9+
10+
stdlib:
11+
$(MAKE) -f Makefile.manual FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/lib
12+
13+
tests: stdlib
14+
$(MAKE) -f Makefile.manual FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/tests
15+
16+
clean:
17+
$(MAKE) -f Makefile.manual clean --directory=src/lib
18+
$(MAKE) -f Makefile.manual clean --directory=src/tests

‎src/CMakeLists.txt

+14
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
set(SRC
2+
stdlib_experimental_io.f90
3+
stdlib_experimental_error.f90
4+
)
5+
6+
add_library(fortran_stdlib ${SRC})
7+
8+
add_subdirectory(tests)
9+
10+
install(TARGETS fortran_stdlib
11+
RUNTIME DESTINATION bin
12+
ARCHIVE DESTINATION lib
13+
LIBRARY DESTINATION lib
14+
)

‎src/lib/Makefile renamed to ‎src/lib/Makefile.manual

File renamed without changes.

‎src/stdlib_experimental_error.f90

+41
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
module stdlib_experimental_error
2+
implicit none
3+
private
4+
public :: assert, error_stop
5+
6+
contains
7+
8+
subroutine assert(condition)
9+
! If condition == .false., it aborts the program.
10+
!
11+
! Arguments
12+
! ---------
13+
!
14+
logical, intent(in) :: condition
15+
!
16+
! Example
17+
! -------
18+
!
19+
! call assert(a == 5)
20+
21+
if (.not. condition) call error_stop("Assert failed.")
22+
end subroutine
23+
24+
subroutine error_stop(msg)
25+
! Aborts the program with nonzero exit code
26+
!
27+
! The statement "stop msg" will return 0 exit code when compiled using
28+
! gfortran. error_stop() uses the statement "stop 1" which returns an exit code
29+
! 1 and a print statement to print the message.
30+
!
31+
! Example
32+
! -------
33+
!
34+
! call error_stop("Invalid argument")
35+
36+
character(len=*) :: msg ! Message to print on stdout
37+
print *, msg
38+
stop 1
39+
end subroutine
40+
41+
end module

‎src/stdlib_experimental_io.f90

+129
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,129 @@
1+
module stdlib_experimental_io
2+
use iso_fortran_env, only: sp=>real32, dp=>real64
3+
implicit none
4+
private
5+
public :: loadtxt, savetxt
6+
7+
interface loadtxt
8+
module procedure sloadtxt
9+
module procedure dloadtxt
10+
end interface
11+
12+
interface savetxt
13+
module procedure ssavetxt
14+
module procedure dsavetxt
15+
end interface
16+
17+
contains
18+
19+
subroutine sloadtxt(filename, d)
20+
character(len=*), intent(in) :: filename
21+
real(sp), allocatable, intent(out) :: d(:,:)
22+
real(dp), allocatable :: tmp(:,:)
23+
call dloadtxt(filename, tmp)
24+
allocate(d(size(tmp,1),size(tmp,2)))
25+
d = real(tmp,sp)
26+
end subroutine
27+
28+
subroutine dloadtxt(filename, d)
29+
! Loads a 2D array from a text file.
30+
!
31+
! Arguments
32+
! ---------
33+
!
34+
! Filename to load the array from
35+
character(len=*), intent(in) :: filename
36+
! The array 'd' will be automatically allocated with the correct dimensions
37+
real(dp), allocatable, intent(out) :: d(:,:)
38+
!
39+
! Example
40+
! -------
41+
!
42+
! real(dp), allocatable :: data(:, :)
43+
! call loadtxt("log.txt", data) ! 'data' will be automatically allocated
44+
!
45+
! Where 'log.txt' contains for example::
46+
!
47+
! 1 2 3
48+
! 2 4 6
49+
! 8 9 10
50+
! 11 12 13
51+
! ...
52+
!
53+
character :: c
54+
integer :: s, ncol, nrow, ios, i
55+
logical :: lastwhite
56+
real(dp) :: r
57+
58+
open(newunit=s, file=filename, status="old")
59+
60+
! determine number of columns
61+
ncol = 0
62+
lastwhite = .true.
63+
do
64+
read(s, '(a)', advance='no', iostat=ios) c
65+
if (ios /= 0) exit
66+
if (lastwhite .and. .not. whitechar(c)) ncol = ncol + 1
67+
lastwhite = whitechar(c)
68+
end do
69+
70+
rewind(s)
71+
72+
! determine number or rows
73+
nrow = 0
74+
do
75+
read(s, *, iostat=ios) r
76+
if (ios /= 0) exit
77+
nrow = nrow + 1
78+
end do
79+
80+
rewind(s)
81+
82+
allocate(d(nrow, ncol))
83+
do i = 1, nrow
84+
read(s, *) d(i, :)
85+
end do
86+
close(s)
87+
end subroutine
88+
89+
subroutine ssavetxt(filename, d)
90+
character(len=*), intent(in) :: filename
91+
real(sp), intent(in) :: d(:,:)
92+
call dsavetxt(filename, real(d,dp))
93+
end subroutine
94+
95+
subroutine dsavetxt(filename, d)
96+
! Saves a 2D array into a textfile.
97+
!
98+
! Arguments
99+
! ---------
100+
!
101+
character(len=*), intent(in) :: filename ! File to save the array to
102+
real(dp), intent(in) :: d(:,:) ! The 2D array to save
103+
!
104+
! Example
105+
! -------
106+
!
107+
! real(dp) :: data(3, 2)
108+
! call savetxt("log.txt", data)
109+
110+
integer :: s, i
111+
open(newunit=s, file=filename, status="replace")
112+
do i = 1, size(d, 1)
113+
write(s, *) d(i, :)
114+
end do
115+
close(s)
116+
end subroutine
117+
118+
119+
logical function whitechar(char) ! white character
120+
! returns .true. if char is space (32) or tab (9), .false. otherwise
121+
character, intent(in) :: char
122+
if (iachar(char) == 32 .or. iachar(char) == 9) then
123+
whitechar = .true.
124+
else
125+
whitechar = .false.
126+
end if
127+
end function
128+
129+
end module

‎src/tests/CMakeLists.txt

+1
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
add_subdirectory(loadtxt)

‎src/tests/Makefile renamed to ‎src/tests/Makefile.manual

File renamed without changes.

‎src/tests/loadtxt/CMakeLists.txt

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
include_directories(${PROJECT_BINARY_DIR}/src)
2+
3+
project(loadtxt)
4+
5+
add_executable(test_loadtxt test_loadtxt.f90)
6+
target_link_libraries(test_loadtxt fortran_stdlib)
7+
8+
add_executable(test_savetxt test_savetxt.f90)
9+
target_link_libraries(test_savetxt fortran_stdlib)
10+
11+
add_test(test_loadtxt ${PROJECT_BINARY_DIR}/test_loadtxt)
12+
add_test(test_savetxt ${PROJECT_BINARY_DIR}/test_savetxt)

‎src/tests/loadtxt/array1.dat

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
1 2
2+
3 4
3+
5 6
4+
7 8

‎src/tests/loadtxt/array2.dat

+4
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
1 2 9
2+
3 4 10
3+
5 6 11
4+
7 8 12

‎src/tests/loadtxt/array3.dat

+16
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
1.000000000000000021e-08 9.199998759392489944e+01
2+
1.024113254885563425e-08 9.199998731474968849e+01
3+
1.048233721895820948e-08 9.199998703587728244e+01
4+
1.072361403187881949e-08 9.199998675729767683e+01
5+
1.096496300919481796e-08 9.199998647900135040e+01
6+
1.120638417249036630e-08 9.199998620097916557e+01
7+
1.144787754335570897e-08 9.199998592322251056e+01
8+
1.168944314338753750e-08 9.199998564572304360e+01
9+
1.193108099418952317e-08 9.199998536847290609e+01
10+
1.217279111737088596e-08 9.199998509146449521e+01
11+
1.241457353454836993e-08 9.199998481469057765e+01
12+
1.265642826734443823e-08 9.199998453814424693e+01
13+
1.289835533738818635e-08 9.199998426181879552e+01
14+
1.314035476631514857e-08 9.199998398570787117e+01
15+
1.338242657576766519e-08 9.199998370980536322e+01
16+
1.362457078739434161e-08 9.199998343410533153e+01

‎src/tests/loadtxt/array4.dat

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
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
2+
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
3+
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

+30
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
program test_loadtxt
2+
use iso_fortran_env, only: dp=>real64
3+
use stdlib_experimental_io, only: loadtxt
4+
implicit none
5+
6+
real(dp), allocatable :: d(:, :)
7+
call loadtxt("array1.dat", d)
8+
call print_array(d)
9+
10+
call loadtxt("array2.dat", d)
11+
call print_array(d)
12+
13+
call loadtxt("array3.dat", d)
14+
call print_array(d)
15+
16+
call loadtxt("array4.dat", d)
17+
call print_array(d)
18+
19+
contains
20+
21+
subroutine print_array(a)
22+
real(dp) :: a(:, :)
23+
integer :: i
24+
print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
25+
do i = 1, size(a, 1)
26+
print *, a(i, :)
27+
end do
28+
end subroutine
29+
30+
end program

‎src/tests/loadtxt/test_savetxt.f90

+45
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
program test_loadtxt
2+
use iso_fortran_env, only: sp=>real32, dp=>real64
3+
use stdlib_experimental_io, only: loadtxt, savetxt
4+
use stdlib_experimental_error, only: assert
5+
implicit none
6+
7+
call test_sp()
8+
call test_dp()
9+
10+
contains
11+
12+
subroutine test_sp()
13+
real(sp) :: d(3, 2), e(2, 3)
14+
real(sp), allocatable :: d2(:, :)
15+
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
16+
call savetxt("tmp.dat", d)
17+
call loadtxt("tmp.dat", d2)
18+
call assert(all(shape(d2) == [3, 2]))
19+
call assert(all(abs(d-d2) < epsilon(1._sp)))
20+
21+
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
22+
call savetxt("tmp.dat", e)
23+
call loadtxt("tmp.dat", d2)
24+
call assert(all(shape(d2) == [2, 3]))
25+
call assert(all(abs(e-d2) < epsilon(1._sp)))
26+
end subroutine
27+
28+
29+
subroutine test_dp()
30+
real(dp) :: d(3, 2), e(2, 3)
31+
real(dp), allocatable :: d2(:, :)
32+
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
33+
call savetxt("tmp.dat", d)
34+
call loadtxt("tmp.dat", d2)
35+
call assert(all(shape(d2) == [3, 2]))
36+
call assert(all(abs(d-d2) < epsilon(1._dp)))
37+
38+
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
39+
call savetxt("tmp.dat", e)
40+
call loadtxt("tmp.dat", d2)
41+
call assert(all(shape(d2) == [2, 3]))
42+
call assert(all(abs(e-d2) < epsilon(1._dp)))
43+
end subroutine
44+
45+
end program

0 commit comments

Comments
 (0)