dintrv Subroutine

  1. mod_bspline.f90
  2. bspline
  3. dintrv

private subroutine dintrv(XT, lxt, x, ilo, ileft, mflag)

Arguments

Type IntentOptional AttributesName
real(kind=wp), intent(in), dimension(lxt):: XT

a knot or break point vector of length lxt
integer, intent(in) :: lxt

length of the XT vector
real(kind=wp), intent(in) :: x

argument
integer, intent(inout) :: ilo

an initialization parameter which must be set to 1 the first time the spline array XT is processed by dintrv. ilo contains information for efficient processing after the initial call and ilo must not be changed by the user. distinct splines require distinct ilo parameters.
integer, intent(out) :: ileft

largest integer satisfying XT(ileft) <= x
integer, intent(out) :: mflag

signals when x lies out of bounds

Called by

proc~~dintrv~~CalledByGraph proc~dintrv dintrv proc~dbvalu dbvalu proc~dbvalu->proc~dintrv proc~db2val db2val proc~db2val->proc~dintrv proc~db2val->proc~dbvalu proc~db1val db1val proc~db1val->proc~dbvalu

Contents

Source Code

dintrv

Source Code

    subroutine dintrv(XT,lxt,x,ilo,ileft,mflag)

    implicit none

    integer,intent(in)                 :: lxt    !! length of the XT vector
    real(wp),dimension(lxt),intent(in) :: XT     !! a knot or break point vector of length lxt
    real(wp),intent(in)                :: x      !! argument
    integer,intent(inout)              :: ilo    !! an initialization parameter which must be set
                                                 !! to 1 the first time the spline array XT is
                                                 !! processed by dintrv. ilo contains information for
                                                 !! efficient processing after the initial call and ilo
                                                 !! must not be changed by the user.  distinct splines
                                                 !! require distinct ilo parameters.
    integer,intent(out)                :: ileft  !! largest integer satisfying XT(ileft) <= x
    integer,intent(out)                :: mflag  !! signals when x lies out of bounds

    integer :: ihi, istep, middle

      ihi = ilo + 1
      if (ihi<lxt) go to 10
      if (x>=XT(lxt)) go to 110
      if (lxt<=1) go to 90
      ilo = lxt - 1
      ihi = lxt

   10 if (x>=XT(ihi)) go to 40
      if (x>=XT(ilo)) go to 100

! *** now x < XT(ihi) . find lower bound
      istep = 1
   20 ihi = ilo
      ilo = ihi - istep
      if (ilo<=1) go to 30
      if (x>=XT(ilo)) go to 70
      istep = istep*2
      go to 20

   30 ilo = 1
      if (x<XT(1)) go to 90
      go to 70

! *** now x >= XT(ilo) . find upper bound
   40 istep = 1
   50 ilo = ihi
      ihi = ilo + istep
      if (ihi>=lxt) go to 60
      if (x<XT(ihi)) go to 70
      istep = istep*2
      go to 50

   60 if (x>=XT(lxt)) go to 110
      ihi = lxt

! *** now XT(ilo) <= x < XT(ihi) . narrow the interval
   70 middle = (ilo+ihi)/2
      if (middle==ilo) go to 100
!     note. it is assumed that middle = ilo in case ihi = ilo+1
      if (x<XT(middle)) go to 80
      ilo = middle
      go to 70

   80 ihi = middle
      go to 70

! *** set output and return
   90 mflag = -1
      ileft = 1
      return

  100 mflag = 0
      ileft = ilo
      return

  110 mflag = 1
      ileft = lxt

    endsubroutine dintrv