tem_positioninsorted_long Function

private function tem_positioninsorted_long(me, val, lower, upper) result(pos)

return the position of a value in 'me', which is an array with sorted entries. if the value was not found, - return 0 if nextifnotfound = .false. - return position at the end if nextifnotfound = .true.

Arguments

Type IntentOptional Attributes Name
integer(kind=long_k), intent(in) :: me(:)

array to search in
integer(kind=long_k), intent(in) :: val

value to look for
integer, intent(in), optional :: lower

lower search limit
integer, intent(in), optional :: upper

upper search limit

Return Value integer

position of val in the sorted list, 0 if not found


Called by

proc~~tem_positioninsorted_long~~CalledByGraph proc~tem_positioninsorted_long tem_positioninsorted_long interface~tem_positioninsorted tem_positioninsorted interface~tem_positioninsorted->proc~tem_positioninsorted_long

Source Code

  function tem_positioninsorted_long( me, val, lower, upper ) result(pos)
    ! ---------------------------------------------------------------------------
    !> array to search in
    integer(kind=long_k), intent(in) :: me(:)
    !> value to look for
    integer(kind=long_k), intent(in) :: val
    !> lower search limit
    integer, intent(in), optional :: lower
    !> upper search limit
    integer, intent(in), optional :: upper
    !> position of val in the sorted list, 0 if not found
    integer :: pos
    ! ---------------------------------------------------------------------------
    logical :: retnext
    integer :: lb, ub
    integer :: mid
    integer(kind=long_k) :: lb_val, ub_val
    integer(kind=long_k) :: mid_val
    ! ---------------------------------------------------------------------------

    retnext = .false.

    lb = 1
    ub = size( me )

    if( present( lower ) ) lb = lower
    if( present( upper ) ) ub = upper

    pos = 0
    if (retnext) pos = lb

    ! binary search on sorted list
    do while(ub >= lb)

      lb_val = me(lb)

      if (val < lb_val) then
        if (retnext) pos = lb
        exit
      end if

      ub_val = me(ub)

      if (val > ub_val) then
        if (retnext) pos = ub+1
        exit
      end if

      mid = (lb+ub) / 2
      mid_val = me(mid)
      if (val == mid_val) then
        pos = mid
        exit
      end if
      if (val > mid_val) then
        lb = mid + 1
      else
        ub = mid - 1
      end if
    end do
  end function tem_positioninsorted_long