GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: misc/pchfe_95_m.F90 Lines: 0 5 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 20 0.0 %

Line Branch Exec Source
1
module PCHFE_95_m
2
3
  implicit none
4
5
contains
6
7
  SUBROUTINE PCHFE_95(X, F, D, SKIP, XE, FE, IERR)
8
9
    ! PURPOSE  Evaluate a piecewise cubic Hermite function at an array of
10
    !            points.  May be used by itself for Hermite interpolation,
11
    !            or as an evaluator for PCHIM or PCHIC.
12
    ! CATEGORY  E3
13
    ! KEYWORDS  CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
14
    !             PIECEWISE CUBIC EVALUATION
15
16
    !          PCHFE:  Piecewise Cubic Hermite Function Evaluator
17
    ! Evaluates the cubic Hermite function defined by  X, F, D  at
18
    ! the points  XE.
19
20
    use assert_eq_m, only: assert_eq
21
22
    REAL, intent(in):: X(:) ! real array of independent variable values
23
    ! The elements of X must be strictly increasing.
24
25
    REAL, intent(in):: F(:) ! real array of function values
26
    ! F(I) is the value corresponding to X(I).
27
28
    REAL, intent(in):: D(:) ! real array of derivative values
29
    ! D(I) is the value corresponding to X(I).
30
31
    LOGICAL, intent(inout):: SKIP
32
    ! request to skip checks for validity of "x"
33
    ! If "skip" is false then "pchfe" will check that size(x) >= 2 and
34
    ! "x" is in strictly ascending order.
35
    ! Setting "skip" to true will save time in case these checks have
36
    ! already been performed (say, in "PCHIM" or "PCHIC").
37
    ! "SKIP" will be set to TRUE on normal return.
38
39
    real, intent(in):: XE(:) ! points at which the function is to be evaluated
40
    ! NOTES:
41
    ! 1. The evaluation will be most efficient if the elements of XE
42
    ! are increasing relative to X.
43
    ! That is,   XE(J) .GE. X(I)
44
    ! implies    XE(K) .GE. X(I),  all K.GE.J
45
    ! 2. If any of the XE are outside the interval [X(1),X(N)], values
46
    ! are extrapolated from the nearest extreme cubic, and a warning
47
    ! error is returned.
48
49
    real, intent(out):: FE(:) ! values of the cubic Hermite function
50
    ! defined by X, F, D at the points XE
51
52
    integer, intent(out):: IERR ! error flag
53
    ! Normal return:
54
    ! IERR = 0  no error
55
    ! Warning error:
56
    ! IERR > 0  means that extrapolation was performed at IERR points
57
    ! "Recoverable" errors:
58
    !              IERR = -1  if N < 2
59
    !              IERR = -3  if the X-array is not strictly increasing
60
    !              IERR = -4  if NE < 1
61
    ! NOTE: The above errors are checked in the order listed, and
62
    ! following arguments have **NOT** been validated.
63
64
    ! Variables local to the procedure:
65
66
    INTEGER  N, NE
67
68
    !---------------------------------------
69
70
    n = assert_eq(size(x), size(f), size(d), "PCHFE_95 n")
71
    ne = assert_eq(size(xe), size(fe), "PCHFE_95 ne")
72
    call PCHFE(N, X, F, D, 1, SKIP, NE, XE, FE, IERR)
73
74
  end SUBROUTINE PCHFE_95
75
76
end module PCHFE_95_m