File Coverage

lib/PDL/Primitive-pp-pchip_chia.c
Criterion Covered Total %
statement 52 72 72.2
branch 50 264 18.9
condition n/a
subroutine n/a
pod n/a
total 102 336 30.3


line stmt bran cond sub pod time code
1              
2             #line 453 "lib/PDL/PP.pm"
3             /*
4             * THIS FILE WAS GENERATED BY PDL::PP from lib/PDL/Primitive.pd! Do not modify!
5             */
6              
7             #define PDL_FREE_CODE(trans, destroy, comp_free_code, ntpriv_free_code) \
8             if (destroy) { \
9             comp_free_code \
10             } \
11             if ((trans)->dims_redone) { \
12             ntpriv_free_code \
13             }
14              
15             #include "EXTERN.h"
16             #include "perl.h"
17             #include "XSUB.h"
18             #include "pdl.h"
19             #include "pdlcore.h"
20             #define PDL PDL_Primitive
21             extern Core* PDL; /* Structure hold core C functions */
22             #line 23 "lib/PDL/Primitive-pp-pchip_chia.c"
23             extern int pdl_srand_threads;
24             extern uint64_t *pdl_rand_state;
25             void pdl_srand(uint64_t **s, uint64_t seed, int n);
26             double pdl_drand(uint64_t *s);
27             #define PDL_MAYBE_SRAND \
28             if (pdl_srand_threads < 0) \
29             pdl_srand(&pdl_rand_state, PDL->pdl_seed(), PDL->online_cpus());
30             #define PDL_RAND_SET_OFFSET(v, thr, pdl) \
31             if (v < 0) { \
32             if (thr.mag_nthr >= 0) { \
33             int thr_no = PDL->magic_get_thread(pdl); \
34             if (thr_no < 0) return PDL->make_error_simple(PDL_EFATAL, "Invalid pdl_magic_get_thread!"); \
35             v = thr_no == 0 ? thr_no : thr_no % PDL->online_cpus(); \
36             } else { \
37             v = 0; \
38             } \
39             }
40              
41             #line 1857 "lib/PDL/PP.pm"
42             pdl_error pdl_pchip_chia_redodims(pdl_trans *__privtrans) {
43             pdl_error PDL_err = {0, NULL, 0};
44             #line 45 "lib/PDL/Primitive-pp-pchip_chia.c"
45             #ifndef PDL_DECLARE_PARAMS_pchip_chia_0
46             #define PDL_DECLARE_PARAMS_pchip_chia_0(PDL_TYPE_OP,PDL_PPSYM_OP,PDL_TYPE_PARAM_ierr,PDL_PPSYM_PARAM_ierr,PDL_TYPE_PARAM_skip,PDL_PPSYM_PARAM_skip) \
47             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, x, (__privtrans->pdls[0]), 0, PDL_PPSYM_OP) \
48             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, f, (__privtrans->pdls[1]), 0, PDL_PPSYM_OP) \
49             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, d, (__privtrans->pdls[2]), 0, PDL_PPSYM_OP) \
50             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, la, (__privtrans->pdls[3]), 0, PDL_PPSYM_OP) \
51             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, lb, (__privtrans->pdls[4]), 0, PDL_PPSYM_OP) \
52             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, ans, (__privtrans->pdls[5]), 0, PDL_PPSYM_OP) \
53             PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_ierr, ierr, (__privtrans->pdls[6]), 0, PDL_PPSYM_PARAM_ierr) \
54             PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_skip, skip, (__privtrans->pdls[7]), 0, PDL_PPSYM_PARAM_skip)
55             #endif
56             #define PDL_IF_BAD(t,f) f
57 2           switch (__privtrans->__datatype) { /* Start generic switch */
58 0           case PDL_F: {
59 0 0         PDL_DECLARE_PARAMS_pchip_chia_0(PDL_Float,F,PDL_Indx,N,PDL_Long,L)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
60 0 0         {if (__privtrans->ind_sizes[0] < 2) return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "NUMBER OF DATA POINTS LESS THAN TWO");
61             }
62 0           } break;
63 2           case PDL_D: {
64 2 50         PDL_DECLARE_PARAMS_pchip_chia_0(PDL_Double,D,PDL_Indx,N,PDL_Long,L)
    50          
    50          
    50          
    50          
    50          
    50          
    50          
65 2 50         {if (__privtrans->ind_sizes[0] < 2) return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "NUMBER OF DATA POINTS LESS THAN TWO");
66             }
67 2           } break;
68 0           case PDL_LD: {
69 0 0         PDL_DECLARE_PARAMS_pchip_chia_0(PDL_LDouble,E,PDL_Indx,N,PDL_Long,L)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
70 0 0         {if (__privtrans->ind_sizes[0] < 2) return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "NUMBER OF DATA POINTS LESS THAN TWO");
71             }
72 0           } break;
73 0           default: return PDL->make_error(PDL_EUSERERROR, "PP INTERNAL ERROR in pchip_chia: unhandled datatype(%d), only handles (FDE)! PLEASE MAKE A BUG REPORT\n", __privtrans->__datatype);
74             }
75             #undef PDL_IF_BAD
76              
77 2 50         PDL_RETERROR(PDL_err, PDL->redodims_default(__privtrans));
78 2           return PDL_err;
79             }
80              
81              
82             #line 1857 "lib/PDL/PP.pm"
83             pdl_error pdl_pchip_chia_readdata(pdl_trans *__privtrans) {
84             pdl_error PDL_err = {0, NULL, 0};
85             #line 86 "lib/PDL/Primitive-pp-pchip_chia.c"
86 2           register PDL_Indx __n_size = __privtrans->ind_sizes[0];
87 2 50         if (!__privtrans->broadcast.incs) return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "broadcast.incs NULL");
88             /* broadcastloop declarations */
89             int __brcloopval;
90             register PDL_Indx __tind0,__tind1; /* counters along dim */
91 2           register PDL_Indx __tnpdls = __privtrans->broadcast.npdls;
92             /* dims here are how many steps along those dims */
93 2           register PDL_Indx __tinc0_x = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,0,0);
94 2           register PDL_Indx __tinc0_f = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,1,0);
95 2           register PDL_Indx __tinc0_d = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,2,0);
96 2           register PDL_Indx __tinc0_la = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,3,0);
97 2           register PDL_Indx __tinc0_lb = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,4,0);
98 2           register PDL_Indx __tinc0_ans = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,5,0);
99 2           register PDL_Indx __tinc0_ierr = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,6,0);
100 2           register PDL_Indx __tinc0_skip = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,7,0);
101 2           register PDL_Indx __tinc1_x = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,0,1);
102 2           register PDL_Indx __tinc1_f = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,1,1);
103 2           register PDL_Indx __tinc1_d = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,2,1);
104 2           register PDL_Indx __tinc1_la = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,3,1);
105 2           register PDL_Indx __tinc1_lb = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,4,1);
106 2           register PDL_Indx __tinc1_ans = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,5,1);
107 2           register PDL_Indx __tinc1_ierr = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,6,1);
108 2           register PDL_Indx __tinc1_skip = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,7,1);
109             #define PDL_BROADCASTLOOP_START_pchip_chia_readdata PDL_BROADCASTLOOP_START( \
110             readdata, \
111             __privtrans->broadcast, \
112             __privtrans->vtable, \
113             x_datap += __offsp[0]; \
114             f_datap += __offsp[1]; \
115             d_datap += __offsp[2]; \
116             la_datap += __offsp[3]; \
117             lb_datap += __offsp[4]; \
118             ans_datap += __offsp[5]; \
119             ierr_datap += __offsp[6]; \
120             skip_datap += __offsp[7]; \
121             , \
122             ( ,x_datap += __tinc1_x - __tinc0_x * __tdims0 \
123             ,f_datap += __tinc1_f - __tinc0_f * __tdims0 \
124             ,d_datap += __tinc1_d - __tinc0_d * __tdims0 \
125             ,la_datap += __tinc1_la - __tinc0_la * __tdims0 \
126             ,lb_datap += __tinc1_lb - __tinc0_lb * __tdims0 \
127             ,ans_datap += __tinc1_ans - __tinc0_ans * __tdims0 \
128             ,ierr_datap += __tinc1_ierr - __tinc0_ierr * __tdims0 \
129             ,skip_datap += __tinc1_skip - __tinc0_skip * __tdims0 \
130             ), \
131             ( ,x_datap += __tinc0_x \
132             ,f_datap += __tinc0_f \
133             ,d_datap += __tinc0_d \
134             ,la_datap += __tinc0_la \
135             ,lb_datap += __tinc0_lb \
136             ,ans_datap += __tinc0_ans \
137             ,ierr_datap += __tinc0_ierr \
138             ,skip_datap += __tinc0_skip \
139             ) \
140             )
141             #define PDL_BROADCASTLOOP_END_pchip_chia_readdata PDL_BROADCASTLOOP_END( \
142             __privtrans->broadcast, \
143             x_datap -= __tinc1_x * __tdims1 + __offsp[0]; \
144             f_datap -= __tinc1_f * __tdims1 + __offsp[1]; \
145             d_datap -= __tinc1_d * __tdims1 + __offsp[2]; \
146             la_datap -= __tinc1_la * __tdims1 + __offsp[3]; \
147             lb_datap -= __tinc1_lb * __tdims1 + __offsp[4]; \
148             ans_datap -= __tinc1_ans * __tdims1 + __offsp[5]; \
149             ierr_datap -= __tinc1_ierr * __tdims1 + __offsp[6]; \
150             skip_datap -= __tinc1_skip * __tdims1 + __offsp[7]; \
151             )
152 2           register PDL_Indx __inc_d_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,2,0)]; (void)__inc_d_n;
153 2           register PDL_Indx __inc_f_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,1,0)]; (void)__inc_f_n;
154 2           register PDL_Indx __inc_x_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,0,0)]; (void)__inc_x_n;
155             #ifndef PDL_DECLARE_PARAMS_pchip_chia_1
156             #define PDL_DECLARE_PARAMS_pchip_chia_1(PDL_TYPE_OP,PDL_PPSYM_OP,PDL_TYPE_PARAM_ierr,PDL_PPSYM_PARAM_ierr,PDL_TYPE_PARAM_skip,PDL_PPSYM_PARAM_skip) \
157             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, x, (__privtrans->pdls[0]), 1, PDL_PPSYM_OP) \
158             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, f, (__privtrans->pdls[1]), 1, PDL_PPSYM_OP) \
159             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, d, (__privtrans->pdls[2]), 1, PDL_PPSYM_OP) \
160             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, la, (__privtrans->pdls[3]), 1, PDL_PPSYM_OP) \
161             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, lb, (__privtrans->pdls[4]), 1, PDL_PPSYM_OP) \
162             PDL_DECLARE_PARAMETER(PDL_TYPE_OP, ans, (__privtrans->pdls[5]), 1, PDL_PPSYM_OP) \
163             PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_ierr, ierr, (__privtrans->pdls[6]), 1, PDL_PPSYM_PARAM_ierr) \
164             PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_skip, skip, (__privtrans->pdls[7]), 1, PDL_PPSYM_PARAM_skip)
165             #endif
166             #define PDL_IF_BAD(t,f) f
167 2           switch (__privtrans->__datatype) { /* Start generic switch */
168 0           case PDL_F: {
169 0 0         PDL_DECLARE_PARAMS_pchip_chia_1(PDL_Float,F,PDL_Indx,N,PDL_Long,L)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
170 0 0         PDL_BROADCASTLOOP_START_pchip_chia_readdata {
    0          
    0          
    0          
    0          
    0          
    0          
171             #line 5694 "lib/PDL/Primitive.pd"
172             PDL_Indx ia, ib, il;
173             PDL_Float a = (la_datap)[0], b = (lb_datap)[0], xa, xb;
174             PDL_Indx ir, n = __privtrans->ind_sizes[0];
175             PDL_Float value = 0.;
176             if (!(skip_datap)[0]) {
177             {/* Open n=1 */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((1),0), __n_stop=(__n_size)); for(; n<__n_stop; n+=1) {
178             #line 5700 "lib/PDL/Primitive.pd"
179             if ((x_datap)[0+(__inc_x_n*(n))] > (x_datap)[0+(__inc_x_n*(n-1))]) continue;
180             (ierr_datap)[0] = -1;
181             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "X-ARRAY NOT STRICTLY INCREASING");
182             }} /* Close n=1 */
183             #line 5704 "lib/PDL/Primitive.pd"
184             }
185             /* FUNCTION DEFINITION IS OK, GO ON. */
186             (skip_datap)[0] = 1;
187             (ierr_datap)[0] = 0;
188             if (a < (x_datap)[0+(__inc_x_n*(0))] || a > (x_datap)[0+(__inc_x_n*(n-1))]) {
189             ++((ierr_datap)[0]);
190             }
191             if (b < (x_datap)[0+(__inc_x_n*(0))] || b > (x_datap)[0+(__inc_x_n*(n-1))]) {
192             (ierr_datap)[0] += 2;
193             }
194             /* COMPUTE INTEGRAL VALUE. */
195             if (a != b) {
196             xa = PDLMIN(a,b);
197             xb = PDLMAX(a,b);
198             if (xb <= (x_datap)[0+(__inc_x_n*(1))]) {
199             /* INTERVAL IS TO LEFT OF X(2), SO USE FIRST CUBIC. */
200             /* --------------------------------------- */
201            
202             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
203             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
204             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
205             /* Hermite form) over an arbitrary interval (A,B). */
206             /* ---------------------------------------------------------------------- */
207             /* Parameters: */
208             /* VALUE -- (output) value of the requested integral. */
209             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
210             /* F1,F2 -- (input) function values at the ends of the interval. */
211             /* D1,D2 -- (input) derivative values at the ends of the interval. */
212             /* A,B -- (input) endpoints of interval of integration. */
213             /* ***SEE ALSO DPCHIA */
214             /* Programming notes: */
215             /* 1. There is no error return from this routine because zero is */
216             /* indeed the mathematically correct answer when X1.EQ.X2 . */
217             do {
218             if ((x_datap)[0+(__inc_x_n*(0))] == (x_datap)[0+(__inc_x_n*(1))]) {
219             value = 0.; break;
220             }
221             PDL_Float h = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))];
222             PDL_Float ta1 = (a - (x_datap)[0+(__inc_x_n*(0))]) / h;
223             PDL_Float ta2 = ((x_datap)[0+(__inc_x_n*(1))] - a) / h;
224             PDL_Float tb1 = (b - (x_datap)[0+(__inc_x_n*(0))]) / h;
225             PDL_Float tb2 = ((x_datap)[0+(__inc_x_n*(1))] - b) / h;
226             /* Computing 3rd power */
227             PDL_Float ua1 = ta1 * (ta1 * ta1);
228             PDL_Float phia1 = ua1 * (2. - ta1);
229             PDL_Float psia1 = ua1 * (3. * ta1 - 4.);
230             /* Computing 3rd power */
231             PDL_Float ua2 = ta2 * (ta2 * ta2);
232             PDL_Float phia2 = ua2 * (2. - ta2);
233             PDL_Float psia2 = -ua2 * (3. * ta2 - 4.);
234             /* Computing 3rd power */
235             PDL_Float ub1 = tb1 * (tb1 * tb1);
236             PDL_Float phib1 = ub1 * (2. - tb1);
237             PDL_Float psib1 = ub1 * (3. * tb1 - 4.);
238             /* Computing 3rd power */
239             PDL_Float ub2 = tb2 * (tb2 * tb2);
240             PDL_Float phib2 = ub2 * (2. - tb2);
241             PDL_Float psib2 = -ub2 * (3. * tb2 - 4.);
242             PDL_Float fterm = (f_datap)[0+(__inc_f_n*(0))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(1))] * (phib1 - phia1);
243             PDL_Float dterm = ((d_datap)[0+(__inc_d_n*(0))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(1))] * (psib1 - psia1)) * (h / 6.);
244             value = 0.5 * h * (fterm + dterm);
245             } while(0)
246             ;
247             /* --------------------------------------- */
248             } else if (xa >= (x_datap)[0+(__inc_x_n*(n-2))]) {
249             /* INTERVAL IS TO RIGHT OF X(N-1), SO USE LAST CUBIC. */
250             /* ------------------------------------------ */
251            
252             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
253             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
254             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
255             /* Hermite form) over an arbitrary interval (A,B). */
256             /* ---------------------------------------------------------------------- */
257             /* Parameters: */
258             /* VALUE -- (output) value of the requested integral. */
259             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
260             /* F1,F2 -- (input) function values at the ends of the interval. */
261             /* D1,D2 -- (input) derivative values at the ends of the interval. */
262             /* A,B -- (input) endpoints of interval of integration. */
263             /* ***SEE ALSO DPCHIA */
264             /* Programming notes: */
265             /* 1. There is no error return from this routine because zero is */
266             /* indeed the mathematically correct answer when X1.EQ.X2 . */
267             do {
268             if ((x_datap)[0+(__inc_x_n*(n-2))] == (x_datap)[0+(__inc_x_n*(n-1))]) {
269             value = 0.; break;
270             }
271             PDL_Float h = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))];
272             PDL_Float ta1 = (a - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
273             PDL_Float ta2 = ((x_datap)[0+(__inc_x_n*(n-1))] - a) / h;
274             PDL_Float tb1 = (b - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
275             PDL_Float tb2 = ((x_datap)[0+(__inc_x_n*(n-1))] - b) / h;
276             /* Computing 3rd power */
277             PDL_Float ua1 = ta1 * (ta1 * ta1);
278             PDL_Float phia1 = ua1 * (2. - ta1);
279             PDL_Float psia1 = ua1 * (3. * ta1 - 4.);
280             /* Computing 3rd power */
281             PDL_Float ua2 = ta2 * (ta2 * ta2);
282             PDL_Float phia2 = ua2 * (2. - ta2);
283             PDL_Float psia2 = -ua2 * (3. * ta2 - 4.);
284             /* Computing 3rd power */
285             PDL_Float ub1 = tb1 * (tb1 * tb1);
286             PDL_Float phib1 = ub1 * (2. - tb1);
287             PDL_Float psib1 = ub1 * (3. * tb1 - 4.);
288             /* Computing 3rd power */
289             PDL_Float ub2 = tb2 * (tb2 * tb2);
290             PDL_Float phib2 = ub2 * (2. - tb2);
291             PDL_Float psib2 = -ub2 * (3. * tb2 - 4.);
292             PDL_Float fterm = (f_datap)[0+(__inc_f_n*(n-2))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(n-1))] * (phib1 - phia1);
293             PDL_Float dterm = ((d_datap)[0+(__inc_d_n*(n-2))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(n-1))] * (psib1 - psia1)) * (h / 6.);
294             value = 0.5 * h * (fterm + dterm);
295             } while(0)
296             ;
297             /* ------------------------------------------ */
298             } else {
299             /* 'NORMAL' CASE -- XA.LT.XB, XA.LT.X(N-1), XB.GT.X(2). */
300             /* ......LOCATE IA AND IB SUCH THAT */
301             /* X(IA-1).LT.XA.LE.X(IA).LE.X(IB).LE.XB.LE.X(IB+1) */
302             ia = 0;
303             {/* Open n=:-1 */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size-1)); for(; n<__n_stop; n+=1) {
304             #line 5735 "lib/PDL/Primitive.pd"
305             if (xa > (x_datap)[0+(__inc_x_n*(n))])
306             ia = n + 1;
307             }} /* Close n=:-1 */
308             #line 5738 "lib/PDL/Primitive.pd"
309             /* IA = 1 IMPLIES XA.LT.X(1) . OTHERWISE, */
310             /* IA IS LARGEST INDEX SUCH THAT X(IA-1).LT.XA,. */
311             ib = n - 1;
312             {/* Open n=:ia:-1 */ PDL_EXPAND2(register PDL_Indx n=(__n_size-1), __n_stop=PDLMAX((ia),0)); for(; n>=__n_stop; n+=-1) {
313             #line 5742 "lib/PDL/Primitive.pd"
314             if (xb < (x_datap)[0+(__inc_x_n*(n))])
315             ib = n - 1;
316             }} /* Close n=:ia:-1 */
317             #line 5745 "lib/PDL/Primitive.pd"
318             /* IB = N IMPLIES XB.GT.X(N) . OTHERWISE, */
319             /* IB IS SMALLEST INDEX SUCH THAT XB.LT.X(IB+1) . */
320             /* ......COMPUTE THE INTEGRAL. */
321             if (ib <= ia) {
322             /* THIS MEANS IB = IA-1 AND */
323             /* (A,B) IS A SUBSET OF (X(IB),X(IA)). */
324             /* ------------------------------------------- */
325            
326             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
327             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
328             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
329             /* Hermite form) over an arbitrary interval (A,B). */
330             /* ---------------------------------------------------------------------- */
331             /* Parameters: */
332             /* VALUE -- (output) value of the requested integral. */
333             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
334             /* F1,F2 -- (input) function values at the ends of the interval. */
335             /* D1,D2 -- (input) derivative values at the ends of the interval. */
336             /* A,B -- (input) endpoints of interval of integration. */
337             /* ***SEE ALSO DPCHIA */
338             /* Programming notes: */
339             /* 1. There is no error return from this routine because zero is */
340             /* indeed the mathematically correct answer when X1.EQ.X2 . */
341             do {
342             if ((x_datap)[0+(__inc_x_n*(ib))] == (x_datap)[0+(__inc_x_n*(ia))]) {
343             value = 0.; break;
344             }
345             PDL_Float h = (x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(ib))];
346             PDL_Float ta1 = (a - (x_datap)[0+(__inc_x_n*(ib))]) / h;
347             PDL_Float ta2 = ((x_datap)[0+(__inc_x_n*(ia))] - a) / h;
348             PDL_Float tb1 = (b - (x_datap)[0+(__inc_x_n*(ib))]) / h;
349             PDL_Float tb2 = ((x_datap)[0+(__inc_x_n*(ia))] - b) / h;
350             /* Computing 3rd power */
351             PDL_Float ua1 = ta1 * (ta1 * ta1);
352             PDL_Float phia1 = ua1 * (2. - ta1);
353             PDL_Float psia1 = ua1 * (3. * ta1 - 4.);
354             /* Computing 3rd power */
355             PDL_Float ua2 = ta2 * (ta2 * ta2);
356             PDL_Float phia2 = ua2 * (2. - ta2);
357             PDL_Float psia2 = -ua2 * (3. * ta2 - 4.);
358             /* Computing 3rd power */
359             PDL_Float ub1 = tb1 * (tb1 * tb1);
360             PDL_Float phib1 = ub1 * (2. - tb1);
361             PDL_Float psib1 = ub1 * (3. * tb1 - 4.);
362             /* Computing 3rd power */
363             PDL_Float ub2 = tb2 * (tb2 * tb2);
364             PDL_Float phib2 = ub2 * (2. - tb2);
365             PDL_Float psib2 = -ub2 * (3. * tb2 - 4.);
366             PDL_Float fterm = (f_datap)[0+(__inc_f_n*(ib))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ia))] * (phib1 - phia1);
367             PDL_Float dterm = ((d_datap)[0+(__inc_d_n*(ib))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ia))] * (psib1 - psia1)) * (h / 6.);
368             value = 0.5 * h * (fterm + dterm);
369             } while(0)
370             ;
371             /* ------------------------------------------- */
372             } else {
373             /* FIRST COMPUTE INTEGRAL OVER (X(IA),X(IB)). */
374             /* (Case (IB .EQ. IA) is taken care of by initialization */
375             /* of VALUE to ZERO.) */
376             if (ib > ia-1) {
377             /* --------------------------------------------- */
378            
379             /* Programming notes: */
380             /* 1. This routine uses a special formula that is valid only for */
381             /* integrals whose limits coincide with data values. This is */
382             /* mathematically equivalent to, but much more efficient than, */
383             /* calls to DCHFIE. */
384             /* VALIDITY-CHECK ARGUMENTS. */
385             do {
386             /* FUNCTION DEFINITION IS OK, GO ON. */
387             (skip_datap)[0] = 1;
388             if (ia < 0 || ia > __privtrans->ind_sizes[0]-1 || ib < 0 || ib > __privtrans->ind_sizes[0]-1) {
389             (ierr_datap)[0] = -4;
390             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "IA OR IB OUT OF RANGE");
391             }
392             (ierr_datap)[0] = 0;
393             /* COMPUTE INTEGRAL VALUE. */
394             if (ia == ib) { value = 0; continue; }
395             PDL_Indx low = PDLMIN(ia,ib), iup = PDLMAX(ia,ib);
396             PDL_Float sum = 0.;
397             {/* Open n=low:iup */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((low),0), __n_stop=PDLMIN(iup, (__n_size))); for(; n<__n_stop; n+=1) {
398             PDL_Float h = (x_datap)[0+(__inc_x_n*(n+1))] - (x_datap)[0+(__inc_x_n*(n))];
399             sum += h * ((f_datap)[0+(__inc_f_n*(n))] + (f_datap)[0+(__inc_f_n*(n+1))] + ((d_datap)[0+(__inc_d_n*(n))] - (d_datap)[0+(__inc_d_n*(n+1))]) * (h / 6.));
400             }} /* Close n=low:iup */
401             value = 0.5 * (ia > ib ? -sum : sum);
402             } while(0)
403             ;
404             /* --------------------------------------------- */
405             }
406             /* THEN ADD ON INTEGRAL OVER (XA,X(IA)). */
407             if (xa < (x_datap)[0+(__inc_x_n*(ia))]) {
408             /* Computing MAX */
409             il = PDLMAX(0,ia - 1);
410             ir = il + 1;
411             /* ------------------------------------- */
412             PDL_Float chfie_ans = 0;
413            
414             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
415             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
416             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
417             /* Hermite form) over an arbitrary interval (A,B). */
418             /* ---------------------------------------------------------------------- */
419             /* Parameters: */
420             /* VALUE -- (output) value of the requested integral. */
421             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
422             /* F1,F2 -- (input) function values at the ends of the interval. */
423             /* D1,D2 -- (input) derivative values at the ends of the interval. */
424             /* A,B -- (input) endpoints of interval of integration. */
425             /* ***SEE ALSO DPCHIA */
426             /* Programming notes: */
427             /* 1. There is no error return from this routine because zero is */
428             /* indeed the mathematically correct answer when X1.EQ.X2 . */
429             do {
430             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
431             chfie_ans = 0.; break;
432             }
433             PDL_Float h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
434             PDL_Float ta1 = (xa - (x_datap)[0+(__inc_x_n*(il))]) / h;
435             PDL_Float ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - xa) / h;
436             PDL_Float tb1 = ((x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
437             PDL_Float tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ia))]) / h;
438             /* Computing 3rd power */
439             PDL_Float ua1 = ta1 * (ta1 * ta1);
440             PDL_Float phia1 = ua1 * (2. - ta1);
441             PDL_Float psia1 = ua1 * (3. * ta1 - 4.);
442             /* Computing 3rd power */
443             PDL_Float ua2 = ta2 * (ta2 * ta2);
444             PDL_Float phia2 = ua2 * (2. - ta2);
445             PDL_Float psia2 = -ua2 * (3. * ta2 - 4.);
446             /* Computing 3rd power */
447             PDL_Float ub1 = tb1 * (tb1 * tb1);
448             PDL_Float phib1 = ub1 * (2. - tb1);
449             PDL_Float psib1 = ub1 * (3. * tb1 - 4.);
450             /* Computing 3rd power */
451             PDL_Float ub2 = tb2 * (tb2 * tb2);
452             PDL_Float phib2 = ub2 * (2. - tb2);
453             PDL_Float psib2 = -ub2 * (3. * tb2 - 4.);
454             PDL_Float fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
455             PDL_Float dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
456             chfie_ans = 0.5 * h * (fterm + dterm);
457             } while(0)
458             ;
459             value += chfie_ans;
460             /* ------------------------------------- */
461             }
462             /* THEN ADD ON INTEGRAL OVER (X(IB),XB). */
463             if (xb > (x_datap)[0+(__inc_x_n*(ib))]) {
464             /* Computing MIN */
465             ir = PDLMIN(ib + 1,n-1);
466             il = ir - 1;
467             /* ------------------------------------- */
468             PDL_Float chfie_ans = 0;
469            
470             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
471             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
472             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
473             /* Hermite form) over an arbitrary interval (A,B). */
474             /* ---------------------------------------------------------------------- */
475             /* Parameters: */
476             /* VALUE -- (output) value of the requested integral. */
477             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
478             /* F1,F2 -- (input) function values at the ends of the interval. */
479             /* D1,D2 -- (input) derivative values at the ends of the interval. */
480             /* A,B -- (input) endpoints of interval of integration. */
481             /* ***SEE ALSO DPCHIA */
482             /* Programming notes: */
483             /* 1. There is no error return from this routine because zero is */
484             /* indeed the mathematically correct answer when X1.EQ.X2 . */
485             do {
486             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
487             chfie_ans = 0.; break;
488             }
489             PDL_Float h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
490             PDL_Float ta1 = ((x_datap)[0+(__inc_x_n*(ib))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
491             PDL_Float ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ib))]) / h;
492             PDL_Float tb1 = (xb - (x_datap)[0+(__inc_x_n*(il))]) / h;
493             PDL_Float tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - xb) / h;
494             /* Computing 3rd power */
495             PDL_Float ua1 = ta1 * (ta1 * ta1);
496             PDL_Float phia1 = ua1 * (2. - ta1);
497             PDL_Float psia1 = ua1 * (3. * ta1 - 4.);
498             /* Computing 3rd power */
499             PDL_Float ua2 = ta2 * (ta2 * ta2);
500             PDL_Float phia2 = ua2 * (2. - ta2);
501             PDL_Float psia2 = -ua2 * (3. * ta2 - 4.);
502             /* Computing 3rd power */
503             PDL_Float ub1 = tb1 * (tb1 * tb1);
504             PDL_Float phib1 = ub1 * (2. - tb1);
505             PDL_Float psib1 = ub1 * (3. * tb1 - 4.);
506             /* Computing 3rd power */
507             PDL_Float ub2 = tb2 * (tb2 * tb2);
508             PDL_Float phib2 = ub2 * (2. - tb2);
509             PDL_Float psib2 = -ub2 * (3. * tb2 - 4.);
510             PDL_Float fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
511             PDL_Float dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
512             chfie_ans = 0.5 * h * (fterm + dterm);
513             } while(0)
514             ;
515             value += chfie_ans;
516             /* ------------------------------------- */
517             }
518             /* FINALLY, ADJUST SIGN IF NECESSARY. */
519             if (a > b) {
520             value = -value;
521             }
522             }
523             }
524             }
525             (ans_datap)[0] = value;
526             #line 527 "lib/PDL/Primitive-pp-pchip_chia.c"
527 0 0         }PDL_BROADCASTLOOP_END_pchip_chia_readdata
    0          
