~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to Lib/Slatec/slatec/dpchdf.f

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
*DECK DPCHDF
 
2
      DOUBLE PRECISION FUNCTION DPCHDF (K, X, S, IERR)
 
3
C***BEGIN PROLOGUE  DPCHDF
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  Computes divided differences for DPCHCE and DPCHSP
 
6
C***LIBRARY   SLATEC (PCHIP)
 
7
C***TYPE      DOUBLE PRECISION (PCHDF-S, DPCHDF-D)
 
8
C***AUTHOR  Fritsch, F. N., (LLNL)
 
9
C***DESCRIPTION
 
10
C
 
11
C          DPCHDF:   DPCHIP 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  DPCHCE  and  DPCHSP  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        DPCHDF  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  DPCHCE, DPCHSP
 
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   870707  Corrected XERROR calls for d.p. name(s).
 
47
C   870813  Minor cosmetic changes.
 
48
C   890206  Corrected XERROR calls.
 
49
C   890411  Added SAVE statements (Vers. 3.2).
 
50
C   890411  REVISION DATE from Version 3.2
 
51
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
52
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
 
53
C   900328  Added TYPE section.  (WRB)
 
54
C   910408  Updated AUTHOR and DATE WRITTEN sections in prologue.  (WRB)
 
55
C   920429  Revised format and order of references.  (WRB,FNF)
 
56
C   930503  Improved purpose.  (FNF)
 
57
C***END PROLOGUE  DPCHDF
 
58
C
 
59
C**End
 
60
C
 
61
C  DECLARE ARGUMENTS.
 
62
C
 
63
      INTEGER  K, IERR
 
64
      DOUBLE PRECISION  X(K), S(K)
 
65
C
 
66
C  DECLARE LOCAL VARIABLES.
 
67
C
 
68
      INTEGER  I, J
 
69
      DOUBLE PRECISION  VALUE, ZERO
 
70
      SAVE ZERO
 
71
      DATA  ZERO /0.D0/
 
72
C
 
73
C  CHECK FOR LEGAL VALUE OF K.
 
74
C
 
75
C***FIRST EXECUTABLE STATEMENT  DPCHDF
 
76
      IF (K .LT. 3)  GO TO 5001
 
77
C
 
78
C  COMPUTE COEFFICIENTS OF INTERPOLATING POLYNOMIAL.
 
79
C
 
80
      DO 10  J = 2, K-1
 
81
         DO 9  I = 1, K-J
 
82
            S(I) = (S(I+1)-S(I))/(X(I+J)-X(I))
 
83
    9    CONTINUE
 
84
   10 CONTINUE
 
85
C
 
86
C  EVALUATE DERIVATIVE AT X(K).
 
87
C
 
88
      VALUE = S(1)
 
89
      DO 20  I = 2, K-1
 
90
         VALUE = S(I) + VALUE*(X(K)-X(I))
 
91
   20 CONTINUE
 
92
C
 
93
C  NORMAL RETURN.
 
94
C
 
95
      IERR = 0
 
96
      DPCHDF = VALUE
 
97
      RETURN
 
98
C
 
99
C  ERROR RETURN.
 
100
C
 
101
 5001 CONTINUE
 
102
C     K.LT.3 RETURN.
 
103
      IERR = -1
 
104
      CALL XERMSG ('SLATEC', 'DPCHDF', 'K LESS THAN THREE', IERR, 1)
 
105
      DPCHDF = ZERO
 
106
      RETURN
 
107
C------------- LAST LINE OF DPCHDF FOLLOWS -----------------------------
 
108
      END