in_flat_region Function

private pure function in_flat_region(t, c, n, k, a, ftol, x) result(inside)

Returns true if x is inside a region where the spline is equal to a (to within ftol). The ends of such a region are not inside. Used by db1root.

Arguments

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

knot array
real(kind=wp), intent(in), dimension(n) :: c

b-spline coefficient array
integer(kind=ip), intent(in) :: n

number of b-spline coefficients
integer(kind=ip), intent(in) :: k

order of the b-spline
real(kind=wp), intent(in) :: a

the value to solve for
real(kind=wp), intent(in) :: ftol

tolerance on

real(kind=wp), intent(in) :: x

the point to check

Return Value logical

true if x is inside a region where (to within ftol)


Calls

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

Called by

proc~~in_flat_region~~CalledByGraph proc~in_flat_region in_flat_region proc~db1root db1root proc~db1root->proc~in_flat_region proc~spline_roots spline_roots proc~db1root->proc~spline_roots proc~spline_roots->proc~in_flat_region proc~db1extremum db1extremum proc~db1extremum->proc~spline_roots proc~roots_1d bspline_1d%roots_1d proc~roots_1d->proc~db1root proc~db1max db1max proc~db1max->proc~db1extremum proc~db1min db1min proc~db1min->proc~db1extremum 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

Source Code

    pure function in_flat_region(t,c,n,k,a,ftol,x) result(inside)

    implicit none

    integer(ip),intent(in)             :: n     !! number of b-spline coefficients
    integer(ip),intent(in)             :: k     !! order of the b-spline
    real(wp),dimension(n+k),intent(in) :: t     !! knot array
    real(wp),dimension(n),intent(in)   :: c     !! b-spline coefficient array
    real(wp),intent(in)                :: a     !! the value to solve for
    real(wp),intent(in)                :: ftol  !! tolerance on \( |s(x)-a| \)
    real(wp),intent(in)                :: x     !! the point to check
    logical                            :: inside  !! true if `x` is inside a region where
                                                  !! \( s(x) = a \) (to within `ftol`)

    integer(ip) :: l      !! knot interval containing `x`: `t(l) <= x < t(l+1)`
    integer(ip) :: j      !! previous nonempty knot interval
    integer(ip) :: ilo    !! initial guess for [[dintrv]]
    integer(ip) :: mflag  !! status flag from [[dintrv]] (not used: `x` is in the domain)

    inside = .false.
    if (x<=t(k) .or. x>=t(n+1_ip)) return

    ! knot interval containing x: t(l) <= x < t(l+1)
    ilo = 1_ip
    call dintrv(t,n+k,x,ilo,l,mflag)
    l = min(max(l,k),n)
    inside = flat(l)

    if (inside .and. x==t(l)) then
        ! at a knot: also check the previous (nonempty) interval
        j = l - 1_ip
        do while (j>=k)
            if (t(j)<t(j+1_ip)) exit
            j = j - 1_ip
        end do
        inside = j>=k
        if (inside) inside = flat(j)
    end if

    contains

        pure function flat(i)

        !! True if the spline is equal to `a` (to within `ftol`) on knot
        !! interval `i`, which is the case if all of the `k` b-spline
        !! coefficients that are nonzero on it are.

        integer(ip),intent(in) :: i  !! knot interval index: `t(i) <= x < t(i+1)`
        logical :: flat              !! true if \( s(x) = a \) on the interval

        flat = maxval(abs(c(i-k+1_ip:i)-a))<=ftol

        end function flat

    end function in_flat_region