bisect_find_LB_R8_I8 Subroutine

public subroutine bisect_find_LB_R8_I8(xa, x, n, n_LB, n_UB, rc)

Arguments

Type IntentOptional Attributes Name
real(kind=ESMF_KIND_R8), intent(in) :: xa(:)
real(kind=ESMF_KIND_R8), intent(in) :: x
integer(kind=ESMF_KIND_I8), intent(out) :: n
integer(kind=ESMF_KIND_I8), intent(in), optional :: n_LB
integer(kind=ESMF_KIND_I8), intent(in), optional :: n_UB
integer, intent(out), optional :: rc

Calls

proc~~bisect_find_lb_r8_i8~~CallsGraph proc~bisect_find_lb_r8_i8 bisect_find_LB_R8_I8 proc~mapl_return MAPL_Return proc~bisect_find_lb_r8_i8->proc~mapl_return at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception

Called by

proc~~bisect_find_lb_r8_i8~~CalledByGraph proc~bisect_find_lb_r8_i8 bisect_find_LB_R8_I8 interface~bisect bisect interface~bisect->proc~bisect_find_lb_r8_i8

Source Code

  subroutine bisect_find_LB_R8_I8(xa, x, n, n_LB, n_UB, rc)
    implicit none
    real(ESMF_KIND_R8), intent(in) :: xa(:)   ! 1D array
    real(ESMF_KIND_R8), intent(in) :: x       ! pt
    integer(ESMF_KIND_I8), intent(out) :: n   !  out: bisect index
    integer(ESMF_KIND_I8), intent(in), optional :: n_LB  !  opt in : LB
    integer(ESMF_KIND_I8), intent(in), optional :: n_UB  !  opt in : UB
    integer, intent(out), optional :: rc
    integer :: status

    integer(ESMF_KIND_I8) :: k, klo, khi, dk, LB, UB
    integer :: i, nmax

    LB=1; UB=size(xa,1)
    if(present(n_LB)) LB=max(LB, n_LB)
    if(present(n_UB)) UB=min(UB, n_UB)
    klo=LB; khi=UB; dk=1

    if ( xa(LB ) > xa(UB) )  then
       klo= UB
       khi= LB
       dk= -1
    endif

    !    ----|---------------------------|--------->
    !  Y:   klo                         khi
    !     x         x                       x
    !
    !        Y(n)  <  x  <=  Y(n+1)

    status=-1
    if ( x <= xa(klo) ) then
       n=klo-1
       return
    elseif ( x > xa(khi) ) then
       n=khi
       return
    endif

    nmax = log(abs(real(khi-klo))) / log(2.0) + 2  ! LOG2(M)
    do i = 1, nmax
       k=(klo+khi)/2
       if ( x <= xa(k) ) then
          khi = k
       else
          klo = k
       endif
       if( abs(klo-khi) <= 1 ) then
          n=klo
          status=0
          exit
       endif
    enddo

    _RETURN(_SUCCESS)

  end subroutine bisect_find_LB_R8_I8