replace all sort by select

Author: jvdp1

src/stdlib_stats_median.fypp

@@ -11,6 +11,7 @@ submodule (stdlib_stats) stdlib_stats_median
   ! that are already partly sorted. While it is slightly slower for random arrays,
   ! ord_sort seems a better overall choice.
   use stdlib_sorting, only: sort => ord_sort
+  use stdlib_selection, only: select
   implicit none
 
 contains
@@ -24,6 +25,7 @@ contains
         real(${o1}$) :: res
 
         integer(kind = int64) :: c, n
+        ${t1}$ :: val, val1
         ${t1}$, allocatable :: x_tmp(:)
 
         if (.not.optval(mask, .true.) .or. size(x) == 0) then
@@ -43,16 +45,18 @@ contains
 
         x_tmp = reshape(x, [n])
 
-        call sort(x_tmp)
+        call select(x_tmp, c, val)
 
         if (mod(n, 2_int64) == 0) then
+          call select(x_tmp, c+1, val1)
           #:if t1[0] == 'r'
-            res = sum(x_tmp(c:c+1)) / 2._${o1}$
+            res = (val + val1) / 2._${o1}$
           #:else
-            res = sum( real(x_tmp(c:c+1), kind=${o1}$) ) / 2._${o1}$
+            res = (real(val, kind=${o1}$) + &
+                   real(val1, kind=${o1}$)) / 2._${o1}$
           #:endif
         else
-            res = x_tmp(c)
+            res = val
         end if
 
       end function ${name}$
@@ -74,6 +78,7 @@ contains
         integer :: j${fj}$
         #:endfor
         #:endif
+        ${t1}$ :: val, val1
         ${t1}$, allocatable :: x_tmp(:)
 
         if (.not.optval(mask, .true.) .or. size(x) == 0) then
@@ -107,17 +112,18 @@ contains
                   end if
                 #:endif
 
-                call sort(x_tmp)
+                call select(x_tmp, c, val)
 
                 if (mod(n, 2) == 0) then
+                    call select(x_tmp, c+1, val1)
                     res${reduce_subvector('j', rank, fi)}$ = &
                     #:if t1[0] == 'r'
-                        sum(x_tmp(c:c+1)) / 2._${o1}$
+                        (val + val1) / 2._${o1}$
                     #:else
-                        sum(real(x_tmp(c:c+1), kind=${o1}$) ) / 2._${o1}$
+                        (real(val, kind=${o1}$) + real(val1, kind=${o1}$)) / 2._${o1}$
                     #:endif
                 else
-                    res${reduce_subvector('j', rank, fi)}$ = x_tmp(c)
+                    res${reduce_subvector('j', rank, fi)}$ = val
                 end if
             #:for fj in range(1, rank)
               end do
@@ -141,6 +147,7 @@ contains
         real(${o1}$) :: res
 
         integer(kind = int64) :: c, n
+        ${t1}$ :: val, val1
         ${t1}$, allocatable   :: x_tmp(:)
 
         if (any(shape(x) .ne. shape(mask))) then
@@ -156,21 +163,26 @@ contains
 
         x_tmp = pack(x, mask)
 
-        call sort(x_tmp)
-
         n = size(x_tmp, kind=int64)
-        c = floor( (n + 1) / 2._${o1}$, kind=int64)
 
         if (n == 0) then
             res = ieee_value(1._${o1}$, ieee_quiet_nan)
-        else if (mod(n, 2_int64) == 0) then
+            return
+        end if
+
+        c = floor( (n + 1) / 2._${o1}$, kind=int64)
+
+        call select(x_tmp, c, val)
+
+        if (mod(n, 2_int64) == 0) then
+          call select(x_tmp, c+1, val1)
           #:if t1[0] == 'r'
-            res = sum(x_tmp(c:c+1)) / 2._${o1}$
+            res = (val + val1) / 2._${o1}$
           #:else
-            res = sum(real(x_tmp(c:c+1), kind=${o1}$)) / 2._${o1}$
+            res = (real(val, kind=${o1}$) + real(val1, kind=${o1}$)) / 2._${o1}$
           #:endif
         else if (mod(n, 2_int64) == 1) then
-            res = x_tmp(c)
+            res = val
         end if
 
       end function ${name}$
@@ -192,6 +204,7 @@ contains
         integer :: j${fj}$
         #:endfor
         #:endif
+        ${t1}$ :: val, val1
         ${t1}$, allocatable :: x_tmp(:)
 
         if (any(shape(x) .ne. shape(mask))) then
@@ -220,23 +233,28 @@ contains
                   end if
                 #:endif
 
-                call sort(x_tmp)
-
                 n = size(x_tmp, kind=int64)
-                c = floor( (n + 1) / 2._${o1}$, kind=int64 )
 
                 if (n == 0) then
                     res${reduce_subvector('j', rank, fi)}$ = &
                         ieee_value(1._${o1}$, ieee_quiet_nan)
-                else if (mod(n, 2_int64) == 0) then
+                    return
+                end if
+
+                c = floor( (n + 1) / 2._${o1}$, kind=int64 )
+
+                call select(x_tmp, c, val)
+
+                if (mod(n, 2_int64) == 0) then
+                    call select(x_tmp, c+1, val1)
                     res${reduce_subvector('j', rank, fi)}$ = &
                     #:if t1[0] == 'r'
-                        sum(x_tmp(c:c+1)) / 2._${o1}$
+                        (val + val1) / 2._${o1}$
                     #:else
-                        sum(real(x_tmp(c:c+1), kind=${o1}$)) / 2._${o1}$
+                        (real(val, kind=${o1}$) + real(val1, kind=${o1}$)) / 2._${o1}$
                     #:endif
                 else if (mod(n, 2_int64) == 1) then
-                    res${reduce_subvector('j', rank, fi)}$ = x_tmp(c)
+                    res${reduce_subvector('j', rank, fi)}$ = val
                 end if
 
                 deallocate(x_tmp)

src/tests/stats/test_median.fypp

@@ -117,12 +117,6 @@ contains
         call check(error, median(d2odd_${k1}$),  1._dp&
                     , 'median(d2odd_${k1}$): uncorrect answer'&
                     , thr = dptol)
-        if (allocated(error)) return
-
-        call check(error, median(d2odd_${k1}$),  1._dp&
-                    , 'median(d2odd_${k1}$): uncorrect answer'&
-                    , thr = dptol)
-        if (allocated(error)) return
 
     end subroutine