528 0           } break;
529 2           case PDL_D: {
530 2 50         PDL_DECLARE_PARAMS_pchip_chia_1(PDL_Double,D,PDL_Indx,N,PDL_Long,L)
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
531 10 50         PDL_BROADCASTLOOP_START_pchip_chia_readdata {
    50          
    50          
    50          
    50          
    100          
    100          
532             #line 5694 "lib/PDL/Primitive.pd"
533             PDL_Indx ia, ib, il;
534             PDL_Double a = (la_datap)[0], b = (lb_datap)[0], xa, xb;
535             PDL_Indx ir, n = __privtrans->ind_sizes[0];
536             PDL_Double value = 0.;
537             if (!(skip_datap)[0]) {
538             {/* Open n=1 */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((1),0), __n_stop=(__n_size)); for(; n<__n_stop; n+=1) {
539             #line 5700 "lib/PDL/Primitive.pd"
540             if ((x_datap)[0+(__inc_x_n*(n))] > (x_datap)[0+(__inc_x_n*(n-1))]) continue;
541             (ierr_datap)[0] = -1;
542             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "X-ARRAY NOT STRICTLY INCREASING");
543             }} /* Close n=1 */
544             #line 5704 "lib/PDL/Primitive.pd"
545             }
546             /* FUNCTION DEFINITION IS OK, GO ON. */
547             (skip_datap)[0] = 1;
548             (ierr_datap)[0] = 0;
549             if (a < (x_datap)[0+(__inc_x_n*(0))] || a > (x_datap)[0+(__inc_x_n*(n-1))]) {
550             ++((ierr_datap)[0]);
551             }
552             if (b < (x_datap)[0+(__inc_x_n*(0))] || b > (x_datap)[0+(__inc_x_n*(n-1))]) {
553             (ierr_datap)[0] += 2;
554             }
555             /* COMPUTE INTEGRAL VALUE. */
556             if (a != b) {
557             xa = PDLMIN(a,b);
558             xb = PDLMAX(a,b);
559             if (xb <= (x_datap)[0+(__inc_x_n*(1))]) {
560             /* INTERVAL IS TO LEFT OF X(2), SO USE FIRST CUBIC. */
561             /* --------------------------------------- */
562            
563             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
564             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
565             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
566             /* Hermite form) over an arbitrary interval (A,B). */
567             /* ---------------------------------------------------------------------- */
568             /* Parameters: */
569             /* VALUE -- (output) value of the requested integral. */
570             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
571             /* F1,F2 -- (input) function values at the ends of the interval. */
572             /* D1,D2 -- (input) derivative values at the ends of the interval. */
573             /* A,B -- (input) endpoints of interval of integration. */
574             /* ***SEE ALSO DPCHIA */
575             /* Programming notes: */
576             /* 1. There is no error return from this routine because zero is */
577             /* indeed the mathematically correct answer when X1.EQ.X2 . */
578             do {
579             if ((x_datap)[0+(__inc_x_n*(0))] == (x_datap)[0+(__inc_x_n*(1))]) {
580             value = 0.; break;
581             }
582             PDL_Double h = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))];
583             PDL_Double ta1 = (a - (x_datap)[0+(__inc_x_n*(0))]) / h;
584             PDL_Double ta2 = ((x_datap)[0+(__inc_x_n*(1))] - a) / h;
585             PDL_Double tb1 = (b - (x_datap)[0+(__inc_x_n*(0))]) / h;
586             PDL_Double tb2 = ((x_datap)[0+(__inc_x_n*(1))] - b) / h;
587             /* Computing 3rd power */
588             PDL_Double ua1 = ta1 * (ta1 * ta1);
589             PDL_Double phia1 = ua1 * (2. - ta1);
590             PDL_Double psia1 = ua1 * (3. * ta1 - 4.);
591             /* Computing 3rd power */
592             PDL_Double ua2 = ta2 * (ta2 * ta2);
593             PDL_Double phia2 = ua2 * (2. - ta2);
594             PDL_Double psia2 = -ua2 * (3. * ta2 - 4.);
595             /* Computing 3rd power */
596             PDL_Double ub1 = tb1 * (tb1 * tb1);
597             PDL_Double phib1 = ub1 * (2. - tb1);
598             PDL_Double psib1 = ub1 * (3. * tb1 - 4.);
599             /* Computing 3rd power */
600             PDL_Double ub2 = tb2 * (tb2 * tb2);
601             PDL_Double phib2 = ub2 * (2. - tb2);
602             PDL_Double psib2 = -ub2 * (3. * tb2 - 4.);
603             PDL_Double fterm = (f_datap)[0+(__inc_f_n*(0))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(1))] * (phib1 - phia1);
604             PDL_Double dterm = ((d_datap)[0+(__inc_d_n*(0))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(1))] * (psib1 - psia1)) * (h / 6.);
605             value = 0.5 * h * (fterm + dterm);
606             } while(0)
607             ;
608             /* --------------------------------------- */
609             } else if (xa >= (x_datap)[0+(__inc_x_n*(n-2))]) {
610             /* INTERVAL IS TO RIGHT OF X(N-1), SO USE LAST CUBIC. */
611             /* ------------------------------------------ */
612            
613             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
614             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
615             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
616             /* Hermite form) over an arbitrary interval (A,B). */
617             /* ---------------------------------------------------------------------- */
618             /* Parameters: */
619             /* VALUE -- (output) value of the requested integral. */
620             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
621             /* F1,F2 -- (input) function values at the ends of the interval. */
622             /* D1,D2 -- (input) derivative values at the ends of the interval. */
623             /* A,B -- (input) endpoints of interval of integration. */
624             /* ***SEE ALSO DPCHIA */
625             /* Programming notes: */
626             /* 1. There is no error return from this routine because zero is */
627             /* indeed the mathematically correct answer when X1.EQ.X2 . */
628             do {
629             if ((x_datap)[0+(__inc_x_n*(n-2))] == (x_datap)[0+(__inc_x_n*(n-1))]) {
630             value = 0.; break;
631             }
632             PDL_Double h = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))];
633             PDL_Double ta1 = (a - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
634             PDL_Double ta2 = ((x_datap)[0+(__inc_x_n*(n-1))] - a) / h;
635             PDL_Double tb1 = (b - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
636             PDL_Double tb2 = ((x_datap)[0+(__inc_x_n*(n-1))] - b) / h;
637             /* Computing 3rd power */
638             PDL_Double ua1 = ta1 * (ta1 * ta1);
639             PDL_Double phia1 = ua1 * (2. - ta1);
640             PDL_Double psia1 = ua1 * (3. * ta1 - 4.);
641             /* Computing 3rd power */
642             PDL_Double ua2 = ta2 * (ta2 * ta2);
643             PDL_Double phia2 = ua2 * (2. - ta2);
644             PDL_Double psia2 = -ua2 * (3. * ta2 - 4.);
645             /* Computing 3rd power */
646             PDL_Double ub1 = tb1 * (tb1 * tb1);
647             PDL_Double phib1 = ub1 * (2. - tb1);
648             PDL_Double psib1 = ub1 * (3. * tb1 - 4.);
649             /* Computing 3rd power */
650             PDL_Double ub2 = tb2 * (tb2 * tb2);
651             PDL_Double phib2 = ub2 * (2. - tb2);
652             PDL_Double psib2 = -ub2 * (3. * tb2 - 4.);
653             PDL_Double fterm = (f_datap)[0+(__inc_f_n*(n-2))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(n-1))] * (phib1 - phia1);
654             PDL_Double dterm = ((d_datap)[0+(__inc_d_n*(n-2))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(n-1))] * (psib1 - psia1)) * (h / 6.);
655             value = 0.5 * h * (fterm + dterm);
656             } while(0)
657             ;
658             /* ------------------------------------------ */
659             } else {
660             /* 'NORMAL' CASE -- XA.LT.XB, XA.LT.X(N-1), XB.GT.X(2). */
661             /* ......LOCATE IA AND IB SUCH THAT */
662             /* X(IA-1).LT.XA.LE.X(IA).LE.X(IB).LE.XB.LE.X(IB+1) */
663             ia = 0;
664             {/* Open n=:-1 */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size-1)); for(; n<__n_stop; n+=1) {
665             #line 5735 "lib/PDL/Primitive.pd"
666             if (xa > (x_datap)[0+(__inc_x_n*(n))])
667             ia = n + 1;
668             }} /* Close n=:-1 */
669             #line 5738 "lib/PDL/Primitive.pd"
670             /* IA = 1 IMPLIES XA.LT.X(1) . OTHERWISE, */
671             /* IA IS LARGEST INDEX SUCH THAT X(IA-1).LT.XA,. */
672             ib = n - 1;
673             {/* Open n=:ia:-1 */ PDL_EXPAND2(register PDL_Indx n=(__n_size-1), __n_stop=PDLMAX((ia),0)); for(; n>=__n_stop; n+=-1) {
674             #line 5742 "lib/PDL/Primitive.pd"
675             if (xb < (x_datap)[0+(__inc_x_n*(n))])
676             ib = n - 1;
677             }} /* Close n=:ia:-1 */
678             #line 5745 "lib/PDL/Primitive.pd"
679             /* IB = N IMPLIES XB.GT.X(N) . OTHERWISE, */
680             /* IB IS SMALLEST INDEX SUCH THAT XB.LT.X(IB+1) . */
681             /* ......COMPUTE THE INTEGRAL. */
682             if (ib <= ia) {
683             /* THIS MEANS IB = IA-1 AND */
684             /* (A,B) IS A SUBSET OF (X(IB),X(IA)). */
685             /* ------------------------------------------- */
686            
687             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
688             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
689             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
690             /* Hermite form) over an arbitrary interval (A,B). */
691             /* ---------------------------------------------------------------------- */
692             /* Parameters: */
693             /* VALUE -- (output) value of the requested integral. */
694             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
695             /* F1,F2 -- (input) function values at the ends of the interval. */
696             /* D1,D2 -- (input) derivative values at the ends of the interval. */
697             /* A,B -- (input) endpoints of interval of integration. */
698             /* ***SEE ALSO DPCHIA */
699             /* Programming notes: */
700             /* 1. There is no error return from this routine because zero is */
701             /* indeed the mathematically correct answer when X1.EQ.X2 . */
702             do {
703             if ((x_datap)[0+(__inc_x_n*(ib))] == (x_datap)[0+(__inc_x_n*(ia))]) {
704             value = 0.; break;
705             }
706             PDL_Double h = (x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(ib))];
707             PDL_Double ta1 = (a - (x_datap)[0+(__inc_x_n*(ib))]) / h;
708             PDL_Double ta2 = ((x_datap)[0+(__inc_x_n*(ia))] - a) / h;
709             PDL_Double tb1 = (b - (x_datap)[0+(__inc_x_n*(ib))]) / h;
710             PDL_Double tb2 = ((x_datap)[0+(__inc_x_n*(ia))] - b) / h;
711             /* Computing 3rd power */
712             PDL_Double ua1 = ta1 * (ta1 * ta1);
713             PDL_Double phia1 = ua1 * (2. - ta1);
714             PDL_Double psia1 = ua1 * (3. * ta1 - 4.);
715             /* Computing 3rd power */
716             PDL_Double ua2 = ta2 * (ta2 * ta2);
717             PDL_Double phia2 = ua2 * (2. - ta2);
718             PDL_Double psia2 = -ua2 * (3. * ta2 - 4.);
719             /* Computing 3rd power */
720             PDL_Double ub1 = tb1 * (tb1 * tb1);
721             PDL_Double phib1 = ub1 * (2. - tb1);
722             PDL_Double psib1 = ub1 * (3. * tb1 - 4.);
723             /* Computing 3rd power */
724             PDL_Double ub2 = tb2 * (tb2 * tb2);
725             PDL_Double phib2 = ub2 * (2. - tb2);
726             PDL_Double psib2 = -ub2 * (3. * tb2 - 4.);
727             PDL_Double fterm = (f_datap)[0+(__inc_f_n*(ib))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ia))] * (phib1 - phia1);
728             PDL_Double dterm = ((d_datap)[0+(__inc_d_n*(ib))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ia))] * (psib1 - psia1)) * (h / 6.);
729             value = 0.5 * h * (fterm + dterm);
730             } while(0)
731             ;
732             /* ------------------------------------------- */
733             } else {
734             /* FIRST COMPUTE INTEGRAL OVER (X(IA),X(IB)). */
735             /* (Case (IB .EQ. IA) is taken care of by initialization */
736             /* of VALUE to ZERO.) */
737             if (ib > ia-1) {
738             /* --------------------------------------------- */
739            
740             /* Programming notes: */
741             /* 1. This routine uses a special formula that is valid only for */
742             /* integrals whose limits coincide with data values. This is */
743             /* mathematically equivalent to, but much more efficient than, */
744             /* calls to DCHFIE. */
745             /* VALIDITY-CHECK ARGUMENTS. */
746             do {
747             /* FUNCTION DEFINITION IS OK, GO ON. */
748             (skip_datap)[0] = 1;
749             if (ia < 0 || ia > __privtrans->ind_sizes[0]-1 || ib < 0 || ib > __privtrans->ind_sizes[0]-1) {
750             (ierr_datap)[0] = -4;
751             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "IA OR IB OUT OF RANGE");
752             }
753             (ierr_datap)[0] = 0;
754             /* COMPUTE INTEGRAL VALUE. */
755             if (ia == ib) { value = 0; continue; }
756             PDL_Indx low = PDLMIN(ia,ib), iup = PDLMAX(ia,ib);
757             PDL_Double sum = 0.;
758             {/* Open n=low:iup */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((low),0), __n_stop=PDLMIN(iup, (__n_size))); for(; n<__n_stop; n+=1) {
759             PDL_Double h = (x_datap)[0+(__inc_x_n*(n+1))] - (x_datap)[0+(__inc_x_n*(n))];
760             sum += h * ((f_datap)[0+(__inc_f_n*(n))] + (f_datap)[0+(__inc_f_n*(n+1))] + ((d_datap)[0+(__inc_d_n*(n))] - (d_datap)[0+(__inc_d_n*(n+1))]) * (h / 6.));
761             }} /* Close n=low:iup */
762             value = 0.5 * (ia > ib ? -sum : sum);
763             } while(0)
764             ;
765             /* --------------------------------------------- */
766             }
767             /* THEN ADD ON INTEGRAL OVER (XA,X(IA)). */
768             if (xa < (x_datap)[0+(__inc_x_n*(ia))]) {
769             /* Computing MAX */
770             il = PDLMAX(0,ia - 1);
771             ir = il + 1;
772             /* ------------------------------------- */
773             PDL_Double chfie_ans = 0;
774            
775             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
776             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
777             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
778             /* Hermite form) over an arbitrary interval (A,B). */
779             /* ---------------------------------------------------------------------- */
780             /* Parameters: */
781             /* VALUE -- (output) value of the requested integral. */
782             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
783             /* F1,F2 -- (input) function values at the ends of the interval. */
784             /* D1,D2 -- (input) derivative values at the ends of the interval. */
785             /* A,B -- (input) endpoints of interval of integration. */
786             /* ***SEE ALSO DPCHIA */
787             /* Programming notes: */
788             /* 1. There is no error return from this routine because zero is */
789             /* indeed the mathematically correct answer when X1.EQ.X2 . */
790             do {
791             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
792             chfie_ans = 0.; break;
793             }
794             PDL_Double h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
795             PDL_Double ta1 = (xa - (x_datap)[0+(__inc_x_n*(il))]) / h;
796             PDL_Double ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - xa) / h;
797             PDL_Double tb1 = ((x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
798             PDL_Double tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ia))]) / h;
799             /* Computing 3rd power */
800             PDL_Double ua1 = ta1 * (ta1 * ta1);
801             PDL_Double phia1 = ua1 * (2. - ta1);
802             PDL_Double psia1 = ua1 * (3. * ta1 - 4.);
803             /* Computing 3rd power */
804             PDL_Double ua2 = ta2 * (ta2 * ta2);
805             PDL_Double phia2 = ua2 * (2. - ta2);
806             PDL_Double psia2 = -ua2 * (3. * ta2 - 4.);
807             /* Computing 3rd power */
808             PDL_Double ub1 = tb1 * (tb1 * tb1);
809             PDL_Double phib1 = ub1 * (2. - tb1);
810             PDL_Double psib1 = ub1 * (3. * tb1 - 4.);
811             /* Computing 3rd power */
812             PDL_Double ub2 = tb2 * (tb2 * tb2);
813             PDL_Double phib2 = ub2 * (2. - tb2);
814             PDL_Double psib2 = -ub2 * (3. * tb2 - 4.);
815             PDL_Double fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
816             PDL_Double dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
817             chfie_ans = 0.5 * h * (fterm + dterm);
818             } while(0)
819             ;
820             value += chfie_ans;
821             /* ------------------------------------- */
822             }
823             /* THEN ADD ON INTEGRAL OVER (X(IB),XB). */
824             if (xb > (x_datap)[0+(__inc_x_n*(ib))]) {
825             /* Computing MIN */
826             ir = PDLMIN(ib + 1,n-1);
827             il = ir - 1;
828             /* ------------------------------------- */
829             PDL_Double chfie_ans = 0;
830            
831             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
832             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
833             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
834             /* Hermite form) over an arbitrary interval (A,B). */
835             /* ---------------------------------------------------------------------- */
836             /* Parameters: */
837             /* VALUE -- (output) value of the requested integral. */
838             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
839             /* F1,F2 -- (input) function values at the ends of the interval. */
840             /* D1,D2 -- (input) derivative values at the ends of the interval. */
841             /* A,B -- (input) endpoints of interval of integration. */
842             /* ***SEE ALSO DPCHIA */
843             /* Programming notes: */
844             /* 1. There is no error return from this routine because zero is */
845             /* indeed the mathematically correct answer when X1.EQ.X2 . */
846             do {
847             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
848             chfie_ans = 0.; break;
849             }
850             PDL_Double h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
851             PDL_Double ta1 = ((x_datap)[0+(__inc_x_n*(ib))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
852             PDL_Double ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ib))]) / h;
853             PDL_Double tb1 = (xb - (x_datap)[0+(__inc_x_n*(il))]) / h;
854             PDL_Double tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - xb) / h;
855             /* Computing 3rd power */
856             PDL_Double ua1 = ta1 * (ta1 * ta1);
857             PDL_Double phia1 = ua1 * (2. - ta1);
858             PDL_Double psia1 = ua1 * (3. * ta1 - 4.);
859             /* Computing 3rd power */
860             PDL_Double ua2 = ta2 * (ta2 * ta2);
861             PDL_Double phia2 = ua2 * (2. - ta2);
862             PDL_Double psia2 = -ua2 * (3. * ta2 - 4.);
863             /* Computing 3rd power */
864             PDL_Double ub1 = tb1 * (tb1 * tb1);
865             PDL_Double phib1 = ub1 * (2. - tb1);
866             PDL_Double psib1 = ub1 * (3. * tb1 - 4.);
867             /* Computing 3rd power */
868             PDL_Double ub2 = tb2 * (tb2 * tb2);
869             PDL_Double phib2 = ub2 * (2. - tb2);
870             PDL_Double psib2 = -ub2 * (3. * tb2 - 4.);
871             PDL_Double fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
872             PDL_Double dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
873             chfie_ans = 0.5 * h * (fterm + dterm);
874             } while(0)
875             ;
876             value += chfie_ans;
877             /* ------------------------------------- */
878             }
879             /* FINALLY, ADJUST SIGN IF NECESSARY. */
880             if (a > b) {
881             value = -value;
882             }
883             }
884             }
885             }
886             (ans_datap)[0] = value;
887             #line 888 "lib/PDL/Primitive-pp-pchip_chia.c"
888 2 50         }PDL_BROADCASTLOOP_END_pchip_chia_readdata
    50          
