dintrv Subroutine

private pure subroutine dintrv(xt, lxt, xx, ilo, ileft, mflag, extrap)

Computes the largest integer ileft in 1 ileft lxt such that xt(ileft) x where xt(*) is a subdivision of the x interval. precisely,

         if            x < xt(1)   then ileft=1,   mflag=-1
         if   xt(i) <= x < xt(i+1) then ileft=i,   mflag=0
         if xt(lxt) <= x           then ileft=lxt, mflag=-2

that is, when multiplicities are present in the break point to the left of x, the largest index is taken for ileft.

History

  • interv written by carl de boor [5]
  • dintrv author: amos, d. e., (snla) : date written 800901
  • revision date 820801
  • Jacob Williams, 2/24/2015 : updated to free-form Fortran.
  • Jacob Williams, 2/17/2016 : additional refactoring (eliminated GOTOs).
  • Jacob Williams, 3/4/2017 : added extrapolation option.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in), dimension(:) :: xt

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

length of the xt vector
real(kind=wp), intent(in) :: xx

argument
integer(kind=ip), 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(kind=ip), intent(out) :: ileft

largest integer satisfying xt(ileft) x
integer(kind=ip), intent(out) :: mflag

signals when x lies out of bounds
logical, intent(in), optional :: extrap

if extrapolation is allowed (if not present, default is False)

Calls

proc~~dintrv~~CallsGraph proc~dintrv dintrv proc~get_temp_x_for_extrap get_temp_x_for_extrap proc~dintrv->proc~get_temp_x_for_extrap

Called by

proc~~dintrv~~CalledByGraph proc~dintrv dintrv proc~dbfqad dbfqad proc~dbfqad->proc~dintrv proc~dbsgq8 dbsgq8 proc~dbfqad->proc~dbsgq8 proc~dbint4 dbint4 proc~dbint4->proc~dintrv proc~dbsqad dbsqad proc~dbsqad->proc~dintrv proc~dbvalu dbvalu proc~dbsqad->proc~dbvalu proc~dbvalu->proc~dintrv proc~dbvalu_weights dbvalu_weights proc~dbvalu_weights->proc~dintrv proc~in_flat_region in_flat_region proc~in_flat_region->proc~dintrv proc~db1extremum db1extremum proc~db1extremum->proc~dbvalu proc~spline_roots spline_roots proc~db1extremum->proc~spline_roots proc~db1fqad db1fqad proc~db1fqad->proc~dbfqad proc~db1ink_alt db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1root db1root proc~db1root->proc~dbvalu proc~db1root->proc~in_flat_region proc~db1root->proc~spline_roots proc~db1sqad db1sqad proc~db1sqad->proc~dbsqad proc~db1val_alt db1val_alt proc~db1val_alt->proc~dbvalu proc~db1val_default db1val_default proc~db1val_default->proc~dbvalu proc~db1val_multi db1val_multi proc~db1val_multi->proc~dbvalu_weights proc~db2val_default db2val_default proc~db2val_default->proc~dbvalu_weights proc~db2val_multi db2val_multi proc~db2val_multi->proc~dbvalu_weights proc~db3val_default db3val_default proc~db3val_default->proc~dbvalu_weights proc~db3val_multi db3val_multi proc~db3val_multi->proc~dbvalu_weights proc~db4val_default db4val_default proc~db4val_default->proc~dbvalu_weights proc~db4val_multi db4val_multi proc~db4val_multi->proc~dbvalu_weights proc~db5val_default db5val_default proc~db5val_default->proc~dbvalu_weights proc~db5val_multi db5val_multi proc~db5val_multi->proc~dbvalu_weights proc~db6val_default db6val_default proc~db6val_default->proc~dbvalu_weights proc~db6val_multi db6val_multi proc~db6val_multi->proc~dbvalu_weights proc~dbsgq8->proc~dbvalu proc~spline_roots->proc~dbvalu proc~spline_roots->proc~in_flat_region interface~db1ink db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1val db1val interface~db1val->proc~db1val_alt interface~db1val->proc~db1val_default interface~db1val->proc~db1val_multi interface~db2val db2val interface~db2val->proc~db2val_default interface~db2val->proc~db2val_multi interface~db3val db3val interface~db3val->proc~db3val_default interface~db3val->proc~db3val_multi interface~db4val db4val interface~db4val->proc~db4val_default interface~db4val->proc~db4val_multi interface~db5val db5val interface~db5val->proc~db5val_default interface~db5val->proc~db5val_multi interface~db6val db6val interface~db6val->proc~db6val_default interface~db6val->proc~db6val_multi proc~db1max db1max proc~db1max->proc~db1extremum proc~db1min db1min proc~db1min->proc~db1extremum proc~fintegral_1d bspline_1d%fintegral_1d proc~fintegral_1d->proc~db1fqad proc~integral_1d bspline_1d%integral_1d proc~integral_1d->proc~db1sqad proc~roots_1d bspline_1d%roots_1d proc~roots_1d->proc~db1root proc~evaluate_1d bspline_1d%evaluate_1d proc~evaluate_1d->interface~db1val proc~evaluate_1d_multi bspline_1d%evaluate_1d_multi proc~evaluate_1d_multi->interface~db1val proc~evaluate_2d bspline_2d%evaluate_2d proc~evaluate_2d->interface~db2val proc~evaluate_2d_multi bspline_2d%evaluate_2d_multi proc~evaluate_2d_multi->interface~db2val proc~evaluate_3d bspline_3d%evaluate_3d proc~evaluate_3d->interface~db3val proc~evaluate_3d_multi bspline_3d%evaluate_3d_multi proc~evaluate_3d_multi->interface~db3val proc~evaluate_4d bspline_4d%evaluate_4d proc~evaluate_4d->interface~db4val proc~evaluate_4d_multi bspline_4d%evaluate_4d_multi proc~evaluate_4d_multi->interface~db4val proc~evaluate_5d bspline_5d%evaluate_5d proc~evaluate_5d->interface~db5val proc~evaluate_5d_multi bspline_5d%evaluate_5d_multi proc~evaluate_5d_multi->interface~db5val proc~evaluate_6d bspline_6d%evaluate_6d proc~evaluate_6d->interface~db6val proc~evaluate_6d_multi bspline_6d%evaluate_6d_multi proc~evaluate_6d_multi->interface~db6val proc~initialize_1d_auto_knots bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_auto_knots_multi bspline_1d%initialize_1d_auto_knots_multi proc~initialize_1d_auto_knots_multi->interface~db1ink proc~initialize_1d_specify_knots bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink proc~initialize_1d_specify_knots_multi bspline_1d%initialize_1d_specify_knots_multi proc~initialize_1d_specify_knots_multi->interface~db1ink proc~inverse_1d bspline_1d%inverse_1d proc~inverse_1d->proc~roots_1d proc~maximum_1d bspline_1d%maximum_1d proc~maximum_1d->proc~db1max proc~minimum_1d bspline_1d%minimum_1d proc~minimum_1d->proc~db1min proc~bspline_1d_constructor_auto_knots bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots

