Skip to content

Commit c1a7956

Browse files
fioljfiolj
committed
Added support and tests for complex numbers in loadtxt, savetxt
1 parent 38ebcd0 commit c1a7956

File tree

5 files changed

+116
-87
lines changed

5 files changed

+116
-87
lines changed

‎src/stdlib_experimental_io.fypp

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,6 @@ module stdlib_experimental_io
2020
interface loadtxt
2121
#:for k1, t1 in KINDS_TYPES
2222
module procedure loadtxt_${t1[0]}$${k1}$
23-
! loadtxt_${k1}$
2423
#:endfor
2524
end interface loadtxt
2625

@@ -59,7 +58,7 @@ contains
5958
! ...
6059
!
6160
integer :: s
62-
integer :: nrow,ncol,i
61+
integer :: nrow, ncol, i
6362

6463
s = open(filename)
6564

@@ -107,7 +106,7 @@ contains
107106

108107
integer function number_of_columns(s)
109108
! determine number of columns
110-
integer,intent(in)::s
109+
integer,intent(in) :: s
111110

112111
integer :: ios
113112
character :: c

‎src/tests/io/array5.dat

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
(1.0000000000000000,0.0000000000000000) (3.0000000000000000,0.0000000000000000) (5.0000000000000000,0.0000000000000000)
2+
(2.0000000000000000,0.0000000000000000) (4.0000000000000000,0.0000000000000000) (6.0000000000000000,0.0000000000000000)

‎src/tests/io/test_loadtxt.f90

Lines changed: 52 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -1,55 +1,63 @@
11
program test_loadtxt
2-
use stdlib_experimental_kinds, only: int32, sp, dp
3-
use stdlib_experimental_io, only: loadtxt
4-
use stdlib_experimental_error, only: error_stop
5-
implicit none
2+
use stdlib_experimental_kinds, only: int32, sp, dp
3+
use stdlib_experimental_io, only: loadtxt
4+
use stdlib_experimental_error, only: error_stop
5+
implicit none
66

7-
integer(int32), allocatable :: i(:, :)
8-
real(sp), allocatable :: s(:, :)
9-
real(dp), allocatable :: d(:, :)
7+
integer(int32), allocatable :: i(:, :)
8+
real(sp), allocatable :: s(:, :)
9+
real(dp), allocatable :: d(:, :)
10+
complex(dp), allocatable :: z(:, :)
1011

11-
call loadtxt("array1.dat", i)
12-
call print_array(i)
12+
call loadtxt("array1.dat", i)
13+
call print_array(i)
1314

14-
call loadtxt("array1.dat", s)
15-
call print_array(s)
15+
call loadtxt("array1.dat", s)
16+
call print_array(s)
1617

17-
call loadtxt("array1.dat", d)
18-
call print_array(d)
18+
call loadtxt("array1.dat", d)
19+
call print_array(d)
1920

20-
call loadtxt("array2.dat", d)
21-
call print_array(d)
21+
call loadtxt("array2.dat", d)
22+
call print_array(d)
2223

23-
call loadtxt("array3.dat", d)
24-
call print_array(d)
24+
call loadtxt("array3.dat", d)
25+
call print_array(d)
2526

26-
call loadtxt("array4.dat", d)
27-
call print_array(d)
27+
call loadtxt("array4.dat", d)
28+
call print_array(d)
29+
30+
call loadtxt("array5.dat", z)
31+
call print_array(z)
2832

2933
contains
3034

