← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/dchfdv.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/dchfdv.f
 
1
*DECK DCHFDV
 
2
      SUBROUTINE DCHFDV (X1, X2, F1, F2, D1, D2, NE, XE, FE, DE, NEXT,
 
3
     +   IERR)
 
4
C***BEGIN PROLOGUE  DCHFDV
 
5
C***PURPOSE  Evaluate a cubic polynomial given in Hermite form and its
 
6
C            first derivative at an array of points.  While designed for
 
7
C            use by DPCHFD, it may be useful directly as an evaluator
 
8
C            for a piecewise cubic Hermite function in applications,
 
9
C            such as graphing, where the interval is known in advance.
 
10
C            If only function values are required, use DCHFEV instead.
 
11
C***LIBRARY   SLATEC (PCHIP)
 
12
C***CATEGORY  E3, H1
 
13
C***TYPE      DOUBLE PRECISION (CHFDV-S, DCHFDV-D)
 
14
C***KEYWORDS  CUBIC HERMITE DIFFERENTIATION, CUBIC HERMITE EVALUATION,
 
15
C             CUBIC POLYNOMIAL EVALUATION, PCHIP
 
16
C***AUTHOR  Fritsch, F. N., (LLNL)
 
17
C             Lawrence Livermore National Laboratory
 
18
C             P.O. Box 808  (L-316)
 
19
C             Livermore, CA  94550
 
20
C             FTS 532-4275, (510) 422-4275
 
21
C***DESCRIPTION
 
22
C
 
23
C        DCHFDV:  Cubic Hermite Function and Derivative Evaluator
 
24
C
 
25
C     Evaluates the cubic polynomial determined by function values
 
26
C     F1,F2 and derivatives D1,D2 on interval (X1,X2), together with
 
27
C     its first derivative, at the points  XE(J), J=1(1)NE.
 
28
C
 
29
C     If only function values are required, use DCHFEV, instead.
 
30
C
 
31
C ----------------------------------------------------------------------
 
32
C
 
33
C  Calling sequence:
 
34
C
 
35
C        INTEGER  NE, NEXT(2), IERR
 
36
C        DOUBLE PRECISION  X1, X2, F1, F2, D1, D2, XE(NE), FE(NE),
 
37
C                          DE(NE)
 
38
C
 
39
C        CALL  DCHFDV (X1,X2, F1,F2, D1,D2, NE, XE, FE, DE, NEXT, IERR)
 
40
C
 
41
C   Parameters:
 
42
C
 
43
C     X1,X2 -- (input) endpoints of interval of definition of cubic.
 
44
C           (Error return if  X1.EQ.X2 .)
 
45
C
 
46
C     F1,F2 -- (input) values of function at X1 and X2, respectively.
 
47
C
 
48
C     D1,D2 -- (input) values of derivative at X1 and X2, respectively.
 
49
C
 
50
C     NE -- (input) number of evaluation points.  (Error return if
 
51
C           NE.LT.1 .)
 
52
C
 
53
C     XE -- (input) real*8 array of points at which the functions are to
 
54
C           be evaluated.  If any of the XE are outside the interval
 
55
C           [X1,X2], a warning error is returned in NEXT.
 
56
C
 
57
C     FE -- (output) real*8 array of values of the cubic function
 
58
C           defined by  X1,X2, F1,F2, D1,D2  at the points  XE.
 
59
C
 
60
C     DE -- (output) real*8 array of values of the first derivative of
 
61
C           the same function at the points  XE.
 
62
C
 
63
C     NEXT -- (output) integer array indicating number of extrapolation
 
64
C           points:
 
65
C            NEXT(1) = number of evaluation points to left of interval.
 
66
C            NEXT(2) = number of evaluation points to right of interval.
 
67
C
 
68
C     IERR -- (output) error flag.
 
69
C           Normal return:
 
70
C              IERR = 0  (no errors).
 
71
C           "Recoverable" errors:
 
72
C              IERR = -1  if NE.LT.1 .
 
73
C              IERR = -2  if X1.EQ.X2 .
 
74
C                (Output arrays have not been changed in either case.)
 
75
C
 
76
C***REFERENCES  (NONE)
 
77
C***ROUTINES CALLED  XERMSG
 
78
C***REVISION HISTORY  (YYMMDD)
 
79
C   811019  DATE WRITTEN
 
80
C   820803  Minor cosmetic changes for release 1.
 
