From 388cf10162eecefa357db810782192755bca29f1 Mon Sep 17 00:00:00 2001 From: daminton Date: Fri, 3 Feb 2017 16:06:03 +0000 Subject: [PATCH] Expanded util_search to work with single column arrays --- src/util/util_search.f90 | 69 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) diff --git a/src/util/util_search.f90 b/src/util/util_search.f90 index caef13b8..236a8be3 100644 --- a/src/util/util_search.f90 +++ b/src/util/util_search.f90 @@ -92,6 +92,75 @@ subroutine util_search_double(arr,ind,n,val,klo) end subroutine util_search_double +subroutine util_search_double_1(arr,ind,n,val,klo) +use module_globals +use module_util, EXCEPT_THIS_ONE => util_search_double +implicit none + + ! Arguments + integer(I4B),intent(in) :: ind,n + real(DP),dimension(:),intent(in) :: arr + real(DP),intent(in) :: val + integer(I4B),intent(inout) :: klo + + ! Internals + integer(I4B) :: k,khi,inc + logical :: uporder ! true if arr is in ascending order + + ! Executable code + uporder = arr(1) <= arr(n) + ! First hunt for the starting value + if (.not.((klo <= 0).or.(klo > n))) then ! Only proceed if guess is useful + inc = 1 + if ((val >= arr(klo)) .eqv. uporder) then + do + khi = klo + inc + if (khi > n) then + khi = n + 1 + else if ((val >= arr(khi)) .eqv. uporder) then + klo = khi + inc = 2 * inc + cycle + end if + exit + end do + else + khi = klo + do + klo = khi - inc + if (klo < 1 ) then + klo = 0 + else if ((val < arr(klo)) .eqv. uporder) then + khi = klo + inc = 2 * inc + cycle + end if + exit + end do + end if + else + klo = 0 + khi = n + 1 + end if + + ! Start the bisection method search + do + if (khi - klo == 1) then + if (val == arr(n)) klo = n-1 + if (val == arr(1)) klo = 1 + return + end if + k = (khi + klo) / 2 + if ((val >= arr(k)) .eqv. uporder) then + klo = k + else + khi = k + end if + end do + +end subroutine util_search_double_1 + + subroutine util_search_int(arr,ind,n,val,klo) use module_globals use module_util, EXCEPT_THIS_ONE => util_search_int