dchfev Subroutine

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

Cubic Hermite Function Evaluator

Evaluate a cubic polynomial given in Hermite form at an array of points. While designed for use by dpchfe, 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.

Evaluates the cubic polynomial determined by function values F1,F2 and derivatives D1,D2 on interval (X1,X2) 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 function is 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.
integer, intent(out), dimension(2) :: next

integer 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~~dchfev~~CallsGraph proc~dchfev pchip_module::dchfev proc~xermsg pchip_module::xermsg proc~dchfev->proc~xermsg

Called by

proc~~dchfev~~CalledByGraph proc~dchfev pchip_module::dchfev proc~dpchfe pchip_module::dpchfe proc~dpchfe->proc~dchfev

Source Code

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

    integer,intent(in)                :: ne     !! number of evaluation points.  (Error return if NE<1).
    integer,dimension(2),intent(out)  :: next   !! integer 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 .
    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.
    real(wp),dimension(*),intent(in)  :: xe     !! array of points at which the function is 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.

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

    ! validity-check arguments.
    if (ne < 1) then
        ierr = -1
        call xermsg ('PCHIP', 'dchfev', 'number of evaluation points less than one', ierr, 1)
        return
    end if
    h = x2 - x1
    if (h == zero) then
        ierr = -2
        call xermsg ('PCHIP', 'dchfev', '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)
    c3 = (del1 + del2)/h
    ! (h, del1 and del2 are no longer needed.)

    ! evaluation loop.

    do i = 1, ne
        x = xe(i) - x1
        fe(i) = f1 + x*(d1 + x*(c2 + x*c3))
        ! 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 dchfev