81
C   870707  Corrected XERROR calls for d.p. names(s).
 
82
C   870813  Minor cosmetic changes.
 
83
C   890411  Added SAVE statements (Vers. 3.2).
 
84
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
85
C   890831  Modified array declarations.  (WRB)
 
86
C   891006  Cosmetic changes to prologue.  (WRB)
 
87
C   891006  REVISION DATE from Version 3.2
 
88
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
89
C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
 
90
C***END PROLOGUE  DCHFDV
 
91
C  Programming notes:
 
92
C
 
93
C     To produce a single precision version, simply:
 
94
C        a. Change DCHFDV to CHFDV wherever it occurs,
 
95
C        b. Change the double precision declaration to real, and
 
96
C        c. Change the constant ZERO to single precision.
 
97
C
 
98
C  DECLARE ARGUMENTS.
 
99
C
 
100
      INTEGER  NE, NEXT(2), IERR
 
101
      DOUBLE PRECISION  X1, X2, F1, F2, D1, D2, XE(*), FE(*), DE(*)
 
102
C
 
103
C  DECLARE LOCAL VARIABLES.
 
104
C
 
105
      INTEGER  I
 
106
      DOUBLE PRECISION  C2, C2T2, C3, C3T3, DEL1, DEL2, DELTA, H, X,
 
107
     *  XMI, XMA, ZERO
 
108
      SAVE ZERO
 
109
      DATA  ZERO /0.D0/
 
110
C
 
111
C  VALIDITY-CHECK ARGUMENTS.
 
112
C
 
113
C***FIRST EXECUTABLE STATEMENT  DCHFDV
 
114
      IF (NE .LT. 1)  GO TO 5001
 
115
      H = X2 - X1
 
116
      IF (H .EQ. ZERO)  GO TO 5002
 
117
C
 
118
C  INITIALIZE.
 
119
C
 
120
      IERR = 0
 
121
      NEXT(1) = 0
 
122
      NEXT(2) = 0
 
123
      XMI = MIN(ZERO, H)
 
124
      XMA = MAX(ZERO, H)
 
125
C
 
126
C  COMPUTE CUBIC COEFFICIENTS (EXPANDED ABOUT X1).
 
127
C
 
128
      DELTA = (F2 - F1)/H
 
129
      DEL1 = (D1 - DELTA)/H
 
130
      DEL2 = (D2 - DELTA)/H
 
131
C                                           (DELTA IS NO LONGER NEEDED.)
 
132
      C2 = -(DEL1+DEL1 + DEL2)
 
133
      C2T2 = C2 + C2
 
134
      C3 = (DEL1 + DEL2)/H
 
135
C                               (H, DEL1 AND DEL2 ARE NO LONGER NEEDED.)
 
136
      C3T3 = C3+C3+C3
 
137
C
 
138
C  EVALUATION LOOP.
 
139
C
 
140
      DO 500  I = 1, NE
 
141
         X = XE(I) - X1
 
142
         FE(I) = F1 + X*(D1 + X*(C2 + X*C3))
 
143
         DE(I) = D1 + X*(C2T2 + X*C3T3)
 
144
C          COUNT EXTRAPOLATION POINTS.
 
145
         IF ( X.LT.XMI )  NEXT(1) = NEXT(1) + 1
 
146
         IF ( X.GT.XMA )  NEXT(2) = NEXT(2) + 1
 
147
C        (NOTE REDUNDANCY--IF EITHER CONDITION IS TRUE, OTHER IS FALSE.)
 
148
  500 CONTINUE
 
149
C
 
150
C  NORMAL RETURN.
 
151
C
 
152
      RETURN
 
153
C
 
154
C  ERROR RETURNS.
 
155
C
 
156
 5001 CONTINUE
 
157
C     NE.LT.1 RETURN.
 
158
      IERR = -1
 
159
      CALL XERMSG ('SLATEC', 'DCHFDV',
 
160
     +   'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
 
161
      RETURN
 
162
C
 
163
 5002 CONTINUE
 
164
C     X1.EQ.X2 RETURN.
 
165
      IERR = -2
 
166
      CALL XERMSG ('SLATEC', 'DCHFDV', 'INTERVAL ENDPOINTS EQUAL',
 
167
     +   IERR, 1)
 
168
      RETURN
 
169
C------------- LAST LINE OF DCHFDV FOLLOWS -----------------------------
 
170
      END