| [1] | 1 | *DECK PCHDF |
|---|
| 2 | REAL FUNCTION PCHDF (K, X, S, IERR) |
|---|
| 3 | C***BEGIN PROLOGUE PCHDF |
|---|
| 4 | C***SUBSIDIARY |
|---|
| 5 | C***PURPOSE Computes divided differences for PCHCE and PCHSP |
|---|
| 6 | C***LIBRARY SLATEC (PCHIP) |
|---|
| 7 | C***TYPE SINGLE PRECISION (PCHDF-S, DPCHDF-D) |
|---|
| 8 | C***AUTHOR Fritsch, F. N., (LLNL) |
|---|
| 9 | C***DESCRIPTION |
|---|
| 10 | C |
|---|
| 11 | C PCHDF: PCHIP Finite Difference Formula |
|---|
| 12 | C |
|---|
| 13 | C Uses a divided difference formulation to compute a K-point approx- |
|---|
| 14 | C imation to the derivative at X(K) based on the data in X and S. |
|---|
| 15 | C |
|---|
| 16 | C Called by PCHCE and PCHSP to compute 3- and 4-point boundary |
|---|
| 17 | C derivative approximations. |
|---|
| 18 | C |
|---|
| 19 | C ---------------------------------------------------------------------- |
|---|
| 20 | C |
|---|
| 21 | C On input: |
|---|
| 22 | C K is the order of the desired derivative approximation. |
|---|
| 23 | C K must be at least 3 (error return if not). |
|---|
| 24 | C X contains the K values of the independent variable. |
|---|
| 25 | C X need not be ordered, but the values **MUST** be |
|---|
| 26 | C distinct. (Not checked here.) |
|---|
| 27 | C S contains the associated slope values: |
|---|
| 28 | C S(I) = (F(I+1)-F(I))/(X(I+1)-X(I)), I=1(1)K-1. |
|---|
| 29 | C (Note that S need only be of length K-1.) |
|---|
| 30 | C |
|---|
| 31 | C On return: |
|---|
| 32 | C S will be destroyed. |
|---|
| 33 | C IERR will be set to -1 if K.LT.2 . |
|---|
| 34 | C PCHDF will be set to the desired derivative approximation if |
|---|
| 35 | C IERR=0 or to zero if IERR=-1. |
|---|
| 36 | C |
|---|
| 37 | C ---------------------------------------------------------------------- |
|---|
| 38 | C |
|---|
| 39 | C***SEE ALSO PCHCE, PCHSP |
|---|
| 40 | C***REFERENCES Carl de Boor, A Practical Guide to Splines, Springer- |
|---|
| 41 | C Verlag, New York, 1978, pp. 10-16. |
|---|
| 42 | C***ROUTINES CALLED XERMSG |
|---|
| 43 | C***REVISION HISTORY (YYMMDD) |
|---|
| 44 | C 820503 DATE WRITTEN |
|---|
| 45 | C 820805 Converted to SLATEC library version. |
|---|
| 46 | C 870813 Minor cosmetic changes. |
|---|
| 47 | C 890411 Added SAVE statements (Vers. 3.2). |
|---|
| 48 | C 890411 REVISION DATE from Version 3.2 |
|---|
| 49 | C 891214 Prologue converted to Version 4.0 format. (BAB) |
|---|
| 50 | C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ) |
|---|
| 51 | C 900328 Added TYPE section. (WRB) |
|---|
| 52 | C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB) |
|---|
| 53 | C 920429 Revised format and order of references. (WRB,FNF) |
|---|
| 54 | C 930503 Improved purpose. (FNF) |
|---|
| 55 | C***END PROLOGUE PCHDF |
|---|
| 56 | C |
|---|
| 57 | C**End |
|---|
| 58 | C |
|---|
| 59 | C DECLARE ARGUMENTS. |
|---|
| 60 | C |
|---|
| 61 | INTEGER K, IERR |
|---|
| 62 | REAL X(K), S(K) |
|---|
| 63 | C |
|---|
| 64 | C DECLARE LOCAL VARIABLES. |
|---|
| 65 | C |
|---|
| 66 | INTEGER I, J |
|---|
| 67 | REAL VALUE, ZERO |
|---|
| 68 | SAVE ZERO |
|---|
| 69 | DATA ZERO /0./ |
|---|
| 70 | C |
|---|
| 71 | C CHECK FOR LEGAL VALUE OF K. |
|---|
| 72 | C |
|---|
| 73 | C***FIRST EXECUTABLE STATEMENT PCHDF |
|---|
| 74 | IF (K .LT. 3) GO TO 5001 |
|---|
| 75 | C |
|---|
| 76 | C COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL. |
|---|
| 77 | C |
|---|
| 78 | DO 10 J = 2, K-1 |
|---|
| 79 | DO 9 I = 1, K-J |
|---|
| 80 | S(I) = (S(I+1)-S(I))/(X(I+J)-X(I)) |
|---|
| 81 | 9 CONTINUE |
|---|
| 82 | 10 CONTINUE |
|---|
| 83 | C |
|---|
| 84 | C EVALUATE DERIVATIVE AT X(K). |
|---|
| 85 | C |
|---|
| 86 | VALUE = S(1) |
|---|
| 87 | DO 20 I = 2, K-1 |
|---|
| 88 | VALUE = S(I) + VALUE*(X(K)-X(I)) |
|---|
| 89 | 20 CONTINUE |
|---|
| 90 | C |
|---|
| 91 | C NORMAL RETURN. |
|---|
| 92 | C |
|---|
| 93 | IERR = 0 |
|---|
| 94 | PCHDF = VALUE |
|---|
| 95 | RETURN |
|---|
| 96 | C |
|---|
| 97 | C ERROR RETURN. |
|---|
| 98 | C |
|---|
| 99 | 5001 CONTINUE |
|---|
| 100 | C K.LT.3 RETURN. |
|---|
| 101 | IERR = -1 |
|---|
| 102 | CALL XERMSG ('SLATEC', 'PCHDF', 'K LESS THAN THREE', IERR, 1) |
|---|
| 103 | PCHDF = ZERO |
|---|
| 104 | RETURN |
|---|
| 105 | C------------- LAST LINE OF PCHDF FOLLOWS ------------------------------ |
|---|
| 106 | END |
|---|
