GCC Code Coverage Report

Directory:	./
File:	misc/pchfe.f
Date:	2022-01-11 19:19:34

	Exec	Total	Coverage
Lines:	0	58	0.0%
Branches:	0	42	0.0%

Line	Exec	Source
1		*DECK PCHFE
2	✗	SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
3		C***BEGIN PROLOGUE PCHFE
4		C***PURPOSE Evaluate a piecewise cubic Hermite function at an array of
5		C points. May be used by itself for Hermite interpolation,
6		C or as an evaluator for PCHIM or PCHIC.
7		C***LIBRARY SLATEC (PCHIP)
8		C***CATEGORY E3
9		C***TYPE SINGLE PRECISION (PCHFE-S, DPCHFE-D)
10		C***KEYWORDS CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,
11		C PIECEWISE CUBIC EVALUATION
12		C***AUTHOR Fritsch, F. N., (LLNL)
13		C Lawrence Livermore National Laboratory
14		C P.O. Box 808 (L-316)
15		C Livermore, CA 94550
16		C FTS 532-4275, (510) 422-4275
17		C***DESCRIPTION
18		C
19		C PCHFE: Piecewise Cubic Hermite Function Evaluator
20		C
21		C Evaluates the cubic Hermite function defined by N, X, F, D at
22		C the points XE(J), J=1(1)NE.
23		C
24		C To provide compatibility with PCHIM and PCHIC, includes an
25		C increment between successive values of the F- and D-arrays.
26		C
27		C ----------------------------------------------------------------------
28		C
29		C Calling sequence:
30		C
31		C PARAMETER (INCFD = ...)
32		C INTEGER N, NE, IERR
33		C REAL X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE)
34		C LOGICAL SKIP
35		C
36		C CALL PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
37		C
38		C Parameters:
39		C
40		C N -- (input) number of data points. (Error return if N.LT.2 .)
41		C
42		C X -- (input) real array of independent variable values. The
43		C elements of X must be strictly increasing:
44		C X(I-1) .LT. X(I), I = 2(1)N.
45		C (Error return if not.)
46		C
47		C F -- (input) real array of function values. F(1+(I-1)*INCFD) is
48		C the value corresponding to X(I).
49		C
50		C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is
51		C the value corresponding to X(I).
52		C
53		C INCFD -- (input) increment between successive values in F and D.
54		C (Error return if INCFD.LT.1 .)
55		C
56		C SKIP -- (input/output) logical variable which should be set to
57		C .TRUE. if the user wishes to skip checks for validity of
58		C preceding parameters, or to .FALSE. otherwise.
59		C This will save time in case these checks have already
60		C been performed (say, in PCHIM or PCHIC).
61		C SKIP will be set to .TRUE. on normal return.
62		C
63		C NE -- (input) number of evaluation points. (Error return if
64		C NE.LT.1 .)
65		C
66		C XE -- (input) real array of points at which the function is to be
67		C evaluated.
68		C
69		C NOTES:
70		C 1. The evaluation will be most efficient if the elements
71		C of XE are increasing relative to X;
72		C that is, XE(J) .GE. X(I)
73		C implies XE(K) .GE. X(I), all K.GE.J .
74		C 2. If any of the XE are outside the interval [X(1),X(N)],
75		C values are extrapolated from the nearest extreme cubic,
76		C and a warning error is returned.
77		C
78		C FE -- (output) real array of values of the cubic Hermite function
79		C defined by N, X, F, D at the points XE.
80		C
81		C IERR -- (output) error flag.
82		C Normal return:
83		C IERR = 0 (no errors).
84		C Warning error:
85		C IERR.GT.0 means that extrapolation was performed at
86		C IERR points.
87		C "Recoverable" errors:
88		C IERR = -1 if N.LT.2 .
89		C IERR = -2 if INCFD.LT.1 .
90		C IERR = -3 if the X-array is not strictly increasing.
91		C IERR = -4 if NE.LT.1 .
92		C (The FE-array has not been changed in any of these cases.)
93		C NOTE: The above errors are checked in the order listed,
94		C and following arguments have NOT been validated.
95		C
96		C***REFERENCES (NONE)
97		C***ROUTINES CALLED CHFEV, XERMSG
98		C***REVISION HISTORY (YYMMDD)
99		C 811020 DATE WRITTEN
100		C 820803 Minor cosmetic changes for release 1.
101		C 870707 Minor cosmetic changes to prologue.
102		C 890531 Changed all specific intrinsics to generic. (WRB)
103		C 890831 Modified array declarations. (WRB)
104		C 890831 REVISION DATE from Version 3.2
105		C 891214 Prologue converted to Version 4.0 format. (BAB)
106		C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)
107		C***END PROLOGUE PCHFE
108		C Programming notes:
109		C
110		C 1. To produce a double precision version, simply:
111		C a. Change PCHFE to DPCHFE, and CHFEV to DCHFEV, wherever they
112		C occur,
113		C b. Change the real declaration to double precision,
114		C
115		C 2. Most of the coding between the call to CHFEV and the end of
116		C the IR-loop could be eliminated if it were permissible to
117		C assume that XE is ordered relative to X.
118		C
119		C 3. CHFEV does not assume that X1 is less than X2. thus, it would
120		C be possible to write a version of PCHFE that assumes a strict-
121		C ly decreasing X-array by simply running the IR-loop backwards
122		C (and reversing the order of appropriate tests).
123		C
124		C 4. The present code has a minor bug, which I have decided is not
125		C worth the effort that would be required to fix it.
126		C If XE contains points in [X(N-1),X(N)], followed by points .LT.
127		C X(N-1), followed by points .GT.X(N), the extrapolation points
128		C will be counted (at least) twice in the total returned in IERR.
129		C
130		C DECLARE ARGUMENTS.
131		C
132		INTEGER N, INCFD, NE, IERR
133		REAL X(), F(INCFD,), D(INCFD,), XE(), FE(*)
134		LOGICAL SKIP
135		C
136		C DECLARE LOCAL VARIABLES.
137		C
138		INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ
139		C
140		C VALIDITY-CHECK ARGUMENTS.
141		C
142		C***FIRST EXECUTABLE STATEMENT PCHFE
143	✗	IF (SKIP) GO TO 5
144		C
145	✗	IF ( N.LT.2 ) GO TO 5001
146	✗	IF ( INCFD.LT.1 ) GO TO 5002
147	✗	DO 1 I = 2, N
148	✗	IF ( X(I).LE.X(I-1) ) GO TO 5003
149	✗	1 CONTINUE
150		C
151		C FUNCTION DEFINITION IS OK, GO ON.
152		C
153		5 CONTINUE
154	✗	IF ( NE.LT.1 ) GO TO 5004
155	✗	IERR = 0
156	✗	SKIP = .TRUE.
157		C
158		C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )
159		C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )
160		JFIRST = 1
161	✗	IR = 2
162		10 CONTINUE
163		C
164		C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.
165		C
166	✗	IF (JFIRST .GT. NE) GO TO 5000
167		C
168		C LOCATE ALL POINTS IN INTERVAL.
169		C
170	✗	DO 20 J = JFIRST, NE
171	✗	IF (XE(J) .GE. X(IR)) GO TO 30
172	✗	20 CONTINUE
173	✗	J = NE + 1
174	✗	GO TO 40
175		C
176		C HAVE LOCATED FIRST POINT BEYOND INTERVAL.
177		C
178		30 CONTINUE
179	✗	IF (IR .EQ. N) J = NE + 1
180		C
181		40 CONTINUE
182	✗	NJ = J - JFIRST
183		C
184		C SKIP EVALUATION IF NO POINTS IN INTERVAL.
185		C
186	✗	IF (NJ .EQ. 0) GO TO 50
187		C
188		C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .
189		C
190		C ----------------------------------------------------------------
191		CALL CHFEV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR),
192	✗	* NJ, XE(JFIRST), FE(JFIRST), NEXT, IERC)
193		C ----------------------------------------------------------------
194	✗	IF (IERC .LT. 0) GO TO 5005
195		C
196	✗	IF (NEXT(2) .EQ. 0) GO TO 42
197		C IF (NEXT(2) .GT. 0) THEN
198		C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE
199		C RIGHT OF X(IR).
200		C
201	✗	IF (IR .LT. N) GO TO 41
202		C IF (IR .EQ. N) THEN
203		C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
204	✗	IERR = IERR + NEXT(2)
205	✗	GO TO 42
206		41 CONTINUE
207		C ELSE
208		C WE SHOULD NEVER HAVE GOTTEN HERE.
209	✗	GO TO 5005
210		C ENDIF
211		C ENDIF
212		42 CONTINUE
213		C
214	✗	IF (NEXT(1) .EQ. 0) GO TO 49
215		C IF (NEXT(1) .GT. 0) THEN
216		C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE
217		C LEFT OF X(IR-1).
218		C
219	✗	IF (IR .GT. 2) GO TO 43
220		C IF (IR .EQ. 2) THEN
221		C THESE ARE ACTUALLY EXTRAPOLATION POINTS.
222	✗	IERR = IERR + NEXT(1)
223	✗	GO TO 49
224		43 CONTINUE
225		C ELSE
226		C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST
227		C EVALUATION INTERVAL.
228		C
229		C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).
230	✗	DO 44 I = JFIRST, J-1
231	✗	IF (XE(I) .LT. X(IR-1)) GO TO 45
232	✗	44 CONTINUE
233		C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR
234		C IN CHFEV.
235	✗	GO TO 5005
236		C
237		45 CONTINUE
238		C RESET J. (THIS WILL BE THE NEW JFIRST.)
239		J = I
240		C
241		C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.
242	✗	DO 46 I = 1, IR-1
243	✗	IF (XE(J) .LT. X(I)) GO TO 47
244	✗	46 CONTINUE
245		C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).
246		C
247		47 CONTINUE
248		C AT THIS POINT, EITHER XE(J) .LT. X(1)
249		C OR X(I-1) .LE. XE(J) .LT. X(I) .
250		C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE
251		C CYCLING.
252	✗	IR = MAX(1, I-1)
253		C ENDIF
254		C ENDIF
255		49 CONTINUE
256		C
257	✗	JFIRST = J
258		C
259		C END OF IR-LOOP.
260		C
261		50 CONTINUE
262	✗	IR = IR + 1
263	✗	IF (IR .LE. N) GO TO 10
264		C
265		C NORMAL RETURN.
266		C
267		5000 CONTINUE
268	✗	RETURN
269		C
270		C ERROR RETURNS.
271		C
272		5001 CONTINUE
273		C N.LT.2 RETURN.
274	✗	IERR = -1
275		CALL XERMSG ('SLATEC', 'PCHFE',
276	✗	+ 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)
277	✗	RETURN
278		C
279		5002 CONTINUE
280		C INCFD.LT.1 RETURN.
281	✗	IERR = -2
282		CALL XERMSG ('SLATEC', 'PCHFE', 'INCREMENT LESS THAN ONE', IERR,
283	✗	+ 1)
284	✗	RETURN
285		C
286		5003 CONTINUE
287		C X-ARRAY NOT STRICTLY INCREASING.
288	✗	IERR = -3
289		CALL XERMSG ('SLATEC', 'PCHFE', 'X-ARRAY NOT STRICTLY INCREASING'
290	✗	+ , IERR, 1)
291	✗	RETURN
292		C
293		5004 CONTINUE
294		C NE.LT.1 RETURN.
295	✗	IERR = -4
296		CALL XERMSG ('SLATEC', 'PCHFE',
297	✗	+ 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)
298	✗	RETURN
299		C
300		5005 CONTINUE
301		C ERROR RETURN FROM CHFEV.
302		C * THIS CASE SHOULD NEVER OCCUR *
303	✗	IERR = -5
304		CALL XERMSG ('SLATEC', 'PCHFE',
305	✗	+ 'ERROR RETURN FROM CHFEV -- FATAL', IERR, 2)
306	✗	RETURN
307		C------------- LAST LINE OF PCHFE FOLLOWS ------------------------------
308		END
309

