fitp_intrvp Function

private function fitp_intrvp(t, x, n, p, tp)

FIXME : Add documentation

Arguments

Type IntentOptional Attributes Name
real, intent(in) :: t
real, intent(in), dimension(n) :: x
integer, intent(in) :: n
real, intent(in) :: p
real, intent(out) :: tp

Return Value integer


Contents

Source Code


Source Code

  integer function fitp_intrvp (t,x,n,p,tp)
    implicit none
    integer, intent(in) :: n
    real, intent(in) :: t, p
    real, intent(out) :: tp
    real, dimension(n), intent(in) :: x
!
!                                 coded by alan kaylor cline
!                           from fitpack -- january 26, 1987
!                        a curve and surface fitting package
!                      a product of pleasant valley software
!                  8603 altus cove, austin, texas 78759, usa
!
! this function determines the index of the interval
! (determined by a given increasing sequence) in which a
! given value lies, after translating the value to within
! the correct period.  it also returns this translated value.
!
! on input--
!
!   t is the given value.
!
!   x is a vector of strictly increasing values.
!
!   n is the length of x (n .ge. 2).
!
! and
!
!   p contains the period.
!
! on output--
!
!   tp contains a translated value of t (i. e. x(1) .le. tp,
!   tp .lt. x(1)+p, and tp = t + k*p for some integer k).
!
!   intrvl returns an integer i such that
!
!          i = 1       if             tp .lt. x(2)  ,
!          i = n       if   x(n) .le. tp            ,
!          otherwise       x(i)  .le. tp .lt. x(i+1),
!
! none of the input parameters are altered.
!
!-----------------------------------------------------------
    integer :: il, ih, i, nper
    real :: tt

    save i
    data i /1/

    nper = int((t-x(1))/p)
    tp = t-real(nper)*p
    if (tp .lt. x(1)) tp = tp+p
    tt = tp
!
! check for illegal i
!
    if (i .ge. n) i = n/2
!
! check old interval and extremes
!
    if (tt .lt. x(i)) then
       if (tt .le. x(2)) then
          i = 1
          fitp_intrvp = 1
          return
       else
          il = 2
          ih = i
       end if
    else if (tt .le. x(i+1)) then
       fitp_intrvp = i
       return
    else if (tt .ge. x(n)) then
       i = n
       fitp_intrvp = n
       return
    else
       il = i+1
       ih = n
    end if
!
! binary search loop
!
1   i = (il+ih)/2
    if (tt .lt. x(i)) then
       ih = i
    else if (tt .gt. x(i+1)) then
       il = i+1
    else
       fitp_intrvp = i
       return
    end if
    go to 1
  end function fitp_intrvp