31-
subroutine print_array(a)
32-
class(*),intent(in) :: a(:, :)
33-
integer :: i
34-
print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
35-
36-
select type(a)
37-
type is(integer(int32))
38-
do i = 1, size(a, 1)
39-
print *, a(i, :)
40-
end do
41-
type is(real(sp))
42-
do i = 1, size(a, 1)
43-
print *, a(i, :)
44-
end do
45-
type is(real(dp))
46-
do i = 1, size(a, 1)
47-
print *, a(i, :)
48-
end do
49-
class default
50-
call error_stop('The proposed type is not supported')
51-
end select
52-
53-
end subroutine
54-
55-
end program
35+
subroutine print_array(a)
36+
class(*),intent(in) :: a(:, :)
37+
integer :: i
38+
print *, "Array, shape=(", size(a, 1), ",", size(a, 2), ")"
39+
40+
select type(a)
41+
type is(integer(int32))
42+
do i = 1, size(a, 1)
43+
print *, a(i, :)
44+
end do
45+
type is(real(sp))
46+
do i = 1, size(a, 1)
47+
print *, a(i, :)
48+
end do
49+
type is(real(dp))
50+
do i = 1, size(a, 1)
51+
print *, a(i, :)
52+
end do
53+
type is(complex(dp))
54+
do i = 1, size(a, 1)
55+
print *, a(i, :)
56+
end do
57+
class default
58+
call error_stop('The proposed type is not supported')
59+
end select
60+
61+
end subroutine print_array
62+
63+
end program test_loadtxt

‎src/tests/io/test_savetxt.f90

Lines changed: 26 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,35 @@
11
program test_savetxt
2-
use stdlib_experimental_kinds, only: int32, sp, dp
3-
use stdlib_experimental_io, only: loadtxt, savetxt
4-
use stdlib_experimental_error, only: assert
5-
implicit none
2+
use stdlib_experimental_kinds, only: int32, sp, dp
3+
use stdlib_experimental_io, only: loadtxt, savetxt
4+
use stdlib_experimental_error, only: assert
5+
implicit none
66

7-
character(:), allocatable :: outpath
7+
character(:), allocatable :: outpath
88

9-
outpath = get_outpath() // "/tmp.dat"
9+
outpath = get_outpath() // "/tmp.dat"
1010

11-
call test_int32(outpath)
12-
call test_rsp(outpath)
13-
call test_rdp(outpath)
14-
call test_csp(outpath)
15-
call test_cdp(outpath)
11+
call test_int32(outpath)
12+
call test_rsp(outpath)
13+
call test_rdp(outpath)
14+
call test_csp(outpath)
15+
call test_cdp(outpath)
1616

1717
contains
1818

19-
function get_outpath() result(outpath)
19+
function get_outpath() result(outpath)
2020
integer :: ierr
2121
character(256) :: argv
2222
character(:), allocatable :: outpath
2323

2424
call get_command_argument(1, argv, status=ierr)
2525
if (ierr==0) then
26-
outpath = trim(argv)
26+
outpath = trim(argv)
2727
else
28-
outpath = '.'
28+
outpath = '.'
2929
endif
30-
end function get_outpath
30+
end function get_outpath
3131

32-
subroutine test_int32(outpath)
32+
subroutine test_int32(outpath)
3333
character(*), intent(in) :: outpath
3434
integer(int32) :: d(3, 2), e(2, 3)
3535
integer(int32), allocatable :: d2(:, :)
@@ -44,10 +44,10 @@ subroutine test_int32(outpath)
4444
call loadtxt(outpath, d2)
4545
call assert(all(shape(d2) == [2, 3]))
4646
call assert(all(abs(e-d2) == 0))
47-
end subroutine
47+
end subroutine test_int32
4848

4949

50-
subroutine test_rsp(outpath)
50+
subroutine test_rsp(outpath)
5151
character(*), intent(in) :: outpath
5252
real(sp) :: d(3, 2), e(2, 3)
5353
real(sp), allocatable :: d2(:, :)
@@ -62,10 +62,10 @@ subroutine test_rsp(outpath)
6262
call loadtxt(outpath, d2)
6363
call assert(all(shape(d2) == [2, 3]))
6464
call assert(all(abs(e-d2) < epsilon(1._sp)))
65-
end subroutine
65+
end subroutine test_rsp
6666

6767

68-
subroutine test_rdp(outpath)
68+
subroutine test_rdp(outpath)
6969
character(*), intent(in) :: outpath
7070
real(dp) :: d(3, 2), e(2, 3)
7171
real(dp), allocatable :: d2(:, :)
@@ -80,9 +80,9 @@ subroutine test_rdp(outpath)
8080
call loadtxt(outpath, d2)
8181
call assert(all(shape(d2) == [2, 3]))
8282
call assert(all(abs(e-d2) < epsilon(1._dp)))
83-
end subroutine
83+
end subroutine test_rdp
8484

