From affa81a7faeec13053c1ce115bfb9918da1ecb19 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 11:51:38 +0200 Subject: [PATCH 01/89] Add linspace submodule to stdlib_stats --- src/CMakeLists.txt | 1 + src/tests/stats/CMakeLists.txt | 1 + 2 files changed, 2 insertions(+) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index a1df4d52c..c22159f2b 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,6 +13,7 @@ set(fppFiles stdlib_stats.fypp stdlib_stats_corr.fypp stdlib_stats_cov.fypp + stdlib_stats_linspace.fypp stdlib_stats_mean.fypp stdlib_stats_moment.fypp stdlib_stats_moment_all.fypp diff --git a/src/tests/stats/CMakeLists.txt b/src/tests/stats/CMakeLists.txt index 38f9bb84b..7f9cea12a 100644 --- a/src/tests/stats/CMakeLists.txt +++ b/src/tests/stats/CMakeLists.txt @@ -6,6 +6,7 @@ ADDTEST(rawmoment) ADDTEST(var) ADDTEST(varn) ADDTEST(distribution_PRNG) +ADDTEST(linspace) if(DEFINED CMAKE_MAXIMUM_RANK) if(${CMAKE_MAXIMUM_RANK} GREATER 7) From 7d7a99220e816b53040697309f5dc9af31401faf Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 11:52:04 +0200 Subject: [PATCH 02/89] Verify that linspace generates the proper spread --- src/tests/stats/test_linspace.f90 | 43 +++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+) create mode 100644 src/tests/stats/test_linspace.f90 diff --git a/src/tests/stats/test_linspace.f90 b/src/tests/stats/test_linspace.f90 new file mode 100644 index 000000000..8a52cf375 --- /dev/null +++ b/src/tests/stats/test_linspace.f90 @@ -0,0 +1,43 @@ +program test_linspace + use stdlib_error, only: check + use stdlib_kinds, only: sp, dp + use stdlib_stats, only: linspace + + implicit none + logical :: warn = .true. + + call test_linspace_sp + call test_linspace_dp + +contains + + subroutine test_linspace_sp + + integer :: n = 20 + real(sp) :: start = 1.0_sp + real(sp) :: end = 10.0_sp + + real(sp), dimension(:), allocatable :: x + + x = linspace(start, end, n) + + call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + + + end subroutine + + subroutine test_linspace_dp + + real(dp) :: start = 1.0_dp + real(dp) :: end = 10.0_dp + + real(dp), dimension(:), allocatable :: x + + x = linspace(start, end) + + call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + + end subroutine + + +end program \ No newline at end of file From 415e79d136f572283f4413d9293bf735d9639cb5 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:25:56 +0200 Subject: [PATCH 03/89] Add linspace and object dependencies --- src/Makefile.manual | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index b372a8cb6..6b8745e66 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -13,6 +13,7 @@ SRCFYPP =\ stdlib_stats.fypp \ stdlib_stats_corr.fypp \ stdlib_stats_cov.fypp \ + stdlib_stats_linspace.fypp \ stdlib_stats_mean.fypp \ stdlib_stats_moment.fypp \ stdlib_stats_moment_all.fypp \ @@ -91,6 +92,10 @@ stdlib_stats_cov.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o +stdlib_stats_linspace.o: \ + stdlib_optval.o \ + stdlib_kinds.o \ + stdlib_stats.o stdlib_stats_mean.o: \ stdlib_optval.o \ stdlib_kinds.o \ From b42b4fc25e946fdeaa02c92c4f2344abbf117de8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:26:15 +0200 Subject: [PATCH 04/89] libspace function source code --- src/stdlib_stats_linspace.fypp | 45 ++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 src/stdlib_stats_linspace.fypp diff --git a/src/stdlib_stats_linspace.fypp b/src/stdlib_stats_linspace.fypp new file mode 100644 index 000000000..62d4e7aff --- /dev/null +++ b/src/stdlib_stats_linspace.fypp @@ -0,0 +1,45 @@ +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +submodule (stdlib_stats) stdlib_stats_linspace + + use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan + use stdlib_error, only: check + use stdlib_optval, only: optval + implicit none + +contains + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in), optional :: n + + ${t1}$, dimension(:), allocatable :: res + + integer :: ierr ! Error status of allocation + integer :: len ! Length of allocated result + integer :: i ! Looping index + ${t1}$ :: interval ! Difference between adjacent elements + + len = optval(n, 100) + + allocate(res(len), stat=ierr) ! Allocate result to have default 100 values + call check(ierr==0, msg="Error allocating res") + + if(len <= 0) return ! If passed length is less than or equal to 0, return an empty (allocated with length 0) array + + interval = (end - start) / (len - 1) + + do i = 1, len + + res(i) = (i-1)*interval + start + + end do + + end function ${RName}$ + #:endfor + +end submodule \ No newline at end of file From 4db9ccabf23bda81515ac85b0be9fdb2d8dd7bab Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:26:39 +0200 Subject: [PATCH 05/89] Add linspace to public api --- src/stdlib_stats.fypp | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/stdlib_stats.fypp b/src/stdlib_stats.fypp index 4aa9edaa1..81bab50f6 100644 --- a/src/stdlib_stats.fypp +++ b/src/stdlib_stats.fypp @@ -11,7 +11,7 @@ module stdlib_stats implicit none private ! Public API - public :: corr, cov, mean, moment, var + public :: corr, cov, mean, moment, var, linspace interface corr @@ -584,4 +584,23 @@ module stdlib_stats #:endfor end interface moment + interface linspace + !! Version: Experimental + !! + !! Create rank 1 array of linearly spaced elements + !! If the number of elements is not specified, create an array with size 100. If n is a negative value, + !! return an array with size 0. + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in), optional :: n + + ${t1}$, dimension(:), allocatable :: res + end function ${RName}$ + #:endfor + end interface + + end module stdlib_stats From 3040135ec5d7784d93a7a5aa494f2c524baa0692 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:27:07 +0200 Subject: [PATCH 06/89] Update test to include negative integer for elements requested --- src/tests/stats/test_linspace.f90 | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/src/tests/stats/test_linspace.f90 b/src/tests/stats/test_linspace.f90 index 8a52cf375..12b055d78 100644 --- a/src/tests/stats/test_linspace.f90 +++ b/src/tests/stats/test_linspace.f90 @@ -4,10 +4,11 @@ program test_linspace use stdlib_stats, only: linspace implicit none - logical :: warn = .true. + logical :: warn = .false. call test_linspace_sp call test_linspace_dp + call test_linspace_neg_index ! Make sure that when passed a negative index the result is an empty array contains @@ -22,7 +23,8 @@ subroutine test_linspace_sp x = linspace(start, end, n) call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) - + call check(x(20) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) end subroutine @@ -36,6 +38,21 @@ subroutine test_linspace_dp x = linspace(start, end) call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(x(100) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(x) == 100, msg="Array not allocated to appropriate size", warn=warn) + + end subroutine + + subroutine test_linspace_neg_index + + real(dp) :: start = 1.0_dp + real(dp) :: end = 10.0_dp + + real(dp), dimension(:), allocatable :: x + + x = linspace(start, end, -15) + + call check(size(x) == 0, msg="Allocated array is not empty", warn=warn) end subroutine From 4257b4ea6fe8fe35d0f61308d92b8043a6fb95de Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:39:01 +0200 Subject: [PATCH 07/89] Fix manual dependency --- src/Makefile.manual | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Makefile.manual b/src/Makefile.manual index 6b8745e66..7778c3ef1 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -93,6 +93,7 @@ stdlib_stats_cov.o: \ stdlib_kinds.o \ stdlib_stats.o stdlib_stats_linspace.o: \ + stdlib_error.o \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o From 87fde2287414874d62f2ee22ed5ffae4c6aa2499 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 12:46:00 +0200 Subject: [PATCH 08/89] Add real conversions to integer arithmetic --- src/stdlib_stats_linspace.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_stats_linspace.fypp b/src/stdlib_stats_linspace.fypp index 62d4e7aff..65368c3e2 100644 --- a/src/stdlib_stats_linspace.fypp +++ b/src/stdlib_stats_linspace.fypp @@ -31,11 +31,11 @@ contains if(len <= 0) return ! If passed length is less than or equal to 0, return an empty (allocated with length 0) array - interval = (end - start) / (len - 1) + interval = (end - start) / real((len - 1), ${k1}$) do i = 1, len - res(i) = (i-1)*interval + start + res(i) = real((i-1), ${k1}$) * interval + start end do From 3db3357c8033b3f07a76bc6014494b6280037a19 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 14:40:33 +0200 Subject: [PATCH 09/89] Refactor stdlib_stats_linspace -> stdlib_linalg_linspace; Split linspace into "default" and "n" function calls to avoid use of allocatable array --- src/CMakeLists.txt | 2 +- src/stdlib_linalg.fypp | 42 +++++++++++++-- src/stdlib_linalg_linspace.fypp | 51 +++++++++++++++++++ src/stdlib_stats_linspace.fypp | 45 ---------------- src/tests/linalg/CMakeLists.txt | 1 + src/tests/{stats => linalg}/test_linspace.f90 | 2 +- src/tests/stats/CMakeLists.txt | 1 - 7 files changed, 91 insertions(+), 53 deletions(-) create mode 100644 src/stdlib_linalg_linspace.fypp delete mode 100644 src/stdlib_stats_linspace.fypp rename src/tests/{stats => linalg}/test_linspace.f90 (97%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c22159f2b..76232b49a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -9,11 +9,11 @@ set(fppFiles stdlib_io.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp + stdlib_linalg_linspace.fypp stdlib_optval.fypp stdlib_stats.fypp stdlib_stats_corr.fypp stdlib_stats_cov.fypp - stdlib_stats_linspace.fypp stdlib_stats_mean.fypp stdlib_stats_moment.fypp stdlib_stats_moment_all.fypp diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 51c2cdd54..d222ff676 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -56,12 +56,40 @@ module stdlib_linalg interface trace !! version: experimental !! - !! Computes the trace of a matrix - !! ([Specification](../page/specs/stdlib_linalg.html#description_2)) - #:for k1, t1 in RCI_KINDS_TYPES - module procedure trace_${t1[0]}$${k1}$ + !! Computes the trace of a matrix + !! ([Specification](../page/specs/stdlib_linalg.html#description_2)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure trace_${t1[0]}$${k1}$ #:endfor - end interface + end interface + + interface linspace + !! Version: Experimental + !! + !! Create rank 1 array of linearly spaced elements + !! If the number of elements is not specified, create an array with size 100. If n is a negative value, + !! return an array with size 0. + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(100) + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + end interface contains @@ -91,4 +119,8 @@ contains end do end function trace_${t1[0]}$${k1}$ #:endfor + + + + end module diff --git a/src/stdlib_linalg_linspace.fypp b/src/stdlib_linalg_linspace.fypp new file mode 100644 index 000000000..e4fd4a05d --- /dev/null +++ b/src/stdlib_linalg_linspace.fypp @@ -0,0 +1,51 @@ +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +submodule (stdlib_linalg) stdlib_linalg_linspace + + implicit none + + integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 + +contains + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + + res = linspace(start, end, DEFAULT_LINSPACE_LENGTH) + + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + + integer :: i ! Looping index + ${t1}$ :: interval ! Difference between adjacent elements + + + if(n <= 0) return ! If passed length is less than or equal to 0, return an empty (allocated with length 0) array + + interval = (end - start) / real((n - 1), ${k1}$) + + do i = 1, n + + res(i) = real((i-1), ${k1}$) * interval + start + + end do + + end function ${RName}$ + #:endfor + +end submodule \ No newline at end of file diff --git a/src/stdlib_stats_linspace.fypp b/src/stdlib_stats_linspace.fypp deleted file mode 100644 index 65368c3e2..000000000 --- a/src/stdlib_stats_linspace.fypp +++ /dev/null @@ -1,45 +0,0 @@ -#:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -submodule (stdlib_stats) stdlib_stats_linspace - - use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan - use stdlib_error, only: check - use stdlib_optval, only: optval - implicit none - -contains - - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in), optional :: n - - ${t1}$, dimension(:), allocatable :: res - - integer :: ierr ! Error status of allocation - integer :: len ! Length of allocated result - integer :: i ! Looping index - ${t1}$ :: interval ! Difference between adjacent elements - - len = optval(n, 100) - - allocate(res(len), stat=ierr) ! Allocate result to have default 100 values - call check(ierr==0, msg="Error allocating res") - - if(len <= 0) return ! If passed length is less than or equal to 0, return an empty (allocated with length 0) array - - interval = (end - start) / real((len - 1), ${k1}$) - - do i = 1, len - - res(i) = real((i-1), ${k1}$) * interval + start - - end do - - end function ${RName}$ - #:endfor - -end submodule \ No newline at end of file diff --git a/src/tests/linalg/CMakeLists.txt b/src/tests/linalg/CMakeLists.txt index f1098405b..7332a72b9 100644 --- a/src/tests/linalg/CMakeLists.txt +++ b/src/tests/linalg/CMakeLists.txt @@ -1,2 +1,3 @@ ADDTEST(linalg) +ADDTEST(linspace) diff --git a/src/tests/stats/test_linspace.f90 b/src/tests/linalg/test_linspace.f90 similarity index 97% rename from src/tests/stats/test_linspace.f90 rename to src/tests/linalg/test_linspace.f90 index 12b055d78..4ae61292a 100644 --- a/src/tests/stats/test_linspace.f90 +++ b/src/tests/linalg/test_linspace.f90 @@ -1,7 +1,7 @@ program test_linspace use stdlib_error, only: check use stdlib_kinds, only: sp, dp - use stdlib_stats, only: linspace + use stdlib_linalg, only: linspace implicit none logical :: warn = .false. diff --git a/src/tests/stats/CMakeLists.txt b/src/tests/stats/CMakeLists.txt index 7f9cea12a..38f9bb84b 100644 --- a/src/tests/stats/CMakeLists.txt +++ b/src/tests/stats/CMakeLists.txt @@ -6,7 +6,6 @@ ADDTEST(rawmoment) ADDTEST(var) ADDTEST(varn) ADDTEST(distribution_PRNG) -ADDTEST(linspace) if(DEFINED CMAKE_MAXIMUM_RANK) if(${CMAKE_MAXIMUM_RANK} GREATER 7) From 6e4224977bbdb0bc88be67014591beab1ed7184b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 14:44:53 +0200 Subject: [PATCH 10/89] Make linspace public and add DEFAULT_LINSPACE_LENGTH parameter --- src/stdlib_linalg.fypp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index d222ff676..3ba1447bf 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -11,6 +11,9 @@ module stdlib_linalg public :: diag public :: eye public :: trace + public :: linspace + + integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 interface diag !! version: experimental @@ -75,7 +78,7 @@ module stdlib_linalg ${t1}$, intent(in) :: start ${t1}$, intent(in) :: end - ${t1}$ :: res(100) + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) end function ${RName}$ #:endfor From b08ba8cc271dcddd8c867e7b6f865dc3f99be983 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 14:50:16 +0200 Subject: [PATCH 11/89] Fix whitespace indentation that I interrupted --- src/stdlib_linalg.fypp | 64 +++++++++++++++++++++--------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 3ba1447bf..9dbe97c51 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -59,40 +59,40 @@ module stdlib_linalg interface trace !! version: experimental !! - !! Computes the trace of a matrix - !! ([Specification](../page/specs/stdlib_linalg.html#description_2)) - #:for k1, t1 in RCI_KINDS_TYPES - module procedure trace_${t1[0]}$${k1}$ + !! Computes the trace of a matrix + !! ([Specification](../page/specs/stdlib_linalg.html#description_2)) + #:for k1, t1 in RCI_KINDS_TYPES + module procedure trace_${t1[0]}$${k1}$ #:endfor - end interface - - interface linspace - !! Version: Experimental - !! - !! Create rank 1 array of linearly spaced elements - !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace_default", 1, t1, k1) - module function ${RName}$(start, end) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) - end function ${RName}$ - #:endfor + end interface - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - ${t1}$ :: res(n) - end function ${RName}$ - #:endfor - end interface + interface linspace + !! Version: Experimental + !! + !! Create rank 1 array of linearly spaced elements + !! If the number of elements is not specified, create an array with size 100. If n is a negative value, + !! return an array with size 0. + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + end interface contains From 48a619d1d00e7006cc9eb89d6bd7aadf9d03b402 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 14:53:50 +0200 Subject: [PATCH 12/89] Refactor linspace manual dependencies --- src/Makefile.manual | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 7778c3ef1..62ed89b79 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -6,6 +6,7 @@ SRCFYPP =\ stdlib_io.fypp \ stdlib_linalg.fypp \ stdlib_linalg_diag.fypp \ + stdlib_linalg_linspace.fypp \ stdlib_optval.fypp \ stdlib_quadrature.fypp \ stdlib_quadrature_trapz.fypp \ @@ -13,7 +14,6 @@ SRCFYPP =\ stdlib_stats.fypp \ stdlib_stats_corr.fypp \ stdlib_stats_cov.fypp \ - stdlib_stats_linspace.fypp \ stdlib_stats_mean.fypp \ stdlib_stats_moment.fypp \ stdlib_stats_moment_all.fypp \ @@ -71,6 +71,9 @@ stdlib_linalg.o: \ stdlib_linalg_diag.o: \ stdlib_linalg.o \ stdlib_kinds.o +stdlib_linalg_linspace.o: \ + stdlib_linalg.o \ + stdlib_kinds.o stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o @@ -92,11 +95,6 @@ stdlib_stats_cov.o: \ stdlib_optval.o \ stdlib_kinds.o \ stdlib_stats.o -stdlib_stats_linspace.o: \ - stdlib_error.o \ - stdlib_optval.o \ - stdlib_kinds.o \ - stdlib_stats.o stdlib_stats_mean.o: \ stdlib_optval.o \ stdlib_kinds.o \ From f997c59faa34b9fb45325d9c7ad7f4facef552c0 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 15:01:59 +0200 Subject: [PATCH 13/89] Remove linspace public export --- src/stdlib_stats.fypp | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/src/stdlib_stats.fypp b/src/stdlib_stats.fypp index 81bab50f6..f54dd6793 100644 --- a/src/stdlib_stats.fypp +++ b/src/stdlib_stats.fypp @@ -11,7 +11,7 @@ module stdlib_stats implicit none private ! Public API - public :: corr, cov, mean, moment, var, linspace + public :: corr, cov, mean, moment, var interface corr @@ -584,23 +584,5 @@ module stdlib_stats #:endfor end interface moment - interface linspace - !! Version: Experimental - !! - !! Create rank 1 array of linearly spaced elements - !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in), optional :: n - - ${t1}$, dimension(:), allocatable :: res - end function ${RName}$ - #:endfor - end interface - end module stdlib_stats From 51c9b1df8b077f9f6e9e9964e4f09bf98a5985aa Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 19:48:22 +0200 Subject: [PATCH 14/89] Remove linspace from stdlib_linalg --- src/CMakeLists.txt | 2 +- src/Makefile.manual | 9 +++--- src/stdlib_linalg.fypp | 29 ------------------- ...inspace.fypp => stdlib_math_linspace.fypp} | 6 ++-- 4 files changed, 8 insertions(+), 38 deletions(-) rename src/{stdlib_linalg_linspace.fypp => stdlib_math_linspace.fypp} (90%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 76232b49a..907ee6ca2 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -9,7 +9,6 @@ set(fppFiles stdlib_io.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp - stdlib_linalg_linspace.fypp stdlib_optval.fypp stdlib_stats.fypp stdlib_stats_corr.fypp @@ -25,6 +24,7 @@ set(fppFiles stdlib_quadrature_simps.fypp stdlib_stats_distribution_PRNG.fypp stdlib_math.fypp + stdlib_math_linspace.fypp stdlib_string_type.fypp ) diff --git a/src/Makefile.manual b/src/Makefile.manual index 62ed89b79..9aa97a8e3 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -6,7 +6,6 @@ SRCFYPP =\ stdlib_io.fypp \ stdlib_linalg.fypp \ stdlib_linalg_diag.fypp \ - stdlib_linalg_linspace.fypp \ stdlib_optval.fypp \ stdlib_quadrature.fypp \ stdlib_quadrature_trapz.fypp \ @@ -21,6 +20,7 @@ SRCFYPP =\ stdlib_stats_moment_scalar.fypp \ stdlib_stats_var.fypp \ stdlib_math.fypp \ + stdlib_math_linspace.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp @@ -71,9 +71,6 @@ stdlib_linalg.o: \ stdlib_linalg_diag.o: \ stdlib_linalg.o \ stdlib_kinds.o -stdlib_linalg_linspace.o: \ - stdlib_linalg.o \ - stdlib_kinds.o stdlib_logger.o: stdlib_ascii.o stdlib_optval.o stdlib_optval.o: stdlib_kinds.o stdlib_quadrature.o: stdlib_kinds.o @@ -119,3 +116,7 @@ stdlib_stats_distribution_PRNG.o: \ stdlib_string_type.o: stdlib_ascii.o stdlib_kinds.o stdlib_strings.o: stdlib_ascii.o stdlib_string_type.o stdlib_math.o: stdlib_kinds.o +stdlib_math_linspace.o: \ + stdlib_math.o \ + stdlib_kinds.o + diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 9dbe97c51..3dc705488 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -11,9 +11,7 @@ module stdlib_linalg public :: diag public :: eye public :: trace - public :: linspace - integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 interface diag !! version: experimental @@ -66,33 +64,6 @@ module stdlib_linalg #:endfor end interface - interface linspace - !! Version: Experimental - !! - !! Create rank 1 array of linearly spaced elements - !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace_default", 1, t1, k1) - module function ${RName}$(start, end) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) - end function ${RName}$ - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("linspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - ${t1}$ :: res(n) - end function ${RName}$ - #:endfor - end interface contains diff --git a/src/stdlib_linalg_linspace.fypp b/src/stdlib_math_linspace.fypp similarity index 90% rename from src/stdlib_linalg_linspace.fypp rename to src/stdlib_math_linspace.fypp index e4fd4a05d..e9bf61f40 100644 --- a/src/stdlib_linalg_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -1,11 +1,9 @@ #:include "common.fypp" #:set RANKS = range(1, MAXRANK + 1) #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -submodule (stdlib_linalg) stdlib_linalg_linspace +submodule (stdlib_math) stdlib_math_linspace - implicit none - - integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 +implicit none contains From 9c57100d7b0adbd864d9bdf164024a93fd3d730f Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 21:00:53 +0200 Subject: [PATCH 15/89] Refactor linspace interface to stdlib_math --- src/stdlib_math.fypp | 32 +++++++++++++++++++- src/tests/math/CMakeLists.txt | 1 + src/tests/math/Makefile.manual | 2 +- src/tests/{linalg => math}/test_linspace.f90 | 2 +- 4 files changed, 34 insertions(+), 3 deletions(-) rename src/tests/{linalg => math}/test_linspace.f90 (97%) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index fc00d94f8..68dcf5258 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -6,7 +6,9 @@ module stdlib_math implicit none private - public :: clip + public :: clip, linspace + + integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 interface clip #:for k1, t1 in IR_KINDS_TYPES @@ -14,6 +16,34 @@ module stdlib_math #:endfor end interface clip + interface linspace + !! Version: Experimental + !! + !! Create rank 1 array of linearly spaced elements + !! If the number of elements is not specified, create an array with size 100. If n is a negative value, + !! return an array with size 0. + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + end interface + contains #:for k1, t1 in IR_KINDS_TYPES diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index ed5f32894..affd7435d 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1 +1,2 @@ ADDTEST(stdlib_math) +ADDTEST(linspace) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index de5f87d26..fdbd38810 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -1,4 +1,4 @@ -PROGS_SRC = test_stdlib_math.f90 +PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 include ../Makefile.manual.test.mk diff --git a/src/tests/linalg/test_linspace.f90 b/src/tests/math/test_linspace.f90 similarity index 97% rename from src/tests/linalg/test_linspace.f90 rename to src/tests/math/test_linspace.f90 index 4ae61292a..f725c3fe5 100644 --- a/src/tests/linalg/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -1,7 +1,7 @@ program test_linspace use stdlib_error, only: check use stdlib_kinds, only: sp, dp - use stdlib_linalg, only: linspace + use stdlib_math, only: linspace implicit none logical :: warn = .false. From acd695e837bdb9b2d891f841a7fb08318b31f308 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 31 May 2021 21:01:28 +0200 Subject: [PATCH 16/89] Remove linspace test from linalgebra folder --- src/tests/linalg/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/tests/linalg/CMakeLists.txt b/src/tests/linalg/CMakeLists.txt index 7332a72b9..f1098405b 100644 --- a/src/tests/linalg/CMakeLists.txt +++ b/src/tests/linalg/CMakeLists.txt @@ -1,3 +1,2 @@ ADDTEST(linalg) -ADDTEST(linspace) From 875a58276db743ba24d3684cf96bba9c03bfbcc8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 1 Jun 2021 00:16:38 +0200 Subject: [PATCH 17/89] Add logspace and lnspace functions in stdlib_math --- src/CMakeLists.txt | 2 + src/Makefile.manual | 12 +++ src/stdlib_math.fypp | 92 ++++++++++++++++++- src/stdlib_math_lnspace.fypp | 41 +++++++++ src/stdlib_math_logspace.fypp | 64 +++++++++++++ src/tests/math/CMakeLists.txt | 2 + src/tests/math/test_linspace.f90 | 7 ++ src/tests/math/test_lnspace.f90 | 126 ++++++++++++++++++++++++++ src/tests/math/test_logspace.f90 | 150 +++++++++++++++++++++++++++++++ 9 files changed, 494 insertions(+), 2 deletions(-) create mode 100644 src/stdlib_math_lnspace.fypp create mode 100644 src/stdlib_math_logspace.fypp create mode 100644 src/tests/math/test_lnspace.f90 create mode 100644 src/tests/math/test_logspace.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 907ee6ca2..18114494a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -25,6 +25,8 @@ set(fppFiles stdlib_stats_distribution_PRNG.fypp stdlib_math.fypp stdlib_math_linspace.fypp + stdlib_math_logspace.fypp + stdlib_math_lnspace.fypp stdlib_string_type.fypp ) diff --git a/src/Makefile.manual b/src/Makefile.manual index 9aa97a8e3..c60c19b9a 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -21,6 +21,8 @@ SRCFYPP =\ stdlib_stats_var.fypp \ stdlib_math.fypp \ stdlib_math_linspace.fypp \ + stdlib_math_logspace.fypp \ + stdlib_math_lnspace.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp @@ -119,4 +121,14 @@ stdlib_math.o: stdlib_kinds.o stdlib_math_linspace.o: \ stdlib_math.o \ stdlib_kinds.o +stdlib_math_logspace.o: \ + stdlib_math.o \ + stdlib_linspace.o \ + stdlib_kinds.o \ + stdlib_optval.o +stdlib_math_lnspace.o: \ + stdlib_math.o \ + stdlib_linspace.o \ + stdlib_logspace.o \ + stdlib_kinds.o diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 68dcf5258..54229ebbf 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -6,9 +6,16 @@ module stdlib_math implicit none private - public :: clip, linspace + public :: clip, linspace, logspace, lnspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 + integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 + real(dp), parameter :: DEFAULT_LOGSPACE_BASE = 10 + + ! Useful constants for lnspace + real(sp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_sp + real(dp), parameter :: EULERS_NUMBER_SP = 2.71828182845904523536028747135266249775724709369995_dp + real(qp), parameter :: EULERS_NUMBER_QP = 2.71828182845904523536028747135266249775724709369995_qp interface clip #:for k1, t1 in IR_KINDS_TYPES @@ -21,7 +28,7 @@ module stdlib_math !! !! Create rank 1 array of linearly spaced elements !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. + !! return an array with size 0. If n = 1, return end #:for k1, t1 in REAL_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) @@ -44,6 +51,87 @@ module stdlib_math #:endfor end interface + interface logspace + !! Version: Experimental + !! + !! Create rank 1 array of logarithmically spaced elements from base**start to base**end. + !! If the number of elements is not specified, create an array with size 50. If n is a negative value, + !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of + !! 10 + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("logspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("logspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:for k2, t2 in IR_KINDS_TYPES + #! k2, t2 correspond to the kind/type of the base that is passed + #:set RName = rname("logspace_n_base", 1, k1, k2) + ! Need another function where base is not optional, otherwise the compiler can not differentiate between + ! generic calls to logspace_n where a base is not present + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + ${t2}$, intent(in) :: base + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + #:endfor +end interface + +interface lnspace +!! Version: Experimental +!! +!! Create rank 1 array of **natural** logarithmically spaced elements from e**start to e**end. +!! If the number of elements is not specified, create an array with size 50. If n is a negative value, +!! return an array with size 0. If n = 1, return e**end. +#:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("lnspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + + end function ${RName}$ +#:endfor + +#:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("lnspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ +#:endfor + +end interface + + + contains #:for k1, t1 in IR_KINDS_TYPES diff --git a/src/stdlib_math_lnspace.fypp b/src/stdlib_math_lnspace.fypp new file mode 100644 index 000000000..9cff00a11 --- /dev/null +++ b/src/stdlib_math_lnspace.fypp @@ -0,0 +1,41 @@ +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + +submodule (stdlib_math) stdlib_math_lnspace + +implicit none + +contains + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("lnspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + + res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, EULERS_NUMBER_${k1}$) + + + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("lnspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + + res = logspace(start, end, n, EULERS_NUMBER_${k1}$) + + end function ${RName}$ + #:endfor + + +end submodule \ No newline at end of file diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp new file mode 100644 index 000000000..b588659ff --- /dev/null +++ b/src/stdlib_math_logspace.fypp @@ -0,0 +1,64 @@ +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + +submodule (stdlib_math) stdlib_math_logspace + +implicit none + +contains + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("logspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + + res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, DEFAULT_LOGSPACE_BASE) + + + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:set RName = rname("logspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + + res = logspace(start, end, n, DEFAULT_LOGSPACE_BASE) + + end function ${RName}$ + #:endfor + + #:for k1, t1 in REAL_KINDS_TYPES + #:for k2, t2 in IR_KINDS_TYPES + #! k2, t2 correspond to the kind/type of the base that is passed + #:set RName = rname("logspace_n_base", 1, k1, k2) + ! Need another function where base is not optional, otherwise the compiler can not differentiate between + ! generic calls to logspace_n where a base is not present + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + ${t2}$, intent(in) :: base + + ${t1}$ :: res(n) + + ${t1}$ :: lin(n) ! Linspace of exponents + + lin = linspace(start, end, n) + + res = real(base, ${k1}$) ** lin ! Convert base to the proper kind + + end function ${RName}$ + #:endfor + #:endfor + +end submodule \ No newline at end of file diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index affd7435d..b24b2b694 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1,2 +1,4 @@ ADDTEST(stdlib_math) ADDTEST(linspace) +ADDTEST(logspace) +ADDTEST(lnspace) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index f725c3fe5..6cf6cded2 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -6,6 +6,13 @@ program test_linspace implicit none logical :: warn = .false. + ! Testing linspace. + ! + ! For single and double precision, check if the beginning and end values are properly calculated + ! and make sure that the size of the result is as expected. + ! + ! + call test_linspace_sp call test_linspace_dp call test_linspace_neg_index ! Make sure that when passed a negative index the result is an empty array diff --git a/src/tests/math/test_lnspace.f90 b/src/tests/math/test_lnspace.f90 new file mode 100644 index 000000000..d138d496f --- /dev/null +++ b/src/tests/math/test_lnspace.f90 @@ -0,0 +1,126 @@ +program test_lnspace + +use stdlib_error, only: check +use stdlib_kinds, only: sp, dp, int8, int16, int32, int64 +use stdlib_math, only: lnspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP + +implicit none + + logical :: warn = .false. + + ! Testing lnspace + ! + ! lnspace should return a rank 1 array of values equally logarithmically spaced + ! from the base**start to base**end, using Euler's number e as the base. If no length + ! is specified, return a rank 1 array with 50 elements. + + open(unit=9, file="test_lnspace_log.txt", status="unknown") ! Log the results of the function + + call test_linspace_sp + call test_linspace_dp + call test_linspace_default + + close(unit=9) + +contains + + subroutine test_linspace_sp + + integer :: n = 20 + real(sp) :: start = 0.0_sp + real(sp) :: end = 2.0_sp + + real(sp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = lnspace(start, end, n) + + cond_1 = (x(1) == (EULERS_NUMBER_SP ** start)) + cond_2 = (x(n) == (EULERS_NUMBER_SP ** end)) + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "lnspace(0.0_sp, 2.0_sp, 20): " + write(unit=9,fmt=99) + write(unit=9,fmt="(20(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_dp + + integer :: n = 10 + real(dp) :: start = 1.0_dp + real(dp) :: end = 0.0_dp + + real(dp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = lnspace(start, end, n) + + cond_1 = (x(1) == (EULERS_NUMBER_DP ** start)) + cond_2 = (x(n) == (EULERS_NUMBER_DP ** end)) + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "lnspace(0.0_dp, 1.0_dp, 10): " + write(unit=9,fmt=99) + write(unit=9,fmt="(10(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_default + + real(dp) :: start = 1.0_dp + real(dp) :: end = 0.0_dp + + real(dp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = lnspace(start, end) + + cond_1 = (x(1) == (EULERS_NUMBER_DP ** start)) + cond_2 = (x(50) == (EULERS_NUMBER_DP ** end)) + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == 50, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "lnspace(0.0_dp, 1.0_dp): " + write(unit=9,fmt=99) + write(unit=9,fmt="(50(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + +end program \ No newline at end of file diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 new file mode 100644 index 000000000..0501e7b86 --- /dev/null +++ b/src/tests/math/test_logspace.f90 @@ -0,0 +1,150 @@ +program test_logspace + + use stdlib_error, only: check + use stdlib_kinds, only: sp, dp, int8, int16, int32, int64 + use stdlib_math, only: logspace + + implicit none + + logical :: warn = .false. + + ! Testing logspace + ! + ! logspace should return a rank 1 array of values equally logarithmically spaced + ! from the base**start to base**end, using Euler's number e as the base. If no length + ! is specified, return a rank 1 array with 50 elements. + + open(unit=9, file="test_logspace_log.txt", status="unknown") ! Log the results of the function + + call test_logspace_sp + call test_logspace_dp + call test_logspace_default + call test_logspace_base_2 + + close(unit=9) + + contains + + subroutine test_logspace_sp + + integer :: n = 20 + real(sp) :: start = 0.0_sp + real(sp) :: end = 2.0_sp + + real(sp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = logspace(start, end, n) + + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "logspace(0.0_sp, 2.0_sp, 20): " + write(unit=9,fmt=99) + write(unit=9,fmt="(20(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_logspace_dp + + integer :: n = 10 + real(dp) :: start = 1.0_dp + real(dp) :: end = 0.0_dp + + real(dp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = logspace(start, end, n) + + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp, 10): " + write(unit=9,fmt=99) + write(unit=9,fmt="(10(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_logspace_default + + real(dp) :: start = 1.0_dp + real(dp) :: end = 0.0_dp + + real(dp), allocatable :: x(:) + + x = logspace(start, end) + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == 50, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp): " + write(unit=9,fmt=99) + write(unit=9,fmt="(50(F7.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_logspace_base_2 + + integer :: n = 10 + real(dp) :: start = 1.0_dp + real(dp) :: end = 10.0_dp + integer :: base = 2 + + real(dp), allocatable :: x(:) + + logical :: cond_1, cond_2 + + x = logspace(start, end, n, base) + + + ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) + ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) + ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") + ! 99 format(G11.5, X) + + write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp, 10, 2): " + write(unit=9,fmt=99) + write(unit=9,fmt="(10(F9.3, 2X))") x + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + + end program \ No newline at end of file From 598287b6080ae4a999d1d3bd1a0bddc08acb1675 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 1 Jun 2021 00:17:00 +0200 Subject: [PATCH 18/89] Modify function behvaior on input n = 1 --- src/stdlib_math_linspace.fypp | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/stdlib_math_linspace.fypp b/src/stdlib_math_linspace.fypp index e9bf61f40..da22e26c2 100644 --- a/src/stdlib_math_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -34,6 +34,10 @@ contains if(n <= 0) return ! If passed length is less than or equal to 0, return an empty (allocated with length 0) array + if(n == 1) then + res(1) = end + return + end if interval = (end - start) / real((n - 1), ${k1}$) From f8dbe003f569e7e605fd0b078b26b6630fc54137 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 1 Jun 2021 11:18:33 +0200 Subject: [PATCH 19/89] Fix printed function call --- src/tests/math/test_lnspace.f90 | 6 +++--- src/tests/math/test_logspace.f90 | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/tests/math/test_lnspace.f90 b/src/tests/math/test_lnspace.f90 index d138d496f..c21c38f16 100644 --- a/src/tests/math/test_lnspace.f90 +++ b/src/tests/math/test_lnspace.f90 @@ -80,7 +80,7 @@ subroutine test_linspace_dp ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "lnspace(0.0_dp, 1.0_dp, 10): " + write(unit=9, fmt=*) "lnspace(1.0_dp, 0.0_dp, 10): " write(unit=9,fmt=99) write(unit=9,fmt="(10(F7.3, 2X))") x write(9,*) @@ -92,8 +92,8 @@ subroutine test_linspace_dp subroutine test_linspace_default - real(dp) :: start = 1.0_dp - real(dp) :: end = 0.0_dp + real(dp) :: start = 0.0_dp + real(dp) :: end = 1.0_dp real(dp), allocatable :: x(:) diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 index 0501e7b86..d2450a03b 100644 --- a/src/tests/math/test_logspace.f90 +++ b/src/tests/math/test_logspace.f90 @@ -77,7 +77,7 @@ subroutine test_logspace_dp ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp, 10): " + write(unit=9, fmt=*) "logspace(1.0_dp, 0.0_dp, 10): " write(unit=9,fmt=99) write(unit=9,fmt="(10(F7.3, 2X))") x write(9,*) @@ -89,8 +89,8 @@ subroutine test_logspace_dp subroutine test_logspace_default - real(dp) :: start = 1.0_dp - real(dp) :: end = 0.0_dp + real(dp) :: start = 0.0_dp + real(dp) :: end = 1.0_dp real(dp), allocatable :: x(:) @@ -136,7 +136,7 @@ subroutine test_logspace_base_2 ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp, 10, 2): " + write(unit=9, fmt=*) "logspace(1.0_dp, 10.0_dp, 10, 2): " write(unit=9,fmt=99) write(unit=9,fmt="(10(F9.3, 2X))") x write(9,*) From 8b1e0ff8430a6146869196313b9d7dca5d992c91 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Wed, 2 Jun 2021 22:32:35 +0200 Subject: [PATCH 20/89] Fix manual object dependencies --- src/Makefile.manual | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index c60c19b9a..b060af3a0 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -123,12 +123,12 @@ stdlib_math_linspace.o: \ stdlib_kinds.o stdlib_math_logspace.o: \ stdlib_math.o \ - stdlib_linspace.o \ + stdlib_math_linspace.o \ stdlib_kinds.o \ stdlib_optval.o stdlib_math_lnspace.o: \ stdlib_math.o \ - stdlib_linspace.o \ - stdlib_logspace.o \ + stdlib_math_linspace.o \ + stdlib_math_logspace.o \ stdlib_kinds.o From 8d12f5e3d369f259eedb349bba8b1074fa14530b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Thu, 3 Jun 2021 01:51:23 +0200 Subject: [PATCH 21/89] Add complex support for linspace function --- src/stdlib_math.fypp | 23 ++++++++++ src/stdlib_math_linspace.fypp | 25 +++++++++++ src/tests/math/test_linspace.f90 | 76 ++++++++++++++++++++++++++++++++ 3 files changed, 124 insertions(+) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 54229ebbf..4d6e71c43 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -49,6 +49,29 @@ module stdlib_math ${t1}$ :: res(n) end function ${RName}$ #:endfor + + ! Add support for complex linspace + #:for k1, t1 in CMPLX_KINDS_TYPES + #:set RName = rname("clinspace_default", 1, t1, k1) + module function ${RName}$(start, end) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + end function ${RName}$ + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + #:set RName = rname("clinspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + end interface interface logspace diff --git a/src/stdlib_math_linspace.fypp b/src/stdlib_math_linspace.fypp index da22e26c2..1d9caa573 100644 --- a/src/stdlib_math_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -50,4 +50,29 @@ contains end function ${RName}$ #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + #:set RName = rname("clinspace_default", 1, t1, k1) + module procedure ${RName}$ + + res = linspace(start, end, DEFAULT_LINSPACE_LENGTH) + + end procedure ${RName}$ + #:endfor + + #:for k1, t1 in CMPLX_KINDS_TYPES + #:set RName = rname("clinspace_n", 1, t1, k1) + module procedure ${RName}$ + + real(${k1}$) :: x(n) ! array of the real part of complex number + real(${k1}$) :: y(n) ! array of the imaginary part of the complex number + + x = linspace(real(start), real(end), n) + y = linspace(aimag(start), aimag(end), n) + + res = cmplx(x, y, kind=${k1}$) + + end procedure ${RName}$ + #:endfor + end submodule \ No newline at end of file diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 6cf6cded2..c3a0d1764 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -12,10 +12,17 @@ program test_linspace ! and make sure that the size of the result is as expected. ! ! + open(unit=9, file="test_linspace_log.txt", status="unknown") ! Log the results of the functio call test_linspace_sp call test_linspace_dp call test_linspace_neg_index ! Make sure that when passed a negative index the result is an empty array + call test_linspace_cmplx + call test_linspace_cmplx_2 + call test_linspace_cmplx_3 + + close(unit=9) + contains @@ -63,5 +70,74 @@ subroutine test_linspace_neg_index end subroutine + subroutine test_linspace_cmplx + + complex(dp) :: start = (0.0_dp, 10.0_dp) + complex(dp) :: end = (1.0_dp, 0.0_dp) + + complex(dp) :: z(10) + + integer :: i + + z = linspace(start, end, 10) + + write(unit=9, fmt=*) "linspace((0.0_dp, 10.0_dp), (1.0_dp, 0.0_dp), 10): " + write(unit=9,fmt=99) + do i = 1, 10 + write(unit=9,fmt=*) z(i) + end do + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_cmplx_2 + + complex(dp) :: start = (10.0_dp, 10.0_dp) + complex(dp) :: end = (1.0_dp, 1.0_dp) + + complex(dp) :: z(5) + + integer :: i + + z = linspace(start, end, 5) + + write(unit=9, fmt=*) "linspace((10.0_dp, 10.0_dp), (1.0_dp, 1.0_dp), 5): " + write(unit=9,fmt=99) + do i = 1, 5 + write(unit=9,fmt=*) z(i) + end do + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_cmplx_3 + + complex(dp) :: start = (-5.0_dp, 100.0_dp) + complex(dp) :: end = (20.0_dp, 13.0_dp) + + complex(dp) :: z(20) + + integer :: i + + z = linspace(start, end, 20) + + write(unit=9, fmt=*) "linspace((-5.0_dp, 100.0_dp), (20.0_dp, 13.0_dp), 20): " + write(unit=9,fmt=99) + do i = 1, 20 + write(unit=9,fmt=*) z(i) + end do + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + end program \ No newline at end of file From 46f17f68c79717a8c16a6c7eab21649228cdda53 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Thu, 3 Jun 2021 01:58:21 +0200 Subject: [PATCH 22/89] Add single precision complex testing --- src/tests/math/test_linspace.f90 | 48 ++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index c3a0d1764..21d7738d3 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -20,6 +20,8 @@ program test_linspace call test_linspace_cmplx call test_linspace_cmplx_2 call test_linspace_cmplx_3 + call test_linspace_cmplx_sp + call test_linspace_cmplx_sp_2 close(unit=9) @@ -139,5 +141,51 @@ subroutine test_linspace_cmplx_3 end subroutine + subroutine test_linspace_cmplx_sp + + complex(sp) :: start = (0.5_sp, 5.0_sp) + complex(sp) :: end = (1.0_sp, -30.0_sp) + + complex(sp) :: z(10) + + integer :: i + + z = linspace(start, end, 10) + + write(unit=9, fmt=*) "linspace((0.5_sp, 5.0_sp), (1.0_sp, -30.0_sp), 10): " + write(unit=9,fmt=99) + do i = 1, 10 + write(unit=9,fmt=*) z(i) + end do + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_cmplx_sp_2 + + complex(sp) :: start = (50.0_sp, 500.0_sp) + complex(sp) :: end = (-100.0_sp, 2000.0_sp) + + complex(sp) :: z(100) + + integer :: i + + z = linspace(start, end, 100) + + write(unit=9, fmt=*) "linspace((50.0_sp, 500.0_sp), (-100.0_sp, 2000.0_sp)): " + write(unit=9,fmt=99) + do i = 1, 100 + write(unit=9,fmt=*) z(i) + end do + write(9,*) + write(9,*) + + 99 format(70("=")) + + end subroutine + end program \ No newline at end of file From d3a515433e0c07b3998d1dcfb7cefca8997300f3 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:05:23 -0400 Subject: [PATCH 23/89] Update src/stdlib_linalg.fypp Remove unnecessary whitespace Co-authored-by: Jeremie Vandenplas --- src/stdlib_linalg.fypp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 3dc705488..e5e9368e0 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -12,7 +12,6 @@ module stdlib_linalg public :: eye public :: trace - interface diag !! version: experimental !! From 213b3024b60ebaeafa51ae61bf05877f2f7374e8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:05:49 -0400 Subject: [PATCH 24/89] Update src/stdlib_linalg.fypp Remove vestigial white space Co-authored-by: Jeremie Vandenplas --- src/stdlib_linalg.fypp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index e5e9368e0..225f4ac05 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -62,7 +62,6 @@ module stdlib_linalg module procedure trace_${t1[0]}$${k1}$ #:endfor end interface - contains From dc47698f56d06583b845bac55e362c4ad8ac4e30 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:06:02 -0400 Subject: [PATCH 25/89] Update src/stdlib_linalg.fypp Remove vestigial white space Co-authored-by: Jeremie Vandenplas --- src/stdlib_linalg.fypp | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/stdlib_linalg.fypp b/src/stdlib_linalg.fypp index 225f4ac05..51c2cdd54 100644 --- a/src/stdlib_linalg.fypp +++ b/src/stdlib_linalg.fypp @@ -91,8 +91,4 @@ contains end do end function trace_${t1[0]}$${k1}$ #:endfor - - - - end module From 37b6beaa379ed1153ab7459424e69c15e5b97e35 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:16:06 -0400 Subject: [PATCH 26/89] Update src/stdlib_math_logspace.fypp Remove trailing white space Co-authored-by: Jeremie Vandenplas --- src/stdlib_math_logspace.fypp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index b588659ff..b34afba1b 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -18,7 +18,6 @@ contains ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, DEFAULT_LOGSPACE_BASE) - end function ${RName}$ #:endfor @@ -61,4 +60,4 @@ contains #:endfor #:endfor -end submodule \ No newline at end of file +end submodule From 98f72d8d43e7454041295f6a2b8f7bb02435812e Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:18:10 -0400 Subject: [PATCH 27/89] Update src/stdlib_stats.fypp Remove trailing white space Co-authored-by: Jeremie Vandenplas --- src/stdlib_stats.fypp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_stats.fypp b/src/stdlib_stats.fypp index f54dd6793..4aa9edaa1 100644 --- a/src/stdlib_stats.fypp +++ b/src/stdlib_stats.fypp @@ -584,5 +584,4 @@ module stdlib_stats #:endfor end interface moment - end module stdlib_stats From 973bd3c34fb8c8b4872e9c78008ed61d2f63ff70 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 16:29:06 +0200 Subject: [PATCH 28/89] Change open unit option to newunit --- src/tests/math/test_linspace.f90 | 60 ++++++++++++++++++-------------- src/tests/math/test_lnspace.f90 | 37 +++++++++++--------- src/tests/math/test_logspace.f90 | 48 +++++++++++++------------ 3 files changed, 79 insertions(+), 66 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 21d7738d3..5d73fc132 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -4,6 +4,8 @@ program test_linspace use stdlib_math, only: linspace implicit none + + integer :: iunit logical :: warn = .false. ! Testing linspace. @@ -12,7 +14,11 @@ program test_linspace ! and make sure that the size of the result is as expected. ! ! - open(unit=9, file="test_linspace_log.txt", status="unknown") ! Log the results of the functio + + + open(newunit=iunit, file="test_linspace_log.txt", status="unknown") ! Log the results of the functio + + write(iunit,*) "Writing to unit #: ", iunit call test_linspace_sp call test_linspace_dp @@ -23,7 +29,7 @@ program test_linspace call test_linspace_cmplx_sp call test_linspace_cmplx_sp_2 - close(unit=9) + close(unit=iunit) contains @@ -83,13 +89,13 @@ subroutine test_linspace_cmplx z = linspace(start, end, 10) - write(unit=9, fmt=*) "linspace((0.0_dp, 10.0_dp), (1.0_dp, 0.0_dp), 10): " - write(unit=9,fmt=99) + write(unit=iunit, fmt=*) "linspace((0.0_dp, 10.0_dp), (1.0_dp, 0.0_dp), 10): " + write(unit=iunit,fmt=99) do i = 1, 10 - write(unit=9,fmt=*) z(i) + write(unit=iunit,fmt=*) z(i) end do - write(9,*) - write(9,*) + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -106,13 +112,13 @@ subroutine test_linspace_cmplx_2 z = linspace(start, end, 5) - write(unit=9, fmt=*) "linspace((10.0_dp, 10.0_dp), (1.0_dp, 1.0_dp), 5): " - write(unit=9,fmt=99) + write(unit=iunit, fmt=*) "linspace((10.0_dp, 10.0_dp), (1.0_dp, 1.0_dp), 5): " + write(unit=iunit,fmt=99) do i = 1, 5 - write(unit=9,fmt=*) z(i) + write(unit=iunit,fmt=*) z(i) end do - write(9,*) - write(9,*) + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -129,13 +135,13 @@ subroutine test_linspace_cmplx_3 z = linspace(start, end, 20) - write(unit=9, fmt=*) "linspace((-5.0_dp, 100.0_dp), (20.0_dp, 13.0_dp), 20): " - write(unit=9,fmt=99) + write(unit=iunit, fmt=*) "linspace((-5.0_dp, 100.0_dp), (20.0_dp, 13.0_dp), 20): " + write(unit=iunit,fmt=99) do i = 1, 20 - write(unit=9,fmt=*) z(i) + write(unit=iunit,fmt=*) z(i) end do - write(9,*) - write(9,*) + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -152,13 +158,13 @@ subroutine test_linspace_cmplx_sp z = linspace(start, end, 10) - write(unit=9, fmt=*) "linspace((0.5_sp, 5.0_sp), (1.0_sp, -30.0_sp), 10): " - write(unit=9,fmt=99) + write(unit=iunit, fmt=*) "linspace((0.5_sp, 5.0_sp), (1.0_sp, -30.0_sp), 10): " + write(unit=iunit,fmt=99) do i = 1, 10 - write(unit=9,fmt=*) z(i) + write(unit=iunit,fmt=*) z(i) end do - write(9,*) - write(9,*) + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -175,13 +181,13 @@ subroutine test_linspace_cmplx_sp_2 z = linspace(start, end, 100) - write(unit=9, fmt=*) "linspace((50.0_sp, 500.0_sp), (-100.0_sp, 2000.0_sp)): " - write(unit=9,fmt=99) + write(unit=iunit, fmt=*) "linspace((50.0_sp, 500.0_sp), (-100.0_sp, 2000.0_sp)): " + write(unit=iunit,fmt=99) do i = 1, 100 - write(unit=9,fmt=*) z(i) + write(unit=iunit,fmt=*) z(i) end do - write(9,*) - write(9,*) + write(iunit,*) + write(iunit,*) 99 format(70("=")) diff --git a/src/tests/math/test_lnspace.f90 b/src/tests/math/test_lnspace.f90 index c21c38f16..3406c726b 100644 --- a/src/tests/math/test_lnspace.f90 +++ b/src/tests/math/test_lnspace.f90 @@ -13,14 +13,17 @@ program test_lnspace ! lnspace should return a rank 1 array of values equally logarithmically spaced ! from the base**start to base**end, using Euler's number e as the base. If no length ! is specified, return a rank 1 array with 50 elements. + integer :: iunit - open(unit=9, file="test_lnspace_log.txt", status="unknown") ! Log the results of the function + open(newunit=iunit, file="test_lnspace_log.txt", status="unknown") ! Log the results of the function + + write(iunit,*) "Writing to unit #: ", iunit call test_linspace_sp call test_linspace_dp call test_linspace_default - close(unit=9) + close(unit=iunit) contains @@ -47,11 +50,11 @@ subroutine test_linspace_sp ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "lnspace(0.0_sp, 2.0_sp, 20): " - write(unit=9,fmt=99) - write(unit=9,fmt="(20(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "lnspace(0.0_sp, 2.0_sp, 20): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(20(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -80,11 +83,11 @@ subroutine test_linspace_dp ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "lnspace(1.0_dp, 0.0_dp, 10): " - write(unit=9,fmt=99) - write(unit=9,fmt="(10(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "lnspace(1.0_dp, 0.0_dp, 10): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(10(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -112,11 +115,11 @@ subroutine test_linspace_default ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "lnspace(0.0_dp, 1.0_dp): " - write(unit=9,fmt=99) - write(unit=9,fmt="(50(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "lnspace(0.0_dp, 1.0_dp): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(50(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 index d2450a03b..cfd5775b6 100644 --- a/src/tests/math/test_logspace.f90 +++ b/src/tests/math/test_logspace.f90 @@ -7,6 +7,8 @@ program test_logspace implicit none logical :: warn = .false. + + integer :: iunit ! Testing logspace ! @@ -14,14 +16,16 @@ program test_logspace ! from the base**start to base**end, using Euler's number e as the base. If no length ! is specified, return a rank 1 array with 50 elements. - open(unit=9, file="test_logspace_log.txt", status="unknown") ! Log the results of the function + open(newunit=iunit, file="test_logspace_log.txt", status="unknown") ! Log the results of the function + write(iunit,*) "Writing to unit #: ", iunit + call test_logspace_sp call test_logspace_dp call test_logspace_default call test_logspace_base_2 - close(unit=9) + close(unit=iunit) contains @@ -46,11 +50,11 @@ subroutine test_logspace_sp ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(0.0_sp, 2.0_sp, 20): " - write(unit=9,fmt=99) - write(unit=9,fmt="(20(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "logspace(0.0_sp, 2.0_sp, 20): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(20(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -77,11 +81,11 @@ subroutine test_logspace_dp ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(1.0_dp, 0.0_dp, 10): " - write(unit=9,fmt=99) - write(unit=9,fmt="(10(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "logspace(1.0_dp, 0.0_dp, 10): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(10(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -104,11 +108,11 @@ subroutine test_logspace_default ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(0.0_dp, 1.0_dp): " - write(unit=9,fmt=99) - write(unit=9,fmt="(50(F7.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "logspace(0.0_dp, 1.0_dp): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(50(F7.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) @@ -136,11 +140,11 @@ subroutine test_logspace_base_2 ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") ! 99 format(G11.5, X) - write(unit=9, fmt=*) "logspace(1.0_dp, 10.0_dp, 10, 2): " - write(unit=9,fmt=99) - write(unit=9,fmt="(10(F9.3, 2X))") x - write(9,*) - write(9,*) + write(unit=iunit, fmt=*) "logspace(1.0_dp, 10.0_dp, 10, 2): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(10(F9.3, 2X))") x + write(iunit,*) + write(iunit,*) 99 format(70("=")) From c1dc924698cec402cecdb0094adf9451265f3d82 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 16:31:53 +0200 Subject: [PATCH 29/89] Add lnspace and logspace tests to manual makefile --- src/tests/math/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index fdbd38810..4794764ea 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -1,4 +1,4 @@ -PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 +PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 test_lnspace.f90 include ../Makefile.manual.test.mk From 7fe8ebfa13f17d2dc64f652306eb69a741bf35d5 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Fri, 4 Jun 2021 10:33:54 -0400 Subject: [PATCH 30/89] Update src/stdlib_math_lnspace.fypp Removed trailing white spaces Co-authored-by: Jeremie Vandenplas --- src/stdlib_math_lnspace.fypp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/stdlib_math_lnspace.fypp b/src/stdlib_math_lnspace.fypp index 9cff00a11..948af9e1e 100644 --- a/src/stdlib_math_lnspace.fypp +++ b/src/stdlib_math_lnspace.fypp @@ -18,7 +18,6 @@ contains ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, EULERS_NUMBER_${k1}$) - end function ${RName}$ #:endfor @@ -38,4 +37,4 @@ contains #:endfor -end submodule \ No newline at end of file +end submodule From 4284b60968e19d9631c837992b85cb3b44380bf4 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:41:19 +0200 Subject: [PATCH 31/89] Add linspace specs --- doc/specs/stdlib_math.md | 66 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 3e45b6696..89519edc1 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -90,3 +90,69 @@ program demo_clip_real ! clipped_value <- 3.02500010 end program demo_clip_real ``` + +### `linspace` function + +#### Description + +Returns a linearly spaced rank 1 array from [`start`, `end`]. Optionally, you can specify the length of the returned array by passing `n`. + +#### Syntax + +`res = [[stdlib_math(module):linspace(interface)]] (start, end [, n])` + +#### Status + +Experimental + +#### Class + +function. + +#### Argument(s) + +`start`: scalar of any numeric type. This argument is `intent(in)`. +`end`: same `type` and `kind` as `start`. This argument is `intent(in)`. +`n`: Integer parameter specifying the length of the output. This argument is `intent(in)`. + +#### Output value or Result value + +The output is a rank 1 array of `type` and `kind`, whose length is either 100 (default value) or `n`. + +#### Examples + +##### Example 1: + +Here inputs are of type `complex` and kind `dp` +```fortran +program demo_linspace_complex + use stdlib_math, only: linspace + use stdlib_kinds, only: dp + implicit none + + complex(dp) :: start = complex(10.0_dp, 5.0_dp) + complex(dp) :: end = complex(-10.0_dp, 15.0_dp) + + complex(dp) :: z(11) + + z = linspace(start, end, 11) +end program demo_linspace_complex +``` + +##### Example 2: + +Here inputs are of type `integer` and kind `int16` +```fortran +program demo_linspace_int16 + use stdlib_math, only: linspace + use stdlib_kinds, only: int16 + implicit none + + integer(int16) :: start = 10_int16 + integer(int16) :: end = 23_int16 + + integer(int16) :: r(15) + + r = linspace(start, end, 15) +end program demo_linspace_int16 +``` From 501f3608c7cb3d6bd50aa7a385bbb58d52a57b4b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:42:11 +0200 Subject: [PATCH 32/89] Remove lnspace --- src/CMakeLists.txt | 1 - src/Makefile.manual | 6 -- src/stdlib_math_lnspace.fypp | 40 ---------- src/tests/math/CMakeLists.txt | 1 - src/tests/math/test_lnspace.f90 | 129 -------------------------------- 5 files changed, 177 deletions(-) delete mode 100644 src/stdlib_math_lnspace.fypp delete mode 100644 src/tests/math/test_lnspace.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 18114494a..ba4debe0e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,7 +26,6 @@ set(fppFiles stdlib_math.fypp stdlib_math_linspace.fypp stdlib_math_logspace.fypp - stdlib_math_lnspace.fypp stdlib_string_type.fypp ) diff --git a/src/Makefile.manual b/src/Makefile.manual index b060af3a0..8bda2a0ca 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -22,7 +22,6 @@ SRCFYPP =\ stdlib_math.fypp \ stdlib_math_linspace.fypp \ stdlib_math_logspace.fypp \ - stdlib_math_lnspace.fypp \ stdlib_stats_distribution_PRNG.fypp \ stdlib_string_type.fypp @@ -126,9 +125,4 @@ stdlib_math_logspace.o: \ stdlib_math_linspace.o \ stdlib_kinds.o \ stdlib_optval.o -stdlib_math_lnspace.o: \ - stdlib_math.o \ - stdlib_math_linspace.o \ - stdlib_math_logspace.o \ - stdlib_kinds.o diff --git a/src/stdlib_math_lnspace.fypp b/src/stdlib_math_lnspace.fypp deleted file mode 100644 index 948af9e1e..000000000 --- a/src/stdlib_math_lnspace.fypp +++ /dev/null @@ -1,40 +0,0 @@ -#:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES - -submodule (stdlib_math) stdlib_math_lnspace - -implicit none - -contains - - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("lnspace_default", 1, t1, k1) - module function ${RName}$(start, end) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) - - res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, EULERS_NUMBER_${k1}$) - - end function ${RName}$ - #:endfor - - #:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("lnspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - ${t1}$ :: res(n) - - res = logspace(start, end, n, EULERS_NUMBER_${k1}$) - - end function ${RName}$ - #:endfor - - -end submodule diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index b24b2b694..e760e1c32 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1,4 +1,3 @@ ADDTEST(stdlib_math) ADDTEST(linspace) ADDTEST(logspace) -ADDTEST(lnspace) diff --git a/src/tests/math/test_lnspace.f90 b/src/tests/math/test_lnspace.f90 deleted file mode 100644 index 3406c726b..000000000 --- a/src/tests/math/test_lnspace.f90 +++ /dev/null @@ -1,129 +0,0 @@ -program test_lnspace - -use stdlib_error, only: check -use stdlib_kinds, only: sp, dp, int8, int16, int32, int64 -use stdlib_math, only: lnspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP - -implicit none - - logical :: warn = .false. - - ! Testing lnspace - ! - ! lnspace should return a rank 1 array of values equally logarithmically spaced - ! from the base**start to base**end, using Euler's number e as the base. If no length - ! is specified, return a rank 1 array with 50 elements. - integer :: iunit - - open(newunit=iunit, file="test_lnspace_log.txt", status="unknown") ! Log the results of the function - - write(iunit,*) "Writing to unit #: ", iunit - - call test_linspace_sp - call test_linspace_dp - call test_linspace_default - - close(unit=iunit) - -contains - - subroutine test_linspace_sp - - integer :: n = 20 - real(sp) :: start = 0.0_sp - real(sp) :: end = 2.0_sp - - real(sp), allocatable :: x(:) - - logical :: cond_1, cond_2 - - x = lnspace(start, end, n) - - cond_1 = (x(1) == (EULERS_NUMBER_SP ** start)) - cond_2 = (x(n) == (EULERS_NUMBER_SP ** end)) - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) - call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - - write(unit=iunit, fmt=*) "lnspace(0.0_sp, 2.0_sp, 20): " - write(unit=iunit,fmt=99) - write(unit=iunit,fmt="(20(F7.3, 2X))") x - write(iunit,*) - write(iunit,*) - - 99 format(70("=")) - - end subroutine - - subroutine test_linspace_dp - - integer :: n = 10 - real(dp) :: start = 1.0_dp - real(dp) :: end = 0.0_dp - - real(dp), allocatable :: x(:) - - logical :: cond_1, cond_2 - - x = lnspace(start, end, n) - - cond_1 = (x(1) == (EULERS_NUMBER_DP ** start)) - cond_2 = (x(n) == (EULERS_NUMBER_DP ** end)) - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) - call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - - write(unit=iunit, fmt=*) "lnspace(1.0_dp, 0.0_dp, 10): " - write(unit=iunit,fmt=99) - write(unit=iunit,fmt="(10(F7.3, 2X))") x - write(iunit,*) - write(iunit,*) - - 99 format(70("=")) - - end subroutine - - subroutine test_linspace_default - - real(dp) :: start = 0.0_dp - real(dp) :: end = 1.0_dp - - real(dp), allocatable :: x(:) - - logical :: cond_1, cond_2 - - x = lnspace(start, end) - - cond_1 = (x(1) == (EULERS_NUMBER_DP ** start)) - cond_2 = (x(50) == (EULERS_NUMBER_DP ** end)) - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) - call check(size(x) == 50, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_lnspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = lnspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - - write(unit=iunit, fmt=*) "lnspace(0.0_dp, 1.0_dp): " - write(unit=iunit,fmt=99) - write(unit=iunit,fmt="(50(F7.3, 2X))") x - write(iunit,*) - write(iunit,*) - - 99 format(70("=")) - - end subroutine - - -end program \ No newline at end of file From 6f93e389f0a4d133d5eb275666c2c6fabb23977d Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:42:28 +0200 Subject: [PATCH 33/89] Remove lnspace, add support for int types in linspace --- src/stdlib_math_linspace.fypp | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/src/stdlib_math_linspace.fypp b/src/stdlib_math_linspace.fypp index 1d9caa573..3704dfae9 100644 --- a/src/stdlib_math_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -1,6 +1,4 @@ #:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES submodule (stdlib_math) stdlib_math_linspace implicit none @@ -52,7 +50,7 @@ contains #:for k1, t1 in CMPLX_KINDS_TYPES - #:set RName = rname("clinspace_default", 1, t1, k1) + #:set RName = rname("linspace_default", 1, t1, k1) module procedure ${RName}$ res = linspace(start, end, DEFAULT_LINSPACE_LENGTH) @@ -61,18 +59,36 @@ contains #:endfor #:for k1, t1 in CMPLX_KINDS_TYPES - #:set RName = rname("clinspace_n", 1, t1, k1) + #:set RName = rname("linspace_n", 1, t1, k1) module procedure ${RName}$ real(${k1}$) :: x(n) ! array of the real part of complex number real(${k1}$) :: y(n) ! array of the imaginary part of the complex number - x = linspace(real(start), real(end), n) - y = linspace(aimag(start), aimag(end), n) + x = linspace(start%re, end%re, n) + y = linspace(start%im, end%im, n) res = cmplx(x, y, kind=${k1}$) end procedure ${RName}$ #:endfor + #:for k1, t1 in INT_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) + module procedure ${RName}$ + + res = linspace(real(start, kind=dp), real(end, kind=dp), DEFAULT_LINSPACE_LENGTH) + + end procedure ${RName}$ + #:endfor + + #:for k1, t1 in INT_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) + module procedure ${RName}$ + + res = linspace(real(start, kind=dp), real(end, kind=dp), n) + + end procedure ${RName}$ + #:endfor + end submodule \ No newline at end of file From 2843ffd800446b924474e574dd602284d5956185 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:43:11 +0200 Subject: [PATCH 34/89] Remove lnspace, add support for int types in linspace --- src/stdlib_math.fypp | 85 ++++++++++++++++++-------------------------- 1 file changed, 34 insertions(+), 51 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 4d6e71c43..65b8e7ff7 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,12 +1,14 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +! #:set ICR_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp implicit none private - public :: clip, linspace, logspace, lnspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP + public :: clip, linspace, logspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 @@ -29,7 +31,7 @@ module stdlib_math !! Create rank 1 array of linearly spaced elements !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return end - #:for k1, t1 in REAL_KINDS_TYPES + #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start @@ -39,7 +41,7 @@ module stdlib_math end function ${RName}$ #:endfor - #:for k1, t1 in REAL_KINDS_TYPES + #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start @@ -50,25 +52,32 @@ module stdlib_math end function ${RName}$ #:endfor - ! Add support for complex linspace - #:for k1, t1 in CMPLX_KINDS_TYPES - #:set RName = rname("clinspace_default", 1, t1, k1) + + ! Add suport for integer linspace + !! Version: Experimental + !! + !! Create rank 1 array of linearly spaced elements from start to end. + !! If the number of elements is not specified, create an array with size 100. If n is a negative value, + !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` + !! paramaters, the return type is always a double precision real. + #:for k1, t1 in INT_KINDS_TYPES + #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + ${t1}$, intent(in) :: end + + real(dp) :: res(DEFAULT_LINSPACE_LENGTH) end function ${RName}$ #:endfor - - #:for k1, t1 in CMPLX_KINDS_TYPES - #:set RName = rname("clinspace_n", 1, t1, k1) + + #:for k1, t1 in INT_KINDS_TYPES + #:set RName = rname("linspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - - ${t1}$ :: res(n) + + real(dp) :: res(n) end function ${RName}$ #:endfor @@ -108,52 +117,26 @@ module stdlib_math #:for k2, t2 in IR_KINDS_TYPES #! k2, t2 correspond to the kind/type of the base that is passed #:set RName = rname("logspace_n_base", 1, k1, k2) - ! Need another function where base is not optional, otherwise the compiler can not differentiate between - ! generic calls to logspace_n where a base is not present + #! ================================================================ !# + #! Need another function where base is not optional, otherwise the + #! compiler can not differentiate between + #! generic calls to logspace_n where a base is not present + #! ================================================================ !# module function ${RName}$(start, end, n, base) result(res) + ! Generate logarithmically spaced sequence from ${k2}$ base to the powers + ! of ${k1}$ start and end. [base^start, ... , base^end] ${t1}$, intent(in) :: start ${t1}$, intent(in) :: end integer, intent(in) :: n ${t2}$, intent(in) :: base ${t1}$ :: res(n) + end function ${RName}$ + #:endfor #:endfor - #:endfor -end interface - -interface lnspace -!! Version: Experimental -!! -!! Create rank 1 array of **natural** logarithmically spaced elements from e**start to e**end. -!! If the number of elements is not specified, create an array with size 50. If n is a negative value, -!! return an array with size 0. If n = 1, return e**end. -#:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("lnspace_default", 1, t1, k1) - module function ${RName}$(start, end) result(res) - - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) - - end function ${RName}$ -#:endfor - -#:for k1, t1 in REAL_KINDS_TYPES - #:set RName = rname("lnspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - ${t1}$ :: res(n) - end function ${RName}$ -#:endfor - -end interface - + end interface contains From b19d4477eb10f9f4c1cdca4925d51bde4b312063 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:43:42 +0200 Subject: [PATCH 35/89] Add integer type tests to test_linspace.f90 --- src/tests/math/test_linspace.f90 | 50 +++++++++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 5d73fc132..d522a0c7e 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -1,6 +1,6 @@ program test_linspace use stdlib_error, only: check - use stdlib_kinds, only: sp, dp + use stdlib_kinds, only: sp, dp, int16, int8 use stdlib_math, only: linspace implicit none @@ -28,6 +28,8 @@ program test_linspace call test_linspace_cmplx_3 call test_linspace_cmplx_sp call test_linspace_cmplx_sp_2 + call test_linspace_int16 + call test_linspace_int8 close(unit=iunit) @@ -193,5 +195,51 @@ subroutine test_linspace_cmplx_sp_2 end subroutine + subroutine test_linspace_int16 + + integer(int16) :: start = 5 + integer(int16) :: end = 10 + + integer(int16) :: z(6) + + integer :: i + + z = linspace(start, end, 6) + + write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " + write(unit=iunit,fmt=99) + do i = 1, 6 + write(unit=iunit,fmt=*) z(i) + end do + write(iunit,*) + write(iunit,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_linspace_int8 + + integer(int8) :: start = 20 + integer(int8) :: end = 50 + + integer(int8) :: z(10) + + integer :: i + + z = linspace(start, end, 10) + + write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " + write(unit=iunit,fmt=99) + do i = 1, 10 + write(unit=iunit,fmt=*) z(i) + end do + write(iunit,*) + write(iunit,*) + + 99 format(70("=")) + + end subroutine + end program \ No newline at end of file From 3dd576fd39501b4a76acfa61f2097a1b26221dc7 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:54:00 +0200 Subject: [PATCH 36/89] Add specification link and remove unused variables --- src/stdlib_math.fypp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 65b8e7ff7..71f2950e8 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,7 +1,6 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -! #:set ICR_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp @@ -31,6 +30,7 @@ module stdlib_math !! Create rank 1 array of linearly spaced elements !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return end + !!([Specification](../page/specs/stdlib_math.html#description)) #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) @@ -60,8 +60,12 @@ module stdlib_math !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` !! paramaters, the return type is always a double precision real. + !! + !!([Specification](../page/specs/stdlib_math.html#description)) #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) + #! The interface for INT_KINDS_TYPES cannot be combined with RC_KINDS_TYPES + #! because the output for integer types is always a real with dp. module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start ${t1}$, intent(in) :: end From 8f39ad56cad6a60ea277b41f7803971ce17b681e Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 16:59:10 +0200 Subject: [PATCH 37/89] Remove unused preprocessor variables --- src/stdlib_math_logspace.fypp | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index b34afba1b..2b8d225c5 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -1,6 +1,4 @@ #:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES submodule (stdlib_math) stdlib_math_logspace From e62f3fcc05f3367fe01df04902441d78a5a7e8c8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 6 Jun 2021 17:02:31 +0200 Subject: [PATCH 38/89] Remove lnspace test from Makefile.manual --- src/tests/math/Makefile.manual | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/math/Makefile.manual b/src/tests/math/Makefile.manual index 4794764ea..209990732 100644 --- a/src/tests/math/Makefile.manual +++ b/src/tests/math/Makefile.manual @@ -1,4 +1,4 @@ -PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 test_lnspace.f90 +PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 include ../Makefile.manual.test.mk From c62fc0f16fab89bb603dd89cd812ff240afb9d7a Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:14:42 -0400 Subject: [PATCH 39/89] Update src/stdlib_math.fypp Spelling update Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 71f2950e8..5435d169e 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -59,7 +59,7 @@ module stdlib_math !! Create rank 1 array of linearly spaced elements from start to end. !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` - !! paramaters, the return type is always a double precision real. + !! parameters, the return type is always a double precision real. !! !!([Specification](../page/specs/stdlib_math.html#description)) #:for k1, t1 in INT_KINDS_TYPES From f15f0281a516e4c295fb9f9988fa17befb226c53 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:18:43 -0400 Subject: [PATCH 40/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 89519edc1..f78af626b 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -113,7 +113,7 @@ function. `start`: scalar of any numeric type. This argument is `intent(in)`. `end`: same `type` and `kind` as `start`. This argument is `intent(in)`. -`n`: Integer parameter specifying the length of the output. This argument is `intent(in)`. +`n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. #### Output value or Result value From 828fe9e5994d0b74cdda4059794af941e6a649e6 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:19:02 -0400 Subject: [PATCH 41/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index f78af626b..f55581fa5 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -112,7 +112,7 @@ function. #### Argument(s) `start`: scalar of any numeric type. This argument is `intent(in)`. -`end`: same `type` and `kind` as `start`. This argument is `intent(in)`. +`end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. #### Output value or Result value From f0246a08aac7755261538991d6bb2cbee7e81262 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:19:14 -0400 Subject: [PATCH 42/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index f55581fa5..3a2b61eca 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -111,7 +111,7 @@ function. #### Argument(s) -`start`: scalar of any numeric type. This argument is `intent(in)`. +`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. From 48e868253bb7ac22f70b2a09254d9fec8a72a992 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:20:57 -0400 Subject: [PATCH 43/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 3a2b61eca..018c55648 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -91,7 +91,7 @@ program demo_clip_real end program demo_clip_real ``` -### `linspace` function +### `linspace` - Create a linearly spaced rank one array #### Description From abe8dab83a3afe8d29a07b2372dc09828ac850bd Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:32:24 -0400 Subject: [PATCH 44/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 5435d169e..b055b36cf 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -7,7 +7,8 @@ module stdlib_math implicit none private - public :: clip, linspace, logspace, EULERS_NUMBER_DP, EULERS_NUMBER_SP + public :: clip, linspace, logspace + public :: EULERS_NUMBER_DP, EULERS_NUMBER_SP integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 From 9a57f566b454631409052fd7cb1a0ec841fd6aa8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 07:41:48 -0400 Subject: [PATCH 45/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index b055b36cf..b67ff1ba6 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -54,7 +54,7 @@ module stdlib_math #:endfor - ! Add suport for integer linspace + ! Add support for integer linspace !! Version: Experimental !! !! Create rank 1 array of linearly spaced elements from start to end. From 044c37791eed40c12133cc1306f51f4a66c1cc2f Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 17:35:07 +0200 Subject: [PATCH 46/89] Made qp euler's number public --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index b055b36cf..9a0143648 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -8,7 +8,7 @@ module stdlib_math implicit none private public :: clip, linspace, logspace - public :: EULERS_NUMBER_DP, EULERS_NUMBER_SP + public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 From 5705c89a660a8b0dbe1362410f2a4ac5148ecee5 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 7 Jun 2021 17:40:04 +0200 Subject: [PATCH 47/89] Remove trailing white spaces --- doc/specs/stdlib_math.md | 14 ++++----- src/stdlib_math.fypp | 54 +++++++++++++++++------------------ src/stdlib_math_linspace.fypp | 8 +++--- src/stdlib_math_logspace.fypp | 16 +++++------ src/tests/math/CMakeLists.txt | 2 +- 5 files changed, 47 insertions(+), 47 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 018c55648..d9a961195 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -19,7 +19,7 @@ title: math #### Description -Returns a value which lies in the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive) and is closest to the input value `x`. +Returns a value which lies in the given interval [`xmin`, `xmax`] (interval is `xmin` and `xmax` inclusive) and is closest to the input value `x`. #### Syntax @@ -35,8 +35,8 @@ Elemental function. #### Argument(s) -`x`: scalar of either `integer` or `real` type. This argument is `intent(in)`. -`xmin`: scalar of either `integer` or `real` type. This argument is `intent(in)`. +`x`: scalar of either `integer` or `real` type. This argument is `intent(in)`. +`xmin`: scalar of either `integer` or `real` type. This argument is `intent(in)`. `xmax`: scalar of either `integer` or `real` type, which must be greater than or equal to `xmin`. This argument is `intent(in)`. Note: All arguments must have same `type` and same `kind`. @@ -111,8 +111,8 @@ function. #### Argument(s) -`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. -`end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. +`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. +`end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. #### Output value or Result value @@ -129,7 +129,7 @@ program demo_linspace_complex use stdlib_math, only: linspace use stdlib_kinds, only: dp implicit none - + complex(dp) :: start = complex(10.0_dp, 5.0_dp) complex(dp) :: end = complex(-10.0_dp, 15.0_dp) @@ -147,7 +147,7 @@ program demo_linspace_int16 use stdlib_math, only: linspace use stdlib_kinds, only: int16 implicit none - + integer(int16) :: start = 10_int16 integer(int16) :: end = 23_int16 diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 95ca547aa..fa0afc161 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -14,7 +14,7 @@ module stdlib_math integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 real(dp), parameter :: DEFAULT_LOGSPACE_BASE = 10 - ! Useful constants for lnspace + ! Useful constants for lnspace real(sp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_sp real(dp), parameter :: EULERS_NUMBER_SP = 2.71828182845904523536028747135266249775724709369995_dp real(qp), parameter :: EULERS_NUMBER_QP = 2.71828182845904523536028747135266249775724709369995_qp @@ -25,7 +25,7 @@ module stdlib_math #:endfor end interface clip - interface linspace + interface linspace !! Version: Experimental !! !! Create rank 1 array of linearly spaced elements @@ -36,30 +36,30 @@ module stdlib_math #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) + ${t1}$, intent(in) :: end + + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) end function ${RName}$ #:endfor - + #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - + ${t1}$ :: res(n) end function ${RName}$ #:endfor - ! Add support for integer linspace + ! Add support for integer linspace !! Version: Experimental !! !! Create rank 1 array of linearly spaced elements from start to end. !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` + !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` !! parameters, the return type is always a double precision real. !! !!([Specification](../page/specs/stdlib_math.html#description)) @@ -69,40 +69,40 @@ module stdlib_math #! because the output for integer types is always a real with dp. module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - real(dp) :: res(DEFAULT_LINSPACE_LENGTH) + ${t1}$, intent(in) :: end + + real(dp) :: res(DEFAULT_LINSPACE_LENGTH) end function ${RName}$ #:endfor - + #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("linspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - + real(dp) :: res(n) end function ${RName}$ #:endfor end interface - interface logspace + interface logspace !! Version: Experimental !! !! Create rank 1 array of logarithmically spaced elements from base**start to base**end. !! If the number of elements is not specified, create an array with size 50. If n is a negative value, - !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of + !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of !! 10 #:for k1, t1 in REAL_KINDS_TYPES #:set RName = rname("logspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end - ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) end function ${RName}$ #:endfor @@ -111,9 +111,9 @@ module stdlib_math #:set RName = rname("logspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - + ${t1}$ :: res(n) end function ${RName}$ #:endfor @@ -123,7 +123,7 @@ module stdlib_math #! k2, t2 correspond to the kind/type of the base that is passed #:set RName = rname("logspace_n_base", 1, k1, k2) #! ================================================================ !# - #! Need another function where base is not optional, otherwise the + #! Need another function where base is not optional, otherwise the #! compiler can not differentiate between #! generic calls to logspace_n where a base is not present #! ================================================================ !# @@ -131,10 +131,10 @@ module stdlib_math ! Generate logarithmically spaced sequence from ${k2}$ base to the powers ! of ${k1}$ start and end. [base^start, ... , base^end] ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n ${t2}$, intent(in) :: base - + ${t1}$ :: res(n) end function ${RName}$ @@ -144,7 +144,7 @@ module stdlib_math end interface contains - + #:for k1, t1 in IR_KINDS_TYPES elemental function clip_${k1}$(x, xmin, xmax) result(res) ${t1}$, intent(in) :: x @@ -154,6 +154,6 @@ contains res = max(min(x, xmax), xmin) end function clip_${k1}$ - + #:endfor end module stdlib_math diff --git a/src/stdlib_math_linspace.fypp b/src/stdlib_math_linspace.fypp index 3704dfae9..22267b0b6 100644 --- a/src/stdlib_math_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -9,8 +9,8 @@ contains #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - + ${t1}$, intent(in) :: end + ${t1}$ :: res(DEFAULT_LINSPACE_LENGTH) res = linspace(start, end, DEFAULT_LINSPACE_LENGTH) @@ -22,9 +22,9 @@ contains #:set RName = rname("linspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - + ${t1}$ :: res(n) integer :: i ! Looping index diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 2b8d225c5..38eec93d9 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -5,15 +5,15 @@ submodule (stdlib_math) stdlib_math_logspace implicit none -contains +contains #:for k1, t1 in REAL_KINDS_TYPES #:set RName = rname("logspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end - ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) + ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, DEFAULT_LOGSPACE_BASE) @@ -24,9 +24,9 @@ contains #:set RName = rname("logspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n - + ${t1}$ :: res(n) res = logspace(start, end, n, DEFAULT_LOGSPACE_BASE) @@ -42,16 +42,16 @@ contains ! generic calls to logspace_n where a base is not present module function ${RName}$(start, end, n, base) result(res) ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end + ${t1}$, intent(in) :: end integer, intent(in) :: n ${t2}$, intent(in) :: base - + ${t1}$ :: res(n) ${t1}$ :: lin(n) ! Linspace of exponents lin = linspace(start, end, n) - + res = real(base, ${k1}$) ** lin ! Convert base to the proper kind end function ${RName}$ diff --git a/src/tests/math/CMakeLists.txt b/src/tests/math/CMakeLists.txt index e760e1c32..c4335e9ce 100644 --- a/src/tests/math/CMakeLists.txt +++ b/src/tests/math/CMakeLists.txt @@ -1,3 +1,3 @@ ADDTEST(stdlib_math) ADDTEST(linspace) -ADDTEST(logspace) +ADDTEST(logspace) \ No newline at end of file From 8e5a598e5cb5da4f69efbb51b0a6c9132866e89f Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 8 Jun 2021 12:53:22 +0200 Subject: [PATCH 48/89] Edit linspace specs, start logspace specs --- doc/specs/stdlib_math.md | 73 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index d9a961195..b8a8f021d 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -119,6 +119,9 @@ function. The output is a rank 1 array of `type` and `kind`, whose length is either 100 (default value) or `n`. +If `n` == 1, return a rank 1 array whose only element is `end`. +If `n` <= 0, return a rank 1 array with length 0 + #### Examples ##### Example 1: @@ -156,3 +159,73 @@ program demo_linspace_int16 r = linspace(start, end, 15) end program demo_linspace_int16 ``` + +### `logspace` - Create a logarithmically spaced rank one array + +#### Description + +Returns a logarithmically spaced rank 1 array from [`base`^`start`, `base`^`end`]. Optionally, you can specify the length of the returned array by passing `n`. + +#### Syntax + +`res = [[stdlib_math(module):logspace(interface)]] (start, end [, n [, base]])` + +#### Status + +Experimental + +#### Class + +function. + +#### Argument(s) + +`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. +`end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. +`n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. +`base` : Shall be a scalar of any numeric type. This argument is `intent(in)` + +#### Output value or Result value + +The output is a rank 1 array of `type` and `kind`, whose length is either 50 (default value) or `n`. + +If `n` == 1, return a rank 1 array whose only element is `base`^`end`. +If `n` <= 0, return a rank 1 array with length 0 + +#### Examples + +##### Example 1: + +Here inputs are of type `complex` and kind `dp` +```fortran +program demo_logspace_complex + use stdlib_math, only: logspace + use stdlib_kinds, only: dp + implicit none + + complex(dp) :: start = complex(10.0_dp, 5.0_dp) + complex(dp) :: end = complex(-10.0_dp, 15.0_dp) + + complex(dp) :: z(11) + + z = logspace(start, end, 11) +end program demo_logspace_complex +``` + +##### Example 2: + +Here inputs are of type `integer` and kind `int16` +```fortran +program demo_logspace_int16 + use stdlib_math, only: logspace + use stdlib_kinds, only: int16 + implicit none + + integer(int16) :: start = 10_int16 + integer(int16) :: end = 23_int16 + + integer(int16) :: r(15) + + r = logspace(start, end, 15) +end program demo_logspace_int16 +``` \ No newline at end of file From 012329664d2b9b36ca026ca3c42175c5fd9d6442 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 8 Jun 2021 12:54:20 +0200 Subject: [PATCH 49/89] Expand logspace interface to complex values --- src/stdlib_math.fypp | 9 +++++---- src/stdlib_math_logspace.fypp | 30 ++++++++++++++++++++++++++---- 2 files changed, 31 insertions(+), 8 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index fa0afc161..8ca6ca2ca 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,6 +1,7 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +#:set IRC_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + CMPLX_KINDS_TYPES module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp @@ -95,7 +96,7 @@ module stdlib_math !! If the number of elements is not specified, create an array with size 50. If n is a negative value, !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of !! 10 - #:for k1, t1 in REAL_KINDS_TYPES + #:for k1, t1 in IRC_KINDS_TYPES #:set RName = rname("logspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) @@ -107,7 +108,7 @@ module stdlib_math end function ${RName}$ #:endfor - #:for k1, t1 in REAL_KINDS_TYPES + #:for k1, t1 in IRC_KINDS_TYPES #:set RName = rname("logspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start @@ -118,8 +119,8 @@ module stdlib_math end function ${RName}$ #:endfor - #:for k1, t1 in REAL_KINDS_TYPES - #:for k2, t2 in IR_KINDS_TYPES + #:for k1, t1 in IRC_KINDS_TYPES + #:for k2, t2 in IRC_KINDS_TYPES #! k2, t2 correspond to the kind/type of the base that is passed #:set RName = rname("logspace_n_base", 1, k1, k2) #! ================================================================ !# diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 38eec93d9..983a391a0 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -1,5 +1,7 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +#:set IRC_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + CMPLX_KINDS_TYPES submodule (stdlib_math) stdlib_math_logspace @@ -7,7 +9,10 @@ implicit none contains - #:for k1, t1 in REAL_KINDS_TYPES + #!======================================================== + #! Real and Complex Implementations + #!======================================================== + #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("logspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start @@ -20,7 +25,7 @@ contains end function ${RName}$ #:endfor - #:for k1, t1 in REAL_KINDS_TYPES + #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("logspace_n", 1, t1, k1) module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start @@ -34,8 +39,25 @@ contains end function ${RName}$ #:endfor - #:for k1, t1 in REAL_KINDS_TYPES - #:for k2, t2 in IR_KINDS_TYPES + #!======================================================== + #! Real and Complex Implementations + #!======================================================== + #:for k1, t1 in INT_KINDS_TYPES + #:set RName = rname("logspace_n", 1, t1, k1) + module function ${RName}$(start, end, n) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + + real(dp) :: res(n) + + res = logspace(start, end, n, DEFAULT_LOGSPACE_BASE) + + end function ${RName}$ + #:endfor + + #:for k1, t1 in RC_KINDS_TYPES + #:for k2, t2 in IRC_KINDS_TYPES #! k2, t2 correspond to the kind/type of the base that is passed #:set RName = rname("logspace_n_base", 1, k1, k2) ! Need another function where base is not optional, otherwise the compiler can not differentiate between From 59bdc5c840922f3e700cf6679c00e2a08c7f9701 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sat, 10 Jul 2021 19:31:38 -0400 Subject: [PATCH 50/89] Remove double generator loop from interface and implementation --- src/stdlib_math.fypp | 35 ++++++++++++++++------------------ src/stdlib_math_logspace.fypp | 36 +++++++++++++++++------------------ 2 files changed, 34 insertions(+), 37 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 8ca6ca2ca..c4e0b49ea 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -120,27 +120,24 @@ module stdlib_math #:endfor #:for k1, t1 in IRC_KINDS_TYPES - #:for k2, t2 in IRC_KINDS_TYPES - #! k2, t2 correspond to the kind/type of the base that is passed - #:set RName = rname("logspace_n_base", 1, k1, k2) - #! ================================================================ !# - #! Need another function where base is not optional, otherwise the - #! compiler can not differentiate between - #! generic calls to logspace_n where a base is not present - #! ================================================================ !# - module function ${RName}$(start, end, n, base) result(res) - ! Generate logarithmically spaced sequence from ${k2}$ base to the powers - ! of ${k1}$ start and end. [base^start, ... , base^end] - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - ${t2}$, intent(in) :: base + #:set RName = rname("logspace_n_base", 1, k1, k1) + #! ================================================================ !# + #! Need another function where base is not optional, otherwise the + #! compiler can not differentiate between + #! generic calls to logspace_n where a base is not present + #! ================================================================ !# + module function ${RName}$(start, end, n, base) result(res) + ! Generate logarithmically spaced sequence from ${k1}$ base to the powers + ! of ${k1}$ start and end. [base^start, ... , base^end] + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + ${t1}$, intent(in) :: base - ${t1}$ :: res(n) + ${t1}$ :: res(n) - end function ${RName}$ - #:endfor - #:endfor + end function ${RName}$ + #:endfor end interface diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 983a391a0..fca127b1b 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -56,28 +56,28 @@ contains end function ${RName}$ #:endfor - #:for k1, t1 in RC_KINDS_TYPES - #:for k2, t2 in IRC_KINDS_TYPES - #! k2, t2 correspond to the kind/type of the base that is passed - #:set RName = rname("logspace_n_base", 1, k1, k2) - ! Need another function where base is not optional, otherwise the compiler can not differentiate between - ! generic calls to logspace_n where a base is not present - module function ${RName}$(start, end, n, base) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - ${t2}$, intent(in) :: base + ! #:for k1, t1 in RC_KINDS_TYPES + ! #:for k2, t2 in IRC_KINDS_TYPES + ! #! k2, t2 correspond to the kind/type of the base that is passed + ! #:set RName = rname("logspace_n_base", 1, k1, k2) + ! ! Need another function where base is not optional, otherwise the compiler can not differentiate between + ! ! generic calls to logspace_n where a base is not present + ! module function ${RName}$(start, end, n, base) result(res) + ! ${t1}$, intent(in) :: start + ! ${t1}$, intent(in) :: end + ! integer, intent(in) :: n + ! ${t2}$, intent(in) :: base - ${t1}$ :: res(n) + ! ${t1}$ :: res(n) - ${t1}$ :: lin(n) ! Linspace of exponents + ! ${t1}$ :: lin(n) ! Linspace of exponents - lin = linspace(start, end, n) + ! lin = linspace(start, end, n) - res = real(base, ${k1}$) ** lin ! Convert base to the proper kind + ! res = real(base, ${k1}$) ** lin ! Convert base to the proper kind - end function ${RName}$ - #:endfor - #:endfor + ! end function ${RName}$ + ! #:endfor + ! #:endfor end submodule From cf69f126c0e6f10a44c1fb5438a1d26e38d3c93b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sat, 10 Jul 2021 19:31:56 -0400 Subject: [PATCH 51/89] Kill double generator in implementation --- src/stdlib_math_logspace.fypp | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index fca127b1b..32009275c 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -56,28 +56,4 @@ contains end function ${RName}$ #:endfor - ! #:for k1, t1 in RC_KINDS_TYPES - ! #:for k2, t2 in IRC_KINDS_TYPES - ! #! k2, t2 correspond to the kind/type of the base that is passed - ! #:set RName = rname("logspace_n_base", 1, k1, k2) - ! ! Need another function where base is not optional, otherwise the compiler can not differentiate between - ! ! generic calls to logspace_n where a base is not present - ! module function ${RName}$(start, end, n, base) result(res) - ! ${t1}$, intent(in) :: start - ! ${t1}$, intent(in) :: end - ! integer, intent(in) :: n - ! ${t2}$, intent(in) :: base - - ! ${t1}$ :: res(n) - - ! ${t1}$ :: lin(n) ! Linspace of exponents - - ! lin = linspace(start, end, n) - - ! res = real(base, ${k1}$) ** lin ! Convert base to the proper kind - - ! end function ${RName}$ - ! #:endfor - ! #:endfor - end submodule From db0f976fc4a6144c79a2cc37c64f26a0d32e162c Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 16:55:37 -0400 Subject: [PATCH 52/89] Remove redundant dependencies --- src/Makefile.manual | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 20e2ecb8a..19d738e60 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -144,12 +144,8 @@ stdlib_strings.o: stdlib_ascii.o \ stdlib_optval.o stdlib_math.o: stdlib_kinds.o stdlib_math_linspace.o: \ - stdlib_math.o \ - stdlib_kinds.o + stdlib_math.o stdlib_math_logspace.o: \ stdlib_math.o \ stdlib_math_linspace.o \ - stdlib_kinds.o \ - stdlib_optval.o - stdlib_linalg_outer_product.o: stdlib_linalg.o From 718357e1ae1223519d1ff701f32cdcfddd3d9eb0 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 16:56:10 -0400 Subject: [PATCH 53/89] Clean up obsolete generic logspace combinations --- src/stdlib_math.fypp | 146 +++++++++++++++++++++++++++++++--- src/stdlib_math_logspace.fypp | 87 +++++++++++--------- 2 files changed, 182 insertions(+), 51 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index c4e0b49ea..849f33e6a 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -13,7 +13,7 @@ module stdlib_math integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 - real(dp), parameter :: DEFAULT_LOGSPACE_BASE = 10 + integer, parameter :: DEFAULT_LOGSPACE_BASE = 10 ! Useful constants for lnspace real(sp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_sp @@ -96,8 +96,11 @@ module stdlib_math !! If the number of elements is not specified, create an array with size 50. If n is a negative value, !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of !! 10 - #:for k1, t1 in IRC_KINDS_TYPES - #:set RName = rname("logspace_default", 1, t1, k1) + #!========================================================= + #!= logspace(start, end) = + #!========================================================= + #:for k1, t1 in RC_KINDS_TYPES + #:set RName = rname("logspace", 1, t1, k1, "default") module function ${RName}$(start, end) result(res) ${t1}$, intent(in) :: start @@ -107,9 +110,22 @@ module stdlib_math end function ${RName}$ #:endfor + #! Integer support + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "default") + module function ${RName}$(start, end) result(res) + + integer, intent(in) :: start + integer, intent(in) :: end + + real(dp) :: res(DEFAULT_LOGSPACE_LENGTH) + + end function ${RName}$ - #:for k1, t1 in IRC_KINDS_TYPES - #:set RName = rname("logspace_n", 1, t1, k1) + #!========================================================= + #!= logspace(start, end, n) = + #!========================================================= + #:for k1, t1 in RC_KINDS_TYPES + #:set RName = rname("logspace", 1, t1, k1, "n") module function ${RName}$(start, end, n) result(res) ${t1}$, intent(in) :: start ${t1}$, intent(in) :: end @@ -118,27 +134,131 @@ module stdlib_math ${t1}$ :: res(n) end function ${RName}$ #:endfor + #! Integer support + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n") + module function ${RName}$(start, end, n) result(res) + integer, intent(in) :: start + integer, intent(in) :: end + integer, intent(in) :: n - #:for k1, t1 in IRC_KINDS_TYPES - #:set RName = rname("logspace_n_base", 1, k1, k1) - #! ================================================================ !# - #! Need another function where base is not optional, otherwise the - #! compiler can not differentiate between - #! generic calls to logspace_n where a base is not present - #! ================================================================ !# - module function ${RName}$(start, end, n, base) result(res) + real(dp) :: res(n) + end function ${RName}$ + + #!========================================================= + #!= logspace(start, end, n, base) = + #!========================================================= + #! Need another function where base is not optional, + #! otherwise the compiler can not differentiate between + #! generic calls to logspace_n where a base is not present + #! ======================================================== + #:for k1, t1 in REAL_KINDS_TYPES ! Generate logarithmically spaced sequence from ${k1}$ base to the powers ! of ${k1}$ start and end. [base^start, ... , base^end] + ! RName = ${RName}$ + #:set RName = rname("logspace", 1, t1, k1, "n_rbase") + module function ${RName}$(start, end, n, base) result(res) ${t1}$, intent(in) :: start ${t1}$, intent(in) :: end integer, intent(in) :: n ${t1}$, intent(in) :: base + ! real(${k1}$) endpoints + real(${k1}$) base = real(${k1}$) result + ${t1}$ :: res(n) + end function ${RName}$ + + #:set RName = rname("logspace", 1, t1, k1, "n_cbase") + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + complex(${k1}$), intent(in) :: base + ! real(${k1}$) endpoints + complex(${k1}$) base = complex(${k1}$) result + ${t1}$ :: res(n) + end function ${RName}$ + + #:set RName = rname("logspace", 1, t1, k1, "n_ibase") + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + integer, intent(in) :: base + ! real(${k1}$) endpoints + integer base = real(${k1}$) result + ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + #! ======================================================== + #! ======================================================== + #:for k1, t1 in CMPLX_KINDS_TYPES + ! Generate logarithmically spaced sequence from ${k1}$ base to the powers + ! of ${k1}$ start and end. [base^start, ... , base^end] + ! RName = ${RName}$ + #:set RName = rname("logspace", 1, t1, k1, "n_rbase") + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + real(${k1}$), intent(in) :: base + ! complex(${k1}$) endpoints + real(${k1}$) base = complex(${k1}$) result + ${t1}$ :: res(n) + end function ${RName}$ + #:set RName = rname("logspace", 1, t1, k1, "n_cbase") + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + complex(${k1}$), intent(in) :: base + ! complex(${k1}$) endpoints + complex(${k1}$) base = complex(${k1}$) result + ${t1}$ :: res(n) + end function ${RName}$ + + #:set RName = rname("logspace", 1, t1, k1, "n_ibase") + module function ${RName}$(start, end, n, base) result(res) + ${t1}$, intent(in) :: start + ${t1}$, intent(in) :: end + integer, intent(in) :: n + integer, intent(in) :: base + ! complex(${k1}$) endpoints + integer base = complex(${k1}$) result ${t1}$ :: res(n) + end function ${RName}$ + #:endfor + #! ======================================================== + #! ======================================================== + ! Generate logarithmically spaced sequence from ${k1}$ base to the powers + ! of ${k1}$ start and end. [base^start, ... , base^end] + ! RName = ${RName}$ + #:for k1 in REAL_KINDS + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_r" + str(k1) + "base") + module function ${RName}$(start, end, n, base) result(res) + integer, intent(in) :: start + integer, intent(in) :: end + integer, intent(in) :: n + real(${k1}$), intent(in) :: base + ! integer endpoints + real(${k1}$) base = real(${k1}$) result + real(${k1}$) :: res(n) + end function ${RName}$ + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_c" + str(k1) + "base") + module function ${RName}$(start, end, n, base) result(res) + integer, intent(in) :: start + integer, intent(in) :: end + integer, intent(in) :: n + complex(${k1}$), intent(in) :: base + ! integer endpoints + complex(${k1}$) base = complex(${k1}$) result + complex(${k1}$) :: res(n) end function ${RName}$ #:endfor + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_ibase") + module function ${RName}$(start, end, n, base) result(res) + integer, intent(in) :: start + integer, intent(in) :: end + integer, intent(in) :: n + integer, intent(in) :: base + ! integer endpoints + integer base = integer result + integer :: res(n) + end function ${RName}$ + + end interface contains diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 32009275c..82812a445 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -1,7 +1,9 @@ #:include "common.fypp" +#:set I_KIND_TYPE = INT_KINDS_TYPES[2] #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES #:set IRC_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +#:set RCI_KINDS_TYPES = RC_KINDS_TYPES submodule (stdlib_math) stdlib_math_logspace @@ -9,51 +11,60 @@ implicit none contains - #!======================================================== - #! Real and Complex Implementations - #!======================================================== + #!========================================================= + #!= logspace(start, end) = + #!========================================================= #:for k1, t1 in RC_KINDS_TYPES - #:set RName = rname("logspace_default", 1, t1, k1) - module function ${RName}$(start, end) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - - ${t1}$ :: res(DEFAULT_LOGSPACE_LENGTH) - - res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, DEFAULT_LOGSPACE_BASE) - - end function ${RName}$ + #:set RName = rname("logspace", 1, t1, k1, "default") + module procedure ${RName}$ + res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, real(DEFAULT_LOGSPACE_BASE, ${k1}$)) + end procedure #:endfor + #! Integer support + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "default") + module procedure ${RName}$ + res = logspace(start, end, DEFAULT_LOGSPACE_LENGTH, DEFAULT_LOGSPACE_BASE) + end procedure + #!========================================================= + #!= logspace(start, end, n) = + #!========================================================= #:for k1, t1 in RC_KINDS_TYPES - #:set RName = rname("logspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - ${t1}$ :: res(n) - - res = logspace(start, end, n, DEFAULT_LOGSPACE_BASE) - - end function ${RName}$ + #:set RName = rname("logspace", 1, t1, k1, "n") + module procedure ${RName}$ + res = logspace(start, end, n, real(DEFAULT_LOGSPACE_BASE, ${k1}$)) + end procedure #:endfor - - #!======================================================== - #! Real and Complex Implementations - #!======================================================== - #:for k1, t1 in INT_KINDS_TYPES - #:set RName = rname("logspace_n", 1, t1, k1) - module function ${RName}$(start, end, n) result(res) - ${t1}$, intent(in) :: start - ${t1}$, intent(in) :: end - integer, intent(in) :: n - - real(dp) :: res(n) - + #! Integer support + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n") + module procedure ${RName}$ res = logspace(start, end, n, DEFAULT_LOGSPACE_BASE) + end procedure - end function ${RName}$ + #!========================================================= + #!= logspace(start, end, n, base) = + #!========================================================= + #:for k1, t1 in RC_KINDS_TYPES + #:set RName = rname("logspace", 1, t1, k1, "n_rbase") + module procedure ${RName}$ + ${t1}$ :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure + + #:set RName = rname("logspace", 1, t1, k1, "n_cbase") + module procedure ${RName}$ + ${t1}$ :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure + + #:set RName = rname("logspace", 1, t1, k1, "n_ibase") + module procedure ${RName}$ + ${t1}$ :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure #:endfor end submodule From fa76f6a96c76b531ed81128bca889de8fd900b25 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 17:09:22 -0400 Subject: [PATCH 54/89] Remove obsolete fypp variable --- src/stdlib_math.fypp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 849f33e6a..032c2a2ea 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -1,7 +1,6 @@ #:include "common.fypp" #:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -#:set IRC_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + CMPLX_KINDS_TYPES module stdlib_math use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp From ef381476abf3e6b3186c85e4fc75da5ae6e611d6 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 17:24:40 -0400 Subject: [PATCH 55/89] Complete support for integer start/endpoints --- src/stdlib_math_logspace.fypp | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 82812a445..0a4035cb3 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -66,5 +66,32 @@ contains res = base ** exponents end procedure #:endfor + #! Integer support: + ! Generate logarithmically spaced sequence from ${k1}$ base to the powers + ! of ${k1}$ start and end. [base^start, ... , base^end] + ! RName = ${RName}$ + #:for k1 in REAL_KINDS + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_r" + str(k1) + "base") + module procedure ${RName}$ + integer :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure + + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_c" + str(k1) + "base") + module procedure ${RName}$ + integer :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure + #:endfor + + #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_ibase") + module procedure ${RName}$ + integer :: exponents(n) + exponents = linspace(start, end, n) + res = base ** exponents + end procedure + end submodule From e3793e7a9e5b28f0558640111b69067ac98749bd Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 17:26:50 -0400 Subject: [PATCH 56/89] Fix euler's number precision allignment --- src/stdlib_math.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 032c2a2ea..1a0f1765d 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -15,8 +15,8 @@ module stdlib_math integer, parameter :: DEFAULT_LOGSPACE_BASE = 10 ! Useful constants for lnspace - real(sp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_sp - real(dp), parameter :: EULERS_NUMBER_SP = 2.71828182845904523536028747135266249775724709369995_dp + real(sp), parameter :: EULERS_NUMBER_SP = 2.71828182845904523536028747135266249775724709369995_sp + real(dp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_dp real(qp), parameter :: EULERS_NUMBER_QP = 2.71828182845904523536028747135266249775724709369995_qp interface clip From abf52e27121b1530c834d4d9ea090b8c5935896a Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 18:13:07 -0400 Subject: [PATCH 57/89] remove obsolete fypp variables --- src/stdlib_math_logspace.fypp | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/stdlib_math_logspace.fypp b/src/stdlib_math_logspace.fypp index 0a4035cb3..87544ffcc 100644 --- a/src/stdlib_math_logspace.fypp +++ b/src/stdlib_math_logspace.fypp @@ -1,9 +1,5 @@ #:include "common.fypp" -#:set I_KIND_TYPE = INT_KINDS_TYPES[2] -#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -#:set IRC_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES + CMPLX_KINDS_TYPES -#:set RCI_KINDS_TYPES = RC_KINDS_TYPES submodule (stdlib_math) stdlib_math_logspace From ecee7a7ac7b70f62c98f9ee5851fa6475e6c259b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 18:16:22 -0400 Subject: [PATCH 58/89] https://github.com/fortran-lang/stdlib/pull/420/files#r667540472 --- src/stdlib_math_linspace.fypp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/stdlib_math_linspace.fypp b/src/stdlib_math_linspace.fypp index 22267b0b6..655051b41 100644 --- a/src/stdlib_math_linspace.fypp +++ b/src/stdlib_math_linspace.fypp @@ -39,7 +39,10 @@ contains interval = (end - start) / real((n - 1), ${k1}$) - do i = 1, n + res(1) = start + res(n) = end + + do i = 2, n - 1 res(i) = real((i-1), ${k1}$) * interval + start From 4a890e00871fd6ea7bb73217b2c5ed8ad17ebf01 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 20:56:25 -0400 Subject: [PATCH 59/89] Make DEFAULT_LINSPACE_PUBLIC for more robust testing --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 1a0f1765d..dcfe4c29b 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -8,7 +8,7 @@ module stdlib_math implicit none private public :: clip, linspace, logspace - public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP + public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP, DEFAULT_LINSPACE_LENGTH integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 From 482791b2f8a91d93a05589f2d08f867706af8ebd Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 21:09:05 -0400 Subject: [PATCH 60/89] Revamp testing Test that start and end values of result are bit-exact with what the user passes as parameters. Also verify that each element is linearly spaced. --- src/tests/math/test_linspace.f90 | 241 +++++++++++++++++++++++++------ 1 file changed, 196 insertions(+), 45 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index d522a0c7e..858862575 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -1,22 +1,25 @@ program test_linspace use stdlib_error, only: check use stdlib_kinds, only: sp, dp, int16, int8 - use stdlib_math, only: linspace + use stdlib_math, only: linspace, DEFAULT_LINSPACE_LENGTH implicit none integer :: iunit logical :: warn = .false. + real(dp), parameter :: TOLERANCE = 0.00001 ! Percentage of the range for which the actual gap must not exceed ! Testing linspace. ! - ! For single and double precision, check if the beginning and end values are properly calculated - ! and make sure that the size of the result is as expected. + ! For single and double precision, check if the beginning and end values are properly recorded + ! and make sure that the size of the result array is as expected. ! - ! - + ! This testing suite makes use of the a repeated section of code that will check to make + ! sure that every element is linearly spaced (i.e., call check(|array(i+1) - array(i)| < |expected_value| * TOLERANCE)). + ! I would convert this repeated code into a subroutine but that would require the implementation of a + ! generic procedure given that each linear space will have a different expected_value type and kind. - open(newunit=iunit, file="test_linspace_log.txt", status="unknown") ! Log the results of the functio + open(newunit=iunit, file="test_linspace_log.txt", status="unknown") ! Log the results of the functions write(iunit,*) "Writing to unit #: ", iunit @@ -31,39 +34,67 @@ program test_linspace call test_linspace_int16 call test_linspace_int8 - close(unit=iunit) - + close(unit=iunit) contains subroutine test_linspace_sp - integer :: n = 20 + integer, parameter :: n = 20 real(sp) :: start = 1.0_sp real(sp) :: end = 10.0_sp + real(sp) :: expected_interval + real(sp) :: true_difference + integer :: i real(sp), dimension(:), allocatable :: x x = linspace(start, end, n) + expected_interval =( end - start ) / real(( n - 1 ), sp) + call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) - call check(x(20) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(x(n) == end, msg="Final array value is not equal to end parameter", warn=warn) call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + print *, "Made it through first round of tests" + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + true_difference = x(i + 1) - x(i) + call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do + end subroutine subroutine test_linspace_dp real(dp) :: start = 1.0_dp real(dp) :: end = 10.0_dp + integer, parameter :: n = DEFAULT_LINSPACE_LENGTH + real(dp) :: expected_interval + real(dp) :: true_difference real(dp), dimension(:), allocatable :: x + integer :: i x = linspace(start, end) + expected_interval =( end - start ) / ( n - 1 ) + call check(x(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) - call check(x(100) == end, msg="Final array value is not equal to end parameter", warn=warn) - call check(size(x) == 100, msg="Array not allocated to appropriate size", warn=warn) + call check(x(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(x) == n, msg="Array not allocated to default size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + true_difference = x(i + 1) - x(i) + call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do end subroutine @@ -84,22 +115,37 @@ subroutine test_linspace_cmplx complex(dp) :: start = (0.0_dp, 10.0_dp) complex(dp) :: end = (1.0_dp, 0.0_dp) + complex(dp) :: expected_interval + integer, parameter :: n = 10 - complex(dp) :: z(10) + complex(dp) :: z(n) integer :: i - z = linspace(start, end, 10) + z = linspace(start, end, n) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace((0.0_dp, 10.0_dp), (1.0_dp, 0.0_dp), 10): " write(unit=iunit,fmt=99) - do i = 1, 10 + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -107,22 +153,38 @@ subroutine test_linspace_cmplx_2 complex(dp) :: start = (10.0_dp, 10.0_dp) complex(dp) :: end = (1.0_dp, 1.0_dp) + complex(dp) :: expected_interval - complex(dp) :: z(5) + integer, parameter :: n = 5 + + complex(dp) :: z(n) integer :: i - z = linspace(start, end, 5) + z = linspace(start, end, n) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace((10.0_dp, 10.0_dp), (1.0_dp, 1.0_dp), 5): " write(unit=iunit,fmt=99) - do i = 1, 5 + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -130,12 +192,28 @@ subroutine test_linspace_cmplx_3 complex(dp) :: start = (-5.0_dp, 100.0_dp) complex(dp) :: end = (20.0_dp, 13.0_dp) + complex(dp) :: expected_interval - complex(dp) :: z(20) + integer, parameter :: n = 20 + + complex(dp) :: z(n) integer :: i - z = linspace(start, end, 20) + z = linspace(start, end, n) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace((-5.0_dp, 100.0_dp), (20.0_dp, 13.0_dp), 20): " write(unit=iunit,fmt=99) @@ -144,8 +222,8 @@ subroutine test_linspace_cmplx_3 end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -153,22 +231,38 @@ subroutine test_linspace_cmplx_sp complex(sp) :: start = (0.5_sp, 5.0_sp) complex(sp) :: end = (1.0_sp, -30.0_sp) + complex(sp) :: expected_interval + + integer, parameter :: n = 10 - complex(sp) :: z(10) + complex(sp) :: z(n) integer :: i - z = linspace(start, end, 10) + z = linspace(start, end, n) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace((0.5_sp, 5.0_sp), (1.0_sp, -30.0_sp), 10): " write(unit=iunit,fmt=99) - do i = 1, 10 + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -176,22 +270,43 @@ subroutine test_linspace_cmplx_sp_2 complex(sp) :: start = (50.0_sp, 500.0_sp) complex(sp) :: end = (-100.0_sp, 2000.0_sp) + complex(sp) :: expected_interval + complex(sp) :: true_interval + real(sp) :: offset + + integer, parameter :: n = DEFAULT_LINSPACE_LENGTH - complex(sp) :: z(100) + complex(sp) :: z(n) integer :: i - z = linspace(start, end, 100) + z = linspace(start, end) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to default size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + true_interval = (z(i + 1) - z(i)) + offset = abs(true_interval - expected_interval) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + ! print *, i + + end do write(unit=iunit, fmt=*) "linspace((50.0_sp, 500.0_sp), (-100.0_sp, 2000.0_sp)): " write(unit=iunit,fmt=99) - do i = 1, 100 + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -199,12 +314,28 @@ subroutine test_linspace_int16 integer(int16) :: start = 5 integer(int16) :: end = 10 + real(dp) :: expected_interval - integer(int16) :: z(6) + integer, parameter :: n = 6 + + integer(int16) :: z(n) integer :: i - z = linspace(start, end, 6) + z = linspace(start, end, n) + + expected_interval =( end - start ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " write(unit=iunit,fmt=99) @@ -213,8 +344,8 @@ subroutine test_linspace_int16 end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine @@ -223,23 +354,43 @@ subroutine test_linspace_int8 integer(int8) :: start = 20 integer(int8) :: end = 50 - integer(int8) :: z(10) + real(dp) :: expected_interval + + integer, parameter :: n = 10 + + real(dp) :: z(n) + integer(int8) :: z_int(n) integer :: i - z = linspace(start, end, 10) + z = linspace(start, end, n) + z_int = linspace(start, end, n) + + expected_interval =real( end - start, dp ) / ( n - 1 ) + + call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) + call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) + call check(size(z) == n, msg="Array not allocated to correct size", warn=warn) + + ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval + do i = 1, n-1 + + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + + end do write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " write(unit=iunit,fmt=99) do i = 1, 10 - write(unit=iunit,fmt=*) z(i) + write(unit=iunit,fmt=*) z_int(i) end do write(iunit,*) write(iunit,*) - - 99 format(70("=")) + + 99 format(70("=")) end subroutine + end program \ No newline at end of file From 4799aaee24bc6b2972555aa6060ef5e9c9538618 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 21:12:14 -0400 Subject: [PATCH 61/89] Add logspace spec links --- src/stdlib_math.fypp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index dcfe4c29b..1836e6bbe 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -62,7 +62,7 @@ module stdlib_math !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` !! parameters, the return type is always a double precision real. !! - !!([Specification](../page/specs/stdlib_math.html#description)) + !!([Specification](../page/specs/stdlib_math.html#linspace)) #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) #! The interface for INT_KINDS_TYPES cannot be combined with RC_KINDS_TYPES @@ -95,6 +95,8 @@ module stdlib_math !! If the number of elements is not specified, create an array with size 50. If n is a negative value, !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of !! 10 + !! + !!([Specification](../page/specs/stdlib_math.html#logspace)) #!========================================================= #!= logspace(start, end) = #!========================================================= From 66341b40d1b922d9c2bfa4171899ff2695c3ae80 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 21:15:08 -0400 Subject: [PATCH 62/89] Clarify wording of specs --- src/stdlib_math.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 1836e6bbe..5c259df17 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -30,7 +30,7 @@ module stdlib_math !! !! Create rank 1 array of linearly spaced elements !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. If n = 1, return end + !! return an array with size 0. If n = 1, return an array whose only element is end !!([Specification](../page/specs/stdlib_math.html#description)) #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) @@ -59,7 +59,7 @@ module stdlib_math !! !! Create rank 1 array of linearly spaced elements from start to end. !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. If n = 1, return end. When dealing with integers as the `start` and `end` + !! return an array with size 0. If n = 1, return a rank 1 array whose only element is end. When dealing with integers as the `start` and `end` !! parameters, the return type is always a double precision real. !! !!([Specification](../page/specs/stdlib_math.html#linspace)) @@ -93,8 +93,8 @@ module stdlib_math !! !! Create rank 1 array of logarithmically spaced elements from base**start to base**end. !! If the number of elements is not specified, create an array with size 50. If n is a negative value, - !! return an array with size 0. If n = 1, return base**end. If no base is specified, logspace will default to using a base of - !! 10 + !! return an array with size 0. If n = 1, return an array whose only element is base**end. If no base + !! is specified, logspace will default to using a base of 10 !! !!([Specification](../page/specs/stdlib_math.html#logspace)) #!========================================================= From df0b73adad27341546c27749c0ca47b0e025d155 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 21:46:14 -0400 Subject: [PATCH 63/89] Make variables public for more rigorous testing --- src/stdlib_math.fypp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 5c259df17..dd6ab93a9 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -8,7 +8,8 @@ module stdlib_math implicit none private public :: clip, linspace, logspace - public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP, DEFAULT_LINSPACE_LENGTH + public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP + public :: DEFAULT_LINSPACE_LENGTH, DEFAULT_LOGSPACE_BASE, DEFAULT_LOGSPACE_LENGTH integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100 integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50 From adbcab950f2a26e9cf10761bc2bb52c3fff9ff0f Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Sun, 11 Jul 2021 23:21:04 -0400 Subject: [PATCH 64/89] Invigorate testing procedures --- src/tests/math/test_linspace.f90 | 20 +-- src/tests/math/test_logspace.f90 | 266 +++++++++++++++++++++---------- 2 files changed, 192 insertions(+), 94 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 858862575..532290ca1 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -47,7 +47,7 @@ subroutine test_linspace_sp real(sp) :: true_difference integer :: i - real(sp), dimension(:), allocatable :: x + real(sp), allocatable :: x(:) x = linspace(start, end, n) @@ -77,7 +77,7 @@ subroutine test_linspace_dp real(dp) :: expected_interval real(dp) :: true_difference - real(dp), dimension(:), allocatable :: x + real(dp), allocatable :: x(:) integer :: i x = linspace(start, end) @@ -103,7 +103,7 @@ subroutine test_linspace_neg_index real(dp) :: start = 1.0_dp real(dp) :: end = 10.0_dp - real(dp), dimension(:), allocatable :: x + real(dp), allocatable :: x(:) x = linspace(start, end, -15) @@ -118,7 +118,7 @@ subroutine test_linspace_cmplx complex(dp) :: expected_interval integer, parameter :: n = 10 - complex(dp) :: z(n) + complex(dp), allocatable :: z(:) integer :: i @@ -157,7 +157,7 @@ subroutine test_linspace_cmplx_2 integer, parameter :: n = 5 - complex(dp) :: z(n) + complex(dp), allocatable :: z(:) integer :: i @@ -196,7 +196,7 @@ subroutine test_linspace_cmplx_3 integer, parameter :: n = 20 - complex(dp) :: z(n) + complex(dp), allocatable :: z(:) integer :: i @@ -235,7 +235,7 @@ subroutine test_linspace_cmplx_sp integer, parameter :: n = 10 - complex(sp) :: z(n) + complex(sp), allocatable :: z(:) integer :: i @@ -276,7 +276,7 @@ subroutine test_linspace_cmplx_sp_2 integer, parameter :: n = DEFAULT_LINSPACE_LENGTH - complex(sp) :: z(n) + complex(sp), allocatable :: z(:) integer :: i @@ -318,7 +318,7 @@ subroutine test_linspace_int16 integer, parameter :: n = 6 - integer(int16) :: z(n) + integer(int16), allocatable :: z(:) integer :: i @@ -358,7 +358,7 @@ subroutine test_linspace_int8 integer, parameter :: n = 10 - real(dp) :: z(n) + real(dp), allocatable :: z(:) integer(int8) :: z_int(n) integer :: i diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 index cfd5775b6..2da8b3dc5 100644 --- a/src/tests/math/test_logspace.f90 +++ b/src/tests/math/test_logspace.f90 @@ -2,153 +2,251 @@ program test_logspace use stdlib_error, only: check use stdlib_kinds, only: sp, dp, int8, int16, int32, int64 - use stdlib_math, only: logspace - + use stdlib_math, only: logspace, DEFAULT_LOGSPACE_BASE, DEFAULT_LOGSPACE_LENGTH + implicit none - - logical :: warn = .false. + + logical :: warn = .false. integer :: iunit - + ! Testing logspace ! - ! logspace should return a rank 1 array of values equally logarithmically spaced - ! from the base**start to base**end, using Euler's number e as the base. If no length + ! logspace should return a rank 1 array of values equally logarithmically spaced + ! from the base**start to base**end, using 10 as the base. If no length ! is specified, return a rank 1 array with 50 elements. - + ! + ! Also test to verify that the proportion between adjacent elements is constant within + ! a certain tolerance + + real(dp), parameter :: TOLERANCE = 0.00001 + open(newunit=iunit, file="test_logspace_log.txt", status="unknown") ! Log the results of the function - + write(iunit,*) "Writing to unit #: ", iunit call test_logspace_sp call test_logspace_dp call test_logspace_default call test_logspace_base_2 - - close(unit=iunit) - + call test_logspace_base_2_cmplx_start + call test_logspace_base_i_int_start + + close(unit=iunit) + contains - + subroutine test_logspace_sp - + integer :: n = 20 real(sp) :: start = 0.0_sp real(sp) :: end = 2.0_sp - + + real(sp) :: expected_proportion + integer :: i = 1 + real(sp), allocatable :: x(:) - - logical :: cond_1, cond_2 - + x = logspace(start, end, n) - - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + + expected_proportion = 10 ** ( ( end - start ) / ( n - 1 ) ) + + call check(x(1) == DEFAULT_LOGSPACE_BASE ** start, msg="Initial value of array is not equal to 10^start", warn=warn) + call check(x(n) == DEFAULT_LOGSPACE_BASE ** end, msg="Final value of array is not equal to 10^end", warn=warn) call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + + write(unit=iunit, fmt=*) "logspace(0.0_sp, 2.0_sp, 20): " write(unit=iunit,fmt=99) write(unit=iunit,fmt="(20(F7.3, 2X))") x write(iunit,*) write(iunit,*) - + 99 format(70("=")) - - end subroutine - + + end subroutine + subroutine test_logspace_dp - + integer :: n = 10 real(dp) :: start = 1.0_dp real(dp) :: end = 0.0_dp - + real(dp) :: expected_proportion + integer :: i = 1 + real(dp), allocatable :: x(:) - - logical :: cond_1, cond_2 - + x = logspace(start, end, n) - - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + + expected_proportion = 10 ** ( ( end - start ) / ( n - 1 ) ) + + + call check(x(1) == DEFAULT_LOGSPACE_BASE ** start, msg="Initial value of array is not equal to 10^start", warn=warn) + call check(x(n) == DEFAULT_LOGSPACE_BASE ** end, msg="Final value of array is not equal to 10^end", warn=warn) call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + write(unit=iunit, fmt=*) "logspace(1.0_dp, 0.0_dp, 10): " write(unit=iunit,fmt=99) write(unit=iunit,fmt="(10(F7.3, 2X))") x write(iunit,*) write(iunit,*) - + 99 format(70("=")) - - end subroutine - + + end subroutine + subroutine test_logspace_default - + real(dp) :: start = 0.0_dp real(dp) :: end = 1.0_dp - + integer :: n = DEFAULT_LOGSPACE_LENGTH + real(dp) :: expected_proportion + integer :: i + real(dp), allocatable :: x(:) - - x = logspace(start, end) - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) - call check(size(x) == 50, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - + + x = logspace(start, end) + + expected_proportion = 10 ** ( ( end - start ) / ( n - 1 ) ) + + + call check(x(1) == DEFAULT_LOGSPACE_BASE ** start, msg="Initial value of array is not equal to 10^start", warn=warn) + call check(x(n) == DEFAULT_LOGSPACE_BASE ** end, msg="Final value of array is not equal to 10^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + write(unit=iunit, fmt=*) "logspace(0.0_dp, 1.0_dp): " write(unit=iunit,fmt=99) write(unit=iunit,fmt="(50(F7.3, 2X))") x write(iunit,*) write(iunit,*) - + 99 format(70("=")) - - end subroutine + + end subroutine subroutine test_logspace_base_2 - + integer :: n = 10 real(dp) :: start = 1.0_dp real(dp) :: end = 10.0_dp integer :: base = 2 - + integer :: i + real(dp) :: expected_proportion + real(dp), allocatable :: x(:) - - logical :: cond_1, cond_2 - + x = logspace(start, end, n, base) - - - ! call check(cond_1, msg="Initial value of array is not equal to e^start", warn=warn) - ! call check(cond_2, msg="Final value of array is not equal to e^end", warn=warn) + + expected_proportion = 2 ** ( ( end - start ) / ( n - 1 ) ) + + call check(x(1) == base ** start, msg="Initial value of array is not equal to 2^start", warn=warn) + call check(x(n) == base ** end, msg="Final value of array is not equal to 2^end", warn=warn) call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) - - ! call global_logger%add_log_file("test_logspace_log_file.txt", unit=unit) - ! call global_logger%log_message("x = logspace(0.0_sp, 2.0_sp, 20)") - ! 99 format(G11.5, X) - + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + write(unit=iunit, fmt=*) "logspace(1.0_dp, 10.0_dp, 10, 2): " write(unit=iunit,fmt=99) write(unit=iunit,fmt="(10(F9.3, 2X))") x write(iunit,*) write(iunit,*) - + 99 format(70("=")) - - end subroutine - - + + end subroutine + + subroutine test_logspace_base_2_cmplx_start + + integer :: n = 10 + complex(dp) :: start = (1, 0) + complex(dp) :: end = (0, 1) + integer :: base = 2 + complex(dp) :: expected_proportion + integer :: i + + complex(dp), allocatable :: x(:) + + x = logspace(start, end, n, base) + + expected_proportion = 2 ** ( ( end - start ) / ( n - 1 ) ) + + + call check(x(1) == base ** start, msg="Initial value of array is not equal to 2^start", warn=warn) + call check(x(n) == base ** end, msg="Final value of array is not equal to 2^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + + write(unit=iunit, fmt=*) "logspace(1, i, 10, 2): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(10('(', F6.3, ',', 1X, F6.3, ')', 2X))") x + write(iunit,*) + write(iunit,*) + + 99 format(70("=")) + + end subroutine + + subroutine test_logspace_base_i_int_start + + integer :: n = 5 + integer :: start = 1 + integer :: end = 5 + complex(dp) :: base = (0, 1) ! i + complex(dp) :: expected_proportion + integer :: i = 1 + + complex(dp), allocatable :: x(:) + + x = logspace(start, end, n, base) + + expected_proportion = base ** ( ( end - start ) / ( n - 1 ) ) + + call check(x(1) == base ** start, msg="Initial value of array is not equal to 2^start", warn=warn) + call check(x(n) == base ** end, msg="Final value of array is not equal to 2^end", warn=warn) + call check(size(x) == n, msg="Array not allocated to appropriate size", warn=warn) + + do i = 1, n-1 + + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + + end do + + write(unit=iunit, fmt=*) "logspace(1, 5, 5, i): " + write(unit=iunit,fmt=99) + write(unit=iunit,fmt="(10('(', F6.3, ',', 1X, F6.3, ')', 2X))") x + write(iunit,*) + write(iunit,*) + + 99 format(70("=")) + + end subroutine + + end program \ No newline at end of file From 269c0cc06f12948e22058196175864f1795a1b56 Mon Sep 17 00:00:00 2001 From: "Evan Voyles [wsl-ubuntu]" Date: Mon, 12 Jul 2021 11:19:18 -0400 Subject: [PATCH 65/89] Fix manual dependencies For some reason stdlib_ascii.o was not listed as a dependency under stdlib_io.o, despite the fact that the stdlib_io module uses stdlib_ascii.o. This commit addresses that discrepency. Furthermore, I cleaned up redundant dependencies under stdlib_math_logspace and I fixed a formatting mistake that prevented the latest version 10 Ubuntu check from being passed. --- src/Makefile.manual | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Makefile.manual b/src/Makefile.manual index 19d738e60..2bb75c319 100644 --- a/src/Makefile.manual +++ b/src/Makefile.manual @@ -75,6 +75,7 @@ stdlib_error.o: stdlib_optval.o stdlib_specialfunctions.o: stdlib_kinds.o stdlib_specialfunctions_legendre.o: stdlib_kinds.o stdlib_specialfunctions.o stdlib_io.o: \ + stdlib_ascii.o \ stdlib_error.o \ stdlib_optval.o \ stdlib_kinds.o @@ -146,6 +147,5 @@ stdlib_math.o: stdlib_kinds.o stdlib_math_linspace.o: \ stdlib_math.o stdlib_math_logspace.o: \ - stdlib_math.o \ - stdlib_math_linspace.o \ + stdlib_math_linspace.o stdlib_linalg_outer_product.o: stdlib_linalg.o From 6098d8c9c140fe1654797ea098fb2a5f066ac7a8 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:51:12 -0400 Subject: [PATCH 66/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index b8a8f021d..7dafa4989 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -164,7 +164,7 @@ end program demo_linspace_int16 #### Description -Returns a logarithmically spaced rank 1 array from [`base`^`start`, `base`^`end`]. Optionally, you can specify the length of the returned array by passing `n`. +Returns a logarithmically spaced rank 1 array from [`base`^`start`, `base`^`end`]. The default size of the array is 100. Optionally, you can specify the length of the returned array by passing `n`. #### Syntax @@ -228,4 +228,4 @@ program demo_logspace_int16 r = logspace(start, end, 15) end program demo_logspace_int16 -``` \ No newline at end of file +``` From 96ffcc17dbaeabfae8b66c54c10f1f36f09fc52a Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:51:26 -0400 Subject: [PATCH 67/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 7dafa4989..c10f0a121 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -107,7 +107,7 @@ Experimental #### Class -function. +Function. #### Argument(s) From 1b39346219b797a9383491f64c509a57426b5e67 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:51:36 -0400 Subject: [PATCH 68/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index c10f0a121..f5018d5c7 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -176,7 +176,7 @@ Experimental #### Class -function. +Function. #### Argument(s) From ad1f2ed0ded89c7a446c7d59f7cfce294bace410 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:51:58 -0400 Subject: [PATCH 69/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index f5018d5c7..ad94db078 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -180,7 +180,7 @@ Function. #### Argument(s) -`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. +`start`: Shall be a scalar of any numeric type. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. `base` : Shall be a scalar of any numeric type. This argument is `intent(in)` From 347890a32edd94154b32eb16824ac8700f25301e Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:52:36 -0400 Subject: [PATCH 70/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index ad94db078..f6b6c2b11 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -182,7 +182,7 @@ Function. `start`: Shall be a scalar of any numeric type. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. -`n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. +`n`: Shall be an integer specifying the length of the output. This argument is `optional` and `intent(in)`. `base` : Shall be a scalar of any numeric type. This argument is `intent(in)` #### Output value or Result value From 6167af78ee8f8b01f1892ea985317f78fc663238 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:52:48 -0400 Subject: [PATCH 71/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index f6b6c2b11..efbc6e158 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -183,7 +183,7 @@ Function. `start`: Shall be a scalar of any numeric type. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `optional` and `intent(in)`. -`base` : Shall be a scalar of any numeric type. This argument is `intent(in)` +`base` : Shall be a scalar of any numeric type. This argument is `optional` and `intent(in)` #### Output value or Result value From 3b62495413b2b49626b88971c1a8fa3bf6352cac Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:53:03 -0400 Subject: [PATCH 72/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index efbc6e158..436a156d7 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -113,7 +113,7 @@ Function. `start`: Shall be scalar of any numeric type. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. -`n`: Shall be an integer specifying the length of the output. This argument is `intent(in)`. +`n`: Shall be an integer specifying the length of the output. This argument is `optional` and `intent(in)`. #### Output value or Result value From 316e34934868f6a4cfbe69098994a44829dd63c4 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:55:10 -0400 Subject: [PATCH 73/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index dd6ab93a9..a8aaf212f 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -32,7 +32,7 @@ module stdlib_math !! Create rank 1 array of linearly spaced elements !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return an array whose only element is end - !!([Specification](../page/specs/stdlib_math.html#description)) + !!([Specification](../page/specs/stdlib_math.html#linspace-create-a-linearly-spaced-rank-one-array)) #:for k1, t1 in RC_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) module function ${RName}$(start, end) result(res) From f9a6623522ab854d8d40c1c69bfb9780acf9aff3 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 13:55:38 -0400 Subject: [PATCH 74/89] Update src/tests/math/test_linspace.f90 Co-authored-by: Jeremie Vandenplas --- src/tests/math/test_linspace.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 532290ca1..ac94dc955 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -1,6 +1,6 @@ program test_linspace use stdlib_error, only: check - use stdlib_kinds, only: sp, dp, int16, int8 + use stdlib_kinds, only: sp, dp, int8, int16 use stdlib_math, only: linspace, DEFAULT_LINSPACE_LENGTH implicit none @@ -393,4 +393,4 @@ subroutine test_linspace_int8 -end program \ No newline at end of file +end program From e292347cc90f1408bd8305ecf26fe6db8b56b3b0 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 14:03:43 -0400 Subject: [PATCH 75/89] Update src/tests/math/test_linspace.f90 Co-authored-by: Jeremie Vandenplas --- src/tests/math/test_linspace.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index ac94dc955..c2dd09bfa 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -202,7 +202,7 @@ subroutine test_linspace_cmplx_3 z = linspace(start, end, n) - expected_interval =( end - start ) / ( n - 1 ) + expected_interval = ( end - start ) / ( n - 1 ) call check(z(1) == start, msg="Initial value of array is not equal to the passed start parameter", warn=warn) call check(z(n) == end, msg="Final array value is not equal to end parameter", warn=warn) From 905dc28d496024ef631c90538ccedb4261768ab6 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 14:14:06 -0400 Subject: [PATCH 76/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index a8aaf212f..0050350d9 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -61,7 +61,7 @@ module stdlib_math !! Create rank 1 array of linearly spaced elements from start to end. !! If the number of elements is not specified, create an array with size 100. If n is a negative value, !! return an array with size 0. If n = 1, return a rank 1 array whose only element is end. When dealing with integers as the `start` and `end` - !! parameters, the return type is always a double precision real. + !! parameters, the return type is always a `real(dp)`. !! !!([Specification](../page/specs/stdlib_math.html#linspace)) #:for k1, t1 in INT_KINDS_TYPES From 4780d272e0a30d7c34ce9085c494bf5504c50272 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 14:14:40 -0400 Subject: [PATCH 77/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 0050350d9..e5fa5f168 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -63,7 +63,7 @@ module stdlib_math !! return an array with size 0. If n = 1, return a rank 1 array whose only element is end. When dealing with integers as the `start` and `end` !! parameters, the return type is always a `real(dp)`. !! - !!([Specification](../page/specs/stdlib_math.html#linspace)) + !!([Specification](../page/specs/stdlib_math.html#linspace-create-a-linearly-spaced-rank-one-array)) #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) #! The interface for INT_KINDS_TYPES cannot be combined with RC_KINDS_TYPES From 9c4dcef789e85b7234ab97a3f6d850d3f0c469a3 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 14:15:14 -0400 Subject: [PATCH 78/89] Update src/stdlib_math.fypp Co-authored-by: Jeremie Vandenplas --- src/stdlib_math.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index e5fa5f168..83d7f7ac0 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -97,7 +97,7 @@ module stdlib_math !! return an array with size 0. If n = 1, return an array whose only element is base**end. If no base !! is specified, logspace will default to using a base of 10 !! - !!([Specification](../page/specs/stdlib_math.html#logspace)) + !!([Specification](../page/specs/stdlib_math.html#logspace-create-a-logarithmically-spaced-rank-one-array)) #!========================================================= #!= logspace(start, end) = #!========================================================= From efa82b2d18b57e3fd7426b2550caa85a8e47856b Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 16:19:52 -0400 Subject: [PATCH 79/89] Add more comprehensive documentation --- doc/specs/stdlib_math.md | 90 ++++++++++++++++++++++++++++++---------- src/stdlib_math.fypp | 10 +++-- 2 files changed, 75 insertions(+), 25 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 436a156d7..c92c73654 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -111,16 +111,19 @@ Function. #### Argument(s) -`start`: Shall be scalar of any numeric type. This argument is `intent(in)`. +`start`: Shall be scalar of any numeric type or kind. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `optional` and `intent(in)`. #### Output value or Result value -The output is a rank 1 array of `type` and `kind`, whose length is either 100 (default value) or `n`. +The output is a rank 1 array whose length is either 100 (default value) or `n`. If `n` == 1, return a rank 1 array whose only element is `end`. -If `n` <= 0, return a rank 1 array with length 0 +If `n` <= 0, return a rank 1 array with length 0. + +If `start`/`end` are real or complex types, the `result` will be the same `type` and `kind` as `start`/`end`. +If `start`/`end` are integer types, the `result` will default to a double precision real array. #### Examples @@ -144,17 +147,17 @@ end program demo_linspace_complex ##### Example 2: -Here inputs are of type `integer` and kind `int16` +Here inputs are of type `integer` and kind `int16`, with the result defaulting to double precision real. ```fortran program demo_linspace_int16 use stdlib_math, only: linspace - use stdlib_kinds, only: int16 + use stdlib_kinds, only: int16, dp implicit none integer(int16) :: start = 10_int16 integer(int16) :: end = 23_int16 - integer(int16) :: r(15) + real(dp) :: r(15) r = linspace(start, end, 15) end program demo_linspace_int16 @@ -164,7 +167,7 @@ end program demo_linspace_int16 #### Description -Returns a logarithmically spaced rank 1 array from [`base`^`start`, `base`^`end`]. The default size of the array is 100. Optionally, you can specify the length of the returned array by passing `n`. +Returns a logarithmically spaced rank 1 array from [`base`^`start`, `base`^`end`]. The default size of the array is 50. Optionally, you can specify the length of the returned array by passing `n`. You can also specify the `base` used to compute the range (default 10). #### Syntax @@ -180,33 +183,54 @@ Function. #### Argument(s) -`start`: Shall be a scalar of any numeric type. This argument is `intent(in)`. +`start`: Shall be a scalar of any numeric type. All kinds are supported for real and complex arguments. For integers, only the default kind is currently implemented. This argument is `intent(in)`. `end`: Shall be the same `type` and `kind` as `start`. This argument is `intent(in)`. `n`: Shall be an integer specifying the length of the output. This argument is `optional` and `intent(in)`. -`base` : Shall be a scalar of any numeric type. This argument is `optional` and `intent(in)` +`base` : Shall be a scalar of any numeric type. All kinds are supported for real and complex arguments. For integers, only the default kind is currently implemented. This argument is `optional` and `intent(in)`. #### Output value or Result value -The output is a rank 1 array of `type` and `kind`, whose length is either 50 (default value) or `n`. +The output is a rank 1 array whose length is either 50 (default value) or `n`. If `n` == 1, return a rank 1 array whose only element is `base`^`end`. If `n` <= 0, return a rank 1 array with length 0 +The `type` and `kind` of the output is dependent on the `type` and `kind` of the passed parameters. + +For function calls where the `base` is not specified: `logspace(start, end)`/`logspace(start, end, n)`, the `type` and `kind` of +the output follows the same scheme as above for `linspace`. +>If `start`/`end` are real or complex types, the `result` will be the same `type` and `kind` as `start`/`end`. +>If `start`/`end` are integer types, the `result` will default to a double precision real array. + +For function calls where the `base` is specified, the `type` and `kind` of the result is in accordance with the following table: + +| `start`/`end` | `n` | `base` | `output` | +| ------------- | --- | ------ | -------- | +| `real(KIND)` | `Integer` | `real(KIND)` | `real(KIND)` | +| " " | " " | `complex(KIND)` | `complex(KIND)` | +| " " | " " | `Integer` | `real(KIND)` | +| `complex(KIND)` | " " | `real(KIND)` | `complex(KIND)` | +| " " | " " | `complex(KIND)` | `complex(KIND)` | +| " " | " " | `Integer` | `complex(KIND)` | +| `Integer` | " " | `real(KIND)` | `real(KIND)` | +| " " | " " | `complex(KIND)` | `complex(KIND)` | +| " " | " " | `Integer` | `Integer` | + #### Examples ##### Example 1: -Here inputs are of type `complex` and kind `dp` +Here inputs are of type `complex` and kind `dp`. `n` and `base` is not specified and thus default to 50 and 10, respectively. ```fortran program demo_logspace_complex use stdlib_math, only: logspace use stdlib_kinds, only: dp implicit none - complex(dp) :: start = complex(10.0_dp, 5.0_dp) - complex(dp) :: end = complex(-10.0_dp, 15.0_dp) + complex(dp) :: start = (10.0_dp, 5.0_dp) + complex(dp) :: end = (-10.0_dp, 15.0_dp) - complex(dp) :: z(11) + complex(dp) :: z(11) ! Complex values raised to complex powers results in complex values z = logspace(start, end, 11) end program demo_logspace_complex @@ -214,18 +238,40 @@ end program demo_logspace_complex ##### Example 2: -Here inputs are of type `integer` and kind `int16` +Here inputs are of type `integer` and default kind. `base` is not specified and thus defaults to 10. ```fortran -program demo_logspace_int16 +program demo_logspace_int use stdlib_math, only: logspace - use stdlib_kinds, only: int16 + use stdlib_kinds, only: dp implicit none - integer(int16) :: start = 10_int16 - integer(int16) :: end = 23_int16 + integer :: start = 10 + integer :: end = 23 + integer :: n = 15 + + real(dp) :: r(n) ! Integer values raised to real powers results in real values + + r = logspace(start, end, n) +end program demo_logspace_int +``` + +##### Example 3: + +Here `start`/`end` are of type `real` and double precision. `base` is type `complex` and also double precision. +```fortran +program demo_logspace_rstart_cbase + use stdlib_math, only: logspace + use stdlib_kinds, only: dp + implicit none + + real(dp) :: start = 0.0_dp + real(dp) :: end = 3.0_dp + integer :: n = 4 + complex(dp) :: base = (0.0_dp, 1.0_dp) + + complex(dp) :: z(n) ! complex values raised to real powers result in complex values - integer(int16) :: r(15) + z = logspace(start, end, n, base) - r = logspace(start, end, 15) -end program demo_logspace_int16 +end program demo_logspace_rstart_cbase ``` diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 83d7f7ac0..e4d669e5b 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -156,7 +156,8 @@ module stdlib_math #:for k1, t1 in REAL_KINDS_TYPES ! Generate logarithmically spaced sequence from ${k1}$ base to the powers ! of ${k1}$ start and end. [base^start, ... , base^end] - ! RName = ${RName}$ + ! Different combinations of parameter types will lead to different result types. + ! Those combinations are indicated in the body of each function. #:set RName = rname("logspace", 1, t1, k1, "n_rbase") module function ${RName}$(start, end, n, base) result(res) ${t1}$, intent(in) :: start @@ -192,7 +193,8 @@ module stdlib_math #:for k1, t1 in CMPLX_KINDS_TYPES ! Generate logarithmically spaced sequence from ${k1}$ base to the powers ! of ${k1}$ start and end. [base^start, ... , base^end] - ! RName = ${RName}$ + ! Different combinations of parameter types will lead to different result types. + ! Those combinations are indicated in the body of each function. #:set RName = rname("logspace", 1, t1, k1, "n_rbase") module function ${RName}$(start, end, n, base) result(res) ${t1}$, intent(in) :: start @@ -225,9 +227,11 @@ module stdlib_math #:endfor #! ======================================================== #! ======================================================== + #! Provide support for Integer start/endpoints ! Generate logarithmically spaced sequence from ${k1}$ base to the powers ! of ${k1}$ start and end. [base^start, ... , base^end] - ! RName = ${RName}$ + ! Different combinations of parameter types will lead to different result types. + ! Those combinations are indicated in the body of each function. #:for k1 in REAL_KINDS #:set RName = rname("logspace", 1, "integer(int32)", "int32", "n_r" + str(k1) + "base") module function ${RName}$(start, end, n, base) result(res) From d428ad8fe4ecfd976c49bd276c2cedec0f4448d6 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 16:37:37 -0400 Subject: [PATCH 80/89] Add appropriate tolerance level Demand a lower tolerance value for higher precision tests --- src/tests/math/test_linspace.f90 | 21 +++++++++++---------- src/tests/math/test_logspace.f90 | 15 ++++++++------- 2 files changed, 19 insertions(+), 17 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index c2dd09bfa..7f07ff571 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -7,7 +7,8 @@ program test_linspace integer :: iunit logical :: warn = .false. - real(dp), parameter :: TOLERANCE = 0.00001 ! Percentage of the range for which the actual gap must not exceed + real(sp), parameter :: TOLERANCE_SP = 1000 * epsilon(1.0_sp) + real(dp), parameter :: TOLERANCE_DP = 1000 * epsilon(1.0_dp) ! Percentage of the range for which the actual gap must not exceed ! Testing linspace. ! @@ -63,7 +64,7 @@ subroutine test_linspace_sp do i = 1, n-1 true_difference = x(i + 1) - x(i) - call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE_SP) end do @@ -92,7 +93,7 @@ subroutine test_linspace_dp do i = 1, n-1 true_difference = x(i + 1) - x(i) - call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs(true_difference - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do @@ -133,7 +134,7 @@ subroutine test_linspace_cmplx ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do @@ -172,7 +173,7 @@ subroutine test_linspace_cmplx_2 ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do @@ -211,7 +212,7 @@ subroutine test_linspace_cmplx_3 ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do @@ -250,7 +251,7 @@ subroutine test_linspace_cmplx_sp ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_SP) end do @@ -293,7 +294,7 @@ subroutine test_linspace_cmplx_sp_2 true_interval = (z(i + 1) - z(i)) offset = abs(true_interval - expected_interval) - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_SP) ! print *, i end do @@ -333,7 +334,7 @@ subroutine test_linspace_int16 ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do @@ -375,7 +376,7 @@ subroutine test_linspace_int8 ! Due to roundoff error, it is possible that the jump from x(n-1) to x(n) is slightly different than the expected interval do i = 1, n-1 - call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE) + call check(abs( ( z(i + 1) - z(i) ) - expected_interval) < abs(expected_interval) * TOLERANCE_DP) end do diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 index 2da8b3dc5..b268d77d3 100644 --- a/src/tests/math/test_logspace.f90 +++ b/src/tests/math/test_logspace.f90 @@ -19,7 +19,8 @@ program test_logspace ! Also test to verify that the proportion between adjacent elements is constant within ! a certain tolerance - real(dp), parameter :: TOLERANCE = 0.00001 + real(sp), parameter :: TOLERANCE_SP = 1000 * epsilon(1.0_sp) + real(dp), parameter :: TOLERANCE_DP = 1000 * epsilon(1.0_dp) ! Percentage of the range for which the actual gap must not exceed open(newunit=iunit, file="test_logspace_log.txt", status="unknown") ! Log the results of the function @@ -57,7 +58,7 @@ subroutine test_logspace_sp do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_SP) end do @@ -93,7 +94,7 @@ subroutine test_logspace_dp do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_DP) end do @@ -128,7 +129,7 @@ subroutine test_logspace_default do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_DP) end do @@ -163,7 +164,7 @@ subroutine test_logspace_base_2 do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_DP) end do @@ -199,7 +200,7 @@ subroutine test_logspace_base_2_cmplx_start do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_DP) end do @@ -234,7 +235,7 @@ subroutine test_logspace_base_i_int_start do i = 1, n-1 - call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE) + call check(abs(x(i + 1) / x(i) - expected_proportion) < abs(expected_proportion) * TOLERANCE_DP) end do From dd4e9350d87ed7ba46b29a9562ad5f1f94eec1aa Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Mon, 12 Jul 2021 16:41:58 -0400 Subject: [PATCH 81/89] Update src/stdlib_math.fypp Co-authored-by: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> --- src/stdlib_math.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index e4d669e5b..624569c86 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -16,9 +16,9 @@ module stdlib_math integer, parameter :: DEFAULT_LOGSPACE_BASE = 10 ! Useful constants for lnspace - real(sp), parameter :: EULERS_NUMBER_SP = 2.71828182845904523536028747135266249775724709369995_sp - real(dp), parameter :: EULERS_NUMBER_DP = 2.71828182845904523536028747135266249775724709369995_dp - real(qp), parameter :: EULERS_NUMBER_QP = 2.71828182845904523536028747135266249775724709369995_qp + real(sp), parameter :: EULERS_NUMBER_SP = exp(1.0_sp) + real(dp), parameter :: EULERS_NUMBER_DP = exp(1.0_dp) + real(qp), parameter :: EULERS_NUMBER_QP = exp(1.0_qp) interface clip #:for k1, t1 in IR_KINDS_TYPES From 2caeab33d8c035b118090e75b0772539844f6def Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 13 Jul 2021 21:16:20 -0400 Subject: [PATCH 82/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index c92c73654..af53837af 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -122,7 +122,7 @@ The output is a rank 1 array whose length is either 100 (default value) or `n`. If `n` == 1, return a rank 1 array whose only element is `end`. If `n` <= 0, return a rank 1 array with length 0. -If `start`/`end` are real or complex types, the `result` will be the same `type` and `kind` as `start`/`end`. +If `start`/`end` are `real` or `complex` types, the `result` will be of the same type and kind as `start`/`end`. If `start`/`end` are integer types, the `result` will default to a double precision real array. #### Examples From 105d92d0f18a7d66760352e995ab2271a54925c6 Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Tue, 13 Jul 2021 21:18:43 -0400 Subject: [PATCH 83/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index af53837af..69703744d 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -199,7 +199,7 @@ The `type` and `kind` of the output is dependent on the `type` and `kind` of the For function calls where the `base` is not specified: `logspace(start, end)`/`logspace(start, end, n)`, the `type` and `kind` of the output follows the same scheme as above for `linspace`. ->If `start`/`end` are real or complex types, the `result` will be the same `type` and `kind` as `start`/`end`. +>If `start`/`end` are `real` or `complex` types, the `result` will be the same type and kind as `start`/`end`. >If `start`/`end` are integer types, the `result` will default to a double precision real array. For function calls where the `base` is specified, the `type` and `kind` of the result is in accordance with the following table: From 17c81f8b3a0453ceb877ef27987fb215600c959f Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Wed, 14 Jul 2021 10:01:00 -0400 Subject: [PATCH 84/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index 69703744d..ab34d01ef 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -123,7 +123,7 @@ If `n` == 1, return a rank 1 array whose only element is `end`. If `n` <= 0, return a rank 1 array with length 0. If `start`/`end` are `real` or `complex` types, the `result` will be of the same type and kind as `start`/`end`. -If `start`/`end` are integer types, the `result` will default to a double precision real array. +If `start`/`end` are `integer` types, the `result` will default to a `real(dp)` array. #### Examples From 646bee89df198e9647a4beea8d99ba7a5b984dfb Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Wed, 14 Jul 2021 10:01:11 -0400 Subject: [PATCH 85/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index ab34d01ef..ad4b1e2ca 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -147,7 +147,7 @@ end program demo_linspace_complex ##### Example 2: -Here inputs are of type `integer` and kind `int16`, with the result defaulting to double precision real. +Here inputs are of type `integer` and kind `int16`, with the result defaulting to `real(dp)`. ```fortran program demo_linspace_int16 use stdlib_math, only: linspace From 50a0242824165c87e5bce62ff1369fe8f45c06cc Mon Sep 17 00:00:00 2001 From: Evan Voyles Date: Wed, 14 Jul 2021 10:01:26 -0400 Subject: [PATCH 86/89] Update doc/specs/stdlib_math.md Co-authored-by: Jeremie Vandenplas --- doc/specs/stdlib_math.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index ad4b1e2ca..2e09796de 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -200,7 +200,7 @@ The `type` and `kind` of the output is dependent on the `type` and `kind` of the For function calls where the `base` is not specified: `logspace(start, end)`/`logspace(start, end, n)`, the `type` and `kind` of the output follows the same scheme as above for `linspace`. >If `start`/`end` are `real` or `complex` types, the `result` will be the same type and kind as `start`/`end`. ->If `start`/`end` are integer types, the `result` will default to a double precision real array. +>If `start`/`end` are integer types, the `result` will default to a `real(dp)` array. For function calls where the `base` is specified, the `type` and `kind` of the result is in accordance with the following table: From 6e451655ea539261e48d710551c45ed7526a753c Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 20 Jul 2021 13:56:10 -0400 Subject: [PATCH 87/89] Update src/stdlib_math.fypp --- src/stdlib_math.fypp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index 624569c86..c58ab027d 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -56,7 +56,6 @@ module stdlib_math ! Add support for integer linspace - !! Version: Experimental !! !! Create rank 1 array of linearly spaced elements from start to end. !! If the number of elements is not specified, create an array with size 100. If n is a negative value, From f9b2640db0671986610df698b822475d43a34f82 Mon Sep 17 00:00:00 2001 From: Jeremie Vandenplas Date: Tue, 20 Jul 2021 13:56:30 -0400 Subject: [PATCH 88/89] Update src/stdlib_math.fypp --- src/stdlib_math.fypp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/stdlib_math.fypp b/src/stdlib_math.fypp index c58ab027d..eae02ccc7 100644 --- a/src/stdlib_math.fypp +++ b/src/stdlib_math.fypp @@ -57,12 +57,7 @@ module stdlib_math ! Add support for integer linspace !! - !! Create rank 1 array of linearly spaced elements from start to end. - !! If the number of elements is not specified, create an array with size 100. If n is a negative value, - !! return an array with size 0. If n = 1, return a rank 1 array whose only element is end. When dealing with integers as the `start` and `end` - !! parameters, the return type is always a `real(dp)`. - !! - !!([Specification](../page/specs/stdlib_math.html#linspace-create-a-linearly-spaced-rank-one-array)) + !! When dealing with integers as the `start` and `end` parameters, the return type is always a `real(dp)`. #:for k1, t1 in INT_KINDS_TYPES #:set RName = rname("linspace_default", 1, t1, k1) #! The interface for INT_KINDS_TYPES cannot be combined with RC_KINDS_TYPES From f51b67faac3131ba8817b6532086b968d07df19c Mon Sep 17 00:00:00 2001 From: "Evan Voyles (linux laptop)" Date: Tue, 20 Jul 2021 15:51:17 -0400 Subject: [PATCH 89/89] Clean up format statements --- src/tests/math/test_linspace.f90 | 36 ++++++++++---------------------- src/tests/math/test_logspace.f90 | 20 +++++------------- 2 files changed, 16 insertions(+), 40 deletions(-) diff --git a/src/tests/math/test_linspace.f90 b/src/tests/math/test_linspace.f90 index 7f07ff571..25e5b9202 100644 --- a/src/tests/math/test_linspace.f90 +++ b/src/tests/math/test_linspace.f90 @@ -139,15 +139,13 @@ subroutine test_linspace_cmplx end do write(unit=iunit, fmt=*) "linspace((0.0_dp, 10.0_dp), (1.0_dp, 0.0_dp), 10): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_cmplx_2 @@ -178,15 +176,13 @@ subroutine test_linspace_cmplx_2 end do write(unit=iunit, fmt=*) "linspace((10.0_dp, 10.0_dp), (1.0_dp, 1.0_dp), 5): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_cmplx_3 @@ -217,15 +213,13 @@ subroutine test_linspace_cmplx_3 end do write(unit=iunit, fmt=*) "linspace((-5.0_dp, 100.0_dp), (20.0_dp, 13.0_dp), 20): " - write(unit=iunit,fmt=99) - do i = 1, 20 + write(unit=iunit,fmt='(70("="))') + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_cmplx_sp @@ -256,15 +250,13 @@ subroutine test_linspace_cmplx_sp end do write(unit=iunit, fmt=*) "linspace((0.5_sp, 5.0_sp), (1.0_sp, -30.0_sp), 10): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_cmplx_sp_2 @@ -300,15 +292,13 @@ subroutine test_linspace_cmplx_sp_2 end do write(unit=iunit, fmt=*) "linspace((50.0_sp, 500.0_sp), (-100.0_sp, 2000.0_sp)): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_int16 @@ -339,15 +329,13 @@ subroutine test_linspace_int16 end do write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " - write(unit=iunit,fmt=99) - do i = 1, 6 + write(unit=iunit,fmt='(70("="))') + do i = 1, n write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_linspace_int8 @@ -381,15 +369,13 @@ subroutine test_linspace_int8 end do write(unit=iunit, fmt=*) "linspace(5_int16, 10_int16, 10): " - write(unit=iunit,fmt=99) - do i = 1, 10 - write(unit=iunit,fmt=*) z_int(i) + write(unit=iunit,fmt='(70("="))') + do i = 1, n + write(unit=iunit,fmt=*) z(i) end do write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine diff --git a/src/tests/math/test_logspace.f90 b/src/tests/math/test_logspace.f90 index b268d77d3..57196ead6 100644 --- a/src/tests/math/test_logspace.f90 +++ b/src/tests/math/test_logspace.f90 @@ -64,13 +64,11 @@ subroutine test_logspace_sp write(unit=iunit, fmt=*) "logspace(0.0_sp, 2.0_sp, 20): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') write(unit=iunit,fmt="(20(F7.3, 2X))") x write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_logspace_dp @@ -134,13 +132,11 @@ subroutine test_logspace_default end do write(unit=iunit, fmt=*) "logspace(0.0_dp, 1.0_dp): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') write(unit=iunit,fmt="(50(F7.3, 2X))") x write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_logspace_base_2 @@ -169,13 +165,11 @@ subroutine test_logspace_base_2 end do write(unit=iunit, fmt=*) "logspace(1.0_dp, 10.0_dp, 10, 2): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') write(unit=iunit,fmt="(10(F9.3, 2X))") x write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_logspace_base_2_cmplx_start @@ -205,13 +199,11 @@ subroutine test_logspace_base_2_cmplx_start end do write(unit=iunit, fmt=*) "logspace(1, i, 10, 2): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') write(unit=iunit,fmt="(10('(', F6.3, ',', 1X, F6.3, ')', 2X))") x write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine subroutine test_logspace_base_i_int_start @@ -240,13 +232,11 @@ subroutine test_logspace_base_i_int_start end do write(unit=iunit, fmt=*) "logspace(1, 5, 5, i): " - write(unit=iunit,fmt=99) + write(unit=iunit,fmt='(70("="))') write(unit=iunit,fmt="(10('(', F6.3, ',', 1X, F6.3, ')', 2X))") x write(iunit,*) write(iunit,*) - 99 format(70("=")) - end subroutine