From 55f97733b1d11a80c49c9e572ffaa504c1e66f78 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sat, 20 Mar 2021 12:33:41 +0100 Subject: [PATCH 1/2] Initial checkin for a module for tolerant comparison of reals The module is based on the idea to allow for a small margin when comparing reals. Such a margin can solve the problem that the finite precision of floating-point calculations make the results inaccurate. Two essentially equal real numbers may therefore appear to be different --- doc/specs/index.md | 1 + doc/specs/stdlib_tolerant.md | 85 +++++++ src/CMakeLists.bak | 73 ++++++ src/CMakeLists.txt | 1 + src/stdlib_tolerant.f90 | 342 +++++++++++++++++++++++++++ src/tests/CMakeLists.bak | 23 ++ src/tests/CMakeLists.txt | 1 + src/tests/Makefile.manual | 3 + src/tests/tolerant/CMakeLists.txt | 1 + src/tests/tolerant/Makefile.manual | 4 + src/tests/tolerant/test_tolerant.f90 | 65 +++++ 11 files changed, 599 insertions(+) create mode 100644 doc/specs/stdlib_tolerant.md create mode 100644 src/CMakeLists.bak create mode 100644 src/stdlib_tolerant.f90 create mode 100644 src/tests/CMakeLists.bak create mode 100644 src/tests/tolerant/CMakeLists.txt create mode 100644 src/tests/tolerant/Makefile.manual create mode 100644 src/tests/tolerant/test_tolerant.f90 diff --git a/doc/specs/index.md b/doc/specs/index.md index 4a1e3a919..4052640f7 100644 --- a/doc/specs/index.md +++ b/doc/specs/index.md @@ -22,6 +22,7 @@ This is and index/directory of the specifications (specs) for each new module/fe - [stats](./stdlib_stats.html) - Descriptive Statistics - [stats_distribution_PRNG](./stdlib_stats_distribution_PRNG.html) - Probability Distributions random number generator - [string\_type](./stdlib_string_type.html) - Basic string support + - [tolerant](./stdlib_tolerant.html) - Tolerant comparisons of reals ## Missing specs diff --git a/doc/specs/stdlib_tolerant.md b/doc/specs/stdlib_tolerant.md new file mode 100644 index 000000000..493695b22 --- /dev/null +++ b/doc/specs/stdlib_tolerant.md @@ -0,0 +1,85 @@ +--- +title: tolerant +--- + +# Tolerant comparison of reals + +[TOC] + +## Introduction + +The age-old adagium is that you should never compare real variables directly, as rounding/truncation errors can +give false results. This module provides the means to allow a certain tolerance with such comparisons. In addition +it provides tolerant versions of the `floor`, `ceil` and `round` functions. The operation is in most respects +simple, in that a margin is used which is based on the "epsilon" value for the given kind of reals. + + +## Procedures and operators provided + +The module's procedures and operators work on ordinary single-precision and double-precision reals. + +### `teq`, `tne`, `tgt`, `tge`, `tlt`, `tle` - Tolerant relational operators + +#### Description + +Compare two reals with a tolerance based on a small margin (set to three times the epsilon value). +The implementation is such that if `x .teq. y` is true, then `x .tne. y` is never true and vice versa. +Similarly for the pairs `.tlt.` and `.tge.`, `.tle.` and `.tgt.`. + +#### Syntax + +`if ( x .teq. y ) write(*,*) 'x and y are equal'` + +#### Status + +Experimental + +#### Class + +Operator. + +#### Arguments + +`x`, `y`: Two reals (of the same kind) to be compared + +#### Result value + +A logical indicating whether the two operands are different enough or not. + + +### `tfloor`, `tceil`, `tround` - Tolerant versions of the `floor`, `ceil` and `round` functions + +#### Description + +Provide tolerant versions of the `floor`, `ceil` and `round` functions that take a small interval into account. +While the actual interval can be set, the advised default is three times epsilon(). Note that the implementation +is actually much more involved than would seem necessary. It is the result of extensive research. + + +#### Syntax + +```fortran + fl = [[stdlib_tolerant(module):tfloor(interface)]](x) ! Or: tfloor( x, ct ) if you want control over the interval + cl = [[stdlib_tolerant(module):tfceil(interface)]](x) ! Or: tceil( x, ct ) + rnd = [[stdlib_tolerant(module):tround(interface)]](x) ! Or: tround( x, ct ) +``` + +#### Status + +Experimental + +#### Class + +Elemental function + +#### Arguments + +`x`: The real number that is to be truncated or rounded + +`ct`: Tolearance for comparison (optional, defaults to 3*epsilon) + +#### Return value + +A real value of the same kind as the argument but with proper truncation or rounding in accordance +with the function. + diff --git a/src/CMakeLists.bak b/src/CMakeLists.bak new file mode 100644 index 000000000..85f5c68b6 --- /dev/null +++ b/src/CMakeLists.bak @@ -0,0 +1,73 @@ +### Pre-process: .fpp -> .f90 via Fypp + +# Create a list of the files to be preprocessed +set(fppFiles + stdlib_bitsets.fypp + stdlib_bitsets_64.fypp + stdlib_bitsets_large.fypp + stdlib_io.fypp + stdlib_linalg.fypp + stdlib_linalg_diag.fypp + stdlib_optval.fypp + stdlib_stats.fypp + stdlib_stats_corr.fypp + stdlib_stats_cov.fypp + stdlib_stats_mean.fypp + stdlib_stats_moment.fypp + stdlib_stats_moment_all.fypp + stdlib_stats_moment_mask.fypp + stdlib_stats_moment_scalar.fypp + stdlib_stats_var.fypp + stdlib_quadrature.fypp + stdlib_quadrature_trapz.fypp + stdlib_quadrature_simps.fypp + stdlib_stats_distribution_PRNG.fypp +) + + +# Custom preprocessor flags +if(DEFINED CMAKE_MAXIMUM_RANK) + set(fyppFlags "-DMAXRANK=${CMAKE_MAXIMUM_RANK}") +elseif(f03rank) + set(fyppFlags) +else() + set(fyppFlags "-DVERSION90") +endif() + +fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) + +set(SRC + stdlib_ascii.f90 + stdlib_error.f90 + stdlib_kinds.f90 + stdlib_logger.f90 + stdlib_string_type.f90 + stdlib_system.F90 + ${outFiles} +) + +add_library(${PROJECT_NAME} ${SRC}) + +set(LIB_MOD_DIR ${CMAKE_CURRENT_BINARY_DIR}/mod_files/) +set_target_properties(${PROJECT_NAME} PROPERTIES + Fortran_MODULE_DIRECTORY ${LIB_MOD_DIR}) +target_include_directories(${PROJECT_NAME} PUBLIC + $ + $ +) + +if(f18errorstop) + target_sources(${PROJECT_NAME} PRIVATE f18estop.f90) +else() + target_sources(${PROJECT_NAME} PRIVATE f08estop.f90) +endif() + +add_subdirectory(tests) + +install(TARGETS ${PROJECT_NAME} + EXPORT ${PROJECT_NAME}-targets + RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}" + ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}" + LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}" +) +install(DIRECTORY ${LIB_MOD_DIR} DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}") diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 85f5c68b6..0a25a3ac7 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -43,6 +43,7 @@ set(SRC stdlib_logger.f90 stdlib_string_type.f90 stdlib_system.F90 + stdlib_tolerant.f90 ${outFiles} ) diff --git a/src/stdlib_tolerant.f90 b/src/stdlib_tolerant.f90 new file mode 100644 index 000000000..0b7d10247 --- /dev/null +++ b/src/stdlib_tolerant.f90 @@ -0,0 +1,342 @@ +! stdlib_tolerant.f90 -- +! Compare real values in a "tolerant" way, that is, with a margin +! +! Comments copied from the original code: +!********************************************************************** +! ROUTINE: FUZZY FORTRAN OPERATORS +! PURPOSE: Illustrate Hindmarsh's computation of EPS, and APL +! tolerant comparisons, tolerant CEIL/FLOOR, and Tolerant +! ROUND functions - implemented in Fortran. +! PLATFORM: PC Windows Fortran, Compaq-Digital CVF 6.1a, AIX XLF90 +! TO RUN: Windows: DF EPS.F90 +! AIX: XLF90 eps.f -o eps.exe -qfloat=nomaf +! CALLS: none +! AUTHOR: H. D. Knoble 22 September 1978 +! REVISIONS: +!********************************************************************** +! +module stdlib_tolerant + implicit none + + private + public :: tfloor, tceil, tround + public :: operator(.teq.), operator(.tne.) + public :: operator(.tgt.), operator(.tge.) + public :: operator(.tlt.), operator(.tle.) + + integer, parameter, private :: sp = kind(1.0) + integer, parameter, private :: dp = kind(1.0d0) + + real(kind=sp), parameter, private :: eps_sp = epsilon(eps_sp) + real(kind=dp), parameter, private :: eps_dp = epsilon(eps_dp) + real(kind=sp), parameter, private :: eps_sp3 = 3.0 * epsilon(eps_sp) + real(kind=dp), parameter, private :: eps_dp3 = 3.0_dp * epsilon(eps_dp) + + interface tfloor + module procedure tfloor_sp + module procedure tfloor_dp + end interface + + interface tceil + module procedure tceil_sp + module procedure tceil_dp + end interface + + interface tround + module procedure tround_sp + module procedure tround_dp + end interface + + interface operator(.teq.) + module procedure teq_sp + module procedure teq_dp + end interface + + interface operator(.tne.) + module procedure tne_sp + module procedure tne_dp + end interface + + interface operator(.tgt.) + module procedure tgt_sp + module procedure tgt_dp + end interface + + interface operator(.tge.) + module procedure tge_sp + module procedure tge_dp + end interface + + interface operator(.tlt.) + module procedure tlt_sp + module procedure tlt_dp + end interface + + interface operator(.tle.) + module procedure tle_sp + module procedure tle_dp + end interface + +contains + +! teq_sp, ... -- +! Tolerant comparison for single-precision numbers +! +logical function teq_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = abs(x-y) <= max( abs(x), abs(y) ) * eps_sp3 + +end function teq_sp + +logical function tne_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = .not. (x .teq. y) + +end function tne_sp + +logical function tgt_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = (x - y) > max( abs(x), abs(y) ) * eps_sp3 + +end function tgt_sp + +logical function tle_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = .not. (x .tgt. y) + +end function tle_sp + +logical function tlt_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = (x .tle. y) .and. (x .tne. y) + +end function tlt_sp + +logical function tge_sp( x, y ) result(cmp) + real(kind=sp), intent(in) :: x, y + + cmp = (x .tgt. y) .or. (x .teq. y) + +end function tge_sp + +! teq_dp, ... -- +! Tolerant comparison for single-precision numbers +! +logical function teq_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = abs(x-y) <= max( abs(x), abs(y) ) * eps_dp3 + +end function teq_dp + +logical function tne_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = .not. (x .teq. y) + +end function tne_dp + +logical function tgt_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = (x - y) > max( abs(x), abs(y) ) * eps_dp3 + +end function tgt_dp + +logical function tle_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = .not. (x .tgt. y) + +end function tle_dp + +logical function tlt_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = (x .tle. y) .and. (x .tne. y) + +end function tlt_dp + +logical function tge_dp( x, y ) result(cmp) + real(kind=dp), intent(in) :: x, y + + cmp = (x .tgt. y) .or. (x .teq. y) + +end function tge_dp + +! tfloor_dp -- +! Tolerant FLOOR Function +! +! Arguments: +! +! x - is given as a double precision argument to be operated on. +! it is assumed that X is represented with m mantissa bits. +! ct - is given as a Comparison Tolerance such that +! 0. < CT < 3-Sqrt(5)/2. If the relative difference between +! X and a whole number is less than CT, then TFLOOR is +! returned as this whole number. By treating the +! floating-point numbers as a finite ordered set note that +! the heuristic eps=2.**(-(m-1)) and CT=3*eps causes +! arguments of TFLOOR/TCEIL to be treated as whole numbers +! if they are exactly whole numbers or are immediately +! adjacent to whole number representations. Since EPS, the +! "distance" between floating-point numbers on the unit +! interval, and m, the number of bits in X's mantissa, exist +! on every floating-point computer, TFLOOR/TCEIL are +! consistently definable on every floating-point computer. +! +! For more information see the following references: +! +! {1} P. E. Hagerty, "More on Fuzzy Floor and Ceiling," APL QUOTE +! QUAD 8(4):20-24, June 1978. Note that TFLOOR=FL5 took five +! years of refereed evolution (publication). +! +! {2} L. M. Breed, "Definitions for Fuzzy Floor and Ceiling", APL +! QUOTE QUAD 8(3):16-23, March 1978. +! +! H. D. KNOBLE, Penn State University. +! +! FLOOR(X) is the largest integer algegraically less than +! or equal to X; that is, the unfuzzy Floor Function. +! +elemental function tfloor_dp( x, ct_opt ) + real(kind=dp), intent(in) :: x + real(kind=dp), intent(in), optional :: ct_opt + real(kind=dp) :: tfloor_dp + + real(kind=dp) :: q, rmax, eps5, ct + + if ( present(ct_opt) ) then + ct = ct_opt + else + ct = eps_dp3 + endif + +! Hagerty's FL5 Function follows... + + q=1.0_dp + + if( x < 0.0_dp ) q = 1.0_dp - ct + + rmax = q / (2.0_dp - ct) + eps5 = ct / q + tfloor_dp = floor( x + max( ct, min( rmax, eps5 * abs(1.0_dp + floor(x)) ) ) ) + + if ( x <= 0.0_dp .or. (tfloor_dp - x) < rmax ) return + + tfloor_dp = tfloor_dp-1.0_dp + +contains +elemental function dint( x ) + real(kind=dp), intent(in) :: x + real(kind=dp) :: dint + + dint = x - mod(x,1.0_dp) +end function dint + +elemental function floor( x ) + real(kind=dp), intent(in) :: x + real(kind=dp) :: floor + + floor = dint(x) - mod( 2.0_dp + sign(1.0_dp,x), 3.0_dp ) +end function floor +end function tfloor_dp + +! tceil_dp -- +! Tolerant Ceiling Function +! +! Arguments: +! See tfloor_dp +! +elemental function tceil_dp( x, ct_opt ) + real(kind=dp), intent(in) :: x + real(kind=dp), intent(in), optional :: ct_opt + real(kind=dp) :: tceil_dp + + if ( present(ct_opt) ) then + tceil_dp = -tfloor_dp(-x, ct_opt) + else + tceil_dp = -tfloor_dp(-x, eps_dp3) + endif +end function tceil_dp + +! tround_dp -- +! Tolerant Round Function +! +! Arguments: +! See tfloor_dp +! +! Note: +! See Knuth, Art of Computer Programming, Vol. 1, Problem 1.2.4-5. +! +elemental function tround_dp( x, ct_opt ) + real(kind=dp), intent(in) :: x + real(kind=dp), intent(in), optional :: ct_opt + real(kind=dp) :: tround_dp + + if ( present(ct_opt) ) then + tround_dp = tfloor_dp(x +0.5_dp, ct_opt) + else + tround_dp = tfloor_dp(x +0.5_dp, eps_dp3) + endif + +end function tround_dp + +! tfloor_sp, tceil_sp, tround_sp -- +! Tolerant Floor, Ceiling and Rond Functions for single-precision +! +! Arguments: +! See tfloor_dp +! +elemental function tfloor_sp( x, ct_opt ) + real(kind=sp), intent(in) :: x + real(kind=sp), intent(in), optional :: ct_opt + real(kind=sp) :: tfloor_sp + real(kind=sp) :: ct + + if ( present(ct_opt) ) then + ct = ct_opt + else + ct = eps_sp3 + endif + + tfloor_sp = real( tfloor_dp(real(x,dp), real(ct,dp)), sp) + +end function tfloor_sp + +elemental function tceil_sp( x, ct_opt ) + real(kind=sp), intent(in) :: x + real(kind=sp), intent(in), optional :: ct_opt + real(kind=sp) :: tceil_sp + real(kind=sp) :: ct + + if ( present(ct_opt) ) then + ct = ct_opt + else + ct = eps_sp3 + endif + tceil_sp = -real( tfloor_dp(-real(x,dp), real(ct,dp)), sp) + +end function tceil_sp + +elemental function tround_sp( x, ct_opt ) + real(kind=sp), intent(in) :: x + real(kind=sp), intent(in), optional :: ct_opt + real(kind=sp) :: tround_sp + real(kind=sp) :: ct + + if ( present(ct_opt) ) then + ct = ct_opt + else + ct = eps_sp3 + endif + tround_sp = real( tfloor_dp(real(x,dp) + 0.5_dp, real(ct,dp)), sp) + +end function tround_sp + +end module stdlib_tolerant diff --git a/src/tests/CMakeLists.bak b/src/tests/CMakeLists.bak new file mode 100644 index 000000000..288445de9 --- /dev/null +++ b/src/tests/CMakeLists.bak @@ -0,0 +1,23 @@ +macro(ADDTEST name) + add_executable(test_${name} test_${name}.f90) + target_link_libraries(test_${name} ${PROJECT_NAME}) + add_test(NAME ${name} + COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +endmacro(ADDTEST) + +add_subdirectory(ascii) +add_subdirectory(bitsets) +add_subdirectory(io) +add_subdirectory(linalg) +add_subdirectory(logger) +add_subdirectory(optval) +add_subdirectory(stats) +add_subdirectory(string) +add_subdirectory(system) +add_subdirectory(quadrature) + +ADDTEST(always_skip) +set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77) +ADDTEST(always_fail) +set_tests_properties(always_fail PROPERTIES WILL_FAIL true) diff --git a/src/tests/CMakeLists.txt b/src/tests/CMakeLists.txt index 288445de9..1f8328225 100644 --- a/src/tests/CMakeLists.txt +++ b/src/tests/CMakeLists.txt @@ -16,6 +16,7 @@ add_subdirectory(stats) add_subdirectory(string) add_subdirectory(system) add_subdirectory(quadrature) +add_subdirectory(tolerant) ADDTEST(always_skip) set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77) diff --git a/src/tests/Makefile.manual b/src/tests/Makefile.manual index 553a69bed..fdfd867aa 100644 --- a/src/tests/Makefile.manual +++ b/src/tests/Makefile.manual @@ -9,6 +9,7 @@ all: $(MAKE) -f Makefile.manual --directory=quadrature $(MAKE) -f Makefile.manual --directory=stats $(MAKE) -f Makefile.manual --directory=string + $(MAKE) -f Makefile.manual --directory=tolerant test: $(MAKE) -f Makefile.manual --directory=ascii test @@ -19,6 +20,7 @@ test: $(MAKE) -f Makefile.manual --directory=quadrature test $(MAKE) -f Makefile.manual --directory=stats test $(MAKE) -f Makefile.manual --directory=string test + $(MAKE) -f Makefile.manual --directory=tolerant test clean: $(MAKE) -f Makefile.manual --directory=ascii clean @@ -28,3 +30,4 @@ clean: $(MAKE) -f Makefile.manual --directory=optval clean $(MAKE) -f Makefile.manual --directory=stats clean $(MAKE) -f Makefile.manual --directory=string clean + $(MAKE) -f Makefile.manual --directory=tolerant clean diff --git a/src/tests/tolerant/CMakeLists.txt b/src/tests/tolerant/CMakeLists.txt new file mode 100644 index 000000000..1d9ae1cad --- /dev/null +++ b/src/tests/tolerant/CMakeLists.txt @@ -0,0 +1 @@ +ADDTEST(tolerant) diff --git a/src/tests/tolerant/Makefile.manual b/src/tests/tolerant/Makefile.manual new file mode 100644 index 000000000..76e1919bb --- /dev/null +++ b/src/tests/tolerant/Makefile.manual @@ -0,0 +1,4 @@ +PROGS_SRC = test_tolerant.f90 + + +include ../Makefile.manual.test.mk diff --git a/src/tests/tolerant/test_tolerant.f90 b/src/tests/tolerant/test_tolerant.f90 new file mode 100644 index 000000000..0aff28e76 --- /dev/null +++ b/src/tests/tolerant/test_tolerant.f90 @@ -0,0 +1,65 @@ +! test_tolerant.f90 -- +! Compare real values in a "tolerant" way, that is, with a margin +! +! Copy of the original test program +! +program test_tolerant + use stdlib_tolerant + + implicit none + + integer, parameter :: dp = kind(1.0d0) + real(kind=dp) :: x, y, z + real(kind=dp) :: yfloor, yceil + integer :: i + + real(kind=dp) :: eps3 = 3.0_dp * epsilon(eps3) + +!---Illustrate Fuzzy Comparisons using EPS3. Any other magnitudes will +! behave similarly. + + z = 1.0_dp + i = 49 + x = 1.0_dp / i + y = x * i + + write(*,*) 'x=1.d0/',i,', y=x*',i,', z=1.d0' + write(*,*) 'y=',y,' z=',z + write(*,3) x,y,z +3 format(' x=',z16,' y=',z16,' z=',z16) + +!---floating-point y is not identical (.eq.) to floating-point z. + if ( y == z ) write(*,*) 'fuzzy comparisons: y=z' + if ( y /= z ) write(*,*) 'fuzzy comparisons: y<>z' + +!---but y is tolerantly (and algebraically) equal to z. + if ( y .teq. z ) then + write(*,*) 'but y .teq. z is .true.' + write(*,*) 'that is, y is computationally equal to z.' + endif + if( y .tne. z ) write(*,*) 'and y .tne. z is .true.' + write(*,*) ' ' + +!---evaluate fuzzy floor and ceiling function values using a comparison +! tolerance, ct, of eps3. + x = 0.11_dp + y = ( ( x * 11.0_dp) - x ) - 0.1_dp + yfloor = tfloor( y, eps3 ) + yceil = tceil( y, eps3 ) + + z =1.0_dp + + write(*,*) 'x=0.11d0, y=x*11.d0-x-0.1d0, z=1.d0' + write(*,*) 'x=',x,' y=',y,' z=',z + write(*,3) x,y,z + +!---floating-point y is not identical (.eq.) to floating-point z. + if ( y == z ) write(*,*) 'fuzzy floor/ceil: y=z' + if ( y /= z ) write(*,*) 'fuzzy floor/ceil: y<>z' + if ( tfloor(y,eps3) == tceil(y,eps3) .and. tfloor(y,eps3) == z ) then +!---but tolerant floor/ceil of y is identical (and algebraically equal) +! to z. + write(*,*) 'but tfloor(y,eps3)=tceil(y,eps3)=z.' + write(*,*) 'that is, tfloor/tceil return exact whole numbers.' + endif +end program test_tolerant From e837d9e21003596cec93ef2fb1b3e8c9682ec607 Mon Sep 17 00:00:00 2001 From: arjenmarkus Date: Sat, 20 Mar 2021 12:56:56 +0100 Subject: [PATCH 2/2] Delete CMakeLists.bak This backup file (from an edit action) was not supposed to go into the repository --- src/CMakeLists.bak | 73 ---------------------------------------------- 1 file changed, 73 deletions(-) delete mode 100644 src/CMakeLists.bak diff --git a/src/CMakeLists.bak b/src/CMakeLists.bak deleted file mode 100644 index 85f5c68b6..000000000 --- a/src/CMakeLists.bak +++ /dev/null @@ -1,73 +0,0 @@ -### Pre-process: .fpp -> .f90 via Fypp - -# Create a list of the files to be preprocessed -set(fppFiles - stdlib_bitsets.fypp - stdlib_bitsets_64.fypp - stdlib_bitsets_large.fypp - stdlib_io.fypp - stdlib_linalg.fypp - stdlib_linalg_diag.fypp - stdlib_optval.fypp - stdlib_stats.fypp - stdlib_stats_corr.fypp - stdlib_stats_cov.fypp - stdlib_stats_mean.fypp - stdlib_stats_moment.fypp - stdlib_stats_moment_all.fypp - stdlib_stats_moment_mask.fypp - stdlib_stats_moment_scalar.fypp - stdlib_stats_var.fypp - stdlib_quadrature.fypp - stdlib_quadrature_trapz.fypp - stdlib_quadrature_simps.fypp - stdlib_stats_distribution_PRNG.fypp -) - - -# Custom preprocessor flags -if(DEFINED CMAKE_MAXIMUM_RANK) - set(fyppFlags "-DMAXRANK=${CMAKE_MAXIMUM_RANK}") -elseif(f03rank) - set(fyppFlags) -else() - set(fyppFlags "-DVERSION90") -endif() - -fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) - -set(SRC - stdlib_ascii.f90 - stdlib_error.f90 - stdlib_kinds.f90 - stdlib_logger.f90 - stdlib_string_type.f90 - stdlib_system.F90 - ${outFiles} -) - -add_library(${PROJECT_NAME} ${SRC}) - -set(LIB_MOD_DIR ${CMAKE_CURRENT_BINARY_DIR}/mod_files/) -set_target_properties(${PROJECT_NAME} PROPERTIES - Fortran_MODULE_DIRECTORY ${LIB_MOD_DIR}) -target_include_directories(${PROJECT_NAME} PUBLIC - $ - $ -) - -if(f18errorstop) - target_sources(${PROJECT_NAME} PRIVATE f18estop.f90) -else() - target_sources(${PROJECT_NAME} PRIVATE f08estop.f90) -endif() - -add_subdirectory(tests) - -install(TARGETS ${PROJECT_NAME} - EXPORT ${PROJECT_NAME}-targets - RUNTIME DESTINATION "${CMAKE_INSTALL_BINDIR}" - ARCHIVE DESTINATION "${CMAKE_INSTALL_LIBDIR}" - LIBRARY DESTINATION "${CMAKE_INSTALL_LIBDIR}" -) -install(DIRECTORY ${LIB_MOD_DIR} DESTINATION "${CMAKE_INSTALL_INCLUDEDIR}")