1 #include <stdio.h>
2 #include <assert.h>
3 #include "blas_extended.h"
4 #include "blas_extended_test.h"
5
6
BLAS_sdot_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,float * alpha,int alpha_flag,float * beta,int beta_flag,float * x,float * y,int * seed,float * r,double * r_true_l,double * r_true_t)7 void BLAS_sdot_testgen(int n, int n_fix2, int n_mix, int norm,
8 enum blas_conj_type conj, float *alpha, int alpha_flag,
9 float *beta, int beta_flag, float *x, float *y,
10 int *seed, float *r, double *r_true_l,
11 double *r_true_t)
12
13 /*
14 * Purpose
15 * =======
16 *
17 * This routine generates the test inputs to BLAS_sdot{_x}.
18 *
19 * Arguments
20 * =========
21 *
22 * n (input) int
23 * The length of the vectors X and Y.
24 *
25 * n_fix2 (input) int
26 * Number of pairs in the vectors X and Y that are fixed in value,
27 *
28 * n_mix (input) int
29 * Number of pairs in the vectors X and Y with X(i) fixed
30 * and Y(i) free in value.
31 *
32 * norm (input) int
33 * = -1 : the vectors are scaled with norms near underflow.
34 * = 0 : the vectors have norms of order 1.
35 * = 1 : the vectors are scaled with norms near overflow.
36 *
37 * conj (input) enum blas_conj_type
38 *
39 * alpha (input/output) float*
40 * If alpha_flag = 1, alpha is input.
41 * If alpha_flag = 0, alpha is output.
42 *
43 * alpha_flag (input) int
44 * = 0 : alpha is free, and is output.
45 * = 1 : alpha is fixed on input.
46 *
47 * beta (input) float*
48 * If beta_flag = 1, beta is input.
49 * If beta_flag = 0, beta is output.
50 *
51 * beta_flag (input) int
52 * = 0 : beta is free, and is output.
53 * = 1 : beta is fixed on input.
54 *
55 * x (input/output) float*
56 *
57 * y (input/output) float*
58 *
59 * seed (input/output) int*
60 * The seed for the random number generator.
61 *
62 * r (output) float*
63 * The generated scalar r that will be used as an input to DOT.
64 *
65 * r_true_l (output) double*
66 * The leading part of the truth in double-double.
67 *
68 * r_true_t (output) double*
69 * The trailing part of the truth in double-double.
70 *
71 */
72 {
73 int i, inc = 1;
74 float *alpha_i = alpha;
75 float *beta_i = beta;
76 float *r_i = r;
77 float *x_i = x;
78 float *y_i = y;
79 float alpha_tmp;
80 float beta_tmp;
81 float r_tmp;
82 float *x_vec;
83 float *y_vec;
84
85 alpha_tmp = *alpha_i;
86 beta_tmp = *beta_i;
87
88 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
89 if (2 * n > 0 && x_vec == NULL) {
90 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
91 }
92 y_vec = x_vec + inc * n;
93 for (i = 0; i < inc * n_fix2; i += inc) {
94 x_vec[i] = x_i[i];
95 y_vec[i] = y_i[i];
96 }
97 for (; i < inc * (n_fix2 + n_mix); i += inc) {
98 x_vec[i] = x_i[i];
99 }
100
101 /* Call generator now. */
102 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
103 &alpha_tmp, alpha_flag,
104 &beta_tmp, beta_flag,
105 x_vec, y_vec, seed, &r_tmp, r_true_l, r_true_t);
106
107 *alpha_i = alpha_tmp;
108 *beta_i = beta_tmp;
109 *r_i = r_tmp;
110 for (i = 0; i < inc * n; i += inc) {
111 x_i[i] = x_vec[i];
112 y_i[i] = y_vec[i];
113 }
114
115 blas_free(x_vec); /* also y_i */
116 } /* end BLAS_sdot_testgen */
117
BLAS_ddot_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,double * alpha,int alpha_flag,double * beta,int beta_flag,double * x,double * y,int * seed,double * r,double * r_true_l,double * r_true_t)118 void BLAS_ddot_testgen(int n, int n_fix2, int n_mix, int norm,
119 enum blas_conj_type conj, double *alpha,
120 int alpha_flag, double *beta, int beta_flag, double *x,
121 double *y, int *seed, double *r, double *r_true_l,
122 double *r_true_t)
123
124 /*
125 * Purpose
126 * =======
127 *
128 * This routine generates the test inputs to BLAS_ddot{_x}.
129 *
130 * Arguments
131 * =========
132 *
133 * n (input) int
134 * The length of the vectors X and Y.
135 *
136 * n_fix2 (input) int
137 * Number of pairs in the vectors X and Y that are fixed in value,
138 *
139 * n_mix (input) int
140 * Number of pairs in the vectors X and Y with X(i) fixed
141 * and Y(i) free in value.
142 *
143 * norm (input) int
144 * = -1 : the vectors are scaled with norms near underflow.
145 * = 0 : the vectors have norms of order 1.
146 * = 1 : the vectors are scaled with norms near overflow.
147 *
148 * conj (input) enum blas_conj_type
149 *
150 * alpha (input/output) double*
151 * If alpha_flag = 1, alpha is input.
152 * If alpha_flag = 0, alpha is output.
153 *
154 * alpha_flag (input) int
155 * = 0 : alpha is free, and is output.
156 * = 1 : alpha is fixed on input.
157 *
158 * beta (input) double*
159 * If beta_flag = 1, beta is input.
160 * If beta_flag = 0, beta is output.
161 *
162 * beta_flag (input) int
163 * = 0 : beta is free, and is output.
164 * = 1 : beta is fixed on input.
165 *
166 * x (input/output) double*
167 *
168 * y (input/output) double*
169 *
170 * seed (input/output) int*
171 * The seed for the random number generator.
172 *
173 * r (output) double*
174 * The generated scalar r that will be used as an input to DOT.
175 *
176 * r_true_l (output) double*
177 * The leading part of the truth in double-double.
178 *
179 * r_true_t (output) double*
180 * The trailing part of the truth in double-double.
181 *
182 */
183 {
184 int i, inc = 1;
185 double *alpha_i = alpha;
186 double *beta_i = beta;
187 double *r_i = r;
188 double *x_i = x;
189 double *y_i = y;
190 double alpha_tmp;
191 double beta_tmp;
192 double r_tmp;
193 double *x_vec;
194 double *y_vec;
195
196 alpha_tmp = *alpha_i;
197 beta_tmp = *beta_i;
198
199 x_vec = (double *) blas_malloc(2 * n * sizeof(double));
200 if (2 * n > 0 && x_vec == NULL) {
201 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
202 }
203 y_vec = x_vec + inc * n;
204 for (i = 0; i < inc * n_fix2; i += inc) {
205 x_vec[i] = x_i[i];
206 y_vec[i] = y_i[i];
207 }
208 for (; i < inc * (n_fix2 + n_mix); i += inc) {
209 x_vec[i] = x_i[i];
210 }
211
212 /* Call generator now. */
213 testgen_BLAS_ddot(n, n_fix2, n_mix, norm, conj,
214 &alpha_tmp, alpha_flag,
215 &beta_tmp, beta_flag,
216 x_vec, y_vec, seed, &r_tmp, r_true_l, r_true_t);
217
218 *alpha_i = alpha_tmp;
219 *beta_i = beta_tmp;
220 *r_i = r_tmp;
221 for (i = 0; i < inc * n; i += inc) {
222 x_i[i] = x_vec[i];
223 y_i[i] = y_vec[i];
224 }
225
226 blas_free(x_vec); /* also y_i */
227 } /* end BLAS_ddot_testgen */
228
BLAS_cdot_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)229 void BLAS_cdot_testgen(int n, int n_fix2, int n_mix, int norm,
230 enum blas_conj_type conj, void *alpha, int alpha_flag,
231 void *beta, int beta_flag, void *x, void *y, int *seed,
232 void *r, double *r_true_l, double *r_true_t)
233
234 /*
235 * Purpose
236 * =======
237 *
238 * This routine generates the test inputs to BLAS_cdot{_x}.
239 *
240 * Arguments
241 * =========
242 *
243 * n (input) int
244 * The length of the vectors X and Y.
245 *
246 * n_fix2 (input) int
247 * Number of pairs in the vectors X and Y that are fixed in value,
248 *
249 * n_mix (input) int
250 * Number of pairs in the vectors X and Y with X(i) fixed
251 * and Y(i) free in value.
252 *
253 * norm (input) int
254 * = -1 : the vectors are scaled with norms near underflow.
255 * = 0 : the vectors have norms of order 1.
256 * = 1 : the vectors are scaled with norms near overflow.
257 *
258 * conj (input) enum blas_conj_type
259 *
260 * alpha (input/output) void*
261 * If alpha_flag = 1, alpha is input.
262 * If alpha_flag = 0, alpha is output.
263 *
264 * alpha_flag (input) int
265 * = 0 : alpha is free, and is output.
266 * = 1 : alpha is fixed on input.
267 *
268 * beta (input) void*
269 * If beta_flag = 1, beta is input.
270 * If beta_flag = 0, beta is output.
271 *
272 * beta_flag (input) int
273 * = 0 : beta is free, and is output.
274 * = 1 : beta is fixed on input.
275 *
276 * x (input/output) void*
277 *
278 * y (input/output) void*
279 *
280 * seed (input/output) int*
281 * The seed for the random number generator.
282 *
283 * r (output) void*
284 * The generated scalar r that will be used as an input to DOT.
285 *
286 * r_true_l (output) double*
287 * The leading part of the truth in double-double.
288 *
289 * r_true_t (output) double*
290 * The trailing part of the truth in double-double.
291 *
292 */
293 {
294 int i, inc = 1;
295 float *alpha_i = (float *) alpha;
296 float *beta_i = (float *) beta;
297 float *r_i = (float *) r;
298 float *x_i = (float *) x;
299 float *y_i = (float *) y;
300 float alpha_tmp[2];
301 float beta_tmp[2];
302 float r_tmp[2];
303 float *x_vec;
304 float *y_vec;
305
306 alpha_tmp[0] = alpha_i[0];
307 alpha_tmp[1] = alpha_i[1];
308 beta_tmp[0] = beta_i[0];
309 beta_tmp[1] = beta_i[1];
310 inc *= 2;
311 x_vec = (float *) blas_malloc(2 * n * sizeof(float) * 2);
312 if (2 * n > 0 && x_vec == NULL) {
313 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
314 }
315 y_vec = x_vec + inc * n;
316 for (i = 0; i < inc * n_fix2; i += inc) {
317 x_vec[i] = x_i[i];
318 x_vec[i + 1] = x_i[i + 1];
319 y_vec[i] = y_i[i];
320 y_vec[i + 1] = y_i[i + 1];
321 }
322 for (; i < inc * (n_fix2 + n_mix); i += inc) {
323 x_vec[i] = x_i[i];
324 x_vec[i + 1] = x_i[i + 1];
325 }
326
327 /* Call generator now. */
328 testgen_BLAS_cdot(n, n_fix2, n_mix, norm, conj,
329 alpha_tmp, alpha_flag,
330 beta_tmp, beta_flag,
331 x_vec, y_vec, seed, r_tmp, r_true_l, r_true_t);
332
333 alpha_i[0] = alpha_tmp[0];
334 alpha_i[1] = alpha_tmp[1];
335 beta_i[0] = beta_tmp[0];
336 beta_i[1] = beta_tmp[1];
337 r_i[0] = r_tmp[0];
338 r_i[1] = r_tmp[1];
339 for (i = 0; i < inc * n; i += inc) {
340 x_i[i] = x_vec[i];
341 x_i[i + 1] = x_vec[i + 1];
342 y_i[i] = y_vec[i];
343 y_i[i + 1] = y_vec[i + 1];
344 }
345
346 blas_free(x_vec); /* also y_i */
347 } /* end BLAS_cdot_testgen */
348
BLAS_zdot_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)349 void BLAS_zdot_testgen(int n, int n_fix2, int n_mix, int norm,
350 enum blas_conj_type conj, void *alpha, int alpha_flag,
351 void *beta, int beta_flag, void *x, void *y, int *seed,
352 void *r, double *r_true_l, double *r_true_t)
353
354 /*
355 * Purpose
356 * =======
357 *
358 * This routine generates the test inputs to BLAS_zdot{_x}.
359 *
360 * Arguments
361 * =========
362 *
363 * n (input) int
364 * The length of the vectors X and Y.
365 *
366 * n_fix2 (input) int
367 * Number of pairs in the vectors X and Y that are fixed in value,
368 *
369 * n_mix (input) int
370 * Number of pairs in the vectors X and Y with X(i) fixed
371 * and Y(i) free in value.
372 *
373 * norm (input) int
374 * = -1 : the vectors are scaled with norms near underflow.
375 * = 0 : the vectors have norms of order 1.
376 * = 1 : the vectors are scaled with norms near overflow.
377 *
378 * conj (input) enum blas_conj_type
379 *
380 * alpha (input/output) void*
381 * If alpha_flag = 1, alpha is input.
382 * If alpha_flag = 0, alpha is output.
383 *
384 * alpha_flag (input) int
385 * = 0 : alpha is free, and is output.
386 * = 1 : alpha is fixed on input.
387 *
388 * beta (input) void*
389 * If beta_flag = 1, beta is input.
390 * If beta_flag = 0, beta is output.
391 *
392 * beta_flag (input) int
393 * = 0 : beta is free, and is output.
394 * = 1 : beta is fixed on input.
395 *
396 * x (input/output) void*
397 *
398 * y (input/output) void*
399 *
400 * seed (input/output) int*
401 * The seed for the random number generator.
402 *
403 * r (output) void*
404 * The generated scalar r that will be used as an input to DOT.
405 *
406 * r_true_l (output) double*
407 * The leading part of the truth in double-double.
408 *
409 * r_true_t (output) double*
410 * The trailing part of the truth in double-double.
411 *
412 */
413 {
414 int i, inc = 1;
415 double *alpha_i = (double *) alpha;
416 double *beta_i = (double *) beta;
417 double *r_i = (double *) r;
418 double *x_i = (double *) x;
419 double *y_i = (double *) y;
420 double alpha_tmp[2];
421 double beta_tmp[2];
422 double r_tmp[2];
423 double *x_vec;
424 double *y_vec;
425
426 alpha_tmp[0] = alpha_i[0];
427 alpha_tmp[1] = alpha_i[1];
428 beta_tmp[0] = beta_i[0];
429 beta_tmp[1] = beta_i[1];
430 inc *= 2;
431 x_vec = (double *) blas_malloc(2 * n * sizeof(double) * 2);
432 if (2 * n > 0 && x_vec == NULL) {
433 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
434 }
435 y_vec = x_vec + inc * n;
436 for (i = 0; i < inc * n_fix2; i += inc) {
437 x_vec[i] = x_i[i];
438 x_vec[i + 1] = x_i[i + 1];
439 y_vec[i] = y_i[i];
440 y_vec[i + 1] = y_i[i + 1];
441 }
442 for (; i < inc * (n_fix2 + n_mix); i += inc) {
443 x_vec[i] = x_i[i];
444 x_vec[i + 1] = x_i[i + 1];
445 }
446
447 /* Call generator now. */
448 testgen_BLAS_zdot(n, n_fix2, n_mix, norm, conj,
449 alpha_tmp, alpha_flag,
450 beta_tmp, beta_flag,
451 x_vec, y_vec, seed, r_tmp, r_true_l, r_true_t);
452
453 alpha_i[0] = alpha_tmp[0];
454 alpha_i[1] = alpha_tmp[1];
455 beta_i[0] = beta_tmp[0];
456 beta_i[1] = beta_tmp[1];
457 r_i[0] = r_tmp[0];
458 r_i[1] = r_tmp[1];
459 for (i = 0; i < inc * n; i += inc) {
460 x_i[i] = x_vec[i];
461 x_i[i + 1] = x_vec[i + 1];
462 y_i[i] = y_vec[i];
463 y_i[i + 1] = y_vec[i + 1];
464 }
465
466 blas_free(x_vec); /* also y_i */
467 } /* end BLAS_zdot_testgen */
468
BLAS_cdot_s_s_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,float * x,float * y,int * seed,void * r,double * r_true_l,double * r_true_t)469 void BLAS_cdot_s_s_testgen(int n, int n_fix2, int n_mix, int norm,
470 enum blas_conj_type conj, void *alpha,
471 int alpha_flag, void *beta, int beta_flag,
472 float *x, float *y, int *seed, void *r,
473 double *r_true_l, double *r_true_t)
474
475 /*
476 * Purpose
477 * =======
478 *
479 * This routine generates the test inputs to BLAS_cdot_s_s{_x}.
480 *
481 * Arguments
482 * =========
483 *
484 * n (input) int
485 * The length of the vectors X and Y.
486 *
487 * n_fix2 (input) int
488 * Number of pairs in the vectors X and Y that are fixed in value,
489 *
490 * n_mix (input) int
491 * Number of pairs in the vectors X and Y with X(i) fixed
492 * and Y(i) free in value.
493 *
494 * norm (input) int
495 * = -1 : the vectors are scaled with norms near underflow.
496 * = 0 : the vectors have norms of order 1.
497 * = 1 : the vectors are scaled with norms near overflow.
498 *
499 * conj (input) enum blas_conj_type
500 *
501 * alpha (input/output) void*
502 * If alpha_flag = 1, alpha is input.
503 * If alpha_flag = 0, alpha is output.
504 *
505 * alpha_flag (input) int
506 * = 0 : alpha is free, and is output.
507 * = 1 : alpha is fixed on input.
508 *
509 * beta (input) void*
510 * If beta_flag = 1, beta is input.
511 * If beta_flag = 0, beta is output.
512 *
513 * beta_flag (input) int
514 * = 0 : beta is free, and is output.
515 * = 1 : beta is fixed on input.
516 *
517 * x (input/output) float*
518 *
519 * y (input/output) float*
520 *
521 * seed (input/output) int*
522 * The seed for the random number generator.
523 *
524 * r (output) void*
525 * The generated scalar r that will be used as an input to DOT.
526 *
527 * r_true_l (output) double*
528 * The leading part of the truth in double-double.
529 *
530 * r_true_t (output) double*
531 * The trailing part of the truth in double-double.
532 *
533 */
534 {
535 int i;
536 float *alpha_i = (float *) alpha;
537 float *beta_i = (float *) beta;
538 float *r_i = (float *) r;
539 float *x_i = x;
540 float *y_i = y;
541 float alpha_i_r;
542 float alpha_i_i;
543 float beta_i_r;
544 float beta_i_i;
545 float r_tmp;
546 float *x_vec;
547 float *y_vec;
548
549 alpha_i_r = alpha_i[0];
550 alpha_i_i = alpha_i[1];
551 beta_i_r = beta_i[0];
552 beta_i_i = beta_i[1];
553 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
554 if (2 * n > 0 && x_vec == NULL) {
555 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
556 }
557 y_vec = x_vec + n;
558 for (i = 0; i < n_fix2; i++) {
559 x_vec[i] = x_i[i];
560 y_vec[i] = y_i[i];
561 }
562 for (; i < n_fix2 + n_mix; i++) {
563 x_vec[i] = x_i[i];
564 }
565
566 /* Call generator now. */
567 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
568 &alpha_i_r, alpha_flag,
569 &beta_i_r, beta_flag,
570 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
571
572 if (alpha_flag == 1) { /* alpha_i is fixed */
573 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
574 if (beta_flag == 1 && ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.))) { /* beta_i == 0 or 1 */
575 r_i[0] = r_tmp;
576 r_i[1] = 0.0;
577 } else { /* beta_i *= (1-i), r_i *= (1+i)/2 --> prod = 1 */
578 beta_i[0] = beta_i_r;
579 beta_i[1] = -beta_i_r;
580 r_i[0] = r_tmp / 2.;
581 r_i[1] = r_tmp / 2.;
582 }
583 r_true_l[1] = r_true_t[1] = 0.0;
584 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
585 if (beta_flag == 1 &&
586 ((beta_i_r == 0. && beta_i_i == 0.) ||
587 (beta_i_r == 1. && beta_i_i == 0.))) {
588 /* beta_i == 0 or 1 --> r_i *= (1+i) */
589 r_i[0] = r_tmp;
590 r_i[1] = r_tmp;
591 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
592 beta_i[0] = beta_i_r;
593 beta_i[1] = -beta_i_r;
594 r_i[0] = 0.0;
595 r_i[1] = r_tmp;
596 }
597 r_true_l[1] = r_true_l[0];
598 r_true_t[1] = r_true_t[0];
599 } else { /* alpha_i is a fixed multiple of (1+i) */
600 alpha_i[0] = alpha_i_r;
601 alpha_i[1] = alpha_i_r;
602 if (beta_flag == 1 &&
603 ((beta_i_r == 0. && beta_i_i == 0.) ||
604 (beta_i_r == 1. && beta_i_i == 0.))) {
605 /* beta_i == 0 or 1 --> r_i *= (1+i) */
606 r_i[0] = r_tmp;
607 r_i[1] = r_tmp;
608 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
609 beta_i[0] = beta_i_r;
610 beta_i[1] = -beta_i_r;
611 r_i[0] = 0.0;
612 r_i[1] = r_tmp;
613 }
614 r_true_l[1] = r_true_l[0];
615 r_true_t[1] = r_true_t[0];
616 }
617 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
618 /* alpha_i *= (1+i) */
619 alpha_i[0] = alpha_i_r;
620 alpha_i[1] = alpha_i_r;
621 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i *= (1+i) */
622 r_i[0] = r_tmp;
623 r_i[1] = r_tmp;
624 } else { /* beta_i *= (1-i), r_i *= i */
625 beta_i[0] = beta_i_r;
626 beta_i[1] = -beta_i_r;
627 r_i[0] = 0.;
628 r_i[1] = r_tmp;
629 }
630 r_true_l[1] = r_true_l[0];
631 r_true_t[1] = r_true_t[0];
632 } else { /* both alpha_i and beta_i are free */
633 assert(alpha_flag == 0 && beta_flag == 0);
634 alpha_i[0] = alpha_i_r;
635 alpha_i[1] = alpha_i_r;
636 beta_i[0] = beta_i_r;
637 beta_i[1] = -beta_i_r;
638 r_i[0] = 0;
639 r_i[1] = r_tmp;
640 /* imaginary part of r_true */
641 r_true_l[1] = r_true_l[0];
642 r_true_t[1] = r_true_t[0];
643 }
644 for (i = 0; i < n; ++i) {
645 x_i[i] = x_vec[i];
646 y_i[i] = y_vec[i];
647 }
648
649
650 blas_free(x_vec); /* also y_vec */
651 } /* end BLAS_cdot_s_s_testgen */
652
BLAS_cdot_s_c_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,float * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)653 void BLAS_cdot_s_c_testgen(int n, int n_fix2, int n_mix, int norm,
654 enum blas_conj_type conj, void *alpha,
655 int alpha_flag, void *beta, int beta_flag,
656 float *x, void *y, int *seed, void *r,
657 double *r_true_l, double *r_true_t)
658
659 /*
660 * Purpose
661 * =======
662 *
663 * This routine generates the test inputs to BLAS_cdot_s_c{_x}.
664 *
665 * Arguments
666 * =========
667 *
668 * n (input) int
669 * The length of the vectors X and Y.
670 *
671 * n_fix2 (input) int
672 * Number of pairs in the vectors X and Y that are fixed in value,
673 *
674 * n_mix (input) int
675 * Number of pairs in the vectors X and Y with X(i) fixed
676 * and Y(i) free in value.
677 *
678 * norm (input) int
679 * = -1 : the vectors are scaled with norms near underflow.
680 * = 0 : the vectors have norms of order 1.
681 * = 1 : the vectors are scaled with norms near overflow.
682 *
683 * conj (input) enum blas_conj_type
684 *
685 * alpha (input/output) void*
686 * If alpha_flag = 1, alpha is input.
687 * If alpha_flag = 0, alpha is output.
688 *
689 * alpha_flag (input) int
690 * = 0 : alpha is free, and is output.
691 * = 1 : alpha is fixed on input.
692 *
693 * beta (input) void*
694 * If beta_flag = 1, beta is input.
695 * If beta_flag = 0, beta is output.
696 *
697 * beta_flag (input) int
698 * = 0 : beta is free, and is output.
699 * = 1 : beta is fixed on input.
700 *
701 * x (input/output) float*
702 *
703 * y (input/output) void*
704 *
705 * seed (input/output) int*
706 * The seed for the random number generator.
707 *
708 * r (output) void*
709 * The generated scalar r that will be used as an input to DOT.
710 *
711 * r_true_l (output) double*
712 * The leading part of the truth in double-double.
713 *
714 * r_true_t (output) double*
715 * The trailing part of the truth in double-double.
716 *
717 */
718 {
719 int i;
720 float *alpha_i = (float *) alpha;
721 float *beta_i = (float *) beta;
722 float *r_i = (float *) r;
723 float *x_i = x;
724 float *y_i = (float *) y;
725 float alpha_i_r;
726 float alpha_i_i;
727 float beta_i_r;
728 float beta_i_i;
729 float r_tmp;
730 float *x_vec;
731 float *y_vec;
732
733 alpha_i_r = alpha_i[0];
734 alpha_i_i = alpha_i[1];
735 beta_i_r = beta_i[0];
736 beta_i_i = beta_i[1];
737 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
738 if (2 * n > 0 && x_vec == NULL) {
739 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
740 }
741 y_vec = x_vec + n;
742 for (i = 0; i < n_fix2; i++) {
743 x_vec[i] = x_i[i];
744 y_vec[i] = y_i[2 * i];
745 }
746 for (; i < n_fix2 + n_mix; i++) {
747 x_vec[i] = x_i[i];
748 }
749
750 /* Call generator now. */
751 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
752 &alpha_i_r, alpha_flag,
753 &beta_i_r, beta_flag,
754 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
755
756 if (alpha_flag == 1) { /* alpha_i is fixed */
757 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
758 if (beta_flag == 1 &&
759 ((beta_i_r == 0. && beta_i_i == 0.) ||
760 (beta_i_r == 1. && beta_i_i == 0.))) {
761 /* beta_i == 0 or 1 --> r_i *= (1+i) */
762 r_i[0] = r_tmp;
763 r_i[1] = r_tmp;
764 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
765 beta_i[0] = beta_i_r;
766 beta_i[1] = -beta_i_r;
767 r_i[0] = 0.0;
768 r_i[1] = r_tmp;
769 }
770 r_true_l[1] = r_true_l[0];
771 r_true_t[1] = r_true_t[0];
772 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
773 if (beta_flag == 1 &&
774 ((beta_i_r == 0. && beta_i_i == 0.) ||
775 (beta_i_r == 1. && beta_i_i == 0.))) {
776 /* beta_i == 0 or 1 --> r_i *= (1+i) */
777 r_i[0] = r_tmp;
778 r_i[1] = r_tmp;
779 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
780 beta_i[0] = beta_i_r;
781 beta_i[1] = -beta_i_r;
782 r_i[0] = 0.0;
783 r_i[1] = r_tmp;
784 }
785 r_true_l[1] = r_true_l[0];
786 r_true_t[1] = r_true_t[0];
787 } else { /* alpha_i is a fixed multiple of (1+i) */
788 alpha_i[0] = alpha_i_r;
789 alpha_i[1] = alpha_i_r;
790 if (beta_flag == 1 &&
791 ((beta_i_r == 0. && beta_i_i == 0.) ||
792 (beta_i_r == 1. && beta_i_i == 0.))) {
793 /* beta_i is 0 or 1 --> r_i *= 2i --> prod = 2i */
794 r_i[0] = 0.0;
795 r_i[1] = 2.0 * r_tmp;
796 } else { /* beta_i *= (1+i), r_i *= (1+i) --> prod = 2i */
797 beta_i[0] = beta_i_r;
798 beta_i[1] = beta_i_r;
799 r_i[0] = r_tmp;
800 r_i[1] = r_tmp;
801 }
802 r_true_l[1] = 2.0 * r_true_l[0];
803 r_true_t[1] = 2.0 * r_true_t[0];
804 r_true_l[0] = r_true_t[0] = 0.0;
805 }
806 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
807 /* alpha_i *= (1+i) */
808 alpha_i[0] = alpha_i_r;
809 alpha_i[1] = alpha_i_r;
810 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i*=2i --> prod = 2i */
811 r_i[0] = 0.0;
812 r_i[1] = 2.0 * r_tmp;
813 } else { /* beta_i *= (1+i), r_i *= (1+i) */
814 beta_i[0] = beta_i_r;
815 beta_i[1] = beta_i_r;
816 r_i[0] = r_tmp;
817 r_i[1] = r_tmp;
818 }
819 r_true_l[1] = 2.0 * r_true_l[0];
820 r_true_t[1] = 2.0 * r_true_t[0];
821 r_true_l[0] = r_true_t[0] = 0.0;
822 } else { /* both alpha_i and beta_i are free */
823 assert(alpha_flag == 0 && beta_flag == 0);
824 alpha_i[0] = alpha_i_r;
825 alpha_i[1] = alpha_i_r;
826 beta_i[0] = beta_i_r;
827 beta_i[1] = beta_i_r;
828 r_i[0] = r_tmp;
829 r_i[1] = r_tmp;
830 /* imaginary part of r_true */
831 ddmuld(r_true_l[0], r_true_t[0], 2.0, &r_true_l[1], &r_true_t[1]);
832 /* real part of r_true */
833 r_true_l[0] = 0.;
834 r_true_t[0] = 0.;
835 }
836 for (i = 0; i < n; ++i) {
837 x_i[i] = x_vec[i];
838 y_i[2 * i] = y_vec[i];
839 y_i[2 * i + 1] = y_vec[i];
840 }
841
842
843 blas_free(x_vec); /* also y_vec */
844 } /* end BLAS_cdot_s_c_testgen */
845
BLAS_cdot_c_s_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,float * y,int * seed,void * r,double * r_true_l,double * r_true_t)846 void BLAS_cdot_c_s_testgen(int n, int n_fix2, int n_mix, int norm,
847 enum blas_conj_type conj, void *alpha,
848 int alpha_flag, void *beta, int beta_flag, void *x,
849 float *y, int *seed, void *r, double *r_true_l,
850 double *r_true_t)
851
852 /*
853 * Purpose
854 * =======
855 *
856 * This routine generates the test inputs to BLAS_cdot_c_s{_x}.
857 *
858 * Arguments
859 * =========
860 *
861 * n (input) int
862 * The length of the vectors X and Y.
863 *
864 * n_fix2 (input) int
865 * Number of pairs in the vectors X and Y that are fixed in value,
866 *
867 * n_mix (input) int
868 * Number of pairs in the vectors X and Y with X(i) fixed
869 * and Y(i) free in value.
870 *
871 * norm (input) int
872 * = -1 : the vectors are scaled with norms near underflow.
873 * = 0 : the vectors have norms of order 1.
874 * = 1 : the vectors are scaled with norms near overflow.
875 *
876 * conj (input) enum blas_conj_type
877 *
878 * alpha (input/output) void*
879 * If alpha_flag = 1, alpha is input.
880 * If alpha_flag = 0, alpha is output.
881 *
882 * alpha_flag (input) int
883 * = 0 : alpha is free, and is output.
884 * = 1 : alpha is fixed on input.
885 *
886 * beta (input) void*
887 * If beta_flag = 1, beta is input.
888 * If beta_flag = 0, beta is output.
889 *
890 * beta_flag (input) int
891 * = 0 : beta is free, and is output.
892 * = 1 : beta is fixed on input.
893 *
894 * x (input/output) void*
895 *
896 * y (input/output) float*
897 *
898 * seed (input/output) int*
899 * The seed for the random number generator.
900 *
901 * r (output) void*
902 * The generated scalar r that will be used as an input to DOT.
903 *
904 * r_true_l (output) double*
905 * The leading part of the truth in double-double.
906 *
907 * r_true_t (output) double*
908 * The trailing part of the truth in double-double.
909 *
910 */
911 {
912 int i;
913 float *alpha_i = (float *) alpha;
914 float *beta_i = (float *) beta;
915 float *r_i = (float *) r;
916 float *x_i = (float *) x;
917 float *y_i = y;
918 float alpha_i_r;
919 float alpha_i_i;
920 float beta_i_r;
921 float beta_i_i;
922 float r_tmp;
923 float *x_vec;
924 float *y_vec;
925
926 alpha_i_r = alpha_i[0];
927 alpha_i_i = alpha_i[1];
928 beta_i_r = beta_i[0];
929 beta_i_i = beta_i[1];
930 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
931 if (2 * n > 0 && x_vec == NULL) {
932 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
933 }
934 y_vec = x_vec + n;
935 for (i = 0; i < n_fix2; i++) {
936 x_vec[i] = x_i[2 * i];
937 y_vec[i] = y_i[i];
938 }
939 for (; i < n_fix2 + n_mix; i++) {
940 x_vec[i] = x_i[2 * i];
941 }
942
943 /* Call generator now. */
944 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
945 &alpha_i_r, alpha_flag,
946 &beta_i_r, beta_flag,
947 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
948
949 if (alpha_flag == 1) { /* alpha_i is fixed */
950 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
951 if (beta_flag == 1 &&
952 ((beta_i_r == 0. && beta_i_i == 0.) ||
953 (beta_i_r == 1. && beta_i_i == 0.))) {
954 /* beta_i == 0 or 1 --> r_i *= (1+i) */
955 r_i[0] = r_tmp;
956 r_i[1] = r_tmp;
957 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
958 beta_i[0] = beta_i_r;
959 beta_i[1] = -beta_i_r;
960 r_i[0] = 0.0;
961 r_i[1] = r_tmp;
962 }
963 r_true_l[1] = r_true_l[0];
964 r_true_t[1] = r_true_t[0];
965 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
966 if (beta_flag == 1 &&
967 ((beta_i_r == 0. && beta_i_i == 0.) ||
968 (beta_i_r == 1. && beta_i_i == 0.))) {
969 /* beta_i == 0 or 1 --> r_i *= (1+i) */
970 r_i[0] = r_tmp;
971 r_i[1] = r_tmp;
972 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
973 beta_i[0] = beta_i_r;
974 beta_i[1] = -beta_i_r;
975 r_i[0] = 0.0;
976 r_i[1] = r_tmp;
977 }
978 r_true_l[1] = r_true_l[0];
979 r_true_t[1] = r_true_t[0];
980 } else { /* alpha_i is a fixed multiple of (1+i) */
981 alpha_i[0] = alpha_i_r;
982 alpha_i[1] = alpha_i_r;
983 if (beta_flag == 1 &&
984 ((beta_i_r == 0. && beta_i_i == 0.) ||
985 (beta_i_r == 1. && beta_i_i == 0.))) {
986 /* beta_i is 0 or 1 --> r_i *= 2i --> prod = 2i */
987 r_i[0] = 0.0;
988 r_i[1] = 2.0 * r_tmp;
989 } else { /* beta_i *= (1+i), r_i *= (1+i) --> prod = 2i */
990 beta_i[0] = beta_i_r;
991 beta_i[1] = beta_i_r;
992 r_i[0] = r_tmp;
993 r_i[1] = r_tmp;
994 }
995 r_true_l[1] = 2.0 * r_true_l[0];
996 r_true_t[1] = 2.0 * r_true_t[0];
997 r_true_l[0] = r_true_t[0] = 0.0;
998 }
999 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
1000 /* alpha_i *= (1+i) */
1001 alpha_i[0] = alpha_i_r;
1002 alpha_i[1] = alpha_i_r;
1003 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i*=2i --> prod = 2i */
1004 r_i[0] = 0.0;
1005 r_i[1] = 2.0 * r_tmp;
1006 } else { /* beta_i *= (1+i), r_i *= (1+i) */
1007 beta_i[0] = beta_i_r;
1008 beta_i[1] = beta_i_r;
1009 r_i[0] = r_tmp;
1010 r_i[1] = r_tmp;
1011 }
1012 r_true_l[1] = 2.0 * r_true_l[0];
1013 r_true_t[1] = 2.0 * r_true_t[0];
1014 r_true_l[0] = r_true_t[0] = 0.0;
1015 } else { /* both alpha_i and beta_i are free */
1016 assert(alpha_flag == 0 && beta_flag == 0);
1017 alpha_i[0] = alpha_i_r;
1018 alpha_i[1] = alpha_i_r;
1019 beta_i[0] = beta_i_r;
1020 beta_i[1] = beta_i_r;
1021 r_i[0] = r_tmp;
1022 r_i[1] = r_tmp;
1023 /* imaginary part of r_true */
1024 ddmuld(r_true_l[0], r_true_t[0], 2.0, &r_true_l[1], &r_true_t[1]);
1025 /* real part of r_true */
1026 r_true_l[0] = 0.;
1027 r_true_t[0] = 0.;
1028 }
1029 for (i = 0; i < n; ++i) {
1030 x_i[2 * i] = x_vec[i];
1031 x_i[2 * i + 1] = x_vec[i];
1032 y_i[i] = y_vec[i];
1033 }
1034 if (conj == blas_conj) {
1035 for (i = 0; i < n; ++i)
1036 x_i[2 * i + 1] = -x_i[2 * i + 1];
1037 }
1038
1039 blas_free(x_vec); /* also y_vec */
1040 } /* end BLAS_cdot_c_s_testgen */
1041
BLAS_zdot_d_d_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,double * x,double * y,int * seed,void * r,double * r_true_l,double * r_true_t)1042 void BLAS_zdot_d_d_testgen(int n, int n_fix2, int n_mix, int norm,
1043 enum blas_conj_type conj, void *alpha,
1044 int alpha_flag, void *beta, int beta_flag,
1045 double *x, double *y, int *seed, void *r,
1046 double *r_true_l, double *r_true_t)
1047
1048 /*
1049 * Purpose
1050 * =======
1051 *
1052 * This routine generates the test inputs to BLAS_zdot_d_d{_x}.
1053 *
1054 * Arguments
1055 * =========
1056 *
1057 * n (input) int
1058 * The length of the vectors X and Y.
1059 *
1060 * n_fix2 (input) int
1061 * Number of pairs in the vectors X and Y that are fixed in value,
1062 *
1063 * n_mix (input) int
1064 * Number of pairs in the vectors X and Y with X(i) fixed
1065 * and Y(i) free in value.
1066 *
1067 * norm (input) int
1068 * = -1 : the vectors are scaled with norms near underflow.
1069 * = 0 : the vectors have norms of order 1.
1070 * = 1 : the vectors are scaled with norms near overflow.
1071 *
1072 * conj (input) enum blas_conj_type
1073 *
1074 * alpha (input/output) void*
1075 * If alpha_flag = 1, alpha is input.
1076 * If alpha_flag = 0, alpha is output.
1077 *
1078 * alpha_flag (input) int
1079 * = 0 : alpha is free, and is output.
1080 * = 1 : alpha is fixed on input.
1081 *
1082 * beta (input) void*
1083 * If beta_flag = 1, beta is input.
1084 * If beta_flag = 0, beta is output.
1085 *
1086 * beta_flag (input) int
1087 * = 0 : beta is free, and is output.
1088 * = 1 : beta is fixed on input.
1089 *
1090 * x (input/output) double*
1091 *
1092 * y (input/output) double*
1093 *
1094 * seed (input/output) int*
1095 * The seed for the random number generator.
1096 *
1097 * r (output) void*
1098 * The generated scalar r that will be used as an input to DOT.
1099 *
1100 * r_true_l (output) double*
1101 * The leading part of the truth in double-double.
1102 *
1103 * r_true_t (output) double*
1104 * The trailing part of the truth in double-double.
1105 *
1106 */
1107 {
1108 int i;
1109 double *alpha_i = (double *) alpha;
1110 double *beta_i = (double *) beta;
1111 double *r_i = (double *) r;
1112 double *x_i = x;
1113 double *y_i = y;
1114 double alpha_i_r;
1115 double alpha_i_i;
1116 double beta_i_r;
1117 double beta_i_i;
1118 double r_tmp;
1119 double *x_vec;
1120 double *y_vec;
1121
1122 alpha_i_r = alpha_i[0];
1123 alpha_i_i = alpha_i[1];
1124 beta_i_r = beta_i[0];
1125 beta_i_i = beta_i[1];
1126 x_vec = (double *) blas_malloc(2 * n * sizeof(double));
1127 if (2 * n > 0 && x_vec == NULL) {
1128 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1129 }
1130 y_vec = x_vec + n;
1131 for (i = 0; i < n_fix2; i++) {
1132 x_vec[i] = x_i[i];
1133 y_vec[i] = y_i[i];
1134 }
1135 for (; i < n_fix2 + n_mix; i++) {
1136 x_vec[i] = x_i[i];
1137 }
1138
1139 /* Call generator now. */
1140 testgen_BLAS_ddot(n, n_fix2, n_mix, norm, conj,
1141 &alpha_i_r, alpha_flag,
1142 &beta_i_r, beta_flag,
1143 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
1144
1145 if (alpha_flag == 1) { /* alpha_i is fixed */
1146 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
1147 if (beta_flag == 1 && ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.))) { /* beta_i == 0 or 1 */
1148 r_i[0] = r_tmp;
1149 r_i[1] = 0.0;
1150 } else { /* beta_i *= (1-i), r_i *= (1+i)/2 --> prod = 1 */
1151 beta_i[0] = beta_i_r;
1152 beta_i[1] = -beta_i_r;
1153 r_i[0] = r_tmp / 2.;
1154 r_i[1] = r_tmp / 2.;
1155 }
1156 r_true_l[1] = r_true_t[1] = 0.0;
1157 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
1158 if (beta_flag == 1 &&
1159 ((beta_i_r == 0. && beta_i_i == 0.) ||
1160 (beta_i_r == 1. && beta_i_i == 0.))) {
1161 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1162 r_i[0] = r_tmp;
1163 r_i[1] = r_tmp;
1164 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1165 beta_i[0] = beta_i_r;
1166 beta_i[1] = -beta_i_r;
1167 r_i[0] = 0.0;
1168 r_i[1] = r_tmp;
1169 }
1170 r_true_l[1] = r_true_l[0];
1171 r_true_t[1] = r_true_t[0];
1172 } else { /* alpha_i is a fixed multiple of (1+i) */
1173 alpha_i[0] = alpha_i_r;
1174 alpha_i[1] = alpha_i_r;
1175 if (beta_flag == 1 &&
1176 ((beta_i_r == 0. && beta_i_i == 0.) ||
1177 (beta_i_r == 1. && beta_i_i == 0.))) {
1178 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1179 r_i[0] = r_tmp;
1180 r_i[1] = r_tmp;
1181 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1182 beta_i[0] = beta_i_r;
1183 beta_i[1] = -beta_i_r;
1184 r_i[0] = 0.0;
1185 r_i[1] = r_tmp;
1186 }
1187 r_true_l[1] = r_true_l[0];
1188 r_true_t[1] = r_true_t[0];
1189 }
1190 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
1191 /* alpha_i *= (1+i) */
1192 alpha_i[0] = alpha_i_r;
1193 alpha_i[1] = alpha_i_r;
1194 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i *= (1+i) */
1195 r_i[0] = r_tmp;
1196 r_i[1] = r_tmp;
1197 } else { /* beta_i *= (1-i), r_i *= i */
1198 beta_i[0] = beta_i_r;
1199 beta_i[1] = -beta_i_r;
1200 r_i[0] = 0.;
1201 r_i[1] = r_tmp;
1202 }
1203 r_true_l[1] = r_true_l[0];
1204 r_true_t[1] = r_true_t[0];
1205 } else { /* both alpha_i and beta_i are free */
1206 assert(alpha_flag == 0 && beta_flag == 0);
1207 alpha_i[0] = alpha_i_r;
1208 alpha_i[1] = alpha_i_r;
1209 beta_i[0] = beta_i_r;
1210 beta_i[1] = -beta_i_r;
1211 r_i[0] = 0;
1212 r_i[1] = r_tmp;
1213 /* imaginary part of r_true */
1214 r_true_l[1] = r_true_l[0];
1215 r_true_t[1] = r_true_t[0];
1216 }
1217 for (i = 0; i < n; ++i) {
1218 x_i[i] = x_vec[i];
1219 y_i[i] = y_vec[i];
1220 }
1221
1222
1223 blas_free(x_vec); /* also y_vec */
1224 } /* end BLAS_zdot_d_d_testgen */
1225
BLAS_zdot_d_z_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,double * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)1226 void BLAS_zdot_d_z_testgen(int n, int n_fix2, int n_mix, int norm,
1227 enum blas_conj_type conj, void *alpha,
1228 int alpha_flag, void *beta, int beta_flag,
1229 double *x, void *y, int *seed, void *r,
1230 double *r_true_l, double *r_true_t)
1231
1232 /*
1233 * Purpose
1234 * =======
1235 *
1236 * This routine generates the test inputs to BLAS_zdot_d_z{_x}.
1237 *
1238 * Arguments
1239 * =========
1240 *
1241 * n (input) int
1242 * The length of the vectors X and Y.
1243 *
1244 * n_fix2 (input) int
1245 * Number of pairs in the vectors X and Y that are fixed in value,
1246 *
1247 * n_mix (input) int
1248 * Number of pairs in the vectors X and Y with X(i) fixed
1249 * and Y(i) free in value.
1250 *
1251 * norm (input) int
1252 * = -1 : the vectors are scaled with norms near underflow.
1253 * = 0 : the vectors have norms of order 1.
1254 * = 1 : the vectors are scaled with norms near overflow.
1255 *
1256 * conj (input) enum blas_conj_type
1257 *
1258 * alpha (input/output) void*
1259 * If alpha_flag = 1, alpha is input.
1260 * If alpha_flag = 0, alpha is output.
1261 *
1262 * alpha_flag (input) int
1263 * = 0 : alpha is free, and is output.
1264 * = 1 : alpha is fixed on input.
1265 *
1266 * beta (input) void*
1267 * If beta_flag = 1, beta is input.
1268 * If beta_flag = 0, beta is output.
1269 *
1270 * beta_flag (input) int
1271 * = 0 : beta is free, and is output.
1272 * = 1 : beta is fixed on input.
1273 *
1274 * x (input/output) double*
1275 *
1276 * y (input/output) void*
1277 *
1278 * seed (input/output) int*
1279 * The seed for the random number generator.
1280 *
1281 * r (output) void*
1282 * The generated scalar r that will be used as an input to DOT.
1283 *
1284 * r_true_l (output) double*
1285 * The leading part of the truth in double-double.
1286 *
1287 * r_true_t (output) double*
1288 * The trailing part of the truth in double-double.
1289 *
1290 */
1291 {
1292 int i;
1293 double *alpha_i = (double *) alpha;
1294 double *beta_i = (double *) beta;
1295 double *r_i = (double *) r;
1296 double *x_i = x;
1297 double *y_i = (double *) y;
1298 double alpha_i_r;
1299 double alpha_i_i;
1300 double beta_i_r;
1301 double beta_i_i;
1302 double r_tmp;
1303 double *x_vec;
1304 double *y_vec;
1305
1306 alpha_i_r = alpha_i[0];
1307 alpha_i_i = alpha_i[1];
1308 beta_i_r = beta_i[0];
1309 beta_i_i = beta_i[1];
1310 x_vec = (double *) blas_malloc(2 * n * sizeof(double));
1311 if (2 * n > 0 && x_vec == NULL) {
1312 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1313 }
1314 y_vec = x_vec + n;
1315 for (i = 0; i < n_fix2; i++) {
1316 x_vec[i] = x_i[i];
1317 y_vec[i] = y_i[2 * i];
1318 }
1319 for (; i < n_fix2 + n_mix; i++) {
1320 x_vec[i] = x_i[i];
1321 }
1322
1323 /* Call generator now. */
1324 testgen_BLAS_ddot(n, n_fix2, n_mix, norm, conj,
1325 &alpha_i_r, alpha_flag,
1326 &beta_i_r, beta_flag,
1327 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
1328
1329 if (alpha_flag == 1) { /* alpha_i is fixed */
1330 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
1331 if (beta_flag == 1 &&
1332 ((beta_i_r == 0. && beta_i_i == 0.) ||
1333 (beta_i_r == 1. && beta_i_i == 0.))) {
1334 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1335 r_i[0] = r_tmp;
1336 r_i[1] = r_tmp;
1337 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1338 beta_i[0] = beta_i_r;
1339 beta_i[1] = -beta_i_r;
1340 r_i[0] = 0.0;
1341 r_i[1] = r_tmp;
1342 }
1343 r_true_l[1] = r_true_l[0];
1344 r_true_t[1] = r_true_t[0];
1345 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
1346 if (beta_flag == 1 &&
1347 ((beta_i_r == 0. && beta_i_i == 0.) ||
1348 (beta_i_r == 1. && beta_i_i == 0.))) {
1349 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1350 r_i[0] = r_tmp;
1351 r_i[1] = r_tmp;
1352 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1353 beta_i[0] = beta_i_r;
1354 beta_i[1] = -beta_i_r;
1355 r_i[0] = 0.0;
1356 r_i[1] = r_tmp;
1357 }
1358 r_true_l[1] = r_true_l[0];
1359 r_true_t[1] = r_true_t[0];
1360 } else { /* alpha_i is a fixed multiple of (1+i) */
1361 alpha_i[0] = alpha_i_r;
1362 alpha_i[1] = alpha_i_r;
1363 if (beta_flag == 1 &&
1364 ((beta_i_r == 0. && beta_i_i == 0.) ||
1365 (beta_i_r == 1. && beta_i_i == 0.))) {
1366 /* beta_i is 0 or 1 --> r_i *= 2i --> prod = 2i */
1367 r_i[0] = 0.0;
1368 r_i[1] = 2.0 * r_tmp;
1369 } else { /* beta_i *= (1+i), r_i *= (1+i) --> prod = 2i */
1370 beta_i[0] = beta_i_r;
1371 beta_i[1] = beta_i_r;
1372 r_i[0] = r_tmp;
1373 r_i[1] = r_tmp;
1374 }
1375 r_true_l[1] = 2.0 * r_true_l[0];
1376 r_true_t[1] = 2.0 * r_true_t[0];
1377 r_true_l[0] = r_true_t[0] = 0.0;
1378 }
1379 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
1380 /* alpha_i *= (1+i) */
1381 alpha_i[0] = alpha_i_r;
1382 alpha_i[1] = alpha_i_r;
1383 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i*=2i --> prod = 2i */
1384 r_i[0] = 0.0;
1385 r_i[1] = 2.0 * r_tmp;
1386 } else { /* beta_i *= (1+i), r_i *= (1+i) */
1387 beta_i[0] = beta_i_r;
1388 beta_i[1] = beta_i_r;
1389 r_i[0] = r_tmp;
1390 r_i[1] = r_tmp;
1391 }
1392 r_true_l[1] = 2.0 * r_true_l[0];
1393 r_true_t[1] = 2.0 * r_true_t[0];
1394 r_true_l[0] = r_true_t[0] = 0.0;
1395 } else { /* both alpha_i and beta_i are free */
1396 assert(alpha_flag == 0 && beta_flag == 0);
1397 alpha_i[0] = alpha_i_r;
1398 alpha_i[1] = alpha_i_r;
1399 beta_i[0] = beta_i_r;
1400 beta_i[1] = beta_i_r;
1401 r_i[0] = r_tmp;
1402 r_i[1] = r_tmp;
1403 /* imaginary part of r_true */
1404 ddmuld(r_true_l[0], r_true_t[0], 2.0, &r_true_l[1], &r_true_t[1]);
1405 /* real part of r_true */
1406 r_true_l[0] = 0.;
1407 r_true_t[0] = 0.;
1408 }
1409 for (i = 0; i < n; ++i) {
1410 x_i[i] = x_vec[i];
1411 y_i[2 * i] = y_vec[i];
1412 y_i[2 * i + 1] = y_vec[i];
1413 }
1414
1415
1416 blas_free(x_vec); /* also y_vec */
1417 } /* end BLAS_zdot_d_z_testgen */
1418
BLAS_zdot_z_d_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,double * y,int * seed,void * r,double * r_true_l,double * r_true_t)1419 void BLAS_zdot_z_d_testgen(int n, int n_fix2, int n_mix, int norm,
1420 enum blas_conj_type conj, void *alpha,
1421 int alpha_flag, void *beta, int beta_flag, void *x,
1422 double *y, int *seed, void *r, double *r_true_l,
1423 double *r_true_t)
1424
1425 /*
1426 * Purpose
1427 * =======
1428 *
1429 * This routine generates the test inputs to BLAS_zdot_z_d{_x}.
1430 *
1431 * Arguments
1432 * =========
1433 *
1434 * n (input) int
1435 * The length of the vectors X and Y.
1436 *
1437 * n_fix2 (input) int
1438 * Number of pairs in the vectors X and Y that are fixed in value,
1439 *
1440 * n_mix (input) int
1441 * Number of pairs in the vectors X and Y with X(i) fixed
1442 * and Y(i) free in value.
1443 *
1444 * norm (input) int
1445 * = -1 : the vectors are scaled with norms near underflow.
1446 * = 0 : the vectors have norms of order 1.
1447 * = 1 : the vectors are scaled with norms near overflow.
1448 *
1449 * conj (input) enum blas_conj_type
1450 *
1451 * alpha (input/output) void*
1452 * If alpha_flag = 1, alpha is input.
1453 * If alpha_flag = 0, alpha is output.
1454 *
1455 * alpha_flag (input) int
1456 * = 0 : alpha is free, and is output.
1457 * = 1 : alpha is fixed on input.
1458 *
1459 * beta (input) void*
1460 * If beta_flag = 1, beta is input.
1461 * If beta_flag = 0, beta is output.
1462 *
1463 * beta_flag (input) int
1464 * = 0 : beta is free, and is output.
1465 * = 1 : beta is fixed on input.
1466 *
1467 * x (input/output) void*
1468 *
1469 * y (input/output) double*
1470 *
1471 * seed (input/output) int*
1472 * The seed for the random number generator.
1473 *
1474 * r (output) void*
1475 * The generated scalar r that will be used as an input to DOT.
1476 *
1477 * r_true_l (output) double*
1478 * The leading part of the truth in double-double.
1479 *
1480 * r_true_t (output) double*
1481 * The trailing part of the truth in double-double.
1482 *
1483 */
1484 {
1485 int i;
1486 double *alpha_i = (double *) alpha;
1487 double *beta_i = (double *) beta;
1488 double *r_i = (double *) r;
1489 double *x_i = (double *) x;
1490 double *y_i = y;
1491 double alpha_i_r;
1492 double alpha_i_i;
1493 double beta_i_r;
1494 double beta_i_i;
1495 double r_tmp;
1496 double *x_vec;
1497 double *y_vec;
1498
1499 alpha_i_r = alpha_i[0];
1500 alpha_i_i = alpha_i[1];
1501 beta_i_r = beta_i[0];
1502 beta_i_i = beta_i[1];
1503 x_vec = (double *) blas_malloc(2 * n * sizeof(double));
1504 if (2 * n > 0 && x_vec == NULL) {
1505 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1506 }
1507 y_vec = x_vec + n;
1508 for (i = 0; i < n_fix2; i++) {
1509 x_vec[i] = x_i[2 * i];
1510 y_vec[i] = y_i[i];
1511 }
1512 for (; i < n_fix2 + n_mix; i++) {
1513 x_vec[i] = x_i[2 * i];
1514 }
1515
1516 /* Call generator now. */
1517 testgen_BLAS_ddot(n, n_fix2, n_mix, norm, conj,
1518 &alpha_i_r, alpha_flag,
1519 &beta_i_r, beta_flag,
1520 x_vec, y_vec, seed, &r_tmp, &r_true_l[0], &r_true_t[0]);
1521
1522 if (alpha_flag == 1) { /* alpha_i is fixed */
1523 if (alpha_i_r == 1.0 && alpha_i_i == 0.) { /* alpha_i == 1.0 */
1524 if (beta_flag == 1 &&
1525 ((beta_i_r == 0. && beta_i_i == 0.) ||
1526 (beta_i_r == 1. && beta_i_i == 0.))) {
1527 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1528 r_i[0] = r_tmp;
1529 r_i[1] = r_tmp;
1530 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1531 beta_i[0] = beta_i_r;
1532 beta_i[1] = -beta_i_r;
1533 r_i[0] = 0.0;
1534 r_i[1] = r_tmp;
1535 }
1536 r_true_l[1] = r_true_l[0];
1537 r_true_t[1] = r_true_t[0];
1538 } else if (alpha_i_r == 0. && alpha_i_i == 0.) { /* alpha_i == 0.0 */
1539 if (beta_flag == 1 &&
1540 ((beta_i_r == 0. && beta_i_i == 0.) ||
1541 (beta_i_r == 1. && beta_i_i == 0.))) {
1542 /* beta_i == 0 or 1 --> r_i *= (1+i) */
1543 r_i[0] = r_tmp;
1544 r_i[1] = r_tmp;
1545 } else { /* beta_i *= (1-i), r_i *= i --> prod = 1+i */
1546 beta_i[0] = beta_i_r;
1547 beta_i[1] = -beta_i_r;
1548 r_i[0] = 0.0;
1549 r_i[1] = r_tmp;
1550 }
1551 r_true_l[1] = r_true_l[0];
1552 r_true_t[1] = r_true_t[0];
1553 } else { /* alpha_i is a fixed multiple of (1+i) */
1554 alpha_i[0] = alpha_i_r;
1555 alpha_i[1] = alpha_i_r;
1556 if (beta_flag == 1 &&
1557 ((beta_i_r == 0. && beta_i_i == 0.) ||
1558 (beta_i_r == 1. && beta_i_i == 0.))) {
1559 /* beta_i is 0 or 1 --> r_i *= 2i --> prod = 2i */
1560 r_i[0] = 0.0;
1561 r_i[1] = 2.0 * r_tmp;
1562 } else { /* beta_i *= (1+i), r_i *= (1+i) --> prod = 2i */
1563 beta_i[0] = beta_i_r;
1564 beta_i[1] = beta_i_r;
1565 r_i[0] = r_tmp;
1566 r_i[1] = r_tmp;
1567 }
1568 r_true_l[1] = 2.0 * r_true_l[0];
1569 r_true_t[1] = 2.0 * r_true_t[0];
1570 r_true_l[0] = r_true_t[0] = 0.0;
1571 }
1572 } else if (beta_flag == 1) { /* alpha_i is free, beta_i is fixed */
1573 /* alpha_i *= (1+i) */
1574 alpha_i[0] = alpha_i_r;
1575 alpha_i[1] = alpha_i_r;
1576 if ((beta_i_r == 0. && beta_i_i == 0.) || (beta_i_r == 1. && beta_i_i == 0.)) { /* r_i*=2i --> prod = 2i */
1577 r_i[0] = 0.0;
1578 r_i[1] = 2.0 * r_tmp;
1579 } else { /* beta_i *= (1+i), r_i *= (1+i) */
1580 beta_i[0] = beta_i_r;
1581 beta_i[1] = beta_i_r;
1582 r_i[0] = r_tmp;
1583 r_i[1] = r_tmp;
1584 }
1585 r_true_l[1] = 2.0 * r_true_l[0];
1586 r_true_t[1] = 2.0 * r_true_t[0];
1587 r_true_l[0] = r_true_t[0] = 0.0;
1588 } else { /* both alpha_i and beta_i are free */
1589 assert(alpha_flag == 0 && beta_flag == 0);
1590 alpha_i[0] = alpha_i_r;
1591 alpha_i[1] = alpha_i_r;
1592 beta_i[0] = beta_i_r;
1593 beta_i[1] = beta_i_r;
1594 r_i[0] = r_tmp;
1595 r_i[1] = r_tmp;
1596 /* imaginary part of r_true */
1597 ddmuld(r_true_l[0], r_true_t[0], 2.0, &r_true_l[1], &r_true_t[1]);
1598 /* real part of r_true */
1599 r_true_l[0] = 0.;
1600 r_true_t[0] = 0.;
1601 }
1602 for (i = 0; i < n; ++i) {
1603 x_i[2 * i] = x_vec[i];
1604 x_i[2 * i + 1] = x_vec[i];
1605 y_i[i] = y_vec[i];
1606 }
1607 if (conj == blas_conj) {
1608 for (i = 0; i < n; ++i)
1609 x_i[2 * i + 1] = -x_i[2 * i + 1];
1610 }
1611
1612 blas_free(x_vec); /* also y_vec */
1613 } /* end BLAS_zdot_z_d_testgen */
1614
BLAS_ddot_s_s_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,double * alpha,int alpha_flag,double * beta,int beta_flag,float * x,float * y,int * seed,double * r,double * r_true_l,double * r_true_t)1615 void BLAS_ddot_s_s_testgen(int n, int n_fix2, int n_mix, int norm,
1616 enum blas_conj_type conj, double *alpha,
1617 int alpha_flag, double *beta, int beta_flag,
1618 float *x, float *y, int *seed, double *r,
1619 double *r_true_l, double *r_true_t)
1620
1621 /*
1622 * Purpose
1623 * =======
1624 *
1625 * This routine generates the test inputs to BLAS_ddot_s_s{_x}.
1626 *
1627 * Arguments
1628 * =========
1629 *
1630 * n (input) int
1631 * The length of the vectors X and Y.
1632 *
1633 * n_fix2 (input) int
1634 * Number of pairs in the vectors X and Y that are fixed in value,
1635 *
1636 * n_mix (input) int
1637 * Number of pairs in the vectors X and Y with X(i) fixed
1638 * and Y(i) free in value.
1639 *
1640 * norm (input) int
1641 * = -1 : the vectors are scaled with norms near underflow.
1642 * = 0 : the vectors have norms of order 1.
1643 * = 1 : the vectors are scaled with norms near overflow.
1644 *
1645 * conj (input) enum blas_conj_type
1646 *
1647 * alpha (input/output) double*
1648 * If alpha_flag = 1, alpha is input.
1649 * If alpha_flag = 0, alpha is output.
1650 *
1651 * alpha_flag (input) int
1652 * = 0 : alpha is free, and is output.
1653 * = 1 : alpha is fixed on input.
1654 *
1655 * beta (input) double*
1656 * If beta_flag = 1, beta is input.
1657 * If beta_flag = 0, beta is output.
1658 *
1659 * beta_flag (input) int
1660 * = 0 : beta is free, and is output.
1661 * = 1 : beta is fixed on input.
1662 *
1663 * x (input/output) float*
1664 *
1665 * y (input/output) float*
1666 *
1667 * seed (input/output) int*
1668 * The seed for the random number generator.
1669 *
1670 * r (output) double*
1671 * The generated scalar r that will be used as an input to DOT.
1672 *
1673 * r_true_l (output) double*
1674 * The leading part of the truth in double-double.
1675 *
1676 * r_true_t (output) double*
1677 * The trailing part of the truth in double-double.
1678 *
1679 */
1680 {
1681 int i, inc = 1;
1682 double *alpha_i = alpha;
1683 double *beta_i = beta;
1684 double *r_i = r;
1685 float *x_i = x;
1686 float *y_i = y;
1687 float alpha_tmp;
1688 float beta_tmp;
1689 float r_tmp;
1690 float *x_vec;
1691 float *y_vec;
1692
1693 alpha_tmp = *alpha_i;
1694 beta_tmp = *beta_i;
1695
1696 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
1697 if (2 * n > 0 && x_vec == NULL) {
1698 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1699 }
1700 y_vec = x_vec + inc * n;
1701 for (i = 0; i < inc * n_fix2; i += inc) {
1702 x_vec[i] = x_i[i];
1703 y_vec[i] = y_i[i];
1704 }
1705 for (; i < inc * (n_fix2 + n_mix); i += inc) {
1706 x_vec[i] = x_i[i];
1707 }
1708
1709 /* Call generator now. */
1710 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
1711 &alpha_tmp, alpha_flag,
1712 &beta_tmp, beta_flag,
1713 x_vec, y_vec, seed, &r_tmp, r_true_l, r_true_t);
1714
1715 *alpha_i = alpha_tmp;
1716 *beta_i = beta_tmp;
1717 *r_i = r_tmp;
1718 for (i = 0; i < inc * n; i += inc) {
1719 x_i[i] = x_vec[i];
1720 y_i[i] = y_vec[i];
1721 }
1722
1723 blas_free(x_vec); /* also y_i */
1724 } /* end BLAS_ddot_s_s_testgen */
1725
BLAS_ddot_s_d_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,double * alpha,int alpha_flag,double * beta,int beta_flag,float * x,double * y,int * seed,double * r,double * r_true_l,double * r_true_t)1726 void BLAS_ddot_s_d_testgen(int n, int n_fix2, int n_mix, int norm,
1727 enum blas_conj_type conj, double *alpha,
1728 int alpha_flag, double *beta, int beta_flag,
1729 float *x, double *y, int *seed, double *r,
1730 double *r_true_l, double *r_true_t)
1731
1732 /*
1733 * Purpose
1734 * =======
1735 *
1736 * This routine generates the test inputs to BLAS_ddot_s_d{_x}.
1737 *
1738 * Arguments
1739 * =========
1740 *
1741 * n (input) int
1742 * The length of the vectors X and Y.
1743 *
1744 * n_fix2 (input) int
1745 * Number of pairs in the vectors X and Y that are fixed in value,
1746 *
1747 * n_mix (input) int
1748 * Number of pairs in the vectors X and Y with X(i) fixed
1749 * and Y(i) free in value.
1750 *
1751 * norm (input) int
1752 * = -1 : the vectors are scaled with norms near underflow.
1753 * = 0 : the vectors have norms of order 1.
1754 * = 1 : the vectors are scaled with norms near overflow.
1755 *
1756 * conj (input) enum blas_conj_type
1757 *
1758 * alpha (input/output) double*
1759 * If alpha_flag = 1, alpha is input.
1760 * If alpha_flag = 0, alpha is output.
1761 *
1762 * alpha_flag (input) int
1763 * = 0 : alpha is free, and is output.
1764 * = 1 : alpha is fixed on input.
1765 *
1766 * beta (input) double*
1767 * If beta_flag = 1, beta is input.
1768 * If beta_flag = 0, beta is output.
1769 *
1770 * beta_flag (input) int
1771 * = 0 : beta is free, and is output.
1772 * = 1 : beta is fixed on input.
1773 *
1774 * x (input/output) float*
1775 *
1776 * y (input/output) double*
1777 *
1778 * seed (input/output) int*
1779 * The seed for the random number generator.
1780 *
1781 * r (output) double*
1782 * The generated scalar r that will be used as an input to DOT.
1783 *
1784 * r_true_l (output) double*
1785 * The leading part of the truth in double-double.
1786 *
1787 * r_true_t (output) double*
1788 * The trailing part of the truth in double-double.
1789 *
1790 */
1791 {
1792 int i, inc = 1;
1793 double *alpha_i = alpha;
1794 double *beta_i = beta;
1795 double *r_i = r;
1796 float *x_i = x;
1797 double *y_i = y;
1798 float alpha_tmp;
1799 float beta_tmp;
1800 float r_tmp;
1801 float *x_vec;
1802 float *y_vec;
1803
1804 alpha_tmp = *alpha_i;
1805 beta_tmp = *beta_i;
1806
1807 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
1808 if (2 * n > 0 && x_vec == NULL) {
1809 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1810 }
1811 y_vec = x_vec + inc * n;
1812 for (i = 0; i < inc * n_fix2; i += inc) {
1813 x_vec[i] = x_i[i];
1814 y_vec[i] = y_i[i];
1815 }
1816 for (; i < inc * (n_fix2 + n_mix); i += inc) {
1817 x_vec[i] = x_i[i];
1818 }
1819
1820 /* Call generator now. */
1821 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
1822 &alpha_tmp, alpha_flag,
1823 &beta_tmp, beta_flag,
1824 x_vec, y_vec, seed, &r_tmp, r_true_l, r_true_t);
1825
1826 *alpha_i = alpha_tmp;
1827 *beta_i = beta_tmp;
1828 *r_i = r_tmp;
1829 for (i = 0; i < inc * n; i += inc) {
1830 x_i[i] = x_vec[i];
1831 y_i[i] = y_vec[i];
1832 }
1833
1834 blas_free(x_vec); /* also y_i */
1835 } /* end BLAS_ddot_s_d_testgen */
1836
BLAS_ddot_d_s_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,double * alpha,int alpha_flag,double * beta,int beta_flag,double * x,float * y,int * seed,double * r,double * r_true_l,double * r_true_t)1837 void BLAS_ddot_d_s_testgen(int n, int n_fix2, int n_mix, int norm,
1838 enum blas_conj_type conj, double *alpha,
1839 int alpha_flag, double *beta, int beta_flag,
1840 double *x, float *y, int *seed, double *r,
1841 double *r_true_l, double *r_true_t)
1842
1843 /*
1844 * Purpose
1845 * =======
1846 *
1847 * This routine generates the test inputs to BLAS_ddot_d_s{_x}.
1848 *
1849 * Arguments
1850 * =========
1851 *
1852 * n (input) int
1853 * The length of the vectors X and Y.
1854 *
1855 * n_fix2 (input) int
1856 * Number of pairs in the vectors X and Y that are fixed in value,
1857 *
1858 * n_mix (input) int
1859 * Number of pairs in the vectors X and Y with X(i) fixed
1860 * and Y(i) free in value.
1861 *
1862 * norm (input) int
1863 * = -1 : the vectors are scaled with norms near underflow.
1864 * = 0 : the vectors have norms of order 1.
1865 * = 1 : the vectors are scaled with norms near overflow.
1866 *
1867 * conj (input) enum blas_conj_type
1868 *
1869 * alpha (input/output) double*
1870 * If alpha_flag = 1, alpha is input.
1871 * If alpha_flag = 0, alpha is output.
1872 *
1873 * alpha_flag (input) int
1874 * = 0 : alpha is free, and is output.
1875 * = 1 : alpha is fixed on input.
1876 *
1877 * beta (input) double*
1878 * If beta_flag = 1, beta is input.
1879 * If beta_flag = 0, beta is output.
1880 *
1881 * beta_flag (input) int
1882 * = 0 : beta is free, and is output.
1883 * = 1 : beta is fixed on input.
1884 *
1885 * x (input/output) double*
1886 *
1887 * y (input/output) float*
1888 *
1889 * seed (input/output) int*
1890 * The seed for the random number generator.
1891 *
1892 * r (output) double*
1893 * The generated scalar r that will be used as an input to DOT.
1894 *
1895 * r_true_l (output) double*
1896 * The leading part of the truth in double-double.
1897 *
1898 * r_true_t (output) double*
1899 * The trailing part of the truth in double-double.
1900 *
1901 */
1902 {
1903 int i, inc = 1;
1904 double *alpha_i = alpha;
1905 double *beta_i = beta;
1906 double *r_i = r;
1907 double *x_i = x;
1908 float *y_i = y;
1909 float alpha_tmp;
1910 float beta_tmp;
1911 float r_tmp;
1912 float *x_vec;
1913 float *y_vec;
1914
1915 alpha_tmp = *alpha_i;
1916 beta_tmp = *beta_i;
1917
1918 x_vec = (float *) blas_malloc(2 * n * sizeof(float));
1919 if (2 * n > 0 && x_vec == NULL) {
1920 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1921 }
1922 y_vec = x_vec + inc * n;
1923 for (i = 0; i < inc * n_fix2; i += inc) {
1924 x_vec[i] = x_i[i];
1925 y_vec[i] = y_i[i];
1926 }
1927 for (; i < inc * (n_fix2 + n_mix); i += inc) {
1928 x_vec[i] = x_i[i];
1929 }
1930
1931 /* Call generator now. */
1932 testgen_BLAS_sdot(n, n_fix2, n_mix, norm, conj,
1933 &alpha_tmp, alpha_flag,
1934 &beta_tmp, beta_flag,
1935 x_vec, y_vec, seed, &r_tmp, r_true_l, r_true_t);
1936
1937 *alpha_i = alpha_tmp;
1938 *beta_i = beta_tmp;
1939 *r_i = r_tmp;
1940 for (i = 0; i < inc * n; i += inc) {
1941 x_i[i] = x_vec[i];
1942 y_i[i] = y_vec[i];
1943 }
1944
1945 blas_free(x_vec); /* also y_i */
1946 } /* end BLAS_ddot_d_s_testgen */
1947
BLAS_zdot_c_c_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)1948 void BLAS_zdot_c_c_testgen(int n, int n_fix2, int n_mix, int norm,
1949 enum blas_conj_type conj, void *alpha,
1950 int alpha_flag, void *beta, int beta_flag, void *x,
1951 void *y, int *seed, void *r, double *r_true_l,
1952 double *r_true_t)
1953
1954 /*
1955 * Purpose
1956 * =======
1957 *
1958 * This routine generates the test inputs to BLAS_zdot_c_c{_x}.
1959 *
1960 * Arguments
1961 * =========
1962 *
1963 * n (input) int
1964 * The length of the vectors X and Y.
1965 *
1966 * n_fix2 (input) int
1967 * Number of pairs in the vectors X and Y that are fixed in value,
1968 *
1969 * n_mix (input) int
1970 * Number of pairs in the vectors X and Y with X(i) fixed
1971 * and Y(i) free in value.
1972 *
1973 * norm (input) int
1974 * = -1 : the vectors are scaled with norms near underflow.
1975 * = 0 : the vectors have norms of order 1.
1976 * = 1 : the vectors are scaled with norms near overflow.
1977 *
1978 * conj (input) enum blas_conj_type
1979 *
1980 * alpha (input/output) void*
1981 * If alpha_flag = 1, alpha is input.
1982 * If alpha_flag = 0, alpha is output.
1983 *
1984 * alpha_flag (input) int
1985 * = 0 : alpha is free, and is output.
1986 * = 1 : alpha is fixed on input.
1987 *
1988 * beta (input) void*
1989 * If beta_flag = 1, beta is input.
1990 * If beta_flag = 0, beta is output.
1991 *
1992 * beta_flag (input) int
1993 * = 0 : beta is free, and is output.
1994 * = 1 : beta is fixed on input.
1995 *
1996 * x (input/output) void*
1997 *
1998 * y (input/output) void*
1999 *
2000 * seed (input/output) int*
2001 * The seed for the random number generator.
2002 *
2003 * r (output) void*
2004 * The generated scalar r that will be used as an input to DOT.
2005 *
2006 * r_true_l (output) double*
2007 * The leading part of the truth in double-double.
2008 *
2009 * r_true_t (output) double*
2010 * The trailing part of the truth in double-double.
2011 *
2012 */
2013 {
2014 int i, inc = 1;
2015 double *alpha_i = (double *) alpha;
2016 double *beta_i = (double *) beta;
2017 double *r_i = (double *) r;
2018 float *x_i = (float *) x;
2019 float *y_i = (float *) y;
2020 float alpha_tmp[2];
2021 float beta_tmp[2];
2022 float r_tmp[2];
2023 float *x_vec;
2024 float *y_vec;
2025
2026 alpha_tmp[0] = alpha_i[0];
2027 alpha_tmp[1] = alpha_i[1];
2028 beta_tmp[0] = beta_i[0];
2029 beta_tmp[1] = beta_i[1];
2030 inc *= 2;
2031 x_vec = (float *) blas_malloc(2 * n * sizeof(float) * 2);
2032 if (2 * n > 0 && x_vec == NULL) {
2033 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2034 }
2035 y_vec = x_vec + inc * n;
2036 for (i = 0; i < inc * n_fix2; i += inc) {
2037 x_vec[i] = x_i[i];
2038 x_vec[i + 1] = x_i[i + 1];
2039 y_vec[i] = y_i[i];
2040 y_vec[i + 1] = y_i[i + 1];
2041 }
2042 for (; i < inc * (n_fix2 + n_mix); i += inc) {
2043 x_vec[i] = x_i[i];
2044 x_vec[i + 1] = x_i[i + 1];
2045 }
2046
2047 /* Call generator now. */
2048 testgen_BLAS_cdot(n, n_fix2, n_mix, norm, conj,
2049 alpha_tmp, alpha_flag,
2050 beta_tmp, beta_flag,
2051 x_vec, y_vec, seed, r_tmp, r_true_l, r_true_t);
2052
2053 alpha_i[0] = alpha_tmp[0];
2054 alpha_i[1] = alpha_tmp[1];
2055 beta_i[0] = beta_tmp[0];
2056 beta_i[1] = beta_tmp[1];
2057 r_i[0] = r_tmp[0];
2058 r_i[1] = r_tmp[1];
2059 for (i = 0; i < inc * n; i += inc) {
2060 x_i[i] = x_vec[i];
2061 x_i[i + 1] = x_vec[i + 1];
2062 y_i[i] = y_vec[i];
2063 y_i[i + 1] = y_vec[i + 1];
2064 }
2065
2066 blas_free(x_vec); /* also y_i */
2067 } /* end BLAS_zdot_c_c_testgen */
2068
BLAS_zdot_c_z_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)2069 void BLAS_zdot_c_z_testgen(int n, int n_fix2, int n_mix, int norm,
2070 enum blas_conj_type conj, void *alpha,
2071 int alpha_flag, void *beta, int beta_flag, void *x,
2072 void *y, int *seed, void *r, double *r_true_l,
2073 double *r_true_t)
2074
2075 /*
2076 * Purpose
2077 * =======
2078 *
2079 * This routine generates the test inputs to BLAS_zdot_c_z{_x}.
2080 *
2081 * Arguments
2082 * =========
2083 *
2084 * n (input) int
2085 * The length of the vectors X and Y.
2086 *
2087 * n_fix2 (input) int
2088 * Number of pairs in the vectors X and Y that are fixed in value,
2089 *
2090 * n_mix (input) int
2091 * Number of pairs in the vectors X and Y with X(i) fixed
2092 * and Y(i) free in value.
2093 *
2094 * norm (input) int
2095 * = -1 : the vectors are scaled with norms near underflow.
2096 * = 0 : the vectors have norms of order 1.
2097 * = 1 : the vectors are scaled with norms near overflow.
2098 *
2099 * conj (input) enum blas_conj_type
2100 *
2101 * alpha (input/output) void*
2102 * If alpha_flag = 1, alpha is input.
2103 * If alpha_flag = 0, alpha is output.
2104 *
2105 * alpha_flag (input) int
2106 * = 0 : alpha is free, and is output.
2107 * = 1 : alpha is fixed on input.
2108 *
2109 * beta (input) void*
2110 * If beta_flag = 1, beta is input.
2111 * If beta_flag = 0, beta is output.
2112 *
2113 * beta_flag (input) int
2114 * = 0 : beta is free, and is output.
2115 * = 1 : beta is fixed on input.
2116 *
2117 * x (input/output) void*
2118 *
2119 * y (input/output) void*
2120 *
2121 * seed (input/output) int*
2122 * The seed for the random number generator.
2123 *
2124 * r (output) void*
2125 * The generated scalar r that will be used as an input to DOT.
2126 *
2127 * r_true_l (output) double*
2128 * The leading part of the truth in double-double.
2129 *
2130 * r_true_t (output) double*
2131 * The trailing part of the truth in double-double.
2132 *
2133 */
2134 {
2135 int i, inc = 1;
2136 double *alpha_i = (double *) alpha;
2137 double *beta_i = (double *) beta;
2138 double *r_i = (double *) r;
2139 float *x_i = (float *) x;
2140 double *y_i = (double *) y;
2141 float alpha_tmp[2];
2142 float beta_tmp[2];
2143 float r_tmp[2];
2144 float *x_vec;
2145 float *y_vec;
2146
2147 alpha_tmp[0] = alpha_i[0];
2148 alpha_tmp[1] = alpha_i[1];
2149 beta_tmp[0] = beta_i[0];
2150 beta_tmp[1] = beta_i[1];
2151 inc *= 2;
2152 x_vec = (float *) blas_malloc(2 * n * sizeof(float) * 2);
2153 if (2 * n > 0 && x_vec == NULL) {
2154 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2155 }
2156 y_vec = x_vec + inc * n;
2157 for (i = 0; i < inc * n_fix2; i += inc) {
2158 x_vec[i] = x_i[i];
2159 x_vec[i + 1] = x_i[i + 1];
2160 y_vec[i] = y_i[i];
2161 y_vec[i + 1] = y_i[i + 1];
2162 }
2163 for (; i < inc * (n_fix2 + n_mix); i += inc) {
2164 x_vec[i] = x_i[i];
2165 x_vec[i + 1] = x_i[i + 1];
2166 }
2167
2168 /* Call generator now. */
2169 testgen_BLAS_cdot(n, n_fix2, n_mix, norm, conj,
2170 alpha_tmp, alpha_flag,
2171 beta_tmp, beta_flag,
2172 x_vec, y_vec, seed, r_tmp, r_true_l, r_true_t);
2173
2174 alpha_i[0] = alpha_tmp[0];
2175 alpha_i[1] = alpha_tmp[1];
2176 beta_i[0] = beta_tmp[0];
2177 beta_i[1] = beta_tmp[1];
2178 r_i[0] = r_tmp[0];
2179 r_i[1] = r_tmp[1];
2180 for (i = 0; i < inc * n; i += inc) {
2181 x_i[i] = x_vec[i];
2182 x_i[i + 1] = x_vec[i + 1];
2183 y_i[i] = y_vec[i];
2184 y_i[i + 1] = y_vec[i + 1];
2185 }
2186
2187 blas_free(x_vec); /* also y_i */
2188 } /* end BLAS_zdot_c_z_testgen */
2189
BLAS_zdot_z_c_testgen(int n,int n_fix2,int n_mix,int norm,enum blas_conj_type conj,void * alpha,int alpha_flag,void * beta,int beta_flag,void * x,void * y,int * seed,void * r,double * r_true_l,double * r_true_t)2190 void BLAS_zdot_z_c_testgen(int n, int n_fix2, int n_mix, int norm,
2191 enum blas_conj_type conj, void *alpha,
2192 int alpha_flag, void *beta, int beta_flag, void *x,
2193 void *y, int *seed, void *r, double *r_true_l,
2194 double *r_true_t)
2195
2196 /*
2197 * Purpose
2198 * =======
2199 *
2200 * This routine generates the test inputs to BLAS_zdot_z_c{_x}.
2201 *
2202 * Arguments
2203 * =========
2204 *
2205 * n (input) int
2206 * The length of the vectors X and Y.
2207 *
2208 * n_fix2 (input) int
2209 * Number of pairs in the vectors X and Y that are fixed in value,
2210 *
2211 * n_mix (input) int
2212 * Number of pairs in the vectors X and Y with X(i) fixed
2213 * and Y(i) free in value.
2214 *
2215 * norm (input) int
2216 * = -1 : the vectors are scaled with norms near underflow.
2217 * = 0 : the vectors have norms of order 1.
2218 * = 1 : the vectors are scaled with norms near overflow.
2219 *
2220 * conj (input) enum blas_conj_type
2221 *
2222 * alpha (input/output) void*
2223 * If alpha_flag = 1, alpha is input.
2224 * If alpha_flag = 0, alpha is output.
2225 *
2226 * alpha_flag (input) int
2227 * = 0 : alpha is free, and is output.
2228 * = 1 : alpha is fixed on input.
2229 *
2230 * beta (input) void*
2231 * If beta_flag = 1, beta is input.
2232 * If beta_flag = 0, beta is output.
2233 *
2234 * beta_flag (input) int
2235 * = 0 : beta is free, and is output.
2236 * = 1 : beta is fixed on input.
2237 *
2238 * x (input/output) void*
2239 *
2240 * y (input/output) void*
2241 *
2242 * seed (input/output) int*
2243 * The seed for the random number generator.
2244 *
2245 * r (output) void*
2246 * The generated scalar r that will be used as an input to DOT.
2247 *
2248 * r_true_l (output) double*
2249 * The leading part of the truth in double-double.
2250 *
2251 * r_true_t (output) double*
2252 * The trailing part of the truth in double-double.
2253 *
2254 */
2255 {
2256 int i, inc = 1;
2257 double *alpha_i = (double *) alpha;
2258 double *beta_i = (double *) beta;
2259 double *r_i = (double *) r;
2260 double *x_i = (double *) x;
2261 float *y_i = (float *) y;
2262 float alpha_tmp[2];
2263 float beta_tmp[2];
2264 float r_tmp[2];
2265 float *x_vec;
2266 float *y_vec;
2267
2268 alpha_tmp[0] = alpha_i[0];
2269 alpha_tmp[1] = alpha_i[1];
2270 beta_tmp[0] = beta_i[0];
2271 beta_tmp[1] = beta_i[1];
2272 inc *= 2;
2273 x_vec = (float *) blas_malloc(2 * n * sizeof(float) * 2);
2274 if (2 * n > 0 && x_vec == NULL) {
2275 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2276 }
2277 y_vec = x_vec + inc * n;
2278 for (i = 0; i < inc * n_fix2; i += inc) {
2279 x_vec[i] = x_i[i];
2280 x_vec[i + 1] = x_i[i + 1];
2281 y_vec[i] = y_i[i];
2282 y_vec[i + 1] = y_i[i + 1];
2283 }
2284 for (; i < inc * (n_fix2 + n_mix); i += inc) {
2285 x_vec[i] = x_i[i];
2286 x_vec[i + 1] = x_i[i + 1];
2287 }
2288
2289 /* Call generator now. */
2290 testgen_BLAS_cdot(n, n_fix2, n_mix, norm, conj,
2291 alpha_tmp, alpha_flag,
2292 beta_tmp, beta_flag,
2293 x_vec, y_vec, seed, r_tmp, r_true_l, r_true_t);
2294
2295 alpha_i[0] = alpha_tmp[0];
2296 alpha_i[1] = alpha_tmp[1];
2297 beta_i[0] = beta_tmp[0];
2298 beta_i[1] = beta_tmp[1];
2299 r_i[0] = r_tmp[0];
2300 r_i[1] = r_tmp[1];
2301 for (i = 0; i < inc * n; i += inc) {
2302 x_i[i] = x_vec[i];
2303 x_i[i + 1] = x_vec[i + 1];
2304 y_i[i] = y_vec[i];
2305 y_i[i + 1] = y_vec[i + 1];
2306 }
2307
2308 blas_free(x_vec); /* also y_i */
2309 } /* end BLAS_zdot_z_c_testgen */
2310