1 #include <stdlib.h>
2 #include "blas_extended.h"
3 #include "blas_extended_test.h"
4
test_BLAS_ssum(int n,float sum_comp,double sum_true_l,double sum_true_t,float * x,int incx,double eps_int,double un_int,double * test_ratio)5 void test_BLAS_ssum(int n, float sum_comp, double sum_true_l,
6 double sum_true_t, float *x, int incx,
7 double eps_int, double un_int, double *test_ratio)
8
9 /* Purpose
10 * =======
11 *
12 * Computes ratio of the computed error from sum over the expected
13 * error bound.
14 *
15 * Arguments
16 * =========
17 *
18 * n (input) int
19 * The length of the vector X.
20 *
21 * sum_comp (input) float
22 * This result was computed by some other routine, and will be
23 * tested by this routine by comparing it with the truth.
24 *
25 * sum_true_l (input) double
26 * leading part of true sum value
27 *
28 * sum_true_t (input) double
29 * tailing part of true sum value
30 *
31 * x (input) float*
32 *
33 * incx (input) int
34 *
35 * eps_int (input) double
36 * The internal machine precision.
37 *
38 * un_int (input) double
39 * The internal underflow threshold.
40 *
41 * test_ratio (output) double*
42 * The ratio of computed error for r over the error bound.
43 */
44 {
45 {
46 int i;
47 int xi;
48 int incxi = 1;
49 float y_elem;
50 float alpha;
51 float beta;
52 float r;
53
54 float *y;
55 y = (float *) blas_malloc(n * sizeof(float));
56 if (n > 0 && y == NULL) {
57 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
58 }
59
60
61
62 /* set each element of y to be 1.0 */
63 y_elem = 1.0;
64 for (i = 0, xi = 0; i < n; i++, xi += incxi) {
65 y[xi] = y_elem;
66 }
67
68 alpha = 1.0;
69 beta = 0.0;
70 r = 0.0;
71
72 test_BLAS_sdot(n, blas_no_conj, alpha, beta, r, sum_comp,
73 sum_true_l, sum_true_t, x, incx, y, 1,
74 eps_int, un_int, test_ratio);
75 blas_free(y);
76 }
77 }
test_BLAS_dsum(int n,double sum_comp,double sum_true_l,double sum_true_t,double * x,int incx,double eps_int,double un_int,double * test_ratio)78 void test_BLAS_dsum(int n, double sum_comp, double sum_true_l,
79 double sum_true_t, double *x, int incx,
80 double eps_int, double un_int, double *test_ratio)
81
82 /* Purpose
83 * =======
84 *
85 * Computes ratio of the computed error from sum over the expected
86 * error bound.
87 *
88 * Arguments
89 * =========
90 *
91 * n (input) int
92 * The length of the vector X.
93 *
94 * sum_comp (input) double
95 * This result was computed by some other routine, and will be
96 * tested by this routine by comparing it with the truth.
97 *
98 * sum_true_l (input) double
99 * leading part of true sum value
100 *
101 * sum_true_t (input) double
102 * tailing part of true sum value
103 *
104 * x (input) double*
105 *
106 * incx (input) int
107 *
108 * eps_int (input) double
109 * The internal machine precision.
110 *
111 * un_int (input) double
112 * The internal underflow threshold.
113 *
114 * test_ratio (output) double*
115 * The ratio of computed error for r over the error bound.
116 */
117 {
118 {
119 int i;
120 int xi;
121 int incxi = 1;
122 double y_elem;
123 double alpha;
124 double beta;
125 double r;
126
127 double *y;
128 y = (double *) blas_malloc(n * sizeof(double));
129 if (n > 0 && y == NULL) {
130 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
131 }
132
133
134
135 /* set each element of y to be 1.0 */
136 y_elem = 1.0;
137 for (i = 0, xi = 0; i < n; i++, xi += incxi) {
138 y[xi] = y_elem;
139 }
140
141 alpha = 1.0;
142 beta = 0.0;
143 r = 0.0;
144
145 test_BLAS_ddot(n, blas_no_conj, alpha, beta, r, sum_comp,
146 sum_true_l, sum_true_t, x, incx, y, 1,
147 eps_int, un_int, test_ratio);
148 blas_free(y);
149 }
150 }
test_BLAS_csum(int n,const void * sum_comp,double * sum_true_l,double * sum_true_t,void * x,int incx,double eps_int,double un_int,double * test_ratio)151 void test_BLAS_csum(int n, const void *sum_comp, double *sum_true_l,
152 double *sum_true_t, void *x, int incx,
153 double eps_int, double un_int, double *test_ratio)
154
155 /* Purpose
156 * =======
157 *
158 * Computes ratio of the computed error from sum over the expected
159 * error bound.
160 *
161 * Arguments
162 * =========
163 *
164 * n (input) int
165 * The length of the vector X.
166 *
167 * sum_comp (input) const void*
168 * This result was computed by some other routine, and will be
169 * tested by this routine by comparing it with the truth.
170 *
171 * sum_true_l (input) double*
172 * leading part of true sum value
173 *
174 * sum_true_t (input) double*
175 * tailing part of true sum value
176 *
177 * x (input) void*
178 *
179 * incx (input) int
180 *
181 * eps_int (input) double
182 * The internal machine precision.
183 *
184 * un_int (input) double
185 * The internal underflow threshold.
186 *
187 * test_ratio (output) double*
188 * The ratio of computed error for r over the error bound.
189 */
190 {
191 {
192 int i;
193 int xi;
194 int incxi = 1;
195 float y_elem[2];
196 float alpha[2];
197 float beta[2];
198 float r[2];
199
200 float *y;
201 y = (float *) blas_malloc(n * sizeof(float) * 2);
202 if (n > 0 && y == NULL) {
203 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
204 }
205
206 incxi *= 2;
207
208 /* set each element of y to be 1.0 */
209 y_elem[0] = 1.0;
210 y_elem[1] = 0.0;
211 for (i = 0, xi = 0; i < n; i++, xi += incxi) {
212 y[xi] = y_elem[0];
213 y[xi + 1] = y_elem[1];
214 }
215
216 alpha[0] = 1.0;
217 alpha[1] = 0.0;
218 beta[0] = beta[1] = 0.0;
219 r[0] = r[1] = 0.0;
220
221 test_BLAS_cdot(n, blas_no_conj, alpha, beta, r, sum_comp,
222 sum_true_l, sum_true_t, x, incx, y, 1,
223 eps_int, un_int, test_ratio);
224 blas_free(y);
225 }
226 }
test_BLAS_zsum(int n,const void * sum_comp,double * sum_true_l,double * sum_true_t,void * x,int incx,double eps_int,double un_int,double * test_ratio)227 void test_BLAS_zsum(int n, const void *sum_comp, double *sum_true_l,
228 double *sum_true_t, void *x, int incx,
229 double eps_int, double un_int, double *test_ratio)
230
231 /* Purpose
232 * =======
233 *
234 * Computes ratio of the computed error from sum over the expected
235 * error bound.
236 *
237 * Arguments
238 * =========
239 *
240 * n (input) int
241 * The length of the vector X.
242 *
243 * sum_comp (input) const void*
244 * This result was computed by some other routine, and will be
245 * tested by this routine by comparing it with the truth.
246 *
247 * sum_true_l (input) double*
248 * leading part of true sum value
249 *
250 * sum_true_t (input) double*
251 * tailing part of true sum value
252 *
253 * x (input) void*
254 *
255 * incx (input) int
256 *
257 * eps_int (input) double
258 * The internal machine precision.
259 *
260 * un_int (input) double
261 * The internal underflow threshold.
262 *
263 * test_ratio (output) double*
264 * The ratio of computed error for r over the error bound.
265 */
266 {
267 {
268 int i;
269 int xi;
270 int incxi = 1;
271 double y_elem[2];
272 double alpha[2];
273 double beta[2];
274 double r[2];
275
276 double *y;
277 y = (double *) blas_malloc(n * sizeof(double) * 2);
278 if (n > 0 && y == NULL) {
279 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
280 }
281
282 incxi *= 2;
283
284 /* set each element of y to be 1.0 */
285 y_elem[0] = 1.0;
286 y_elem[1] = 0.0;
287 for (i = 0, xi = 0; i < n; i++, xi += incxi) {
288 y[xi] = y_elem[0];
289 y[xi + 1] = y_elem[1];
290 }
291
292 alpha[0] = 1.0;
293 alpha[1] = 0.0;
294 beta[0] = beta[1] = 0.0;
295 r[0] = r[1] = 0.0;
296
297 test_BLAS_zdot(n, blas_no_conj, alpha, beta, r, sum_comp,
298 sum_true_l, sum_true_t, x, incx, y, 1,
299 eps_int, un_int, test_ratio);
300 blas_free(y);
301 }
302 }
303