diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 000000000..b9706da13 --- /dev/null +++ b/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) diff --git a/Makefile b/Makefile deleted file mode 100644 index 95845cb92..000000000 --- a/Makefile +++ /dev/null @@ -1,18 +0,0 @@ -# Fortran stdlib Makefile - -FC = gfortran -FCFLAGS=-O0 - -.PHONY: all clean - -all: stdlib tests - -stdlib: - $(MAKE) FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/lib - -tests: stdlib - $(MAKE) FC=${FC} FCFLAGS=${FCFLAGS} --directory=src/tests - -clean: - $(MAKE) clean --directory=src/lib - $(MAKE) clean --directory=src/tests diff --git a/Makefile.manual b/Makefile.manual new file mode 100644 index 000000000..c7f45bc74 --- /dev/null +++ b/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 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt new file mode 100644 index 000000000..faa30df06 --- /dev/null +++ b/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 + ) diff --git a/src/lib/Makefile b/src/lib/Makefile.manual similarity index 100% rename from src/lib/Makefile rename to src/lib/Makefile.manual diff --git a/src/stdlib_experimental_error.f90 b/src/stdlib_experimental_error.f90 new file mode 100644 index 000000000..1c82d6539 --- /dev/null +++ b/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 diff --git a/src/stdlib_experimental_io.f90 b/src/stdlib_experimental_io.f90 new file mode 100644 index 000000000..9506bf234 --- /dev/null +++ b/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 diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt new file mode 100644 index 000000000..c6f586e91 --- /dev/null +++ b/src/tests/CMakeLists.txt @@ -0,0 +1 @@ +add_subdirectory(loadtxt) diff --git a/src/tests/Makefile b/src/tests/Makefile.manual similarity index 100% rename from src/tests/Makefile rename to src/tests/Makefile.manual diff --git a/src/tests/loadtxt/CMakeLists.txt b/src/tests/loadtxt/CMakeLists.txt new file mode 100644 index 000000000..de771e0b3 --- /dev/null +++ b/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) diff --git a/src/tests/loadtxt/array1.dat b/src/tests/loadtxt/array1.dat new file mode 100644 index 000000000..9ed9e364d --- /dev/null +++ b/src/tests/loadtxt/array1.dat @@ -0,0 +1,4 @@ +1 2 +3 4 +5 6 +7 8 diff --git a/src/tests/loadtxt/array2.dat b/src/tests/loadtxt/array2.dat new file mode 100644 index 000000000..8136afcc4 --- /dev/null +++ b/src/tests/loadtxt/array2.dat @@ -0,0 +1,4 @@ +1 2 9 +3 4 10 +5 6 11 +7 8 12 diff --git a/src/tests/loadtxt/array3.dat b/src/tests/loadtxt/array3.dat new file mode 100644 index 000000000..13b583f89 --- /dev/null +++ b/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 diff --git a/src/tests/loadtxt/array4.dat b/src/tests/loadtxt/array4.dat new file mode 100644 index 000000000..988e9b6cb --- /dev/null +++ b/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 diff --git a/src/tests/loadtxt/test_loadtxt.f90 b/src/tests/loadtxt/test_loadtxt.f90 new file mode 100644 index 000000000..490fcea38 --- /dev/null +++ b/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 diff --git a/src/tests/loadtxt/test_savetxt.f90 b/src/tests/loadtxt/test_savetxt.f90 new file mode 100644 index 000000000..ca6344b83 --- /dev/null +++ b/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