[1] | 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 |
---|