← Back to branch summary

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

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/pchci.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/pchci.f
 
1
*DECK PCHCI
 
2
      SUBROUTINE PCHCI (N, H, SLOPE, D, INCFD)
 
3
C***BEGIN PROLOGUE  PCHCI
 
4
C***SUBSIDIARY
 
5
C***PURPOSE  Set interior derivatives for PCHIC
 
6
C***LIBRARY   SLATEC (PCHIP)
 
7
C***TYPE      SINGLE PRECISION (PCHCI-S, DPCHCI-D)
 
8
C***AUTHOR  Fritsch, F. N., (LLNL)
 
9
C***DESCRIPTION
 
10
C
 
11
C          PCHCI:  PCHIC Initial Derivative Setter.
 
12
C
 
13
C    Called by PCHIC to set derivatives needed to determine a monotone
 
14
C    piecewise cubic Hermite interpolant to the data.
 
15
C
 
16
C    Default boundary conditions are provided which are compatible
 
17
C    with monotonicity.  If the data are only piecewise monotonic, the
 
18
C    interpolant will have an extremum at each point where monotonicity
 
19
C    switches direction.
 
20
C
 
21
C    To facilitate two-dimensional applications, includes an increment
 
22
C    between successive values of the D-array.
 
23
C
 
24
C    The resulting piecewise cubic Hermite function should be identical
 
25
C    (within roundoff error) to that produced by PCHIM.
 
26
C
 
27
C ----------------------------------------------------------------------
 
28
C
 
29
C  Calling sequence:
 
30
C
 
31
C        PARAMETER  (INCFD = ...)
 
32
C        INTEGER  N
 
33
C        REAL  H(N), SLOPE(N), D(INCFD,N)
 
34
C
 
35
C        CALL  PCHCI (N, H, SLOPE, D, INCFD)
 
36
C
 
37
C   Parameters:
 
38
C
 
39
C     N -- (input) number of data points.
 
40
C           If N=2, simply does linear interpolation.
 
41
C
 
42
C     H -- (input) real array of interval lengths.
 
43
C     SLOPE -- (input) real array of data slopes.
 
44
C           If the data are (X(I),Y(I)), I=1(1)N, then these inputs are:
 
45
C                  H(I) =  X(I+1)-X(I),
 
46
C              SLOPE(I) = (Y(I+1)-Y(I))/H(I),  I=1(1)N-1.
 
47
C
 
48
C     D -- (output) real array of derivative values at the data points.
 
49
C           If the data are monotonic, these values will determine a
 
50
C           a monotone cubic Hermite function.
 
51
C           The value corresponding to X(I) is stored in
 
52
C                D(1+(I-1)*INCFD),  I=1(1)N.
 
53
C           No other entries in D are changed.
 
54
C
 
55
C     INCFD -- (input) increment between successive values in D.
 
56
C           This argument is provided primarily for 2-D applications.
 
57
C
 
58
C    -------
 
59
C    WARNING:  This routine does no validity-checking of arguments.
 
60
C    -------
 
61
C
 
62
C  Fortran intrinsics used:  ABS, MAX, MIN.
 
63
C
 
64
C***SEE ALSO  PCHIC
 
65
C***ROUTINES CALLED  PCHST
 
66
C***REVISION HISTORY  (YYMMDD)
 
67
C   820218  DATE WRITTEN
 
68
C   820601  Modified end conditions to be continuous functions of
 
69
C           data when monotonicity switches in next interval.
 
70
C   820602  1. Modified formulas so end conditions are less prone
 
71
C             to over/underflow problems.
 
72
C           2. Minor modification to HSUM calculation.
 
73
C   820805  Converted to SLATEC library version.
 
74
C   890411  Added SAVE statements (Vers. 3.2).
 
75
C   890531  Changed all specific intrinsics to generic.  (WRB)
 
76
C   890831  Modified array declarations.  (WRB)
 
77
C   890831  REVISION DATE from Version 3.2
 
78
C   891214  Prologue converted to Version 4.0 format.  (BAB)
 
79
C   900328  Added TYPE section.  (WRB)
 
80
C   910408  Updated AUTHOR section in prologue.  (WRB)
 
81
C   930503  Improved purpose.  (FNF)
 
82
C***END PROLOGUE  PCHCI
 
83
C
 
84
C  Programming notes:
 
85
C     1. The function  PCHST(ARG1,ARG2)  is assumed to return zero if
 
86
C        either argument is zero, +1 if they are of the same sign, and
 
87
C        -1 if they are of opposite sign.
 
88
C**End
 
89
C
 
90
C  DECLARE ARGUMENTS.
 
91
C
 
92
      INTEGER  N, INCFD
 
