Context Navigation

spl_incr.pro @ 101

Last change on this file since 101 was 101, checked in by pinsard, 18 years ago
start to modify headers of Interpolation *.pro files for better idldoc output
Property svn:executable set to ``*
File size: 19.2 KB

Line
1	;------------------------------------------------------------
2	;------------------------------------------------------------
3	;------------------------------------------------------------
4	;+
5	;
6	; @file_comments
7	;
8	; Given the arrays X and Y, which tabulate a function (with the X[i]
9	; AND Y[i] in ascending order), and given an input value X2, the
10	; SPL_INCR function returns an interpolated value for the given values
11	; of X2. The interpolation method is based on cubic spline, corrected
12	; in a way that interpolated values are also monotonically increasing.
13	;
14	; @examples y2 = spl_incr(x, y, x2)
15	;
16	; @param x1 {in}{required} An n-element (at least 2) input vector that specifies the
17	; tabulate points in a strict ascending order.
18	;
19	; @param y1 {in}{required} f(x) = y. An n-element input vector that specifies the values
20	; of the tabulated function F(Xi) corresponding to Xi. As f is
21	; supposed to be monotonically increasing, y values must be
22	; monotonically increasing. y can have equal consecutive values.
23	;
24	; @param x2 {in}{required} The input values for which the interpolated values are
25	; desired. Its values must be strictly monotonically increasing.
26	;
27	;
28	;
29	;
30	; @returns
31	;
32	; y2: f(x2) = y2. Double precision array
33	;
34	; @restrictions
35	; It might be possible that y2[i+1]-y2[i] has very small negative
36	; values (amplitude smaller than 1.e-6)...
37	;
38	; @examples
39	;
40	; n = 100L
41	; x = (dindgen(n))^2
42	; y = abs(randomn(0, n))
43	; y[n/2:n/2+1] = 0.
44	; y[n-n/3] = 0.
45	; y[n-n/6:n-n/6+5] = 0.
46	; y = total(y, /cumulative, /double)
47	; x2 = dindgen((n-1)^2)
48	; n2 = n_elements(x2)
49	; print, min(y[1:n-1]-y[0:n-2]) LT 0
50	; y2 = spl_incr( x, y, x2)
51	; splot, x, y, xstyle = 1, ystyle = 1, ysurx=.25, petit = [1, 2, 1], /land
52	; oplot, x2, y2, color = 100
53	; c = y2[1:n2-1] - y2[0:n2-2]
54	; print, min(c) LT 0
55	; print, min(c, max = ma), ma
56	; splot,c,xstyle=1,ystyle=1, yrange=[-.01,.05], ysurx=.25, petit = [1, 2, 2], /noerase
57	; oplot,[0, n_elements(c)], [0, 0], linestyle = 1
58	;
59	; @history
60	; Sebastien Masson (smasson\@lodyc.jussieu.fr): May-Dec 2005
61	;-
62	;------------------------------------------------------------
63	;------------------------------------------------------------
64	;------------------------------------------------------------
65	FUNCTION pure_concave, x1, x2, y1, y2, der2, x
66	; X^n type
67	xx = (double(x)-double(x1))/(double(x2)-double(x1))
68	f = (double(x2)-double(x1))/(double(y2)-double(y1))
69	n = der2*temporary(f)
70	res = xx^(n)
71	; IF check_math() GT 0 THEN BEGIN
72	; zero = where(abs(res) LT 1.e-10)
73	; IF zero[0] NE -1 THEN res[zero] = 0.0d
74	; END
75	res = temporary(res)*(double(y2)-double(y1))+y1
76	;
77	; IF array_equal(sort(res), lindgen(n_elements(res)) ) NE 1 THEN stop
78	RETURN, res
79	END
80
81	FUNCTION pure_convex, x1, x2, y1, y2, der2, x
82	; 1-(1-X)^n type
83	xx = 1.0d - (double(x)-double(x1))/(double(x2)-double(x1))
84	f = (double(x2)-double(x1))/(double(y2)-double(y1))
85	n = der2*temporary(f)
86	res = xx^(n)
87	; IF check_math() GT 0 THEN BEGIN
88	; zero = where(abs(res) LT 1.e-10)
89	; IF zero[0] NE -1 THEN res[zero] = 0.0d
90	; END
91	res = 1.0d - temporary(res)
92	res = temporary(res)*(y2-y1)+y1
93	;
94	; IF array_equal(sort(res), lindgen(n_elements(res)) ) NE 1 THEN stop
95	RETURN, res
96	END
97
98	;+
99	; @keyword YP0 The first derivative of the interpolating function at the
100	; point X0. If YP0 is omitted, the second derivative at the
101	; boundary is set to zero, resulting in a "natural spline."
102	; @keyword YPN_1 The first derivative of the interpolating function at the
103	; point Xn-1. If YPN_1 is omitted, the second derivative at the
104	; boundary is set to zero, resulting in a "natural spline."
105	;-
106	FUNCTION spl_incr, x, y, x2, YP0 = yp0, YPN_1 = ypn_1
107	;
108	;---------------------------------
109	; check and initialisation ...
110	;---------------------------------
111	nx = n_elements(x)
112	ny = n_elements(y)
113	nx2 = n_elements(x2)
114	; x must have at least 2 elements
115	IF nx LT 2 THEN stop
116	; y must have the same number of elements than x
117	IF nx NE ny THEN stop
118	; x be monotonically increasing
119	IF min(x[1:nx-1]-x[0:nx-2]) LE 0 THEN stop
120	; x2 be monotonically increasing
121	IF N_ELEMENTS(X2) GE 2 THEN $
122	IF min(x2[1:nx2-1]-x2[0:nx2-2]) LE 0 THEN stop
123	; y be monotonically increasing
124	IF min(y[1:ny-1]-y[0:ny-2]) LT 0 THEN stop
125	;---------------------------------
126	; first check: check if two consecutive values are equal
127	;---------------------------------
128	bad = where(y[1:ny-1]-y[0:ny-2] EQ 0, cntbad)
129	IF cntbad NE 0 THEN BEGIN
130	; define the results: y2
131	y2 = dblarr(nx2)
132	; define xinx2: see help of value_locate
133	; if xinx2[i] eq -1 : x[bad[i]] < x2[0]
134	; if xinx2[i] eq nx2-1: x[bad[i]] >= x2[nx2-1]
135	; else : x2[xinx2[i]] <= x[bad[i]] < x2[xinx2[i]+1]
136	xinx2 = value_locate(x2, x[bad])
137	xinx2_1 = value_locate(x2, x[bad+1])
138	;
139	; left side ... if there is x2 values smaller that x[bad[0]].
140	; we force ypn_1 = 0.0d
141	IF xinx2[0] NE -1 THEN BEGIN
142	IF bad[0] EQ 0 THEN BEGIN
143	IF xinx2[0] NE 0 THEN stop
144	y2[0] = y[0]
145	ENDIF ELSE BEGIN
146	y2[0:xinx2[0]] $
147	= spl_incr(x[0:bad[0]], y[0:bad[0]], x2[0:xinx2[0]] $
148	, yp0 = yp0, ypn_1 = 0.0d)
149	ENDELSE
150	ENDIF
151	; flat section
152	IF xinx2_1[0] NE -1 THEN $
153	y2[(xinx2[0]+1) < xinx2_1[0] : xinx2_1[0]] = y[bad[0]]
154	; middle pieces ... if cntbad gt 1 then we have to cut spl_incr in
155	; more than 2 pieces...
156	IF cntbad GT 1 THEN BEGIN
157	; we take care of the piece located wetween bad[ib-1]+1 and bad[ib]
158	FOR ib = 1, cntbad-1 DO BEGIN
159	; if there is x2 values smaller that x[bad[ib]], then the x2 values
160	; located between bad[ib-1]+1 and bad[ib] are (xinx2_1[ib-1]+1:xinx2[ib]
161	; and if we don't have two consecutive flat sections
162	IF xinx2[ib] NE -1 AND (bad[ib-1] NE bad[ib]-1) THEN begin
163	y2[(xinx2_1[ib-1]+1) < xinx2[ib]:xinx2[ib]] $
164	= spl_incr(x[bad[ib-1]+1:bad[ib]], y[bad[ib-1]+1:bad[ib]] $
165	, x2[(xinx2_1[ib-1]+1) < xinx2[ib]:xinx2[ib]] $
166	, yp0 = 0.0d, ypn_1 = 0.0d)
167	ENDIF
168	; flat section
169	IF xinx2_1[ib] NE -1 THEN $
170	y2[(xinx2[ib]+1) < xinx2_1[ib] : xinx2_1[ib]] = y[bad[ib]]
171	ENDFOR
172	ENDIF
173	; right side ... if there is x2 values larger that x[bad[cntbad-1]+1].
174	; we force yp0 = 0.0d
175	IF xinx2_1[cntbad-1] NE nx2-1 THEN $
176	y2[xinx2_1[cntbad-1]+1:nx2-1] $
177	= spl_incr(x[bad[cntbad-1]+1:nx-1], y[bad[cntbad-1]+1:nx-1] $
178	, x2[xinx2_1[cntbad-1]+1:nx2-1] $
179	, yp0 = 0.0d, ypn_1 = ypn_1new)
180
181	RETURN, y2
182
183	ENDIF
184	;-----------
185	; compute the second derivative of the cubic spline on each x.
186	;-----------
187	yscd = spl_init(x, y, yp0 = yp0, ypn_1 = ypn_1, /double)
188	;---------------------------------
189	; second check: none of the first derivative on x values must be negative.
190	;---------------------------------
191	;
192	; compute the first derivative on x
193	;
194	yifrst = spl_fstdrv(x, y, yscd, x)
195	;
196	; we force the negative first derivative to 0 by calling again
197	; spl_incr with the keywords yp0 and ypn_1 to specify the
198	; first derivative equal to 0
199	;
200	bad = where(yifrst LT 0.0d, cntbad)
201	IF cntbad NE 0 THEN BEGIN
202	;
203	; we define the new values of the keyword ypn_1:
204	; if the first derivative of the last value of x is negative
205	; we define the new values of the keyword ypn_1 to 0.0d0
206	IF bad[cntbad-1] EQ nx-1 THEN BEGIN
207	ypn_1new = 0.0d
208	; we remove this case from the list
209	IF cntbad GE 2 THEN bad = bad[0:cntbad-2]
210	cntbad = cntbad-1
211	; else we take the value of ypn_1 if it was already defined
212	ENDIF ELSE IF n_elements(ypn_1) NE 0 THEN ypn_1new = ypn_1
213	;
214	; we define the new values of the keyword yp0:
215	; if the first derivative of the first value of x is negative
216	; we define the new values of the keyword yp0 to 0.0
217	IF bad[0] EQ 0 THEN BEGIN
218	yp0new = 0.0d
219	; we remove this case from the list
220	IF cntbad GE 2 THEN bad = bad[1:cntbad-1]
221	cntbad = cntbad-1
222	; else we take the value of yp0 if it was already defined
223	ENDIF ELSE IF n_elements(yp0) NE 0 THEN yp0new = yp0
224	;
225	; if all the negative derivative corresponded to one of the cases above,
226	; then we can directly call spl_incr with the new yp0new and ypn_1new
227	IF cntbad LE 0 THEN BEGIN
228	y2 = spl_incr(x, y, x2, yp0 = yp0new, ypn_1 = ypn_1new)
229	;
230	; else: there is still cases with negative derivative ...
231	; we will cut spl_incr in n spl_incr and specify yp0, ypn_1
232	; for each of this n spl_incr
233	ENDIF ELSE BEGIN
234	; define xinx2: see help of value_locate
235	; if xinx2[i] eq -1 : x[bad[i]] < x2[0]
236	; if xinx2[i] eq nx2-1: x[bad[i]] >= x2[nx2-1]
237	; else : x2[xinx2[i]] <= x[bad[i]] < x2[xinx2[i]+1]
238	xinx2 = value_locate(x2, x[bad])
239	y2 = dblarr(nx2)
240	; left side ... if there is x2 values smaller that x[bad[0]].
241	; we force ypn_1 = 0.0d
242	IF xinx2[0] NE -1 THEN $
243	y2[0:xinx2[0]] $
244	= spl_incr(x[0:bad[0]], y[0:bad[0]], x2[0:xinx2[0]] $
245	, yp0 = yp0new, ypn_1 = 0.0d)
246	; middle pieces ... if cntbad gt 1 then we have to cut spl_incr in
247	; more than 2 pieces -> we have middle pieces for which
248	; we force yp0 = 0.0d and ypn_1 = 0.0d
249	IF cntbad GT 1 THEN BEGIN
250	; we take care of the piece located wetween bad[ib-1] and bad[ib]
251	FOR ib = 1, cntbad-1 DO BEGIN
252	; if there is x2 values smaller that x[bad[ib]], then the x2 values
253	; located between bad[ib-1] and bad[ib] are (xinx2[ib-1]+1:xinx2[ib]
254	IF xinx2[ib] NE -1 THEN begin
255	y2[(xinx2[ib-1]+1) < xinx2[ib]:xinx2[ib]] $
256	= spl_incr(x[bad[ib-1]:bad[ib]], y[bad[ib-1]:bad[ib]] $
257	, x2[(xinx2[ib-1]+1) < xinx2[ib]:xinx2[ib]] $
258	, yp0 = 0.0d, ypn_1 = 0.0d)
259	endif
260	ENDFOR
261	ENDIF
262	; right side ... if there is x2 values larger that x[bad[cntbad-1]].
263	; we force yp0 = 0.0d
264	IF xinx2[cntbad-1] NE nx2-1 THEN $
265	y2[xinx2[cntbad-1]+1:nx2-1] $
266	= spl_incr(x[bad[cntbad-1]:nx-1], y[bad[cntbad-1]:nx-1] $
267	, x2[xinx2[cntbad-1]+1:nx2-1] $
268	, yp0 = 0.0d, ypn_1 = ypn_1new)
269	ENDELSE
270	; we return the checked and corrected value of yfrst
271	; FOR i = 0, nx-1 DO BEGIN
272	; same = where(abs(x2- x[i]) LT 1.e-10, cnt)
273	; ; IF cnt NE 0 THEN y2[same] = y[i]
274	; ENDFOR
275	RETURN, y2
276	ENDIF
277	;
278	; we can be in this part of the code only if:
279	; (1) spl_incr is called by itself
280	; (2) none are the first derivative in x are negative (because they have been
281	; checked and corrected by the previous call to spl_incr, see above)
282	;---------------------------------
283	; third check: we have to make sure that the first derivative cannot
284	; have negative values between on x[0] and x[nx-1]
285	;---------------------------------
286	;
287	; first we compute the first derivative, next we correct the values
288	; where we know that the first derivative can be negative.
289	;
290	y2 = spl_interp(x, y, yscd, x2, /double)
291	;
292	; between x[i] and x[i+1], the cubic spline is a cubic function:
293	; y = aX^3 + bX^2 + c*X + d
294	; y' = 3aX^2 + 2bX + c
295	; y''= 6a*X + 2b
296	; if we take X = x[i+1]-x[i] then
297	; d = y[i]; c = y'[i]; b = 0.5 * y''[i],
298	; a = 1/6 * (y''[i+1]-y''[i])/(x[i+1]-x[i])
299	;
300	; y'[i] and y'[i+1] are positive so y' can be negative
301	; between x[i] and x[i+1] only if
302	; 1) a > 0
303	; ==> y''[i+1] > y''[i]
304	; 2) y' reach its minimum value between x[i] and x[i+1]
305	; -> 0 < - b/(3a) < x[i+1]-x[i]
306	; ==> y''[i+1] > 0 > y''[i]
307	;
308	; we do a first selection by looking for those points...
309	;
310	loc = lindgen(nx-1)
311	maybebad = where(yscd[loc] LE 0.0d AND yscd[loc+1] GE 0.0d, cntbad)
312	;
313	IF cntbad NE 0 THEN BEGIN
314
315	mbbloc = loc[maybebad]
316
317	aaa = (yscd[mbbloc+1]-yscd[mbbloc])/(6.0d*(x[mbbloc+1]-x[mbbloc]))
318	bbb = 0.5d * yscd[mbbloc]
319	ccc = yifrst[mbbloc]
320	ddd = y[mbbloc]
321	;
322	; definitive selection:
323	; y' can become negative if and only if (2b)^2 - 4(3a)c > 0
324	; y' can become negative if and only if b^2 - (3a)c > 0
325	;
326	delta = bbbbbb - 3.0daaa*ccc
327	;
328	bad = where(delta GT 0, cntbad)
329	;
330	IF cntbad NE 0 THEN BEGIN
331	delta = delta[bad]
332	aaa = aaa[bad]
333	bbb = bbb[bad]
334	ccc = ccc[bad]
335	ddd = ddd[bad]
336	bad = maybebad[bad]
337	; define xinx2_1: see help of value_locate
338	; if xinx2_1[i] eq -1 : x[bad[i]] < x2[0]
339	; if xinx2_1[i] eq nx2-1: x[bad[i]] >= x2[nx2-1]
340	; else : x2[xinx2_1[i]] <= x[bad[i]] < x2[xinx2_1[i]+1]
341	xinx2_1 = value_locate(x2, x[bad])
342	; define xinx2_2: see help of value_locate
343	; if xinx2_2[i] eq -1 : x[bad[i]+1] < x2[0]
344	; if xinx2_2[i] eq nx2-1: x[bad[i]+1] >= x2[nx2-1]
345	; else : x2[xinx2_2[i]] <= x[bad[i]+1] < x2[xinx2_2[i]+1]
346	xinx2_2 = value_locate(x2, x[bad+1])
347	; to avoid the particular case when x2 = x[bad[i]]
348	; and there is no other x2 point until x[bad[i]+1]
349	xinx2_1 = xinx2_1 < (xinx2_2-1)
350	;
351	FOR ib = 0, cntbad-1 DO BEGIN
352	;
353	; at least one of the x2 points must be located between
354	; x[bad[ib]] and x[bad[ib]+1]
355	IF x2[0] LE x[bad[ib]+1] AND x2[nx2-1] GE x[bad[ib]] THEN BEGIN
356	;
357	CASE 1 OF
358	yifrst[bad[ib]+1] EQ 0.0d:BEGIN
359	; case pur convex: we use the first derivative of 1-(1-x)^n
360	; and ajust n to get the good value: yifrst[bad[ib]] in x[bad[ib]]
361	y2[xinx2_1[ib]+1:xinx2_2[ib]] $
362	= pure_convex(x[bad[ib]], x[bad[ib]+1] $
363	, y[bad[ib]], y[bad[ib]+1] $
364	, yifrst[bad[ib]] $
365	, x2[xinx2_1[ib]+1:xinx2_2[ib]])
366	END
367	yifrst[bad[ib]] EQ 0.0d:BEGIN
368	; case pur concave: we use the first derivative of x^n
369	; and ajust n to get the good value: yifrst[bad[ib]+1] in x[bad[ib]+1]
370	y2[xinx2_1[ib]+1:xinx2_2[ib]] $
371	= pure_concave(x[bad[ib]], x[bad[ib]+1] $
372	, y[bad[ib]], y[bad[ib]+1] $
373	, yifrst[bad[ib]+1] $
374	, x2[xinx2_1[ib]+1:xinx2_2[ib]])
375	END
376	ELSE:BEGIN
377	; in those cases, the first derivative has 2 zero between
378	; x[bad[ib]] and x[bad[ib]+1]. We look for the minimum value of the
379	; first derivative that correspond to the inflection point of y
380	xinfl = -bbb[ib]/(3.0d*aaa[ib])
381	; we compute the y value for xinfl
382	yinfl = aaa[ib]xinflxinflxinfl + bbb[ib]xinfl*xinfl $
383	+ ccc[ib]*xinfl + ddd[ib]
384	;
385	CASE 1 OF
386	; if y[xinfl] smaller than y[bad[ib]] then we conserve y2 until
387	; the first zero of y2 and from this point we use x^n and ajust n to
388	; get the good value: yifrst[bad[ib]+1] in x[bad[ib]+1]
389	yinfl LT y[bad[ib]]:BEGIN
390	; value of the first zero (y'[xzero]=0)
391	xzero = (-bbb[ib]-sqrt(delta[ib]))/(3.0d*aaa[ib])
392	; value of y[xzero]...
393	yzero = aaa[ib]xzeroxzeroxzero + bbb[ib]xzero*xzero $
394	+ ccc[ib]*xzero + ddd[ib]
395	; if yzero > y[bad[ib]+1] then we cannot applay the method we want to
396	; apply => we use then convex-concave case by changing by hand the
397	; value of yinfl and xinfl
398	IF yzero GT y[bad[ib]+1] THEN BEGIN
399	yinfl = 0.5d*(y[bad[ib]+1]+y[bad[ib]])
400	xinfl = 0.5d*(x[bad[ib]+1]-x[bad[ib]])
401	GOTO, convexconcave
402	ENDIF
403	; define xinx2_3: see help of value_locate
404	; if xinx2_3[ib] eq -1 : x[bad[ib]]+xzero < x2[0]
405	; if xinx2_3[ib] eq nx2-1: x[bad[ib]]+xzero >= x2[nx2-1]
406	; else : x2[xinx2_3] <= x[bad[ib]]+xzero < x2[xinx3_2+1]
407	xinx2_3 = value_locate(x2, x[bad[ib]]+xzero)
408	; to avoid the particular case when x2 = x[bad[ib]]+xzero
409	; and there is no other x2 point until x[bad[ib]+1]
410	xinx2_3 = xinx2_3 < (xinx2_2[ib]-1)
411	IF xinx2_2[ib] GE xinx2_3+1 THEN BEGIN
412	y2[xinx2_3+1:xinx2_2[ib]] $
413	= pure_concave(x[bad[ib]]+xzero, x[bad[ib]+1] $
414	, yzero, y[bad[ib]+1] $
415	, yifrst[bad[ib]+1] $
416	, x2[xinx2_3+1:xinx2_2[ib]])
417	ENDIF
418	END
419	; if y[xinfl] bigger than y[bad[ib]+1] then we conserve y2 from
420	; the second zero of y2 and before this point we use 1-(1-x)^n and
421	; ajust n to get the good value: yifrst[bad[ib]] in x[bad[ib]]
422	yinfl GT y[bad[ib]+1]:BEGIN
423	; value of the second zero (y'[xzero]=0)
424	xzero = (-bbb[ib]+sqrt(delta[ib]))/(3.0d*aaa[ib])
425	; value of y[xzero]...
426	yzero = aaa[ib]xzeroxzeroxzero + bbb[ib]xzero*xzero $
427	+ ccc[ib]*xzero + ddd[ib]
428	; if yzero < y[bad[ib]] then we cannot applay the method we want to
429	; apply => we use then convex-concave case by changing by hand the
430	; value of yinfl and xinfl
431	IF yzero lt y[bad[ib]] THEN BEGIN
432	yinfl = 0.5d*(y[bad[ib]+1]+y[bad[ib]])
433	xinfl = 0.5d*(x[bad[ib]+1]-x[bad[ib]])
434	GOTO, convexconcave
435	ENDIF
436	; define xinx2_3: see help of value_locate
437	; if xinx2_3[ib] eq -1 : x[bad[ib]]+xzero < x2[0]
438	; if xinx2_3[ib] eq nx2-1: x[bad[ib]]+xzero >= x2[nx2-1]
439	; else : x2[xinx2_3] <= x[bad[ib]]+xzero < x2[xinx3_2+1]
440	xinx2_3 = value_locate(x2, x[bad[ib]]+xzero)
441	IF xinx2_3 ge xinx2_1[ib]+1 THEN BEGIN
442	y2[xinx2_1[ib]+1:xinx2_3] $
443	= pure_convex(x[bad[ib]], x[bad[ib]]+xzero $
444	, y[bad[ib]], yzero $
445	, yifrst[bad[ib]] $
446	, x2[xinx2_1[ib]+1:xinx2_3])
447	ENDIF
448	END
449	ELSE:BEGIN
450	convexconcave:
451	; define xinx2_3: see help of value_locate
452	; if xinx2_3[ib] eq -1 : x[bad[ib]]+xzero < x2[0]
453	; if xinx2_3[ib] eq nx2-1: x[bad[ib]]+xzero >= x2[nx2-1]
454	; else : x2[xinx2_3] <= x[bad[ib]]+xzero < x2[xinx3_2+1]
455	xinx2_3 = value_locate(x2, x[bad[ib]]+xinfl)
456
457	IF xinx2_3 ge xinx2_1[ib]+1 THEN BEGIN
458	y2[xinx2_1[ib]+1:xinx2_3] $
459	= pure_convex(x[bad[ib]], x[bad[ib]]+xinfl $
460	, y[bad[ib]], yinfl $
461	, yifrst[bad[ib]] $
462	, x2[xinx2_1[ib]+1:xinx2_3])
463
464	ENDIF
465	IF xinx2_2[ib] GE xinx2_3+1 THEN BEGIN
466	y2[xinx2_3+1:xinx2_2[ib]] $
467	= pure_concave(x[bad[ib]]+xinfl, x[bad[ib]+1] $
468	, yinfl, y[bad[ib]+1] $
469	, yifrst[bad[ib]+1] $
470	, x2[xinx2_3+1:xinx2_2[ib]])
471	ENDIF
472	END
473	ENDCASE
474
475	END
476	ENDCASE
477	ENDIF
478	ENDFOR
479
480	ENDIF
481	ENDIF
482	;
483	RETURN, y2
484	;
485	;------------------------------------------------------------------
486	;------------------------------------------------------------------
487	;
488	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format