1

*DECK PCHFE

2

✗

SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)

3

C***BEGIN PROLOGUE PCHFE

4

C***PURPOSE Evaluate a piecewise cubic Hermite function at an array of

5

C points. May be used by itself for Hermite interpolation,

6

C or as an evaluator for PCHIM or PCHIC.

7

C***LIBRARY SLATEC (PCHIP)

8

C***CATEGORY E3

9

C***TYPE SINGLE PRECISION (PCHFE-S, DPCHFE-D)

10

C***KEYWORDS CUBIC HERMITE EVALUATION, HERMITE INTERPOLATION, PCHIP,

11

C PIECEWISE CUBIC EVALUATION

12

C***AUTHOR Fritsch, F. N., (LLNL)

13

C Lawrence Livermore National Laboratory

14

C P.O. Box 808 (L-316)

15

C Livermore, CA 94550

16

C FTS 532-4275, (510) 422-4275

17

C***DESCRIPTION

18

C

19

C PCHFE: Piecewise Cubic Hermite Function Evaluator

20

C

21

C Evaluates the cubic Hermite function defined by N, X, F, D at

22

C the points XE(J), J=1(1)NE.

23

C

24

C To provide compatibility with PCHIM and PCHIC, includes an

25

C increment between successive values of the F- and D-arrays.