889 2           } break;
890 0           case PDL_LD: {
891 0 0         PDL_DECLARE_PARAMS_pchip_chia_1(PDL_LDouble,E,PDL_Indx,N,PDL_Long,L)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
892 0 0         PDL_BROADCASTLOOP_START_pchip_chia_readdata {
    0          
    0          
    0          
    0          
    0          
    0          
893             #line 5694 "lib/PDL/Primitive.pd"
894             PDL_Indx ia, ib, il;
895             PDL_LDouble a = (la_datap)[0], b = (lb_datap)[0], xa, xb;
896             PDL_Indx ir, n = __privtrans->ind_sizes[0];
897             PDL_LDouble value = 0.;
898             if (!(skip_datap)[0]) {
899             {/* Open n=1 */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((1),0), __n_stop=(__n_size)); for(; n<__n_stop; n+=1) {
900             #line 5700 "lib/PDL/Primitive.pd"
901             if ((x_datap)[0+(__inc_x_n*(n))] > (x_datap)[0+(__inc_x_n*(n-1))]) continue;
902             (ierr_datap)[0] = -1;
903             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "X-ARRAY NOT STRICTLY INCREASING");
904             }} /* Close n=1 */
905             #line 5704 "lib/PDL/Primitive.pd"
906             }
907             /* FUNCTION DEFINITION IS OK, GO ON. */
908             (skip_datap)[0] = 1;
909             (ierr_datap)[0] = 0;
910             if (a < (x_datap)[0+(__inc_x_n*(0))] || a > (x_datap)[0+(__inc_x_n*(n-1))]) {
911             ++((ierr_datap)[0]);
912             }
913             if (b < (x_datap)[0+(__inc_x_n*(0))] || b > (x_datap)[0+(__inc_x_n*(n-1))]) {
914             (ierr_datap)[0] += 2;
915             }
916             /* COMPUTE INTEGRAL VALUE. */
917             if (a != b) {
918             xa = PDLMIN(a,b);
919             xb = PDLMAX(a,b);
920             if (xb <= (x_datap)[0+(__inc_x_n*(1))]) {
921             /* INTERVAL IS TO LEFT OF X(2), SO USE FIRST CUBIC. */
922             /* --------------------------------------- */
923            
924             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
925             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
926             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
927             /* Hermite form) over an arbitrary interval (A,B). */
928             /* ---------------------------------------------------------------------- */
929             /* Parameters: */
930             /* VALUE -- (output) value of the requested integral. */
931             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
932             /* F1,F2 -- (input) function values at the ends of the interval. */
933             /* D1,D2 -- (input) derivative values at the ends of the interval. */
934             /* A,B -- (input) endpoints of interval of integration. */
935             /* ***SEE ALSO DPCHIA */
936             /* Programming notes: */
937             /* 1. There is no error return from this routine because zero is */
938             /* indeed the mathematically correct answer when X1.EQ.X2 . */
939             do {
940             if ((x_datap)[0+(__inc_x_n*(0))] == (x_datap)[0+(__inc_x_n*(1))]) {
941             value = 0.; break;
942             }
943             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))];
944             PDL_LDouble ta1 = (a - (x_datap)[0+(__inc_x_n*(0))]) / h;
945             PDL_LDouble ta2 = ((x_datap)[0+(__inc_x_n*(1))] - a) / h;
946             PDL_LDouble tb1 = (b - (x_datap)[0+(__inc_x_n*(0))]) / h;
947             PDL_LDouble tb2 = ((x_datap)[0+(__inc_x_n*(1))] - b) / h;
948             /* Computing 3rd power */
949             PDL_LDouble ua1 = ta1 * (ta1 * ta1);
950             PDL_LDouble phia1 = ua1 * (2. - ta1);
951             PDL_LDouble psia1 = ua1 * (3. * ta1 - 4.);
952             /* Computing 3rd power */
953             PDL_LDouble ua2 = ta2 * (ta2 * ta2);
954             PDL_LDouble phia2 = ua2 * (2. - ta2);
955             PDL_LDouble psia2 = -ua2 * (3. * ta2 - 4.);
956             /* Computing 3rd power */
957             PDL_LDouble ub1 = tb1 * (tb1 * tb1);
958             PDL_LDouble phib1 = ub1 * (2. - tb1);
959             PDL_LDouble psib1 = ub1 * (3. * tb1 - 4.);
960             /* Computing 3rd power */
961             PDL_LDouble ub2 = tb2 * (tb2 * tb2);
962             PDL_LDouble phib2 = ub2 * (2. - tb2);
963             PDL_LDouble psib2 = -ub2 * (3. * tb2 - 4.);
964             PDL_LDouble fterm = (f_datap)[0+(__inc_f_n*(0))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(1))] * (phib1 - phia1);
965             PDL_LDouble dterm = ((d_datap)[0+(__inc_d_n*(0))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(1))] * (psib1 - psia1)) * (h / 6.);
966             value = 0.5 * h * (fterm + dterm);
967             } while(0)
968             ;
969             /* --------------------------------------- */
970             } else if (xa >= (x_datap)[0+(__inc_x_n*(n-2))]) {
971             /* INTERVAL IS TO RIGHT OF X(N-1), SO USE LAST CUBIC. */
972             /* ------------------------------------------ */
973            
974             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
975             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
976             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
977             /* Hermite form) over an arbitrary interval (A,B). */
978             /* ---------------------------------------------------------------------- */
979             /* Parameters: */
980             /* VALUE -- (output) value of the requested integral. */
981             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
982             /* F1,F2 -- (input) function values at the ends of the interval. */
983             /* D1,D2 -- (input) derivative values at the ends of the interval. */
984             /* A,B -- (input) endpoints of interval of integration. */
985             /* ***SEE ALSO DPCHIA */
986             /* Programming notes: */
987             /* 1. There is no error return from this routine because zero is */
988             /* indeed the mathematically correct answer when X1.EQ.X2 . */
989             do {
990             if ((x_datap)[0+(__inc_x_n*(n-2))] == (x_datap)[0+(__inc_x_n*(n-1))]) {
991             value = 0.; break;
992             }
993             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))];
994             PDL_LDouble ta1 = (a - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
995             PDL_LDouble ta2 = ((x_datap)[0+(__inc_x_n*(n-1))] - a) / h;
996             PDL_LDouble tb1 = (b - (x_datap)[0+(__inc_x_n*(n-2))]) / h;
997             PDL_LDouble tb2 = ((x_datap)[0+(__inc_x_n*(n-1))] - b) / h;
998             /* Computing 3rd power */
999             PDL_LDouble ua1 = ta1 * (ta1 * ta1);
1000             PDL_LDouble phia1 = ua1 * (2. - ta1);
1001             PDL_LDouble psia1 = ua1 * (3. * ta1 - 4.);
1002             /* Computing 3rd power */
1003             PDL_LDouble ua2 = ta2 * (ta2 * ta2);
1004             PDL_LDouble phia2 = ua2 * (2. - ta2);
1005             PDL_LDouble psia2 = -ua2 * (3. * ta2 - 4.);
1006             /* Computing 3rd power */
1007             PDL_LDouble ub1 = tb1 * (tb1 * tb1);
1008             PDL_LDouble phib1 = ub1 * (2. - tb1);
1009             PDL_LDouble psib1 = ub1 * (3. * tb1 - 4.);
1010             /* Computing 3rd power */
1011             PDL_LDouble ub2 = tb2 * (tb2 * tb2);
1012             PDL_LDouble phib2 = ub2 * (2. - tb2);
1013             PDL_LDouble psib2 = -ub2 * (3. * tb2 - 4.);
1014             PDL_LDouble fterm = (f_datap)[0+(__inc_f_n*(n-2))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(n-1))] * (phib1 - phia1);
1015             PDL_LDouble dterm = ((d_datap)[0+(__inc_d_n*(n-2))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(n-1))] * (psib1 - psia1)) * (h / 6.);
1016             value = 0.5 * h * (fterm + dterm);
1017             } while(0)
1018             ;
1019             /* ------------------------------------------ */
1020             } else {
1021             /* 'NORMAL' CASE -- XA.LT.XB, XA.LT.X(N-1), XB.GT.X(2). */
1022             /* ......LOCATE IA AND IB SUCH THAT */
1023             /* X(IA-1).LT.XA.LE.X(IA).LE.X(IB).LE.XB.LE.X(IB+1) */
1024             ia = 0;
1025             {/* Open n=:-1 */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size-1)); for(; n<__n_stop; n+=1) {
1026             #line 5735 "lib/PDL/Primitive.pd"
1027             if (xa > (x_datap)[0+(__inc_x_n*(n))])
1028             ia = n + 1;
1029             }} /* Close n=:-1 */
1030             #line 5738 "lib/PDL/Primitive.pd"
1031             /* IA = 1 IMPLIES XA.LT.X(1) . OTHERWISE, */
1032             /* IA IS LARGEST INDEX SUCH THAT X(IA-1).LT.XA,. */
1033             ib = n - 1;
1034             {/* Open n=:ia:-1 */ PDL_EXPAND2(register PDL_Indx n=(__n_size-1), __n_stop=PDLMAX((ia),0)); for(; n>=__n_stop; n+=-1) {
1035             #line 5742 "lib/PDL/Primitive.pd"
1036             if (xb < (x_datap)[0+(__inc_x_n*(n))])
1037             ib = n - 1;
1038             }} /* Close n=:ia:-1 */
1039             #line 5745 "lib/PDL/Primitive.pd"
1040             /* IB = N IMPLIES XB.GT.X(N) . OTHERWISE, */
1041             /* IB IS SMALLEST INDEX SUCH THAT XB.LT.X(IB+1) . */
1042             /* ......COMPUTE THE INTEGRAL. */
1043             if (ib <= ia) {
1044             /* THIS MEANS IB = IA-1 AND */
1045             /* (A,B) IS A SUBSET OF (X(IB),X(IA)). */
1046             /* ------------------------------------------- */
1047            
1048             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
1049             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
1050             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
1051             /* Hermite form) over an arbitrary interval (A,B). */
1052             /* ---------------------------------------------------------------------- */
1053             /* Parameters: */
1054             /* VALUE -- (output) value of the requested integral. */
1055             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
1056             /* F1,F2 -- (input) function values at the ends of the interval. */
1057             /* D1,D2 -- (input) derivative values at the ends of the interval. */
1058             /* A,B -- (input) endpoints of interval of integration. */
1059             /* ***SEE ALSO DPCHIA */
1060             /* Programming notes: */
1061             /* 1. There is no error return from this routine because zero is */
1062             /* indeed the mathematically correct answer when X1.EQ.X2 . */
1063             do {
1064             if ((x_datap)[0+(__inc_x_n*(ib))] == (x_datap)[0+(__inc_x_n*(ia))]) {
1065             value = 0.; break;
1066             }
1067             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(ib))];
1068             PDL_LDouble ta1 = (a - (x_datap)[0+(__inc_x_n*(ib))]) / h;
1069             PDL_LDouble ta2 = ((x_datap)[0+(__inc_x_n*(ia))] - a) / h;
1070             PDL_LDouble tb1 = (b - (x_datap)[0+(__inc_x_n*(ib))]) / h;
1071             PDL_LDouble tb2 = ((x_datap)[0+(__inc_x_n*(ia))] - b) / h;
1072             /* Computing 3rd power */
1073             PDL_LDouble ua1 = ta1 * (ta1 * ta1);
1074             PDL_LDouble phia1 = ua1 * (2. - ta1);
1075             PDL_LDouble psia1 = ua1 * (3. * ta1 - 4.);
1076             /* Computing 3rd power */
1077             PDL_LDouble ua2 = ta2 * (ta2 * ta2);
1078             PDL_LDouble phia2 = ua2 * (2. - ta2);
1079             PDL_LDouble psia2 = -ua2 * (3. * ta2 - 4.);
1080             /* Computing 3rd power */
1081             PDL_LDouble ub1 = tb1 * (tb1 * tb1);
1082             PDL_LDouble phib1 = ub1 * (2. - tb1);
1083             PDL_LDouble psib1 = ub1 * (3. * tb1 - 4.);
1084             /* Computing 3rd power */
1085             PDL_LDouble ub2 = tb2 * (tb2 * tb2);
1086             PDL_LDouble phib2 = ub2 * (2. - tb2);
1087             PDL_LDouble psib2 = -ub2 * (3. * tb2 - 4.);
1088             PDL_LDouble fterm = (f_datap)[0+(__inc_f_n*(ib))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ia))] * (phib1 - phia1);
1089             PDL_LDouble dterm = ((d_datap)[0+(__inc_d_n*(ib))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ia))] * (psib1 - psia1)) * (h / 6.);
1090             value = 0.5 * h * (fterm + dterm);
1091             } while(0)
1092             ;
1093             /* ------------------------------------------- */
1094             } else {
1095             /* FIRST COMPUTE INTEGRAL OVER (X(IA),X(IB)). */
1096             /* (Case (IB .EQ. IA) is taken care of by initialization */
1097             /* of VALUE to ZERO.) */
1098             if (ib > ia-1) {
1099             /* --------------------------------------------- */
1100            
1101             /* Programming notes: */
1102             /* 1. This routine uses a special formula that is valid only for */
1103             /* integrals whose limits coincide with data values. This is */
1104             /* mathematically equivalent to, but much more efficient than, */
1105             /* calls to DCHFIE. */
1106             /* VALIDITY-CHECK ARGUMENTS. */
1107             do {
1108             /* FUNCTION DEFINITION IS OK, GO ON. */
1109             (skip_datap)[0] = 1;
1110             if (ia < 0 || ia > __privtrans->ind_sizes[0]-1 || ib < 0 || ib > __privtrans->ind_sizes[0]-1) {
1111             (ierr_datap)[0] = -4;
1112             return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chia:" "IA OR IB OUT OF RANGE");
1113             }
1114             (ierr_datap)[0] = 0;
1115             /* COMPUTE INTEGRAL VALUE. */
1116             if (ia == ib) { value = 0; continue; }
1117             PDL_Indx low = PDLMIN(ia,ib), iup = PDLMAX(ia,ib);
1118             PDL_LDouble sum = 0.;
1119             {/* Open n=low:iup */ PDL_EXPAND2(register PDL_Indx n=PDLMAX((low),0), __n_stop=PDLMIN(iup, (__n_size))); for(; n<__n_stop; n+=1) {
1120             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(n+1))] - (x_datap)[0+(__inc_x_n*(n))];
1121             sum += h * ((f_datap)[0+(__inc_f_n*(n))] + (f_datap)[0+(__inc_f_n*(n+1))] + ((d_datap)[0+(__inc_d_n*(n))] - (d_datap)[0+(__inc_d_n*(n+1))]) * (h / 6.));
1122             }} /* Close n=low:iup */
1123             value = 0.5 * (ia > ib ? -sum : sum);
1124             } while(0)
1125             ;
1126             /* --------------------------------------------- */
1127             }
1128             /* THEN ADD ON INTEGRAL OVER (XA,X(IA)). */
1129             if (xa < (x_datap)[0+(__inc_x_n*(ia))]) {
1130             /* Computing MAX */
1131             il = PDLMAX(0,ia - 1);
1132             ir = il + 1;
1133             /* ------------------------------------- */
1134             PDL_LDouble chfie_ans = 0;
1135            
1136             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
1137             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
1138             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
1139             /* Hermite form) over an arbitrary interval (A,B). */
1140             /* ---------------------------------------------------------------------- */
1141             /* Parameters: */
1142             /* VALUE -- (output) value of the requested integral. */
1143             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
1144             /* F1,F2 -- (input) function values at the ends of the interval. */
1145             /* D1,D2 -- (input) derivative values at the ends of the interval. */
1146             /* A,B -- (input) endpoints of interval of integration. */
1147             /* ***SEE ALSO DPCHIA */
1148             /* Programming notes: */
1149             /* 1. There is no error return from this routine because zero is */
1150             /* indeed the mathematically correct answer when X1.EQ.X2 . */
1151             do {
1152             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
1153             chfie_ans = 0.; break;
1154             }
1155             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
1156             PDL_LDouble ta1 = (xa - (x_datap)[0+(__inc_x_n*(il))]) / h;
1157             PDL_LDouble ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - xa) / h;
1158             PDL_LDouble tb1 = ((x_datap)[0+(__inc_x_n*(ia))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
1159             PDL_LDouble tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ia))]) / h;
1160             /* Computing 3rd power */
1161             PDL_LDouble ua1 = ta1 * (ta1 * ta1);
1162             PDL_LDouble phia1 = ua1 * (2. - ta1);
1163             PDL_LDouble psia1 = ua1 * (3. * ta1 - 4.);
1164             /* Computing 3rd power */
1165             PDL_LDouble ua2 = ta2 * (ta2 * ta2);
1166             PDL_LDouble phia2 = ua2 * (2. - ta2);
1167             PDL_LDouble psia2 = -ua2 * (3. * ta2 - 4.);
1168             /* Computing 3rd power */
1169             PDL_LDouble ub1 = tb1 * (tb1 * tb1);
1170             PDL_LDouble phib1 = ub1 * (2. - tb1);
1171             PDL_LDouble psib1 = ub1 * (3. * tb1 - 4.);
1172             /* Computing 3rd power */
1173             PDL_LDouble ub2 = tb2 * (tb2 * tb2);
1174             PDL_LDouble phib2 = ub2 * (2. - tb2);
1175             PDL_LDouble psib2 = -ub2 * (3. * tb2 - 4.);
1176             PDL_LDouble fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
1177             PDL_LDouble dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
1178             chfie_ans = 0.5 * h * (fterm + dterm);
1179             } while(0)
1180             ;
1181             value += chfie_ans;
1182             /* ------------------------------------- */
1183             }
1184             /* THEN ADD ON INTEGRAL OVER (X(IB),XB). */
1185             if (xb > (x_datap)[0+(__inc_x_n*(ib))]) {
1186             /* Computing MIN */
1187             ir = PDLMIN(ib + 1,n-1);
1188             il = ir - 1;
1189             /* ------------------------------------- */
1190             PDL_LDouble chfie_ans = 0;
1191            
1192             /* ***PURPOSE Evaluates integral of a single cubic for DPCHIA */
1193             /* DCHFIE: Cubic Hermite Function Integral Evaluator. */
1194             /* Called by DPCHIA to evaluate the integral of a single cubic (in */
1195             /* Hermite form) over an arbitrary interval (A,B). */
1196             /* ---------------------------------------------------------------------- */
1197             /* Parameters: */
1198             /* VALUE -- (output) value of the requested integral. */
1199             /* X1,X2 -- (input) endpoints if interval of definition of cubic. */
1200             /* F1,F2 -- (input) function values at the ends of the interval. */
1201             /* D1,D2 -- (input) derivative values at the ends of the interval. */
1202             /* A,B -- (input) endpoints of interval of integration. */
1203             /* ***SEE ALSO DPCHIA */
1204             /* Programming notes: */
1205             /* 1. There is no error return from this routine because zero is */
1206             /* indeed the mathematically correct answer when X1.EQ.X2 . */
1207             do {
1208             if ((x_datap)[0+(__inc_x_n*(il))] == (x_datap)[0+(__inc_x_n*(ir))]) {
1209             chfie_ans = 0.; break;
1210             }
1211             PDL_LDouble h = (x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(il))];
1212             PDL_LDouble ta1 = ((x_datap)[0+(__inc_x_n*(ib))] - (x_datap)[0+(__inc_x_n*(il))]) / h;
1213             PDL_LDouble ta2 = ((x_datap)[0+(__inc_x_n*(ir))] - (x_datap)[0+(__inc_x_n*(ib))]) / h;
1214             PDL_LDouble tb1 = (xb - (x_datap)[0+(__inc_x_n*(il))]) / h;
1215             PDL_LDouble tb2 = ((x_datap)[0+(__inc_x_n*(ir))] - xb) / h;
1216             /* Computing 3rd power */
1217             PDL_LDouble ua1 = ta1 * (ta1 * ta1);
1218             PDL_LDouble phia1 = ua1 * (2. - ta1);
1219             PDL_LDouble psia1 = ua1 * (3. * ta1 - 4.);
1220             /* Computing 3rd power */
1221             PDL_LDouble ua2 = ta2 * (ta2 * ta2);
1222             PDL_LDouble phia2 = ua2 * (2. - ta2);
1223             PDL_LDouble psia2 = -ua2 * (3. * ta2 - 4.);
1224             /* Computing 3rd power */
1225             PDL_LDouble ub1 = tb1 * (tb1 * tb1);
1226             PDL_LDouble phib1 = ub1 * (2. - tb1);
1227             PDL_LDouble psib1 = ub1 * (3. * tb1 - 4.);
1228             /* Computing 3rd power */
1229             PDL_LDouble ub2 = tb2 * (tb2 * tb2);
1230             PDL_LDouble phib2 = ub2 * (2. - tb2);
1231             PDL_LDouble psib2 = -ub2 * (3. * tb2 - 4.);
1232             PDL_LDouble fterm = (f_datap)[0+(__inc_f_n*(il))] * (phia2 - phib2) + (f_datap)[0+(__inc_f_n*(ir))] * (phib1 - phia1);
1233             PDL_LDouble dterm = ((d_datap)[0+(__inc_d_n*(il))] * (psia2 - psib2) + (d_datap)[0+(__inc_d_n*(ir))] * (psib1 - psia1)) * (h / 6.);
1234             chfie_ans = 0.5 * h * (fterm + dterm);
1235             } while(0)
1236             ;
1237             value += chfie_ans;
1238             /* ------------------------------------- */
1239             }
1240             /* FINALLY, ADJUST SIGN IF NECESSARY. */
1241             if (a > b) {
1242             value = -value;
1243             }
1244             }
1245             }
1246             }
1247             (ans_datap)[0] = value;
1248             #line 1249 "lib/PDL/Primitive-pp-pchip_chia.c"
1249 0 0         }PDL_BROADCASTLOOP_END_pchip_chia_readdata
    0          