Source Code

    pure subroutine dintrv(xt,lxt,xx,ilo,ileft,mflag,extrap)

    implicit none

    integer(ip),intent(in)             :: lxt    !! length of the `xt` vector
    real(wp),dimension(:),intent(in)   :: xt     !! a knot or break point vector of length `lxt`
    real(wp),intent(in)                :: xx     !! argument
    integer(ip),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(ip),intent(out)            :: ileft  !! largest integer satisfying `xt(ileft)` \( \le \) `x`
    integer(ip),intent(out)            :: mflag  !! signals when `x` lies out of bounds
    logical,intent(in),optional        :: extrap !! if extrapolation is allowed
                                                 !! (if not present, default is False)

    integer(ip) :: ihi, istep, middle
    real(wp) :: x

    x = get_temp_x_for_extrap(xx,xt(1_ip),xt(lxt),extrap)

    ihi = ilo + 1_ip
    if ( ihi>=lxt ) then
        if ( x>=xt(lxt) ) then
            mflag = -2_ip
            ileft = lxt
            return
        end if
        if ( lxt<=1 ) then
            mflag = -1_ip
            ileft = 1_ip
            return
        end if
        ilo = lxt - 1_ip
        ihi = lxt
    end if

    if ( x>=xt(ihi) ) then

        ! now x >= xt(ilo). find upper bound
        istep = 1_ip
        do
            ilo = ihi
            ihi = ilo + istep
            if ( ihi>=lxt ) then
                if ( x>=xt(lxt) ) then
                    mflag = -2_ip
                    ileft = lxt
                    return
                end if
                ihi = lxt
            else if ( x>=xt(ihi) ) then
                istep = istep*2_ip
                cycle
            end if
            exit
        end do

    else

        if ( x>=xt(ilo) ) then
            mflag = 0_ip
            ileft = ilo
            return
        end if
        ! now x <= xt(ihi). find lower bound
        istep = 1_ip
        do
            ihi = ilo
            ilo = ihi - istep
            if ( ilo<=1_ip ) then
                ilo = 1_ip
                if ( x<xt(1_ip) ) then
                    mflag = -1_ip
                    ileft = 1_ip
                    return
                end if
            else if ( x<xt(ilo) ) then
                istep = istep*2_ip
                cycle
            end if
            exit
        end do

    end if

    ! now xt(ilo) <= x < xt(ihi). narrow the interval
    do
        middle = (ilo+ihi)/2_ip
        if ( middle==ilo ) then
            mflag = 0_ip
            ileft = ilo
            return
        end if
        ! note. it is assumed that middle = ilo in case ihi = ilo+1
        if ( x<xt(middle) ) then
            ihi = middle
        else
            ilo = middle
        end if
    end do

    end subroutine dintrv