! LoopingEtc.f90 module globals implicit none save integer, parameter:: dble = kind(1d0) end module globals module subroutines use globals implicit none contains !Values in xvect must be monotonically increasing !Finds the integer loc such that x1 in contained !in [xvect(loc), xvect(loc+1)] !If x1 < xvect(1) then loc is set to 0 !If x1 > xvect(N) then loc is set to N subroutine Locate(xvect, x1, lower) implicit none real(dble), intent(in):: xvect(:) real(dble), intent(in):: x1 integer, intent(out):: lower integer N, mid, upper logical ascnd lower = 0 N = size(xvect) if(N == 0) return upper = N + 1 do if ( upper - lower <= 1) exit mid = ( upper + lower ) / 2 if ( x1 >= xvect(mid) ) then lower = mid else upper = mid end if end do end subroutine end module subroutines program LoopingEtc use subroutines implicit none integer, parameter:: N=5 real(dble) yvect(N) real(dble) y1 integer loc, i yvect = (/(i,i=1,N)/) y1 = 1.50d0 call Locate(yvect,y1,loc) print *, "loc =", loc end program LoopingEtc