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 |
---|