26

C

27

C ----------------------------------------------------------------------

C

C Calling sequence:

C

C PARAMETER (INCFD = ...)

32

C INTEGER N, NE, IERR

33

C REAL X(N), F(INCFD,N), D(INCFD,N), XE(NE), FE(NE)

34

C LOGICAL SKIP

35

C

36

C CALL PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)

C

C Parameters:

C

C N -- (input) number of data points. (Error return if N.LT.2 .)

41

C

42

C X -- (input) real array of independent variable values. The

43

C elements of X must be strictly increasing:

44

C X(I-1) .LT. X(I), I = 2(1)N.

45

C (Error return if not.)

46

C

47

C F -- (input) real array of function values. F(1+(I-1)*INCFD) is

48

C the value corresponding to X(I).

49

C

50

C D -- (input) real array of derivative values. D(1+(I-1)*INCFD) is

51

C the value corresponding to X(I).

52

C

53

C INCFD -- (input) increment between successive values in F and D.

54

C (Error return if INCFD.LT.1 .)

55

C

56

C SKIP -- (input/output) logical variable which should be set to

57

C .TRUE. if the user wishes to skip checks for validity of

58

C preceding parameters, or to .FALSE. otherwise.

59

C This will save time in case these checks have already

60

C been performed (say, in PCHIM or PCHIC).

