1program test_savetxt
2use stdlib_kinds, only: int32, sp, dp
3use stdlib_io, only: loadtxt, savetxt
4use stdlib_error, only: check
5implicit none
6
7character(:), allocatable :: outpath
8
9outpath = get_outpath() // "/tmp.dat"
10
11call test_iint32(outpath)
12call test_rsp(outpath)
13call test_rdp(outpath)
14call test_csp(outpath)
15call test_cdp(outpath)
16
17contains
18
19    function get_outpath() result(outpath)
20    integer :: ierr
21    character(256) :: argv
22    character(:), allocatable :: outpath
23
24    call get_command_argument(1, argv, status=ierr)
25    if (ierr==0) then
26        outpath = trim(argv)
27    else
28        outpath = '.'
29    endif
30    end function get_outpath
31
32    subroutine test_iint32(outpath)
33    character(*), intent(in) :: outpath
34    integer(int32) :: d(3, 2), e(2, 3)
35    integer(int32), allocatable :: d2(:, :)
36    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
37    call savetxt(outpath, d)
38    call loadtxt(outpath, d2)
39    call check(all(shape(d2) == [3, 2]))
40    call check(all(abs(d-d2) == 0))
41
42    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
43    call savetxt(outpath, e)
44    call loadtxt(outpath, d2)
45    call check(all(shape(d2) == [2, 3]))
46    call check(all(abs(e-d2) == 0))
47    end subroutine
48
49
50    subroutine test_rsp(outpath)
51    character(*), intent(in) :: outpath
52    real(sp) :: d(3, 2), e(2, 3)
53    real(sp), allocatable :: d2(:, :)
54    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
55    call savetxt(outpath, d)
56    call loadtxt(outpath, d2)
57    call check(all(shape(d2) == [3, 2]))
58    call check(all(abs(d-d2) < epsilon(1._sp)))
59
60    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
61    call savetxt(outpath, e)
62    call loadtxt(outpath, d2)
63    call check(all(shape(d2) == [2, 3]))
64    call check(all(abs(e-d2) < epsilon(1._sp)))
65    end subroutine test_rsp
66
67
68    subroutine test_rdp(outpath)
69    character(*), intent(in) :: outpath
70    real(dp) :: d(3, 2), e(2, 3)
71    real(dp), allocatable :: d2(:, :)
72    d = reshape([1, 2, 3, 4, 5, 6], [3, 2])
73    call savetxt(outpath, d)
74    call loadtxt(outpath, d2)
75    call check(all(shape(d2) == [3, 2]))
76    call check(all(abs(d-d2) < epsilon(1._dp)))
77
78    e = reshape([1, 2, 3, 4, 5, 6], [2, 3])
79    call savetxt(outpath, e)
80    call loadtxt(outpath, d2)
81    call check(all(shape(d2) == [2, 3]))
82    call check(all(abs(e-d2) < epsilon(1._dp)))
83    end subroutine test_rdp
84
85    subroutine test_csp(outpath)
86    character(*), intent(in) :: outpath
87    complex(sp) :: d(3, 2), e(2, 3)
88    complex(sp), allocatable :: d2(:, :)
89    d = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
90    call savetxt(outpath, d)
91    call loadtxt(outpath, d2)
92    call check(all(shape(d2) == [3, 2]))
93    call check(all(abs(d-d2) < epsilon(1._sp)))
94
95    e = cmplx(1, 1,kind=sp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
96    call savetxt(outpath, e)
97    call loadtxt(outpath, d2)
98    call check(all(shape(d2) == [2, 3]))
99    call check(all(abs(e-d2) < epsilon(1._sp)))
100    end subroutine test_csp
101
102    subroutine test_cdp(outpath)
103    character(*), intent(in) :: outpath
104    complex(dp) :: d(3, 2), e(2, 3)
105    complex(dp), allocatable :: d2(:, :)
106    d = cmplx(1._dp, 1._dp,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [3, 2])
107    call savetxt(outpath, d)
108    call loadtxt(outpath, d2)
109    call check(all(shape(d2) == [3, 2]))
110    call check(all(abs(d-d2) < epsilon(1._dp)))
111
112    e = cmplx(1, 1,kind=dp)* reshape([1, 2, 3, 4, 5, 6], [2, 3])
113    call savetxt(outpath, e)
114    call loadtxt(outpath, d2)
115    call check(all(shape(d2) == [2, 3]))
116    call check(all(abs(e-d2) < epsilon(1._dp)))
117    end subroutine test_cdp
118
119end program test_savetxt
120