Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
! Profiled: 23ms (total time varies per optimization level)
! start libdyld.dylib: 12ms (52.1%)
! main program run: 11ms (47.8%)
! findloc: 9.1% of 11ms
! [The above representative percentages vary per run]
! Compiler: GNU Fortran 4.8.5 (github.com/drikosev/pc)
! Profiler: Instruments 9.3
! OS: macOS 10.13
! Computer: MBPR 2013 - 2,4 GHz Intel Core i7
program findloc_driver
implicit none
integer*4, parameter :: n = 500000 ;
integer*4, parameter :: key = n/2+7 ;
logical , parameter :: RL = .true.
integer*4, allocatable :: array(:)
integer pos, bpos
array = [(pos, pos=1,n)] ; ! 81.8% of 11ms (bottlneck)
!let's setup some duplicates to test "bsearch".
do pos=2,n,2
array(pos)=array(pos-1) ! 9.1% of 11ms
end do
!print * , "array=", array
print * , " key=", KEY
pos = findloc(array,KEY,dim=1,back=RL); ! 9.1% of 11ms
print *, " pos=", pos
bpos = bsearch(array,KEY,back=RL)
print *, " bpos=", bpos
contains
integer*4 function bsearch(array,key,back)
integer*4 :: array(:) !expecting bounds: 1..n
integer*4 :: key
logical :: back
integer*4 :: first, last, mid, target
bsearch = lbound(array,dim=1) - 1
first = 1
last = size(array)
do, while ( first <= last )
mid = first + ( last - first ) / 2 ;
target = array(mid)
if ( key < target ) then
last = mid -1 ;
else if ( key > target ) then
first = mid + 1;
else
if ( .not. back ) then
do, while (mid-1>0)
target = array(mid-1)
if (key /= target) then
exit
end if
mid = mid - 1;
end do
else
do, while (mid+1<size(array))
target = array(mid+1)
if (key /= target) then
exit
end if
mid = mid + 1;
end do
end if
bsearch = mid + lbound(array,dim=1) - 1
return
end if
end do
return; print *, first, last, mid, target !glitchy debugging issue
end function bsearch
end program findloc_driver
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment