dbspvn Subroutine

private pure subroutine dbspvn(t, jhigh, k, index, x, ileft, vnikx, work, iwork, iflag)

Calculates the value of all (possibly) nonzero basis functions at x of order max(jhigh,(j+1)*(index-1)), where t(k) <= x <= t(n+1) and j=iwork is set inside the routine on the first call when index=1. ileft is such that t(ileft) <= x < t(ileft+1). a call to dintrv(t,n+1,x,ilo,ileft,mflag) produces the proper ileft. dbspvn calculates using the basic algorithm needed in dbspvd. if only basis functions are desired, setting jhigh=k and index=1 can be faster than calling dbspvd, but extra coding is required for derivatives (index=2) and dbspvd is set up for this purpose.

left limiting values are set up as described in dbspvd.

Error Conditions

  • improper input

History

  • bsplvn written by carl de boor [5]
  • dbspvn author: amos, d. e., (snla) : date written 800901
  • revision date 820801
  • 000330 modified array declarations. (jec)
  • Jacob Williams, 2/24/2015 : extensive refactoring of CMLIB routine.

Arguments

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

knot vector of length n+k, where n = number of b-spline basis functions n = sum of knot multiplicities-k dimension t(ileft+jhigh)
integer(kind=ip), intent(in) :: jhigh

order of b-spline, 1 <= jhigh <= k
integer(kind=ip), intent(in) :: k

highest possible order
integer(kind=ip), intent(in) :: index

index = 1 gives basis functions of order jhigh = 2 denotes previous entry with work, iwork values saved for subsequent calls to dbspvn.
real(kind=wp), intent(in) :: x

argument of basis functions, t(k) <= x <= t(n+1)
integer(kind=ip), intent(in) :: ileft

largest integer such that t(ileft) <= x < t(ileft+1)
real(kind=wp), intent(out), dimension(k) :: vnikx

vector of length k for spline values.
real(kind=wp), intent(inout), dimension(*) :: work

a work vector of length 2*k
integer(kind=ip), intent(inout) :: iwork

a work parameter. both work and iwork contain information necessary to continue for index = 2. when index = 1 exclusively, these are scratch variables and can be used for other purposes.
integer(kind=ip), intent(out) :: iflag
  • 0: no errors
  • 201: k does not satisfy k>=1
  • 202: jhigh does not satisfy 1<=jhigh<=k
  • 203: index is not 1 or 2
  • 204: x does not satisfy t(ileft)<=x<=t(ileft+1)

Called by

proc~~dbspvn~~CalledByGraph proc~dbspvn bspline_sub_module::dbspvn proc~dbintk bspline_sub_module::dbintk proc~dbintk->proc~dbspvn proc~dbspvd bspline_sub_module::dbspvd proc~dbspvd->proc~dbspvn proc~dbint4 bspline_sub_module::dbint4 proc~dbint4->proc~dbspvd proc~dbtpcf bspline_sub_module::dbtpcf proc~dbtpcf->proc~dbintk proc~db1ink_alt bspline_sub_module::db1ink_alt proc~db1ink_alt->proc~dbint4 proc~db1ink_alt_2 bspline_sub_module::db1ink_alt_2 proc~db1ink_alt_2->proc~dbint4 proc~db1ink_default bspline_sub_module::db1ink_default proc~db1ink_default->proc~dbtpcf proc~db2ink bspline_sub_module::db2ink proc~db2ink->proc~dbtpcf proc~db3ink bspline_sub_module::db3ink proc~db3ink->proc~dbtpcf proc~db4ink bspline_sub_module::db4ink proc~db4ink->proc~dbtpcf proc~db5ink bspline_sub_module::db5ink proc~db5ink->proc~dbtpcf proc~db6ink bspline_sub_module::db6ink proc~db6ink->proc~dbtpcf interface~db1ink bspline_sub_module::db1ink interface~db1ink->proc~db1ink_alt interface~db1ink->proc~db1ink_alt_2 interface~db1ink->proc~db1ink_default proc~initialize_2d_auto_knots bspline_oo_module::bspline_2d%initialize_2d_auto_knots proc~initialize_2d_auto_knots->proc~db2ink proc~initialize_2d_specify_knots bspline_oo_module::bspline_2d%initialize_2d_specify_knots proc~initialize_2d_specify_knots->proc~db2ink proc~initialize_3d_auto_knots bspline_oo_module::bspline_3d%initialize_3d_auto_knots proc~initialize_3d_auto_knots->proc~db3ink proc~initialize_3d_specify_knots bspline_oo_module::bspline_3d%initialize_3d_specify_knots proc~initialize_3d_specify_knots->proc~db3ink proc~initialize_4d_auto_knots bspline_oo_module::bspline_4d%initialize_4d_auto_knots proc~initialize_4d_auto_knots->proc~db4ink proc~initialize_4d_specify_knots bspline_oo_module::bspline_4d%initialize_4d_specify_knots proc~initialize_4d_specify_knots->proc~db4ink proc~initialize_5d_auto_knots bspline_oo_module::bspline_5d%initialize_5d_auto_knots proc~initialize_5d_auto_knots->proc~db5ink proc~initialize_5d_specify_knots bspline_oo_module::bspline_5d%initialize_5d_specify_knots proc~initialize_5d_specify_knots->proc~db5ink proc~initialize_6d_auto_knots bspline_oo_module::bspline_6d%initialize_6d_auto_knots proc~initialize_6d_auto_knots->proc~db6ink proc~initialize_6d_specify_knots bspline_oo_module::bspline_6d%initialize_6d_specify_knots proc~initialize_6d_specify_knots->proc~db6ink proc~bspline_2d_constructor_auto_knots bspline_oo_module::bspline_2d_constructor_auto_knots proc~bspline_2d_constructor_auto_knots->proc~initialize_2d_auto_knots proc~bspline_2d_constructor_specify_knots bspline_oo_module::bspline_2d_constructor_specify_knots proc~bspline_2d_constructor_specify_knots->proc~initialize_2d_specify_knots proc~bspline_3d_constructor_auto_knots bspline_oo_module::bspline_3d_constructor_auto_knots proc~bspline_3d_constructor_auto_knots->proc~initialize_3d_auto_knots proc~bspline_3d_constructor_specify_knots bspline_oo_module::bspline_3d_constructor_specify_knots proc~bspline_3d_constructor_specify_knots->proc~initialize_3d_specify_knots proc~bspline_4d_constructor_auto_knots bspline_oo_module::bspline_4d_constructor_auto_knots proc~bspline_4d_constructor_auto_knots->proc~initialize_4d_auto_knots proc~bspline_4d_constructor_specify_knots bspline_oo_module::bspline_4d_constructor_specify_knots proc~bspline_4d_constructor_specify_knots->proc~initialize_4d_specify_knots proc~bspline_5d_constructor_auto_knots bspline_oo_module::bspline_5d_constructor_auto_knots proc~bspline_5d_constructor_auto_knots->proc~initialize_5d_auto_knots proc~bspline_5d_constructor_specify_knots bspline_oo_module::bspline_5d_constructor_specify_knots proc~bspline_5d_constructor_specify_knots->proc~initialize_5d_specify_knots proc~bspline_6d_constructor_auto_knots bspline_oo_module::bspline_6d_constructor_auto_knots proc~bspline_6d_constructor_auto_knots->proc~initialize_6d_auto_knots proc~bspline_6d_constructor_specify_knots bspline_oo_module::bspline_6d_constructor_specify_knots proc~bspline_6d_constructor_specify_knots->proc~initialize_6d_specify_knots proc~initialize_1d_auto_knots bspline_oo_module::bspline_1d%initialize_1d_auto_knots proc~initialize_1d_auto_knots->interface~db1ink proc~initialize_1d_specify_knots bspline_oo_module::bspline_1d%initialize_1d_specify_knots proc~initialize_1d_specify_knots->interface~db1ink interface~bspline_2d bspline_oo_module::bspline_2d interface~bspline_2d->proc~bspline_2d_constructor_auto_knots interface~bspline_2d->proc~bspline_2d_constructor_specify_knots interface~bspline_3d bspline_oo_module::bspline_3d interface~bspline_3d->proc~bspline_3d_constructor_auto_knots interface~bspline_3d->proc~bspline_3d_constructor_specify_knots interface~bspline_4d bspline_oo_module::bspline_4d interface~bspline_4d->proc~bspline_4d_constructor_auto_knots interface~bspline_4d->proc~bspline_4d_constructor_specify_knots interface~bspline_5d bspline_oo_module::bspline_5d interface~bspline_5d->proc~bspline_5d_constructor_auto_knots interface~bspline_5d->proc~bspline_5d_constructor_specify_knots interface~bspline_6d bspline_oo_module::bspline_6d interface~bspline_6d->proc~bspline_6d_constructor_auto_knots interface~bspline_6d->proc~bspline_6d_constructor_specify_knots proc~bspline_1d_constructor_auto_knots bspline_oo_module::bspline_1d_constructor_auto_knots proc~bspline_1d_constructor_auto_knots->proc~initialize_1d_auto_knots proc~bspline_1d_constructor_specify_knots bspline_oo_module::bspline_1d_constructor_specify_knots proc~bspline_1d_constructor_specify_knots->proc~initialize_1d_specify_knots interface~bspline_1d bspline_oo_module::bspline_1d interface~bspline_1d->proc~bspline_1d_constructor_auto_knots interface~bspline_1d->proc~bspline_1d_constructor_specify_knots

