Add all_close function in stdlib_math.

Author: zoziha

doc/specs/stdlib_math.md

@@ -405,4 +405,64 @@ program demo_math_is_close
     call check(all(is_close(x, [2.0, 2.0])), msg="all(is_close(x, [2.0, 2.0])) failed.", warn=.true.)
         !! all(is_close(x, [2.0, 2.0])) failed.
 end program demo_math_is_close
-```
+```
+
+### `all_close`
+
+#### Description
+
+Returns a boolean scalar where two arrays are element-wise equal within a tolerance, behaves like `all(is_close(a, b [, rel_tol, abs_tol]))`.
+
+#### Syntax
+
+`bool = [[stdlib_math(module):all_close(interface)]] (a, b [, rel_tol, abs_tol])`
+
+#### Status
+
+Experimental.
+
+#### Class
+
+Impure function.
+
+#### Arguments
+
+`a`: Shall be a `real/complex` array.
+This argument is `intent(in)`.
+
+`b`: Shall be a `real/complex` array.
+This argument is `intent(in)`.
+
+`rel_tol`: Shall be a `real` scalar.
+This argument is `intent(in)` and `optional`, which is `1.0e-9` by default.
+
+`abs_tol`: Shall be a `real` scalar.
+This argument is `intent(in)` and `optional`, which is `0.0` by default.
+
+Note: All `real/complex` arguments must have same `kind`.  
+If the value of `rel_tol/abs_tol` is negative (not recommended), 
+it will be corrected to `abs(rel_tol/abs_tol)` by the internal process of `all_close`.
+
+#### Result value
+
+Returns a `logical` scalar.
+
+#### Example
+
+```fortran
+program demo_math_all_close
+    use stdlib_math,  only: all_close
+    use stdlib_error, only: check
+    real    :: x(2) = [1, 2], random(4, 4)
+    complex :: z(4, 4)
+    
+    call check(all_close(x, [2.0, 2.0], rel_tol=1.0e-6, abs_tol=1.0e-3), &
+               msg="all_close(x, [2.0, 2.0]) failed.", warn=.true.)
+               !! all_close(x, [2.0, 2.0]) failed.
+
+    call random_number(random(4, 4))
+    z = 1.0
+    print *, all_close(z+1.0e-11*random, z)     !! T
+    
+end program demo_math_all_close
+```

src/CMakeLists.txt

