Type | Intent | Optional | 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 |
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