findloc_driver.f90

    !            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