93
      REAL  H(*), SLOPE(*), D(INCFD,*)
 
94
C
 
95
C  DECLARE LOCAL VARIABLES.
 
96
C
 
97
      INTEGER  I, NLESS1
 
98
      REAL  DEL1, DEL2, DMAX, DMIN, DRAT1, DRAT2, HSUM, HSUMT3, THREE,
 
99
     *      W1, W2, ZERO
 
100
      SAVE ZERO, THREE
 
101
      REAL  PCHST
 
102
C
 
103
C  INITIALIZE.
 
104
C
 
105
      DATA  ZERO /0./,  THREE /3./
 
106
C***FIRST EXECUTABLE STATEMENT  PCHCI
 
107
      NLESS1 = N - 1
 
108
      DEL1 = SLOPE(1)
 
109
C
 
110
C  SPECIAL CASE N=2 -- USE LINEAR INTERPOLATION.
 
111
C
 
112
      IF (NLESS1 .GT. 1)  GO TO 10
 
113
      D(1,1) = DEL1
 
114
      D(1,N) = DEL1
 
115
      GO TO 5000
 
116
C
 
117
C  NORMAL CASE  (N .GE. 3).
 
118
C
 
119
   10 CONTINUE
 
120
      DEL2 = SLOPE(2)
 
121
C
 
122
C  SET D(1) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
 
123
C     SHAPE-PRESERVING.
 
124
C
 
125
      HSUM = H(1) + H(2)
 
126
      W1 = (H(1) + HSUM)/HSUM
 
127
      W2 = -H(1)/HSUM
 
128
      D(1,1) = W1*DEL1 + W2*DEL2
 
129
      IF ( PCHST(D(1,1),DEL1) .LE. ZERO)  THEN
 
130
         D(1,1) = ZERO
 
131
      ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO)  THEN
 
132
C        NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
 
133
         DMAX = THREE*DEL1
 
134
         IF (ABS(D(1,1)) .GT. ABS(DMAX))  D(1,1) = DMAX
 
135
      ENDIF
 
136
C
 
137
C  LOOP THROUGH INTERIOR POINTS.
 
138
C
 
139
      DO 50  I = 2, NLESS1
 
140
         IF (I .EQ. 2)  GO TO 40
 
141
C
 
142
         HSUM = H(I-1) + H(I)
 
143
         DEL1 = DEL2
 
144
         DEL2 = SLOPE(I)
 
145
   40    CONTINUE
 
146
C
 
147
C        SET D(I)=0 UNLESS DATA ARE STRICTLY MONOTONIC.
 
148
C
 
149
         D(1,I) = ZERO
 
150
         IF ( PCHST(DEL1,DEL2) .LE. ZERO)  GO TO 50
 
151
C
 
152
C        USE BRODLIE MODIFICATION OF BUTLAND FORMULA.
 
153
C
 
154
         HSUMT3 = HSUM+HSUM+HSUM
 
155
         W1 = (HSUM + H(I-1))/HSUMT3
 
156
         W2 = (HSUM + H(I)  )/HSUMT3
 
157
         DMAX = MAX( ABS(DEL1), ABS(DEL2) )
 
158
         DMIN = MIN( ABS(DEL1), ABS(DEL2) )
 
159
         DRAT1 = DEL1/DMAX
 
160
         DRAT2 = DEL2/DMAX
 
161
         D(1,I) = DMIN/(W1*DRAT1 + W2*DRAT2)
 
162
C
 
163
   50 CONTINUE
 
164
C
 
165
C  SET D(N) VIA NON-CENTERED THREE-POINT FORMULA, ADJUSTED TO BE
 
166
C     SHAPE-PRESERVING.
 
167
C
 
168
      W1 = -H(N-1)/HSUM
 
169
      W2 = (H(N-1) + HSUM)/HSUM
 
170
      D(1,N) = W1*DEL1 + W2*DEL2
 
171
      IF ( PCHST(D(1,N),DEL2) .LE. ZERO)  THEN
 
172
         D(1,N) = ZERO
 
173
      ELSE IF ( PCHST(DEL1,DEL2) .LT. ZERO)  THEN
 
174
C        NEED DO THIS CHECK ONLY IF MONOTONICITY SWITCHES.
 
175
         DMAX = THREE*DEL2
 
176
         IF (ABS(D(1,N)) .GT. ABS(DMAX))  D(1,N) = DMAX
 
177
      ENDIF
 
178
C
 
179
C  NORMAL RETURN.
 
180
C
 
181
 5000 CONTINUE
 
182
      RETURN
 
183
C------------- LAST LINE OF PCHCI FOLLOWS ------------------------------
 
184
      END