@@ -34,6 +34,7 @@ set(fppFiles
     stdlib_math_logspace.fypp
     stdlib_math_arange.fypp
     stdlib_math_is_close.fypp
+    stdlib_math_all_close.fypp
     stdlib_string_type.fypp
     stdlib_string_type_constructor.fypp
     stdlib_strings_to_string.fypp

src/stdlib_math.fypp

@@ -11,7 +11,7 @@ module stdlib_math
     public :: clip, linspace, logspace
     public :: EULERS_NUMBER_SP, EULERS_NUMBER_DP, EULERS_NUMBER_QP
     public :: DEFAULT_LINSPACE_LENGTH, DEFAULT_LOGSPACE_BASE, DEFAULT_LOGSPACE_LENGTH
-    public :: arange, is_close
+    public :: arange, is_close, all_close
 
     integer, parameter :: DEFAULT_LINSPACE_LENGTH = 100
     integer, parameter :: DEFAULT_LOGSPACE_LENGTH = 50
@@ -281,7 +281,7 @@ module stdlib_math
 
     !> Version: experimental
     !>
-    !> Determines whether the values of `a` and `b` are close.
+    !> Returns a boolean scalar/array where two scalar/arrays are element-wise equal within a tolerance.
     !> ([Specification](../page/specs/stdlib_logic.html#is_close))
     interface is_close
         #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
@@ -294,6 +294,20 @@ module stdlib_math
         #:endfor
     end interface is_close
 
+    !> Version: experimental
+    !>
+    !> Returns a boolean scalar where two arrays are element-wise equal within a tolerance.
+    !> ([Specification](../page/specs/stdlib_logic.html#all_close))
+    interface all_close
+        #:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
+        #:for k1, t1 in RC_KINDS_TYPES
+        logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close)
+            ${t1}$, intent(in) :: a(..), b(..)
+            real(${k1}$), intent(in), optional :: rel_tol, abs_tol
+        end function all_close_${t1[0]}$${k1}$
+        #:endfor
+    end interface all_close
+
 contains
 
     #:for k1, t1 in IR_KINDS_TYPES

src/stdlib_math_all_close.fypp

@@ -0,0 +1,40 @@
+#:include "common.fypp"
+#:set RANKS = range(1, MAXRANK + 1)
+#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES
+
+submodule (stdlib_math) stdlib_math_all_close
+
+    implicit none
+    
+contains
+
+    #:def inrank(r1)
+        rank(${r1}$)
+            select rank(b)
+            rank(${r1}$)
+                close = all(is_close(a, b, rel_tol, abs_tol))
+            rank default
+                error stop "*<ERROR>* The ranks of `a` and `b` in `all_close` are not equal."
+            end select
+    #:enddef
+
+    #:for k1, t1 in RC_KINDS_TYPES
+    logical module function all_close_${t1[0]}$${k1}$(a, b, rel_tol, abs_tol) result(close)
+
+        ${t1}$, intent(in) :: a(..), b(..)
+        real(${k1}$), intent(in), optional :: rel_tol, abs_tol
+
+        select rank(a)
+
+        #:for r1 in RANKS
+        $:inrank(r1)
+        #:endfor
+
+        rank default
+            error stop "*<ERROR>* The rank of `a` in `all_close` is too large to be supported."
+        end select
+
+    end function all_close_${t1[0]}$${k1}$
+    #:endfor
+
+end submodule stdlib_math_all_close

src/tests/math/CMakeLists.txt

@@ -2,4 +2,5 @@ ADDTEST(stdlib_math)
 ADDTEST(linspace)
 ADDTEST(logspace)
 ADDTEST(math_arange)
-ADDTEST(math_is_close)
+ADDTEST(math_is_close)
+ADDTEST(math_all_close)

src/tests/math/Makefile.manual

@@ -1,6 +1,7 @@
 PROGS_SRC = test_stdlib_math.f90 test_linspace.f90 test_logspace.f90 \
     test_math_arange.f90 \
-    test_math_is_close.f90
+    test_math_is_close.f90 \
+    test_math_all_close.f90
 
 
 include ../Makefile.manual.test.mk

src/tests/math/test_math_all_close.f90

@@ -0,0 +1,38 @@
+program tester
+
+    use stdlib_math, only: all_close
+    use stdlib_error, only: check
+    implicit none
+    
+    call test_math_all_close_real
+    call test_math_all_close_complex
+    print *, "All tests in `test_math_all_close` passed."
+
+contains
+
+    subroutine test_math_all_close_real
+
+        real :: x(4, 4), random(4, 4)
+
+        call random_number(random)
+        x = 1.0
+
+        call check(all_close(x+1.0e-11*random, x), msg="REAL: all_close(x+1.0e-11*random, x) failed.")
+        call check(all_close(x+1.0e-5 *random, x), msg="REAL: all_close(x+1.0e-5 *random, x) failed.", warn=.true.)
+
+    end subroutine test_math_all_close_real
+
+    subroutine test_math_all_close_complex
+
+        real    :: random(4, 4)
+        complex :: x(4, 4)
+
+        call random_number(random)
+        x = 1.0
+
+        call check(all_close(x+1.0e-11*random, x), msg="CMPLX: all_close(x+1.0e-11*random, x)")
+        call check(all_close(x+1.0e-5 *random, x), msg="CMPLX: all_close(x+1.0e-5 *random, x) failed.", warn=.true.)
+
+    end subroutine test_math_all_close_complex
+
+end program tester