dchfdv Subroutine

public subroutine dchfdv(x1, x2, f1, f2, d1, d2, ne, xe, fe, de, next, ierr)

Cubic Hermite Function and Derivative Evaluator

Evaluate a cubic polynomial given in Hermite form and its first derivative at an array of points. While designed for use by dpchfd, it may be useful directly as an evaluator for a piecewise cubic Hermite function in applications, such as graphing, where the interval is known in advance. If only function values are required, use dchfev instead.

Evaluates the cubic polynomial determined by function values F1,F2 and derivatives D1,D2 on interval (X1,X2), together with its first derivative, at the points XE(J), J=1(1)NE.

Arguments

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

initial endpoint of interval of definition of cubic. (Error return if X1==X2.)
real(kind=wp), intent(in) :: x2

final endpoint of interval of definition of cubic. (Error return if X1==X2.)
real(kind=wp), intent(in) :: f1

value of function at X1.
real(kind=wp), intent(in) :: f2

value of function at X2.
real(kind=wp), intent(in) :: d1

value of derivative at X1.
real(kind=wp), intent(in) :: d2

value of derivative at X2.
integer, intent(in) :: ne

number of evaluation points. (Error return if NE<1).
real(kind=wp), intent(in), dimension(*) :: xe

array of points at which the functions are to be evaluated. If any of the XE are outside the interval [X1,X2], a warning error is returned in NEXT.
real(kind=wp), intent(out), dimension(*) :: fe

array of values of the cubic function defined by X1,X2, F1,F2, D1,D2 at the points XE.
real(kind=wp), intent(out), dimension(*) :: de

array of values of the first derivative of the same function at the points XE.
integer, intent(out), dimension(2) :: next

array indicating number of extrapolation points:

  • NEXT(1) = number of evaluation points to left of interval.
  • NEXT(2) = number of evaluation points to right of interval.
integer, intent(out) :: ierr

error flag.

Normal return:

  • IERR = 0 (no errors).

"Recoverable" errors (output arrays have not been changed):

  • IERR = -1 if NE<1 .
  • IERR = -2 if X1==X2 .

Calls

proc~~dchfdv~~CallsGraph proc~dchfdv pchip_module::dchfdv proc~xermsg pchip_module::xermsg proc~dchfdv->proc~xermsg

Called by

proc~~dchfdv~~CalledByGraph proc~dchfdv pchip_module::dchfdv proc~dpchfd pchip_module::dpchfd proc~dpchfd->proc~dchfdv

Source Code

    subroutine dchfdv (x1, x2, f1, f2, d1, d2, ne, xe, fe, de, next, ierr)

    integer,intent(in)                :: ne !! number of evaluation points.  (Error return if NE<1).
    real(wp),dimension(*),intent(in)  :: xe !! array of points at which the functions are to
                                            !! be evaluated.  If any of the XE are outside the interval
                                            !! [X1,X2], a warning error is returned in NEXT.
    real(wp),dimension(*),intent(out) :: fe !! array of values of the cubic function
                                            !! defined by X1,X2, F1,F2, D1,D2 at the points XE.
    real(wp),dimension(*),intent(out) :: de !! array of values of the first derivative of
                                            !! the same function at the points XE.
    real(wp),intent(in)               :: x1 !! initial endpoint of interval of definition of cubic. (Error return if X1==X2.)
    real(wp),intent(in)               :: x2 !! final endpoint of interval of definition of cubic. (Error return if X1==X2.)
    real(wp),intent(in)               :: f1 !! value of function at X1.
    real(wp),intent(in)               :: f2 !! value of function at X2.
    real(wp),intent(in)               :: d1 !! value of derivative at X1.
    real(wp),intent(in)               :: d2 !! value of derivative at X2.
    integer,dimension(2),intent(out) :: next !! array indicating number of extrapolation points:
                                             !!
                                             !! * NEXT(1) = number of evaluation points to left of interval.
                                             !! * NEXT(2) = number of evaluation points to right of interval.
    integer,intent(out) :: ierr     !! error flag.
                                    !!
                                    !! Normal return:
                                    !!
                                    !! * IERR = 0  (no errors).
                                    !!
                                    !! "Recoverable" errors (output arrays have not been changed):
                                    !!
                                    !! * IERR = -1  if NE<1 .
                                    !! * IERR = -2  if X1==X2 .

    integer :: i
    real(wp) :: c2, c2t2, c3, c3t3, del1, del2, delta, h, x, xmi, xma

    ! validity-check arguments.

    if (ne < 1) then
        ierr = -1
        call xermsg ('PCHIP', 'dchfdv', 'number of evaluation points less than one', ierr, 1)
        return
    end if
    h = x2 - x1
    if (h == zero) then
        ierr = -2
        call xermsg ('PCHIP', 'dchfdv', 'interval endpoints equal', ierr, 1)
        return
    end if

    ! initialize:
    ierr = 0
    next = 0
    xmi = min(zero, h)
    xma = max(zero, h)

    ! compute cubic coefficients (expanded about x1).
    delta = (f2 - f1)/h
    del1 = (d1 - delta)/h
    del2 = (d2 - delta)/h
    ! (delta is no longer needed.)
    c2 = -(del1+del1 + del2)
    c2t2 = c2 + c2
    c3 = (del1 + del2)/h
    ! (h, del1 and del2 are no longer needed.)
    c3t3 = c3+c3+c3

    ! evaluation loop.
    do i = 1, ne
        x = xe(i) - x1
        fe(i) = f1 + x*(d1 + x*(c2 + x*c3))
        de(i) = d1 + x*(c2t2 + x*c3t3)
        ! count extrapolation points.
        if ( x<xmi ) next(1) = next(1) + 1
        if ( x>xma ) next(2) = next(2) + 1
        ! (note redundancy--if either condition is true, other is false.)
    end do

    end subroutine dchfdv