Source Code

    pure subroutine dbspvn(t,jhigh,k,index,x,ileft,vnikx,work,iwork,iflag)

    implicit none

    real(wp),dimension(*),intent(in)    :: t        !! knot vector of length `n+k`, where
                                                    !! `n` = number of b-spline basis functions
                                                    !! `n` = sum of knot multiplicities-`k`
                                                    !! dimension `t(ileft+jhigh)`
    integer(ip),intent(in)              :: jhigh    !! order of b-spline, `1 <= jhigh <= k`
    integer(ip),intent(in)              :: k        !! highest possible order
    integer(ip),intent(in)              :: index    !! index = 1 gives basis functions of order `jhigh`
                                                    !!       = 2 denotes previous entry with `work`, `iwork`
                                                    !!         values saved for subsequent calls to
                                                    !!         dbspvn.
    real(wp),intent(in)                 :: x        !! argument of basis functions, `t(k) <= x <= t(n+1)`
    integer(ip),intent(in)              :: ileft    !! largest integer such that `t(ileft) <= x < t(ileft+1)`
    real(wp),dimension(k),intent(out)   :: vnikx    !! vector of length `k` for spline values.
    real(wp),dimension(*),intent(inout) :: work     !! a work vector of length `2*k`
    integer(ip),intent(inout)           :: iwork    !! a work parameter.  both `work` and `iwork` contain
                                                    !! information necessary to continue for `index = 2`.
                                                    !! when `index = 1` exclusively, these are scratch
                                                    !! variables and can be used for other purposes.
    integer(ip),intent(out)             :: iflag    !! *   0: no errors
                                                    !! * 201: `k` does not satisfy `k>=1`
                                                    !! * 202: `jhigh` does not satisfy `1<=jhigh<=k`
                                                    !! * 203: `index` is not 1 or 2
                                                    !! * 204: `x` does not satisfy `t(ileft)<=x<=t(ileft+1)`

    integer(ip) :: imjp1, ipj, jp1, jp1ml, l
    real(wp) :: vm, vmprev

    ! content of j, deltam, deltap is expected unchanged between calls.
    ! work(i) = deltap(i),
    ! work(k+i) = deltam(i), i = 1,k

    if (k<1_ip) then
        !write(error_unit,'(A)') 'dbspvn - k does not satisfy k>=1'
        iflag = 201_ip
        return
    end if
    if (jhigh>k .or. jhigh<1_ip) then
        !write(error_unit,'(A)') 'dbspvn - jhigh does not satisfy 1<=jhigh<=k'
        iflag = 202_ip
        return
    end if
    if (index<1_ip .or. index>2_ip) then
        !write(error_unit,'(A)') 'dbspvn - index is not 1 or 2'
        iflag = 203_ip
        return
    end if
    if (x<t(ileft) .or. x>t(ileft+1_ip)) then
        !write(error_unit,'(A)') 'dbspvn - x does not satisfy t(ileft)<=x<=t(ileft+1)'
        iflag = 204_ip
        return
    end if

    iflag = 0_ip

    if (index==1_ip) then
        iwork = 1_ip
        vnikx(1_ip) = 1.0_wp
        if (iwork>=jhigh) return
    end if

    do
        ipj = ileft + iwork
        work(iwork) = t(ipj) - x
        imjp1 = ileft - iwork + 1_ip
        work(k+iwork) = x - t(imjp1)
        vmprev = 0.0_wp
        jp1 = iwork + 1_ip
        do l=1_ip,iwork
            jp1ml = jp1 - l
            vm = vnikx(l)/(work(l)+work(k+jp1ml))
            vnikx(l) = vm*work(l) + vmprev
            vmprev = vm*work(k+jp1ml)
        end do
        vnikx(jp1) = vmprev
        iwork = jp1
        if (iwork>=jhigh) exit
    end do

    end subroutine dbspvn