85-
subroutine test_csp(outpath)
85+
subroutine test_csp(outpath)
8686
character(*), intent(in) :: outpath
8787
complex(sp) :: d(3, 2), e(2, 3)
8888
complex(sp), allocatable :: d2(:, :)
@@ -97,9 +97,9 @@ subroutine test_csp(outpath)
9797
call loadtxt(outpath, d2)
9898
call assert(all(shape(d2) == [2, 3]))
9999
call assert(all(abs(e-d2) < epsilon(1._sp)))
100-
end subroutine
100+
end subroutine test_csp
101101

102-
subroutine test_cdp(outpath)
102+
subroutine test_cdp(outpath)
103103
character(*), intent(in) :: outpath
104104
complex(dp) :: d(3, 2), e(2, 3)
105105
complex(dp), allocatable :: d2(:, :)
@@ -114,6 +114,6 @@ subroutine test_cdp(outpath)
114114
call loadtxt(outpath, d2)
115115
call assert(all(shape(d2) == [2, 3]))
116116
call assert(all(abs(e-d2) < epsilon(1._dp)))
117-
end subroutine
117+
end subroutine test_cdp
118118

119-
end program
119+
end program test_savetxt

‎src/tests/io/test_savetxt_qp.f90

Lines changed: 34 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,32 @@
11
program test_savetxt_qp
2-
use stdlib_experimental_kinds, only: qp
3-
use stdlib_experimental_io, only: loadtxt, savetxt
4-
use stdlib_experimental_error, only: assert
5-
implicit none
2+
use stdlib_experimental_kinds, only: qp
3+
use stdlib_experimental_io, only: loadtxt, savetxt
4+
use stdlib_experimental_error, only: assert
5+
implicit none
66

7-
character(:), allocatable :: outpath
7+
character(:), allocatable :: outpath
88

9-
outpath = get_outpath() // "/tmp_qp.dat"
9+
outpath = get_outpath() // "/tmp_qp.dat"
1010

11-
call test_qp(outpath)
11+
call test_qp(outpath)
12+
call test_cqp(outpath)
1213

1314
contains
1415

15-
function get_outpath() result(outpath)
16+
function get_outpath() result(outpath)
1617
integer :: ierr
1718
character(256) :: argv
1819
character(:), allocatable :: outpath
1920

2021
call get_command_argument(1, argv, status=ierr)
2122
if (ierr==0) then
22-
outpath = trim(argv)
23+
outpath = trim(argv)
2324
else
24-
outpath = '.'
25+
outpath = '.'
2526
endif
26-
end function get_outpath
27+
end function get_outpath
2728

28-
subroutine test_qp(outpath)
29+
subroutine test_qp(outpath)
2930
character(*), intent(in) :: outpath
3031
real(qp) :: d(3, 2), e(2, 3)
3132
real(qp), allocatable :: d2(:, :)
@@ -40,6 +41,25 @@ subroutine test_qp(outpath)
4041
call loadtxt(outpath, d2)
4142
call assert(all(shape(d2) == [2, 3]))
4243
call assert(all(abs(e-d2) < epsilon(1._qp)))
43-
end subroutine
44+
end subroutine test_qp
4445

45-
end program
46+
47+
subroutine test_cqp(outpath)
48+
character(*), intent(in) :: outpath
49+
complex(qp) :: d(3, 2), e(2, 3)
50+
complex(qp), allocatable :: d2(:, :)
51+
d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
52+
call savetxt(outpath, d)
53+
call loadtxt(outpath, d2)
54+
call assert(all(shape(d2) == [3, 2]))
55+
call assert(all(abs(d-d2) < epsilon(1._qp)))
56+
57+
e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
58+
call savetxt(outpath, e)
59+
call loadtxt(outpath, d2)
60+
call assert(all(shape(d2) == [2, 3]))
61+
call assert(all(abs(e-d2) < epsilon(1._qp)))
62+
end subroutine test_cqp
63+
64+
65+
end program test_savetxt_qp

0 commit comments

Comments
 (0)