implemented clip function

doc/specs/stdlib_math.md

@@ -0,0 +1,92 @@
+---
+title: math
+---
+
+# The `stdlib_math` module
+
+[TOC]
+
+## Introduction
+
+`stdlib_math` module provides general purpose mathematical functions.
+
+
+## Procedures and Methods provided
+
+
+<!-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->
+### `clip` function
+
+#### 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`.  
+
+#### Syntax
+
+`res = [[stdlib_math(module):clip(interface)]] (x, xmin, xmax)`
+
+#### Status
+
+Experimental
+
+#### Class
+
+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)`.  
+`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`.
+
+#### Output value or Result value
+
+The output is a scalar of `type` and `kind` same as to that of the arguments.
+
+#### Examples
+
+##### Example 1:
+
+Here inputs are of type `integer` and kind `int32`
+```fortran
+program demo_clip_integer
+  use stdlib_math, only: clip
+  use stdlib_kinds, only: int32
+  implicit none
+  integer(int32) :: x
+  integer(int32) :: xmin
+  integer(int32) :: xmax
+  integer(int32) :: clipped_value
+
+  xmin = -5_int32
+  xmax = 5_int32
+  x = 12_int32
+
+  clipped_value = clip(x, xmin, xmax)
+  ! clipped_value <- 5
+end program demo_clip_integer
+```
+
+##### Example 2:
+
+Here inputs are of type `real` and kind `sp`
+```fortran
+program demo_clip_real
+  use stdlib_math, only: clip
+  use stdlib_kinds, only: sp
+  implicit none
+  real(sp) :: x
+  real(sp) :: xmin
+  real(sp) :: xmax
+  real(sp) :: clipped_value
+
+  xmin = -5.769_sp
+  xmax = 3.025_sp
+  x = 3.025_sp
+
+  clipped_value = clip(x, xmin, xmax)
+  ! clipped_value <- 3.02500010
+end program demo_clip_real
+```

src/CMakeLists.txt

@@ -23,6 +23,7 @@ set(fppFiles
     stdlib_quadrature_trapz.fypp
     stdlib_quadrature_simps.fypp
     stdlib_stats_distribution_PRNG.fypp
+    stdlib_math.fypp
     stdlib_string_type.fypp
 )
 

src/Makefile.manual

@@ -19,6 +19,7 @@ SRCFYPP =\
         stdlib_stats_moment_mask.fypp \
         stdlib_stats_moment_scalar.fypp \
         stdlib_stats_var.fypp \
+        stdlib_math.fypp \
         stdlib_stats_distribution_PRNG.fypp \
         stdlib_string_type.fypp
 

src/stdlib_math.fypp

@@ -0,0 +1,30 @@
+#:include "common.fypp"
+#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
+
+module stdlib_math
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp
+
+    implicit none
+    private
+    public :: clip
+
+    interface clip
+    #:for k1, t1 in IR_KINDS_TYPES
+        module procedure clip_${k1}$
+    #:endfor
+    end interface clip
+
+contains
+
+    #:for k1, t1 in IR_KINDS_TYPES
+    elemental function clip_${k1}$(x, xmin, xmax) result(res)
+        ${t1}$, intent(in) :: x
+        ${t1}$, intent(in) :: xmin
+        ${t1}$, intent(in) :: xmax
+        ${t1}$ :: res
+
+        res = max(min(x, xmax), xmin)
+    end function clip_${k1}$
+
+    #:endfor
+end module stdlib_math

src/tests/CMakeLists.txt

@@ -16,6 +16,7 @@ add_subdirectory(stats)
 add_subdirectory(string)
 add_subdirectory(system)
 add_subdirectory(quadrature)
+add_subdirectory(math)
 
 ADDTEST(always_skip)
 set_tests_properties(always_skip PROPERTIES SKIP_RETURN_CODE 77)

src/tests/Makefile.manual

@@ -9,3 +9,4 @@ all test clean:
 	$(MAKE) -f Makefile.manual --directory=quadrature $@
 	$(MAKE) -f Makefile.manual --directory=stats $@
 	$(MAKE) -f Makefile.manual --directory=string $@
+	$(MAKE) -f Makefile.manual --directory=math $@

src/tests/math/CMakeLists.txt

@@ -0,0 +1 @@
+ADDTEST(stdlib_math)

src/tests/math/Makefile.manual

@@ -0,0 +1,4 @@
+PROGS_SRC = test_stdlib_math.f90
+
+
+include ../Makefile.manual.test.mk

src/tests/math/test_stdlib_math.f90

@@ -0,0 +1,98 @@
+! SPDX-Identifier: MIT
+
+program test_stdlib_math
+    use stdlib_math, only: clip
+    use stdlib_error, only: check
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, qp
+    implicit none
+
+    ! clip function
+    ! testing format: check(clip(x, xmin, xmax) == correct answer)
+    ! valid case: xmin is not greater than xmax
+    ! invalid case: xmin is greater than xmax
+
+    ! type: integer(int8), kind: int8
+    ! valid test case
+    call check(clip(2_int8, -2_int8, 5_int8) == 2_int8, &
+               'clip_int8 failed for valid case', warn=.true.)
+    call check(clip(127_int8, -127_int8, 0_int8) == 0_int8, &
+               'clip_int8 failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(2_int8, 5_int8, -2_int8) == 5_int8, &
+               'clip_int8 failed for invalid case', warn=.true.)
+    call check(clip(127_int8, 0_int8, -127_int8) == 0_int8, &
+               'clip_int8 failed for invalid case', warn=.true.)
+
+    ! type: integer(int16), kind: int16
+    ! valid test case
+    call check(clip(2_int16, -2_int16, 5_int16) == 2_int16, &
+               'clip_int16 failed for valid case', warn=.true.)
+    call check(clip(32767_int16, -32767_int16, 0_int16) == 0_int16, &
+               'clip_int16 failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(2_int16, 5_int16, -2_int16) == 5_int16, &
+               'clip_int16 failed for invalid case', warn=.true.)
+    call check(clip(32767_int16, 0_int16, -32767_int16) == 0_int16, &
+               'clip_int16 failed for invalid case', warn=.true.)
+
+    ! type: integer(int32), kind: int32
+    ! valid test case
+    call check(clip(2_int32, -2_int32, 5_int32) == 2_int32, &
+               'clip_int32 failed for valid case', warn=.true.)
+    call check(clip(-2147483647_int32, 0_int32, 2147483647_int32) == 0_int32, &
+               'clip_int32 failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(2_int32, 5_int32, -2_int32) == 5_int32, &
+               'clip_int32 failed for invalid case', warn=.true.)
+    call check(clip(-2147483647_int32, 2147483647_int32, 0_int32) == 2147483647_int32, &
+               'clip_int32 failed for invalid case', warn=.true.)
+
+    ! type: integer(int64), kind: int64
+    ! valid test case
+    call check(clip(2_int64, -2_int64, 5_int64) == 2_int64, &
+               'clip_int64 failed for valid case', warn=.true.)
+    call check(clip(-922337203_int64, -10_int64, 25_int64) == -10_int64, &
+               'clip_int64 failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(2_int64, 5_int64, -2_int64) == 5_int64, &
+               'clip_int64 failed for invalid case', warn=.true.)
+    call check(clip(-922337203_int64, 25_int64, -10_int64) == 25_int64, &
+               'clip_int64 failed for invalid case', warn=.true.)
+
+    ! type: real(sp), kind: sp
+    ! valid test case
+    call check(clip(3.025_sp, -5.77_sp, 3.025_sp) == 3.025_sp, &
+               'clip_sp failed for valid case', warn=.true.)
+    call check(clip(0.0_sp, -1578.025_sp, -59.68_sp) == -59.68_sp, &
+               'clip_sp failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(3.025_sp, 3.025_sp, -5.77_sp) == 3.025_sp, &
+               'clip_sp failed for invalid case', warn=.true.)
+    call check(clip(0.0_sp, -59.68_sp, -1578.025_sp) == -59.68_sp, &
+               'clip_sp failed for invalid case', warn=.true.)
+
+    ! type: real(dp), kind: dp
+    ! valid test case
+    call check(clip(3.025_dp, -5.77_dp, 3.025_dp) == 3.025_dp, &
+               'clip_dp failed for valid case', warn=.true.)
+    call check(clip(-7.0_dp, 0.059668_dp, 1.00268_dp) == 0.059668_dp, &
+               'clip_dp failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(3.025_dp, 3.025_dp, -5.77_dp) == 3.025_dp, &
+               'clip_dp failed for invalid case', warn=.true.)
+    call check(clip(-7.0_dp, 1.00268_dp, 0.059668_dp) == 1.00268_dp, &
+               'clip_dp failed for invalid case', warn=.true.)
+
+    ! type: real(qp), kind: qp
+    ! valid test case
+    call check(clip(3.025_qp, -5.77_qp, 3.025_qp) == 3.025_qp, &
+               'clip_qp failed for valid case', warn=.true.)
+    call check(clip(-55891546.2_qp, -8958133457.23_qp, -689712245.23_qp) == -689712245.23_qp, &
+               'clip_qp failed for valid case', warn=.true.)
+    ! invalid test case
+    call check(clip(3.025_qp, 3.025_qp, -5.77_qp) == 3.025_qp, &
+               'clip_qp failed for invalid case', warn=.true.)
+    call check(clip(-55891546.2_qp, -689712245.23_qp, -8958133457.23_qp) == -689712245.23_qp, &
+               'clip_qp failed for invalid case', warn=.true.)
+
+end program test_stdlib_math