61

C SKIP will be set to .TRUE. on normal return.

62

C

63

C NE -- (input) number of evaluation points. (Error return if

64

C NE.LT.1 .)

65

C

66

C XE -- (input) real array of points at which the function is to be

C evaluated.

C

C NOTES:

C 1. The evaluation will be most efficient if the elements

71

C of XE are increasing relative to X;

72

C that is, XE(J) .GE. X(I)

73

C implies XE(K) .GE. X(I), all K.GE.J .

74

C 2. If any of the XE are outside the interval [X(1),X(N)],

75

C values are extrapolated from the nearest extreme cubic,

76

C and a warning error is returned.

77

C

78

C FE -- (output) real array of values of the cubic Hermite function

79

C defined by N, X, F, D at the points XE.

80

C

81

C IERR -- (output) error flag.

82

C Normal return:

83

C IERR = 0 (no errors).

84

C Warning error:

85

C IERR.GT.0 means that extrapolation was performed at

86

C IERR points.

87

C "Recoverable" errors:

88

C IERR = -1 if N.LT.2 .

89

C IERR = -2 if INCFD.LT.1 .

90

C IERR = -3 if the X-array is not strictly increasing.

91

C IERR = -4 if NE.LT.1 .

92

C (The FE-array has not been changed in any of these cases.)

93

C NOTE: The above errors are checked in the order listed,

94

C and following arguments have **NOT** been validated.

95

C

96

C***REFERENCES (NONE)

97

C***ROUTINES CALLED CHFEV, XERMSG

98

C***REVISION HISTORY (YYMMDD)

99

C 811020 DATE WRITTEN

100

C 820803 Minor cosmetic changes for release 1.

101

C 870707 Minor cosmetic changes to prologue.

102

C 890531 Changed all specific intrinsics to generic. (WRB)

103

C 890831 Modified array declarations. (WRB)

104

C 890831 REVISION DATE from Version 3.2

105

C 891214 Prologue converted to Version 4.0 format. (BAB)

106

C 900315 CALLs to XERROR changed to CALLs to XERMSG. (THJ)

107

C***END PROLOGUE PCHFE

108

C Programming notes:

109

C

110

C 1. To produce a double precision version, simply:

111

C a. Change PCHFE to DPCHFE, and CHFEV to DCHFEV, wherever they

112

C occur,

113

C b. Change the real declaration to double precision,

114

C

115

C 2. Most of the coding between the call to CHFEV and the end of

116

C the IR-loop could be eliminated if it were permissible to

117

C assume that XE is ordered relative to X.

118

C

119

C 3. CHFEV does not assume that X1 is less than X2. thus, it would

120

C be possible to write a version of PCHFE that assumes a strict-

121

C ly decreasing X-array by simply running the IR-loop backwards

122

C (and reversing the order of appropriate tests).

123

C

124

C 4. The present code has a minor bug, which I have decided is not

125

C worth the effort that would be required to fix it.

126

C If XE contains points in [X(N-1),X(N)], followed by points .LT.

127

C X(N-1), followed by points .GT.X(N), the extrapolation points

128

C will be counted (at least) twice in the total returned in IERR.

C

C DECLARE ARGUMENTS.

C

INTEGER N, INCFD, NE, IERR

133

REAL X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*)

134

LOGICAL SKIP

135

C

136

C DECLARE LOCAL VARIABLES.

137

C

138

INTEGER I, IERC, IR, J, JFIRST, NEXT(2), NJ

139

C

140

C VALIDITY-CHECK ARGUMENTS.

141

C

142

C***FIRST EXECUTABLE STATEMENT PCHFE

143

✗

IF (SKIP) GO TO 5

144

C

145

✗

IF ( N.LT.2 ) GO TO 5001

146

✗

IF ( INCFD.LT.1 ) GO TO 5002

147

✗

DO 1 I = 2, N

148

✗

IF ( X(I).LE.X(I-1) ) GO TO 5003

149

✗

1 CONTINUE

150

C

151

C FUNCTION DEFINITION IS OK, GO ON.

152

C

153

5 CONTINUE

154

✗

IF ( NE.LT.1 ) GO TO 5004

155

✗

IERR = 0

156

✗

SKIP = .TRUE.

157

C

158

C LOOP OVER INTERVALS. ( INTERVAL INDEX IS IL = IR-1 . )

159

C ( INTERVAL IS X(IL).LE.X.LT.X(IR) . )

160

JFIRST = 1

161

✗

IR = 2

162

10 CONTINUE

163

C

164

C SKIP OUT OF LOOP IF HAVE PROCESSED ALL EVALUATION POINTS.

165

C

166

✗

IF (JFIRST .GT. NE) GO TO 5000

167

C

168

C LOCATE ALL POINTS IN INTERVAL.

169

C

170

✗

DO 20 J = JFIRST, NE

171

✗

IF (XE(J) .GE. X(IR)) GO TO 30

172

✗

20 CONTINUE

173

✗

J = NE + 1

174

✗

GO TO 40

175

C

176

C HAVE LOCATED FIRST POINT BEYOND INTERVAL.

177

C

178

30 CONTINUE

179

✗

IF (IR .EQ. N) J = NE + 1

180

C

181

40 CONTINUE

182

✗

NJ = J - JFIRST

183

C

184

C SKIP EVALUATION IF NO POINTS IN INTERVAL.

185

C

186

✗

IF (NJ .EQ. 0) GO TO 50

187

C

188

C EVALUATE CUBIC AT XE(I), I = JFIRST (1) J-1 .

189

C

190

C ----------------------------------------------------------------

191

CALL CHFEV (X(IR-1),X(IR), F(1,IR-1),F(1,IR), D(1,IR-1),D(1,IR),

192

✗

* NJ, XE(JFIRST), FE(JFIRST), NEXT, IERC)

193

C ----------------------------------------------------------------

194

✗

IF (IERC .LT. 0) GO TO 5005

195

C

196

✗

IF (NEXT(2) .EQ. 0) GO TO 42

197

C IF (NEXT(2) .GT. 0) THEN

198

C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(2) TO THE

199

C RIGHT OF X(IR).

200

C

201

✗

IF (IR .LT. N) GO TO 41

202

C IF (IR .EQ. N) THEN

203

C THESE ARE ACTUALLY EXTRAPOLATION POINTS.

204

✗

IERR = IERR + NEXT(2)

205

✗

GO TO 42

206

41 CONTINUE

207

