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