Skip to content

Commit 5a659c8

Browse files
jvdp1jvdp1
committed
Deploying to stdlib-fpm from @ 2601bf1 🚀
1 parent d048371 commit 5a659c8

File tree

4 files changed

+337
-5
lines changed

4 files changed

+337
-5
lines changed

‎src/stdlib_math.f90‎

Lines changed: 115 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ module stdlib_math
88
public :: clip, gcd, linspace, logspace
99
public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP
1010
public :: DEFAULT_LINSPACE_LENGTH, DEFAULT_LOGSPACE_BASE, DEFAULT_LOGSPACE_LENGTH
11-
public :: arange
11+
public :: arange, is_close, all_close
1212

1313
integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100
1414
integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50
@@ -454,6 +454,120 @@ pure module function arange_i_int64(start, end, step) result(result)
454454
end function arange_i_int64
455455
end interface arange
456456

457+
!> Version: experimental
458+
!>
459+
!> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance.
460+
!> ([Specification](../page/specs/stdlib_math.html#is_close))
461+
interface is_close
462+
elemental module logical function is_close_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
463+
real(sp), intent(in) :: a, b
464+
real(sp), intent(in), optional :: rel_tol, abs_tol
465+
logical, intent(in), optional :: equal_nan
466+
end function is_close_rsp
467+
elemental module logical function is_close_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
468+
real(dp), intent(in) :: a, b
469+
real(dp), intent(in), optional :: rel_tol, abs_tol
470+
logical, intent(in), optional :: equal_nan
471+
end function is_close_rdp
472+
elemental module logical function is_close_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
473+
complex(sp), intent(in) :: a, b
474+
real(sp), intent(in), optional :: rel_tol, abs_tol
475+
logical, intent(in), optional :: equal_nan
476+
end function is_close_csp
477+
elemental module logical function is_close_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
478+
complex(dp), intent(in) :: a, b
479+
real(dp), intent(in), optional :: rel_tol, abs_tol
480+
logical, intent(in), optional :: equal_nan
481+
end function is_close_cdp
482+
end interface is_close
483+
484+
!> Version: experimental
485+
!>
486+
!> Returns a boolean scalar where two arrays are element-wise equal within a tolerance.
487+
!> ([Specification](../page/specs/stdlib_math.html#all_close))
488+
interface all_close
489+
logical pure module function all_close_1_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
490+
real(sp), intent(in) :: a(:), b(:)
491+
real(sp), intent(in), optional :: rel_tol, abs_tol
492+
logical, intent(in), optional :: equal_nan
493+
end function all_close_1_rsp
494+
logical pure module function all_close_2_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
495+
real(sp), intent(in) :: a(:,:), b(:,:)
496+
real(sp), intent(in), optional :: rel_tol, abs_tol
497+
logical, intent(in), optional :: equal_nan
498+
end function all_close_2_rsp
499+
logical pure module function all_close_3_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
500+
real(sp), intent(in) :: a(:,:,:), b(:,:,:)
501+
real(sp), intent(in), optional :: rel_tol, abs_tol
502+
logical, intent(in), optional :: equal_nan
503+
end function all_close_3_rsp
504+
logical pure module function all_close_4_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
505+
real(sp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
506+
real(sp), intent(in), optional :: rel_tol, abs_tol
507+
logical, intent(in), optional :: equal_nan
508+
end function all_close_4_rsp
509+
logical pure module function all_close_1_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
510+
real(dp), intent(in) :: a(:), b(:)
511+
real(dp), intent(in), optional :: rel_tol, abs_tol
512+
logical, intent(in), optional :: equal_nan
513+
end function all_close_1_rdp
514+
logical pure module function all_close_2_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
515+
real(dp), intent(in) :: a(:,:), b(:,:)
516+
real(dp), intent(in), optional :: rel_tol, abs_tol
517+
logical, intent(in), optional :: equal_nan
518+
end function all_close_2_rdp
519+
logical pure module function all_close_3_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
520+
real(dp), intent(in) :: a(:,:,:), b(:,:,:)
521+
real(dp), intent(in), optional :: rel_tol, abs_tol
522+
logical, intent(in), optional :: equal_nan
523+
end function all_close_3_rdp
524+
logical pure module function all_close_4_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
525+
real(dp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
526+
real(dp), intent(in), optional :: rel_tol, abs_tol
527+
logical, intent(in), optional :: equal_nan
528+
end function all_close_4_rdp
529+
logical pure module function all_close_1_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
530+
complex(sp), intent(in) :: a(:), b(:)
531+
real(sp), intent(in), optional :: rel_tol, abs_tol
532+
logical, intent(in), optional :: equal_nan
533+
end function all_close_1_csp
534+
logical pure module function all_close_2_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
535+
complex(sp), intent(in) :: a(:,:), b(:,:)
536+
real(sp), intent(in), optional :: rel_tol, abs_tol
537+
logical, intent(in), optional :: equal_nan
538+
end function all_close_2_csp
539+
logical pure module function all_close_3_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
540+
complex(sp), intent(in) :: a(:,:,:), b(:,:,:)
541+
real(sp), intent(in), optional :: rel_tol, abs_tol
542+
logical, intent(in), optional :: equal_nan
543+
end function all_close_3_csp
544+
logical pure module function all_close_4_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
545+
complex(sp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
546+
real(sp), intent(in), optional :: rel_tol, abs_tol
547+
logical, intent(in), optional :: equal_nan
548+
end function all_close_4_csp
549+
logical pure module function all_close_1_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
550+
complex(dp), intent(in) :: a(:), b(:)
551+
real(dp), intent(in), optional :: rel_tol, abs_tol
552+
logical, intent(in), optional :: equal_nan
553+
end function all_close_1_cdp
554+
logical pure module function all_close_2_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
555+
complex(dp), intent(in) :: a(:,:), b(:,:)
556+
real(dp), intent(in), optional :: rel_tol, abs_tol
557+
logical, intent(in), optional :: equal_nan
558+
end function all_close_2_cdp
559+
logical pure module function all_close_3_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
560+
complex(dp), intent(in) :: a(:,:,:), b(:,:,:)
561+
real(dp), intent(in), optional :: rel_tol, abs_tol
562+
logical, intent(in), optional :: equal_nan
563+
end function all_close_3_cdp
564+
logical pure module function all_close_4_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
565+
complex(dp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
566+
real(dp), intent(in), optional :: rel_tol, abs_tol
567+
logical, intent(in), optional :: equal_nan
568+
end function all_close_4_cdp
569+
end interface all_close
570+
457571
contains
458572

459573
elemental function clip_int8(x, xmin, xmax) result(res)

‎src/stdlib_math_all_close.f90‎

Lines changed: 153 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
2+
submodule (stdlib_math) stdlib_math_all_close
3+
4+
implicit none
5+
6+
contains
7+
8+
logical pure module function all_close_1_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
9+
10+
real(sp), intent(in) :: a(:), b(:)
11+
real(sp), intent(in), optional :: rel_tol, abs_tol
12+
logical, intent(in), optional :: equal_nan
13+
14+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
15+
16+
end function all_close_1_rsp
17+
logical pure module function all_close_2_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
18+
19+
real(sp), intent(in) :: a(:,:), b(:,:)
20+
real(sp), intent(in), optional :: rel_tol, abs_tol
21+
logical, intent(in), optional :: equal_nan
22+
23+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
24+
25+
end function all_close_2_rsp
26+
logical pure module function all_close_3_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
27+
28+
real(sp), intent(in) :: a(:,:,:), b(:,:,:)
29+
real(sp), intent(in), optional :: rel_tol, abs_tol
30+
logical, intent(in), optional :: equal_nan
31+
32+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
33+
34+
end function all_close_3_rsp
35+
logical pure module function all_close_4_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
36+
37+
real(sp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
38+
real(sp), intent(in), optional :: rel_tol, abs_tol
39+
logical, intent(in), optional :: equal_nan
40+
41+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
42+
43+
end function all_close_4_rsp
44+
logical pure module function all_close_1_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
45+
46+
real(dp), intent(in) :: a(:), b(:)
47+
real(dp), intent(in), optional :: rel_tol, abs_tol
48+
logical, intent(in), optional :: equal_nan
49+
50+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
51+
52+
end function all_close_1_rdp
53+
logical pure module function all_close_2_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
54+
55+
real(dp), intent(in) :: a(:,:), b(:,:)
56+
real(dp), intent(in), optional :: rel_tol, abs_tol
57+
logical, intent(in), optional :: equal_nan
58+
59+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
60+
61+
end function all_close_2_rdp
62+
logical pure module function all_close_3_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
63+
64+
real(dp), intent(in) :: a(:,:,:), b(:,:,:)
65+
real(dp), intent(in), optional :: rel_tol, abs_tol
66+
logical, intent(in), optional :: equal_nan
67+
68+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
69+
70+
end function all_close_3_rdp
71+
logical pure module function all_close_4_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
72+
73+
real(dp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
74+
real(dp), intent(in), optional :: rel_tol, abs_tol
75+
logical, intent(in), optional :: equal_nan
76+
77+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
78+
79+
end function all_close_4_rdp
80+
logical pure module function all_close_1_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
81+
82+
complex(sp), intent(in) :: a(:), b(:)
83+
real(sp), intent(in), optional :: rel_tol, abs_tol
84+
logical, intent(in), optional :: equal_nan
85+
86+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
87+
88+
end function all_close_1_csp
89+
logical pure module function all_close_2_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
90+
91+
complex(sp), intent(in) :: a(:,:), b(:,:)
92+
real(sp), intent(in), optional :: rel_tol, abs_tol
93+
logical, intent(in), optional :: equal_nan
94+
95+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
96+
97+
end function all_close_2_csp
98+
logical pure module function all_close_3_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
99+
100+
complex(sp), intent(in) :: a(:,:,:), b(:,:,:)
101+
real(sp), intent(in), optional :: rel_tol, abs_tol
102+
logical, intent(in), optional :: equal_nan
103+
104+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
105+
106+
end function all_close_3_csp
107+
logical pure module function all_close_4_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
108+
109+
complex(sp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
110+
real(sp), intent(in), optional :: rel_tol, abs_tol
111+
logical, intent(in), optional :: equal_nan
112+
113+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
114+
115+
end function all_close_4_csp
116+
logical pure module function all_close_1_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
117+
118+
complex(dp), intent(in) :: a(:), b(:)
119+
real(dp), intent(in), optional :: rel_tol, abs_tol
120+
logical, intent(in), optional :: equal_nan
121+
122+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
123+
124+
end function all_close_1_cdp
125+
logical pure module function all_close_2_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
126+
127+
complex(dp), intent(in) :: a(:,:), b(:,:)
128+
real(dp), intent(in), optional :: rel_tol, abs_tol
129+
logical, intent(in), optional :: equal_nan
130+
131+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
132+
133+
end function all_close_2_cdp
134+
logical pure module function all_close_3_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
135+
136+
complex(dp), intent(in) :: a(:,:,:), b(:,:,:)
137+
real(dp), intent(in), optional :: rel_tol, abs_tol
138+
logical, intent(in), optional :: equal_nan
139+
140+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
141+
142+
end function all_close_3_cdp
143+
logical pure module function all_close_4_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
144+
145+
complex(dp), intent(in) :: a(:,:,:,:), b(:,:,:,:)
146+
real(dp), intent(in), optional :: rel_tol, abs_tol
147+
logical, intent(in), optional :: equal_nan
148+
149+
close = all(is_close(a, b, rel_tol, abs_tol, equal_nan))
150+
151+
end function all_close_4_cdp
152+
153+
end submodule stdlib_math_all_close

‎src/stdlib_math_arange.f90‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ pure module function arange_i_int8(start, end, step) result(result)
6161
step_ = optval(step, 1_int8)
6262
step_ = sign(merge(step_, 1_int8, step_ /= 0_int8), end_ - start_)
6363

64-
allocate(result((end_ - start_)/step_ + 1))
64+
allocate(result((end_ - start_)/step_ + 1_int8))
6565

6666
result = [(i, i=start_, end_, step_)]
6767

@@ -82,7 +82,7 @@ pure module function arange_i_int16(start, end, step) result(result)
8282
step_ = optval(step, 1_int16)
8383
step_ = sign(merge(step_, 1_int16, step_ /= 0_int16), end_ - start_)
8484

85-
allocate(result((end_ - start_)/step_ + 1))
85+
allocate(result((end_ - start_)/step_ + 1_int16))
8686

8787
result = [(i, i=start_, end_, step_)]
8888

@@ -103,7 +103,7 @@ pure module function arange_i_int32(start, end, step) result(result)
103103
step_ = optval(step, 1_int32)
104104
step_ = sign(merge(step_, 1_int32, step_ /= 0_int32), end_ - start_)
105105

106-
allocate(result((end_ - start_)/step_ + 1))
106+
allocate(result((end_ - start_)/step_ + 1_int32))
107107

108108
result = [(i, i=start_, end_, step_)]
109109

@@ -124,7 +124,7 @@ pure module function arange_i_int64(start, end, step) result(result)
124124
step_ = optval(step, 1_int64)
125125
step_ = sign(merge(step_, 1_int64, step_ /= 0_int64), end_ - start_)
126126

127-
allocate(result((end_ - start_)/step_ + 1))
127+
allocate(result((end_ - start_)/step_ + 1_int64))
128128

129129
result = [(i, i=start_, end_, step_)]
130130

‎src/stdlib_math_is_close.f90‎

Lines changed: 65 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,65 @@
1+
2+
submodule(stdlib_math) stdlib_math_is_close
3+
4+
use, intrinsic :: ieee_arithmetic, only: ieee_is_nan
5+
implicit none
6+
7+
real(sp), parameter :: sqrt_eps_sp = sqrt(epsilon(1.0_sp))
8+
real(dp), parameter :: sqrt_eps_dp = sqrt(epsilon(1.0_dp))
9+
10+
contains
11+
12+
13+
elemental module logical function is_close_rsp(a, b, rel_tol, abs_tol, equal_nan) result(close)
14+
real(sp), intent(in) :: a, b
15+
real(sp), intent(in), optional :: rel_tol, abs_tol
16+
logical, intent(in), optional :: equal_nan
17+
logical :: equal_nan_
18+
19+
equal_nan_ = optval(equal_nan, .false.)
20+
21+
if (ieee_is_nan(a) .or. ieee_is_nan(b)) then
22+
close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b))
23+
else
24+
close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_sp)*max(abs(a), abs(b))), &
25+
abs(optval(abs_tol, 0.0_sp)) )
26+
end if
27+
28+
end function is_close_rsp
29+
elemental module logical function is_close_rdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
30+
real(dp), intent(in) :: a, b
31+
real(dp), intent(in), optional :: rel_tol, abs_tol
32+
logical, intent(in), optional :: equal_nan
33+
logical :: equal_nan_
34+
35+
equal_nan_ = optval(equal_nan, .false.)
36+
37+
if (ieee_is_nan(a) .or. ieee_is_nan(b)) then
38+
close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b))
39+
else
40+
close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_dp)*max(abs(a), abs(b))), &
41+
abs(optval(abs_tol, 0.0_dp)) )
42+
end if
43+
44+
end function is_close_rdp
45+
46+
elemental module logical function is_close_csp(a, b, rel_tol, abs_tol, equal_nan) result(close)
47+
complex(sp), intent(in) :: a, b
48+
real(sp), intent(in), optional :: rel_tol, abs_tol
49+
logical, intent(in), optional :: equal_nan
50+
51+
close = is_close_rsp(a%re, b%re, rel_tol, abs_tol, equal_nan) .and. &
52+
is_close_rsp(a%im, b%im, rel_tol, abs_tol, equal_nan)
53+
54+
end function is_close_csp
55+
elemental module logical function is_close_cdp(a, b, rel_tol, abs_tol, equal_nan) result(close)
56+
complex(dp), intent(in) :: a, b
57+
real(dp), intent(in), optional :: rel_tol, abs_tol
58+
logical, intent(in), optional :: equal_nan
59+
60+
close = is_close_rdp(a%re, b%re, rel_tol, abs_tol, equal_nan) .and. &
61+
is_close_rdp(a%im, b%im, rel_tol, abs_tol, equal_nan)
62+
63+
end function is_close_cdp
64+
65+
end submodule stdlib_math_is_close

0 commit comments

Comments
 (0)