| 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_chbs.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_chbs_redodims(pdl_trans *__privtrans) { |
|
43
|
|
|
|
|
|
|
pdl_error PDL_err = {0, NULL, 0}; |
|
44
|
|
|
|
|
|
|
#line 45 "lib/PDL/Primitive-pp-pchip_chbs.c" |
|
45
|
1
|
|
|
|
|
|
__privtrans->ind_sizes[1] = 2*__privtrans->ind_sizes[0]; |
|
46
|
1
|
|
|
|
|
|
__privtrans->ind_sizes[2] = 2*__privtrans->ind_sizes[0]+4; |
|
47
|
1
|
50
|
|
|
|
|
PDL_RETERROR(PDL_err, PDL->redodims_default(__privtrans)); |
|
48
|
1
|
|
|
|
|
|
return PDL_err; |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
#line 1857 "lib/PDL/PP.pm" |
|
53
|
|
|
|
|
|
|
pdl_error pdl_pchip_chbs_readdata(pdl_trans *__privtrans) { |
|
54
|
|
|
|
|
|
|
pdl_error PDL_err = {0, NULL, 0}; |
|
55
|
|
|
|
|
|
|
#line 56 "lib/PDL/Primitive-pp-pchip_chbs.c" |
|
56
|
1
|
|
|
|
|
|
register PDL_Indx __n_size = __privtrans->ind_sizes[0]; |
|
57
|
1
|
50
|
|
|
|
|
if (!__privtrans->broadcast.incs) return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chbs:" "broadcast.incs NULL"); |
|
58
|
|
|
|
|
|
|
/* broadcastloop declarations */ |
|
59
|
|
|
|
|
|
|
int __brcloopval; |
|
60
|
|
|
|
|
|
|
register PDL_Indx __tind0,__tind1; /* counters along dim */ |
|
61
|
1
|
|
|
|
|
|
register PDL_Indx __tnpdls = __privtrans->broadcast.npdls; |
|
62
|
|
|
|
|
|
|
/* dims here are how many steps along those dims */ |
|
63
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_x = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,0,0); |
|
64
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_f = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,1,0); |
|
65
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_d = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,2,0); |
|
66
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_knotyp = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,3,0); |
|
67
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_t = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,4,0); |
|
68
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_bcoef = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,5,0); |
|
69
|
1
|
|
|
|
|
|
register PDL_Indx __tinc0_ierr = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,6,0); |
|
70
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_x = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,0,1); |
|
71
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_f = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,1,1); |
|
72
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_d = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,2,1); |
|
73
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_knotyp = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,3,1); |
|
74
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_t = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,4,1); |
|
75
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_bcoef = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,5,1); |
|
76
|
1
|
|
|
|
|
|
register PDL_Indx __tinc1_ierr = PDL_BRC_INC(__privtrans->broadcast.incs,__tnpdls,6,1); |
|
77
|
|
|
|
|
|
|
#define PDL_BROADCASTLOOP_START_pchip_chbs_readdata PDL_BROADCASTLOOP_START( \ |
|
78
|
|
|
|
|
|
|
readdata, \ |
|
79
|
|
|
|
|
|
|
__privtrans->broadcast, \ |
|
80
|
|
|
|
|
|
|
__privtrans->vtable, \ |
|
81
|
|
|
|
|
|
|
x_datap += __offsp[0]; \ |
|
82
|
|
|
|
|
|
|
f_datap += __offsp[1]; \ |
|
83
|
|
|
|
|
|
|
d_datap += __offsp[2]; \ |
|
84
|
|
|
|
|
|
|
knotyp_datap += __offsp[3]; \ |
|
85
|
|
|
|
|
|
|
t_datap += __offsp[4]; \ |
|
86
|
|
|
|
|
|
|
bcoef_datap += __offsp[5]; \ |
|
87
|
|
|
|
|
|
|
ierr_datap += __offsp[6]; \ |
|
88
|
|
|
|
|
|
|
, \ |
|
89
|
|
|
|
|
|
|
( ,x_datap += __tinc1_x - __tinc0_x * __tdims0 \ |
|
90
|
|
|
|
|
|
|
,f_datap += __tinc1_f - __tinc0_f * __tdims0 \ |
|
91
|
|
|
|
|
|
|
,d_datap += __tinc1_d - __tinc0_d * __tdims0 \ |
|
92
|
|
|
|
|
|
|
,knotyp_datap += __tinc1_knotyp - __tinc0_knotyp * __tdims0 \ |
|
93
|
|
|
|
|
|
|
,t_datap += __tinc1_t - __tinc0_t * __tdims0 \ |
|
94
|
|
|
|
|
|
|
,bcoef_datap += __tinc1_bcoef - __tinc0_bcoef * __tdims0 \ |
|
95
|
|
|
|
|
|
|
,ierr_datap += __tinc1_ierr - __tinc0_ierr * __tdims0 \ |
|
96
|
|
|
|
|
|
|
), \ |
|
97
|
|
|
|
|
|
|
( ,x_datap += __tinc0_x \ |
|
98
|
|
|
|
|
|
|
,f_datap += __tinc0_f \ |
|
99
|
|
|
|
|
|
|
,d_datap += __tinc0_d \ |
|
100
|
|
|
|
|
|
|
,knotyp_datap += __tinc0_knotyp \ |
|
101
|
|
|
|
|
|
|
,t_datap += __tinc0_t \ |
|
102
|
|
|
|
|
|
|
,bcoef_datap += __tinc0_bcoef \ |
|
103
|
|
|
|
|
|
|
,ierr_datap += __tinc0_ierr \ |
|
104
|
|
|
|
|
|
|
) \ |
|
105
|
|
|
|
|
|
|
) |
|
106
|
|
|
|
|
|
|
#define PDL_BROADCASTLOOP_END_pchip_chbs_readdata PDL_BROADCASTLOOP_END( \ |
|
107
|
|
|
|
|
|
|
__privtrans->broadcast, \ |
|
108
|
|
|
|
|
|
|
x_datap -= __tinc1_x * __tdims1 + __offsp[0]; \ |
|
109
|
|
|
|
|
|
|
f_datap -= __tinc1_f * __tdims1 + __offsp[1]; \ |
|
110
|
|
|
|
|
|
|
d_datap -= __tinc1_d * __tdims1 + __offsp[2]; \ |
|
111
|
|
|
|
|
|
|
knotyp_datap -= __tinc1_knotyp * __tdims1 + __offsp[3]; \ |
|
112
|
|
|
|
|
|
|
t_datap -= __tinc1_t * __tdims1 + __offsp[4]; \ |
|
113
|
|
|
|
|
|
|
bcoef_datap -= __tinc1_bcoef * __tdims1 + __offsp[5]; \ |
|
114
|
|
|
|
|
|
|
ierr_datap -= __tinc1_ierr * __tdims1 + __offsp[6]; \ |
|
115
|
|
|
|
|
|
|
) |
|
116
|
1
|
|
|
|
|
|
register PDL_Indx __inc_bcoef_ndim = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,5,0)]; (void)__inc_bcoef_ndim; |
|
117
|
1
|
|
|
|
|
|
register PDL_Indx __inc_d_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,2,0)]; (void)__inc_d_n; |
|
118
|
1
|
|
|
|
|
|
register PDL_Indx __inc_f_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,1,0)]; (void)__inc_f_n; |
|
119
|
1
|
|
|
|
|
|
register PDL_Indx __inc_t_nknots = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,4,0)]; (void)__inc_t_nknots; |
|
120
|
1
|
|
|
|
|
|
register PDL_Indx __inc_x_n = __privtrans->inc_sizes[PDL_INC_ID(__privtrans->vtable,0,0)]; (void)__inc_x_n; |
|
121
|
|
|
|
|
|
|
#ifndef PDL_DECLARE_PARAMS_pchip_chbs_1 |
|
122
|
|
|
|
|
|
|
#define PDL_DECLARE_PARAMS_pchip_chbs_1(PDL_TYPE_OP,PDL_PPSYM_OP,PDL_TYPE_PARAM_knotyp,PDL_PPSYM_PARAM_knotyp,PDL_TYPE_PARAM_ierr,PDL_PPSYM_PARAM_ierr) \ |
|
123
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_OP, x, (__privtrans->pdls[0]), 1, PDL_PPSYM_OP) \ |
|
124
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_OP, f, (__privtrans->pdls[1]), 1, PDL_PPSYM_OP) \ |
|
125
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_OP, d, (__privtrans->pdls[2]), 1, PDL_PPSYM_OP) \ |
|
126
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_knotyp, knotyp, (__privtrans->pdls[3]), 1, PDL_PPSYM_PARAM_knotyp) \ |
|
127
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_OP, t, (__privtrans->pdls[4]), 1, PDL_PPSYM_OP) \ |
|
128
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_OP, bcoef, (__privtrans->pdls[5]), 1, PDL_PPSYM_OP) \ |
|
129
|
|
|
|
|
|
|
PDL_DECLARE_PARAMETER(PDL_TYPE_PARAM_ierr, ierr, (__privtrans->pdls[6]), 1, PDL_PPSYM_PARAM_ierr) |
|
130
|
|
|
|
|
|
|
#endif |
|
131
|
|
|
|
|
|
|
#define PDL_IF_BAD(t,f) f |
|
132
|
1
|
|
|
|
|
|
switch (__privtrans->__datatype) { /* Start generic switch */ |
|
133
|
0
|
|
|
|
|
|
case PDL_F: { |
|
134
|
0
|
0
|
|
|
|
|
PDL_DECLARE_PARAMS_pchip_chbs_1(PDL_Float,F,PDL_SByte,A,PDL_Indx,N) |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
135
|
0
|
0
|
|
|
|
|
PDL_BROADCASTLOOP_START_pchip_chbs_readdata { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
#line 5962 "lib/PDL/Primitive.pd" |
|
137
|
|
|
|
|
|
|
/* Local variables */ |
|
138
|
|
|
|
|
|
|
PDL_Indx n = __privtrans->ind_sizes[0], ndim = __privtrans->ind_sizes[1]; |
|
139
|
|
|
|
|
|
|
(ierr_datap)[0] = 0; |
|
140
|
|
|
|
|
|
|
/* Check argument validity. Set up knot sequence if OK. */ |
|
141
|
|
|
|
|
|
|
if ((knotyp_datap)[0] > 2) { |
|
142
|
|
|
|
|
|
|
(ierr_datap)[0] = -1; |
|
143
|
|
|
|
|
|
|
return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chbs:" "KNOTYP GREATER THAN 2"); |
|
144
|
|
|
|
|
|
|
} |
|
145
|
|
|
|
|
|
|
if ((knotyp_datap)[0] >= 0) { |
|
146
|
|
|
|
|
|
|
/* Set up knot sequence. */ |
|
147
|
|
|
|
|
|
|
do { /* inline dpchkt */ |
|
148
|
|
|
|
|
|
|
/* Set interior knots. */ |
|
149
|
|
|
|
|
|
|
PDL_Indx j = 0; |
|
150
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
151
|
|
|
|
|
|
|
#line 5976 "lib/PDL/Primitive.pd" |
|
152
|
|
|
|
|
|
|
j += 2; |
|
153
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(j+1))] = (t_datap)[0+(__inc_t_nknots*(j))] = (x_datap)[0+(__inc_x_n*(n))]; |
|
154
|
|
|
|
|
|
|
}} /* Close n */ |
|
155
|
|
|
|
|
|
|
#line 5979 "lib/PDL/Primitive.pd" |
|
156
|
|
|
|
|
|
|
/* Assertion: At this point T(3),...,T(NDIM+2) have been set and */ |
|
157
|
|
|
|
|
|
|
/* J=NDIM+1. */ |
|
158
|
|
|
|
|
|
|
/* Set end knots according to KNOTYP. */ |
|
159
|
|
|
|
|
|
|
PDL_Float hbeg = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))]; |
|
160
|
|
|
|
|
|
|
PDL_Float hend = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))]; |
|
161
|
|
|
|
|
|
|
if ((knotyp_datap)[0] == 1) { |
|
162
|
|
|
|
|
|
|
/* Extrapolate. */ |
|
163
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hbeg; |
|
164
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hend; |
|
165
|
|
|
|
|
|
|
} else if ((knotyp_datap)[0] == 2) { |
|
166
|
|
|
|
|
|
|
/* Periodic. */ |
|
167
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hend; |
|
168
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hbeg; |
|
169
|
|
|
|
|
|
|
} else { |
|
170
|
|
|
|
|
|
|
/* Quadruple end knots. */ |
|
171
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))]; |
|
172
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))]; |
|
173
|
|
|
|
|
|
|
} |
|
174
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(0))] = (t_datap)[0+(__inc_t_nknots*(1))]; |
|
175
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+3))] = (t_datap)[0+(__inc_t_nknots*(ndim+2))]; |
|
176
|
|
|
|
|
|
|
} while (0); /* end inline dpchkt */ |
|
177
|
|
|
|
|
|
|
} |
|
178
|
|
|
|
|
|
|
/* Compute B-spline coefficients. */ |
|
179
|
|
|
|
|
|
|
PDL_Float hnew = (t_datap)[0+(__inc_t_nknots*(2))] - (t_datap)[0+(__inc_t_nknots*(0))]; |
|
180
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
181
|
|
|
|
|
|
|
#line 6004 "lib/PDL/Primitive.pd" |
|
182
|
|
|
|
|
|
|
PDL_Float hold = hnew; |
|
183
|
|
|
|
|
|
|
/* The following requires mixed mode arithmetic. */ |
|
184
|
|
|
|
|
|
|
PDL_Float dov3 = (d_datap)[0+(__inc_d_n*(n))] / 3; |
|
185
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n))] = (f_datap)[0+(__inc_f_n*(n))] - hold * dov3; |
|
186
|
|
|
|
|
|
|
/* The following assumes T(2*K+1) = X(K). */ |
|
187
|
|
|
|
|
|
|
hnew = (t_datap)[0+(__inc_t_nknots*(2*n+4))] - (t_datap)[0+(__inc_t_nknots*(2*n+2))]; |
|
188
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n+1))] = (f_datap)[0+(__inc_f_n*(n))] + hnew * dov3; |
|
189
|
|
|
|
|
|
|
}} /* Close n */ |
|
190
|
|
|
|
|
|
|
#line 191 "lib/PDL/Primitive-pp-pchip_chbs.c" |
|
191
|
0
|
0
|
|
|
|
|
}PDL_BROADCASTLOOP_END_pchip_chbs_readdata |
|
|
|
0
|
|
|
|
|
|
|
192
|
0
|
|
|
|
|
|
} break; |
|
193
|
1
|
|
|
|
|
|
case PDL_D: { |
|
194
|
1
|
50
|
|
|
|
|
PDL_DECLARE_PARAMS_pchip_chbs_1(PDL_Double,D,PDL_SByte,A,PDL_Indx,N) |
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
195
|
5
|
50
|
|
|
|
|
PDL_BROADCASTLOOP_START_pchip_chbs_readdata { |
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
#line 5962 "lib/PDL/Primitive.pd" |
|
197
|
|
|
|
|
|
|
/* Local variables */ |
|
198
|
|
|
|
|
|
|
PDL_Indx n = __privtrans->ind_sizes[0], ndim = __privtrans->ind_sizes[1]; |
|
199
|
|
|
|
|
|
|
(ierr_datap)[0] = 0; |
|
200
|
|
|
|
|
|
|
/* Check argument validity. Set up knot sequence if OK. */ |
|
201
|
|
|
|
|
|
|
if ((knotyp_datap)[0] > 2) { |
|
202
|
|
|
|
|
|
|
(ierr_datap)[0] = -1; |
|
203
|
|
|
|
|
|
|
return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chbs:" "KNOTYP GREATER THAN 2"); |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
if ((knotyp_datap)[0] >= 0) { |
|
206
|
|
|
|
|
|
|
/* Set up knot sequence. */ |
|
207
|
|
|
|
|
|
|
do { /* inline dpchkt */ |
|
208
|
|
|
|
|
|
|
/* Set interior knots. */ |
|
209
|
|
|
|
|
|
|
PDL_Indx j = 0; |
|
210
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
211
|
|
|
|
|
|
|
#line 5976 "lib/PDL/Primitive.pd" |
|
212
|
|
|
|
|
|
|
j += 2; |
|
213
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(j+1))] = (t_datap)[0+(__inc_t_nknots*(j))] = (x_datap)[0+(__inc_x_n*(n))]; |
|
214
|
|
|
|
|
|
|
}} /* Close n */ |
|
215
|
|
|
|
|
|
|
#line 5979 "lib/PDL/Primitive.pd" |
|
216
|
|
|
|
|
|
|
/* Assertion: At this point T(3),...,T(NDIM+2) have been set and */ |
|
217
|
|
|
|
|
|
|
/* J=NDIM+1. */ |
|
218
|
|
|
|
|
|
|
/* Set end knots according to KNOTYP. */ |
|
219
|
|
|
|
|
|
|
PDL_Double hbeg = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))]; |
|
220
|
|
|
|
|
|
|
PDL_Double hend = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))]; |
|
221
|
|
|
|
|
|
|
if ((knotyp_datap)[0] == 1) { |
|
222
|
|
|
|
|
|
|
/* Extrapolate. */ |
|
223
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hbeg; |
|
224
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hend; |
|
225
|
|
|
|
|
|
|
} else if ((knotyp_datap)[0] == 2) { |
|
226
|
|
|
|
|
|
|
/* Periodic. */ |
|
227
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hend; |
|
228
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hbeg; |
|
229
|
|
|
|
|
|
|
} else { |
|
230
|
|
|
|
|
|
|
/* Quadruple end knots. */ |
|
231
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))]; |
|
232
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))]; |
|
233
|
|
|
|
|
|
|
} |
|
234
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(0))] = (t_datap)[0+(__inc_t_nknots*(1))]; |
|
235
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+3))] = (t_datap)[0+(__inc_t_nknots*(ndim+2))]; |
|
236
|
|
|
|
|
|
|
} while (0); /* end inline dpchkt */ |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
/* Compute B-spline coefficients. */ |
|
239
|
|
|
|
|
|
|
PDL_Double hnew = (t_datap)[0+(__inc_t_nknots*(2))] - (t_datap)[0+(__inc_t_nknots*(0))]; |
|
240
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
241
|
|
|
|
|
|
|
#line 6004 "lib/PDL/Primitive.pd" |
|
242
|
|
|
|
|
|
|
PDL_Double hold = hnew; |
|
243
|
|
|
|
|
|
|
/* The following requires mixed mode arithmetic. */ |
|
244
|
|
|
|
|
|
|
PDL_Double dov3 = (d_datap)[0+(__inc_d_n*(n))] / 3; |
|
245
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n))] = (f_datap)[0+(__inc_f_n*(n))] - hold * dov3; |
|
246
|
|
|
|
|
|
|
/* The following assumes T(2*K+1) = X(K). */ |
|
247
|
|
|
|
|
|
|
hnew = (t_datap)[0+(__inc_t_nknots*(2*n+4))] - (t_datap)[0+(__inc_t_nknots*(2*n+2))]; |
|
248
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n+1))] = (f_datap)[0+(__inc_f_n*(n))] + hnew * dov3; |
|
249
|
|
|
|
|
|
|
}} /* Close n */ |
|
250
|
|
|
|
|
|
|
#line 251 "lib/PDL/Primitive-pp-pchip_chbs.c" |
|
251
|
1
|
50
|
|
|
|
|
}PDL_BROADCASTLOOP_END_pchip_chbs_readdata |
|
|
|
50
|
|
|
|
|
|
|
252
|
1
|
|
|
|
|
|
} break; |
|
253
|
0
|
|
|
|
|
|
case PDL_LD: { |
|
254
|
0
|
0
|
|
|
|
|
PDL_DECLARE_PARAMS_pchip_chbs_1(PDL_LDouble,E,PDL_SByte,A,PDL_Indx,N) |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
255
|
0
|
0
|
|
|
|
|
PDL_BROADCASTLOOP_START_pchip_chbs_readdata { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
#line 5962 "lib/PDL/Primitive.pd" |
|
257
|
|
|
|
|
|
|
/* Local variables */ |
|
258
|
|
|
|
|
|
|
PDL_Indx n = __privtrans->ind_sizes[0], ndim = __privtrans->ind_sizes[1]; |
|
259
|
|
|
|
|
|
|
(ierr_datap)[0] = 0; |
|
260
|
|
|
|
|
|
|
/* Check argument validity. Set up knot sequence if OK. */ |
|
261
|
|
|
|
|
|
|
if ((knotyp_datap)[0] > 2) { |
|
262
|
|
|
|
|
|
|
(ierr_datap)[0] = -1; |
|
263
|
|
|
|
|
|
|
return PDL->make_error(PDL_EUSERERROR, "Error in pchip_chbs:" "KNOTYP GREATER THAN 2"); |
|
264
|
|
|
|
|
|
|
} |
|
265
|
|
|
|
|
|
|
if ((knotyp_datap)[0] >= 0) { |
|
266
|
|
|
|
|
|
|
/* Set up knot sequence. */ |
|
267
|
|
|
|
|
|
|
do { /* inline dpchkt */ |
|
268
|
|
|
|
|
|
|
/* Set interior knots. */ |
|
269
|
|
|
|
|
|
|
PDL_Indx j = 0; |
|
270
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
271
|
|
|
|
|
|
|
#line 5976 "lib/PDL/Primitive.pd" |
|
272
|
|
|
|
|
|
|
j += 2; |
|
273
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(j+1))] = (t_datap)[0+(__inc_t_nknots*(j))] = (x_datap)[0+(__inc_x_n*(n))]; |
|
274
|
|
|
|
|
|
|
}} /* Close n */ |
|
275
|
|
|
|
|
|
|
#line 5979 "lib/PDL/Primitive.pd" |
|
276
|
|
|
|
|
|
|
/* Assertion: At this point T(3),...,T(NDIM+2) have been set and */ |
|
277
|
|
|
|
|
|
|
/* J=NDIM+1. */ |
|
278
|
|
|
|
|
|
|
/* Set end knots according to KNOTYP. */ |
|
279
|
|
|
|
|
|
|
PDL_LDouble hbeg = (x_datap)[0+(__inc_x_n*(1))] - (x_datap)[0+(__inc_x_n*(0))]; |
|
280
|
|
|
|
|
|
|
PDL_LDouble hend = (x_datap)[0+(__inc_x_n*(n-1))] - (x_datap)[0+(__inc_x_n*(n-2))]; |
|
281
|
|
|
|
|
|
|
if ((knotyp_datap)[0] == 1) { |
|
282
|
|
|
|
|
|
|
/* Extrapolate. */ |
|
283
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hbeg; |
|
284
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hend; |
|
285
|
|
|
|
|
|
|
} else if ((knotyp_datap)[0] == 2) { |
|
286
|
|
|
|
|
|
|
/* Periodic. */ |
|
287
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))] - hend; |
|
288
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))] + hbeg; |
|
289
|
|
|
|
|
|
|
} else { |
|
290
|
|
|
|
|
|
|
/* Quadruple end knots. */ |
|
291
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(1))] = (x_datap)[0+(__inc_x_n*(0))]; |
|
292
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+2))] = (x_datap)[0+(__inc_x_n*(n-1))]; |
|
293
|
|
|
|
|
|
|
} |
|
294
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(0))] = (t_datap)[0+(__inc_t_nknots*(1))]; |
|
295
|
|
|
|
|
|
|
(t_datap)[0+(__inc_t_nknots*(ndim+3))] = (t_datap)[0+(__inc_t_nknots*(ndim+2))]; |
|
296
|
|
|
|
|
|
|
} while (0); /* end inline dpchkt */ |
|
297
|
|
|
|
|
|
|
} |
|
298
|
|
|
|
|
|
|
/* Compute B-spline coefficients. */ |
|
299
|
|
|
|
|
|
|
PDL_LDouble hnew = (t_datap)[0+(__inc_t_nknots*(2))] - (t_datap)[0+(__inc_t_nknots*(0))]; |
|
300
|
|
|
|
|
|
|
{/* Open n */ PDL_EXPAND2(register PDL_Indx n=0, __n_stop=(__n_size)); for(; n<__n_stop; n+=1) { |
|
301
|
|
|
|
|
|
|
#line 6004 "lib/PDL/Primitive.pd" |
|
302
|
|
|
|
|
|
|
PDL_LDouble hold = hnew; |
|
303
|
|
|
|
|
|
|
/* The following requires mixed mode arithmetic. */ |
|
304
|
|
|
|
|
|
|
PDL_LDouble dov3 = (d_datap)[0+(__inc_d_n*(n))] / 3; |
|
305
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n))] = (f_datap)[0+(__inc_f_n*(n))] - hold * dov3; |
|
306
|
|
|
|
|
|
|
/* The following assumes T(2*K+1) = X(K). */ |
|
307
|
|
|
|
|
|
|
hnew = (t_datap)[0+(__inc_t_nknots*(2*n+4))] - (t_datap)[0+(__inc_t_nknots*(2*n+2))]; |
|
308
|
|
|
|
|
|
|
(bcoef_datap)[0+(__inc_bcoef_ndim*(2*n+1))] = (f_datap)[0+(__inc_f_n*(n))] + hnew * dov3; |
|
309
|
|
|
|
|
|
|
}} /* Close n */ |
|
310
|
|
|
|
|
|
|
#line 311 "lib/PDL/Primitive-pp-pchip_chbs.c" |
|
311
|
0
|
0
|
|
|
|
|
}PDL_BROADCASTLOOP_END_pchip_chbs_readdata |
|
|
|
0
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
|
} break; |
|
313
|
0
|
|
|
|
|
|
default: return PDL->make_error(PDL_EUSERERROR, "PP INTERNAL ERROR in pchip_chbs: unhandled datatype(%d), only handles (FDE)! PLEASE MAKE A BUG REPORT\n", __privtrans->__datatype); |
|
314
|
|
|
|
|
|
|
} |
|
315
|
|
|
|
|
|
|
#undef PDL_IF_BAD |
|
316
|
1
|
|
|
|
|
|
return PDL_err; |
|
317
|
|
|
|
|
|
|
} |
|
318
|
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
static pdl_datatypes pdl_pchip_chbs_vtable_gentypes[] = { PDL_F, PDL_D, PDL_LD, -1 }; |
|
320
|
|
|
|
|
|
|
static PDL_Indx pdl_pchip_chbs_vtable_realdims[] = { 1, 1, 1, 0, 1, 1, 0 }; |
|
321
|
|
|
|
|
|
|
static char *pdl_pchip_chbs_vtable_parnames[] = { "x","f","d","knotyp","t","bcoef","ierr" }; |
|
322
|
|
|
|
|
|
|
static short pdl_pchip_chbs_vtable_parflags[] = { |
|
323
|
|
|
|
|
|
|
0, |
|
324
|
|
|
|
|
|
|
0, |
|
325
|
|
|
|
|
|
|
0, |
|
326
|
|
|
|
|
|
|
PDL_PARAM_ISTYPED, |
|
327
|
|
|
|
|
|
|
PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISWRITE, |
|
328
|
|
|
|
|
|
|
PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISWRITE, |
|
329
|
|
|
|
|
|
|
PDL_PARAM_ISCREAT|PDL_PARAM_ISOUT|PDL_PARAM_ISTYPED|PDL_PARAM_ISWRITE |
|
330
|
|
|
|
|
|
|
}; |
|
331
|
|
|
|
|
|
|
static pdl_datatypes pdl_pchip_chbs_vtable_partypes[] = { -1, -1, -1, PDL_SB, -1, -1, PDL_IND }; |
|
332
|
|
|
|
|
|
|
static PDL_Indx pdl_pchip_chbs_vtable_realdims_starts[] = { 0, 1, 2, 3, 3, 4, 5 }; |
|
333
|
|
|
|
|
|
|
static PDL_Indx pdl_pchip_chbs_vtable_realdims_ind_ids[] = { 0, 0, 0, 2, 1 }; |
|
334
|
|
|
|
|
|
|
static char *pdl_pchip_chbs_vtable_indnames[] = { "n","ndim","nknots" }; |
|
335
|
|
|
|
|
|
|
pdl_transvtable pdl_pchip_chbs_vtable = { |
|
336
|
|
|
|
|
|
|
PDL_TRANS_DO_BROADCAST, 0, pdl_pchip_chbs_vtable_gentypes, 4, 7, NULL /*CORE21*/, |
|
337
|
|
|
|
|
|
|
pdl_pchip_chbs_vtable_realdims, pdl_pchip_chbs_vtable_parnames, |
|
338
|
|
|
|
|
|
|
pdl_pchip_chbs_vtable_parflags, pdl_pchip_chbs_vtable_partypes, |
|
339
|
|
|
|
|
|
|
pdl_pchip_chbs_vtable_realdims_starts, pdl_pchip_chbs_vtable_realdims_ind_ids, 5, |
|
340
|
|
|
|
|
|
|
3, pdl_pchip_chbs_vtable_indnames, |
|
341
|
|
|
|
|
|
|
pdl_pchip_chbs_redodims, pdl_pchip_chbs_readdata, NULL, |
|
342
|
|
|
|
|
|
|
NULL, |
|
343
|
|
|
|
|
|
|
0,"PDL::Primitive::pchip_chbs" |
|
344
|
|
|
|
|
|
|
}; |
|
345
|
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
|
347
|
1
|
|
|
|
|
|
pdl_error pdl_run_pchip_chbs(pdl *x,pdl *f,pdl *d,pdl *knotyp,pdl *t,pdl *bcoef,pdl *ierr) { |
|
348
|
1
|
|
|
|
|
|
pdl_error PDL_err = {0, NULL, 0}; |
|
349
|
1
|
50
|
|
|
|
|
if (!PDL) return (pdl_error){PDL_EFATAL, "PDL core struct is NULL, can't continue",0}; |
|
350
|
1
|
|
|
|
|
|
pdl_trans *__privtrans = PDL->create_trans(&pdl_pchip_chbs_vtable); |
|
351
|
1
|
50
|
|
|
|
|
if (!__privtrans) return PDL->make_error_simple(PDL_EFATAL, "Couldn't create trans"); |
|
352
|
1
|
|
|
|
|
|
__privtrans->pdls[0] = x; |
|
353
|
1
|
|
|
|
|
|
__privtrans->pdls[1] = f; |
|
354
|
1
|
|
|
|
|
|
__privtrans->pdls[2] = d; |
|
355
|
1
|
|
|
|
|
|
__privtrans->pdls[3] = knotyp; |
|
356
|
1
|
|
|
|
|
|
__privtrans->pdls[4] = t; |
|
357
|
1
|
|
|
|
|
|
__privtrans->pdls[5] = bcoef; |
|
358
|
1
|
|
|
|
|
|
__privtrans->pdls[6] = ierr; |
|
359
|
1
|
50
|
|
|
|
|
PDL_RETERROR(PDL_err, PDL->type_coerce(__privtrans)); |
|
360
|
1
|
50
|
|
|
|
|
PDL_RETERROR(PDL_err, PDL->make_trans_mutual(__privtrans)); |
|
361
|
1
|
|
|
|
|
|
return PDL_err; |
|
362
|
|
|
|
|
|
|
} |