C ELSE

208

C WE SHOULD NEVER HAVE GOTTEN HERE.

209

✗

GO TO 5005

C ENDIF

C ENDIF

42 CONTINUE

C

✗

IF (NEXT(1) .EQ. 0) GO TO 49

215

C IF (NEXT(1) .GT. 0) THEN

216

C IN THE CURRENT SET OF XE-POINTS, THERE ARE NEXT(1) TO THE

217

C LEFT OF X(IR-1).

218

C

219

✗

IF (IR .GT. 2) GO TO 43

220

C IF (IR .EQ. 2) THEN

221

C THESE ARE ACTUALLY EXTRAPOLATION POINTS.

222

✗

IERR = IERR + NEXT(1)

223

✗

GO TO 49

224

43 CONTINUE

225

C ELSE

226

C XE IS NOT ORDERED RELATIVE TO X, SO MUST ADJUST

227

C EVALUATION INTERVAL.

228

C

229

C FIRST, LOCATE FIRST POINT TO LEFT OF X(IR-1).

230

✗

DO 44 I = JFIRST, J-1

231

✗

IF (XE(I) .LT. X(IR-1)) GO TO 45

232

✗

44 CONTINUE

233

C NOTE-- CANNOT DROP THROUGH HERE UNLESS THERE IS AN ERROR

234

C IN CHFEV.

235

✗

GO TO 5005

236

C

237

45 CONTINUE

238

C RESET J. (THIS WILL BE THE NEW JFIRST.)

239

J = I

240

C

241

C NOW FIND OUT HOW FAR TO BACK UP IN THE X-ARRAY.

242

✗

DO 46 I = 1, IR-1

243

✗

IF (XE(J) .LT. X(I)) GO TO 47

244

✗

46 CONTINUE

245

C NB-- CAN NEVER DROP THROUGH HERE, SINCE XE(J).LT.X(IR-1).

246

C

247

47 CONTINUE

248

C AT THIS POINT, EITHER XE(J) .LT. X(1)

249

C OR X(I-1) .LE. XE(J) .LT. X(I) .

250

C RESET IR, RECOGNIZING THAT IT WILL BE INCREMENTED BEFORE

251

C CYCLING.

252

✗

IR = MAX(1, I-1)

C ENDIF

C ENDIF

49 CONTINUE

C

✗

JFIRST = J

C

C END OF IR-LOOP.

C

50 CONTINUE

✗

IR = IR + 1

263

✗

IF (IR .LE. N) GO TO 10

C

C NORMAL RETURN.

C

5000 CONTINUE

✗

RETURN

C

C ERROR RETURNS.

C

5001 CONTINUE

C N.LT.2 RETURN.

✗

IERR = -1

275

CALL XERMSG ('SLATEC', 'PCHFE',

276

✗

+ 'NUMBER OF DATA POINTS LESS THAN TWO', IERR, 1)

277

✗

RETURN

C

5002 CONTINUE

C INCFD.LT.1 RETURN.

✗

IERR = -2

282

CALL XERMSG ('SLATEC', 'PCHFE', 'INCREMENT LESS THAN ONE', IERR,

283

✗

+ 1)

284

✗

RETURN

285

C

286

5003 CONTINUE

287

C X-ARRAY NOT STRICTLY INCREASING.

288

✗

IERR = -3

289

CALL XERMSG ('SLATEC', 'PCHFE', 'X-ARRAY NOT STRICTLY INCREASING'

290

✗

+ , IERR, 1)

291

✗

RETURN

C

5004 CONTINUE

C NE.LT.1 RETURN.

✗

IERR = -4

296

CALL XERMSG ('SLATEC', 'PCHFE',

297

✗

+ 'NUMBER OF EVALUATION POINTS LESS THAN ONE', IERR, 1)

298

✗

RETURN

299

C

300

5005 CONTINUE

301

C ERROR RETURN FROM CHFEV.

302

C *** THIS CASE SHOULD NEVER OCCUR ***

303

✗

IERR = -5

304

CALL XERMSG ('SLATEC', 'PCHFE',

305

✗

+ 'ERROR RETURN FROM CHFEV -- FATAL', IERR, 2)

306

✗

RETURN

307

C------------- LAST LINE OF PCHFE FOLLOWS ------------------------------

308

END

309