1250 0           } break;
1251 0           default: return PDL->make_error(PDL_EUSERERROR, "PP INTERNAL ERROR in pchip_chia: unhandled datatype(%d), only handles (FDE)! PLEASE MAKE A BUG REPORT\n", __privtrans->__datatype);
1252             }
1253             #undef PDL_IF_BAD
1254 2           return PDL_err;
1255             }
1256              
1257             static pdl_datatypes pdl_pchip_chia_vtable_gentypes[] = { PDL_F, PDL_D, PDL_LD, -1 };
1258             static PDL_Indx pdl_pchip_chia_vtable_realdims[] = { 1, 1, 1, 0, 0, 0, 0, 0 };
1259             static char *pdl_pchip_chia_vtable_parnames[] = { "x","f","d","la","lb","ans","ierr","skip" };
1260             static short pdl_pchip_chia_vtable_parflags[] = {
1261             0,
1262             0,
1263             0,
1264             0,
1265             0,
1266             PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISWRITE,
1267             PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISTYPED|PDL_PARAM_ISWRITE,
1268             PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISTYPED|PDL_PARAM_ISWRITE
1269             };
1270             static pdl_datatypes pdl_pchip_chia_vtable_partypes[] = { -1, -1, -1, -1, -1, -1, PDL_IND, PDL_L };
1271             static PDL_Indx pdl_pchip_chia_vtable_realdims_starts[] = { 0, 1, 2, 3, 3, 3, 3, 3 };
1272             static PDL_Indx pdl_pchip_chia_vtable_realdims_ind_ids[] = { 0, 0, 0 };
1273             static char *pdl_pchip_chia_vtable_indnames[] = { "n" };
1274             pdl_transvtable pdl_pchip_chia_vtable = {
1275             PDL_TRANS_DO_BROADCAST, 0, pdl_pchip_chia_vtable_gentypes, 5, 8, NULL /*CORE21*/,
1276             pdl_pchip_chia_vtable_realdims, pdl_pchip_chia_vtable_parnames,
1277             pdl_pchip_chia_vtable_parflags, pdl_pchip_chia_vtable_partypes,
1278             pdl_pchip_chia_vtable_realdims_starts, pdl_pchip_chia_vtable_realdims_ind_ids, 3,
1279             1, pdl_pchip_chia_vtable_indnames,
1280             pdl_pchip_chia_redodims, pdl_pchip_chia_readdata, NULL,
1281             NULL,
1282             0,"PDL::Primitive::pchip_chia"
1283             };
1284              
1285              
1286 2           pdl_error pdl_run_pchip_chia(pdl *x,pdl *f,pdl *d,pdl *la,pdl *lb,pdl *ans,pdl *ierr,pdl *skip) {
1287 2           pdl_error PDL_err = {0, NULL, 0};
1288 2 50         if (!PDL) return (pdl_error){PDL_EFATAL, "PDL core struct is NULL, can't continue",0};
1289 2           pdl_trans *__privtrans = PDL->create_trans(&pdl_pchip_chia_vtable);
1290 2 50         if (!__privtrans) return PDL->make_error_simple(PDL_EFATAL, "Couldn't create trans");
1291 2           __privtrans->pdls[0] = x;
1292 2           __privtrans->pdls[1] = f;
1293 2           __privtrans->pdls[2] = d;
1294 2           __privtrans->pdls[3] = la;
1295 2           __privtrans->pdls[4] = lb;
1296 2           __privtrans->pdls[5] = ans;
1297 2           __privtrans->pdls[6] = ierr;
1298 2           __privtrans->pdls[7] = skip;
1299 2 50         PDL_RETERROR(PDL_err, PDL->type_coerce(__privtrans));
1300 2 50         PDL_RETERROR(PDL_err, PDL->make_trans_mutual(__privtrans));
1301 2           return PDL_err;
1302             }