1 #include <stdlib.h>
2 #include <stdio.h>
3 #include <math.h>
4 #include "blas_extended.h"
5 #include "blas_extended_private.h"
6 #include "blas_extended_test.h"
7
8 /* 0 -- 1 */
9 #define UPLO_START 0
10 #define UPLO_END 1
11
12 /* 0 -- 1 */
13 #define ORDER_START 0
14 #define ORDER_END 1
15
16 /* 0 -- 2 */
17 #define ALPHA_START 0
18 #define ALPHA_END 2
19
20 /* 0 -- 2 */
21 #define BETA_START 0
22 #define BETA_END 2
23
24 /* -1 -- 1 */
25 #define NORM_START -1
26 #define NORM_END 1
27
28 /* 0 -- 2 */
29 #define PREC_START 0
30 #define PREC_END 2
31
32 /* 0 -- 1 */
33 #define RANDOMIZE_START 0
34 #define RANDOMIZE_END 1
35
36 /* -2 -- 2 (Stride) */
37 #define INCX_START -2
38 #define INCX_END 2
39
40 /* -2 -- 2 (Stride) */
41 #define INCY_START -2
42 #define INCY_END 2
43
44 #define NUM_DATA 7
45
46
47
48
49
50
51
52
53
54
do_test_zhpmv_z_c(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)55 void do_test_zhpmv_z_c
56 (int n,
57 int ntests, int *seed, double thresh, int debug, float test_prob,
58 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
59
60 /* Function name */
61 const char fname[] = "BLAS_zhpmv_z_c";
62
63 int i;
64 int yi;
65 int incyi, y_starti;
66 int test_count;
67 int bad_ratio_count;
68
69 int ri;
70 int incri;
71 int inca, incx, incy;
72
73 double ratio;
74
75 double ratio_min, ratio_max;
76
77 double eps_int; /* internal machine epsilon */
78 double un_int; /* internal underflow threshold */
79
80 double rin[2];
81 double rout[2];
82 double head_r_true_elem[2], tail_r_true_elem[2];
83
84 enum blas_order_type order_type;
85 enum blas_uplo_type uplo_type;
86 enum blas_prec_type prec;
87
88 int order_val, uplo_val;
89 int incx_val, incy_val;
90 int alpha_val, beta_val;
91 int randomize_val;
92
93
94
95 int alpha_flag, beta_flag;
96 int saved_seed;
97 int norm;
98 int test_no;
99
100 int n_i;
101
102 double alpha[2];
103 double beta[2];
104 double *a;
105 float *x;
106 double *y;
107 double *a_vec;
108 float *x_vec;
109
110 /* generated test values for c */
111 double *y_gen;
112
113 double *ratios;
114
115 /* true result calculated by testgen, in double-double */
116 double *head_r_true, *tail_r_true;
117
118
119 FPU_FIX_DECL;
120
121 if (n < 0 || ntests < 0)
122 BLAS_error(fname, 0, 0, NULL);
123
124 /* initialization */
125 saved_seed = *seed;
126 ratio = 0.0;
127 ratio_min = 1e308;
128 ratio_max = 0.0;
129
130 *num_tests = 0;
131 *num_bad_ratio = 0;
132 *min_ratio = 0.0;
133 *max_ratio = 0.0;
134
135 if (n == 0)
136 return;
137
138 FPU_FIX_START;
139
140 n_i = n;
141
142 inca = incx = incy = 1;
143 inca *= 2;
144 incx *= 2;
145 incy *= 2;
146
147 /* allocate memory for arrays */
148 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
149 if (3 * n_i > 0 && y == NULL) {
150 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
151 }
152 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
153 if (3 * n_i > 0 && y_gen == NULL) {
154 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
155 }
156 a = (double *) blas_malloc(2 * n_i * n_i * sizeof(double) * 2);
157 if (2 * n_i * n_i > 0 && a == NULL) {
158 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
159 }
160 x = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
161 if (3 * n_i > 0 && x == NULL) {
162 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
163 }
164 a_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
165 if (n_i > 0 && a_vec == NULL) {
166 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
167 }
168 x_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
169 if (n_i > 0 && x_vec == NULL) {
170 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
171 }
172 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
173 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
174 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
175 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
176 }
177 ratios = (double *) blas_malloc(2 * n * sizeof(double));
178 if (2 * n > 0 && ratios == NULL) {
179 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
180 }
181
182 test_count = 0;
183 bad_ratio_count = 0;
184
185 /* vary alpha */
186 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
187
188 alpha_flag = 0;
189 switch (alpha_val) {
190 case 0:
191 alpha[0] = alpha[1] = 0.0;
192 alpha_flag = 1;
193 break;
194 case 1:
195 alpha[0] = 1.0;
196 alpha[1] = 0.0;
197 alpha_flag = 1;
198 break;
199 }
200
201 /* vary beta */
202 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
203 beta_flag = 0;
204 switch (beta_val) {
205 case 0:
206 beta[0] = beta[1] = 0.0;
207 beta_flag = 1;
208 break;
209 case 1:
210 beta[0] = 1.0;
211 beta[1] = 0.0;
212 beta_flag = 1;
213 break;
214 }
215
216
217 eps_int = power(2, -BITS_D);
218 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
219 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
220 prec = blas_prec_double;
221
222 /* vary norm -- underflow, approx 1, overflow */
223 for (norm = NORM_START; norm <= NORM_END; norm++) {
224
225 /* number of tests */
226 for (test_no = 0; test_no < ntests; test_no++) {
227
228
229 /* vary storage format */
230 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
231
232 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
233
234 /* vary upper / lower variation */
235 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
236
237 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
238
239 /* vary incx = 1, 2 */
240 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
241
242 incx = incx_val;
243 if (0 == incx)
244 continue;
245
246 /* vary incy = 1, 2 */
247 for (incy_val = INCY_START; incy_val <= INCY_END; incy_val++) {
248
249 incy = incy_val;
250 if (0 == incy)
251 continue;
252
253 for (randomize_val = RANDOMIZE_START;
254 randomize_val <= RANDOMIZE_END; randomize_val++) {
255
256 /* For the sake of speed, we throw out this case at random */
257 if (xrand(seed) >= test_prob)
258 continue;
259
260 saved_seed = *seed;
261
262 /* finally we are here to generate the test case */
263 BLAS_zhpmv_z_c_testgen(norm, order_type,
264 uplo_type, n, randomize_val,
265 &alpha, alpha_flag, &beta,
266 beta_flag, a, x, incx, y, incy,
267 seed, head_r_true, tail_r_true);
268 test_count++;
269
270 /* copy generated y vector since this will be
271 over written */
272 zcopy_vector(y, n, incy, y_gen, incy);
273
274 /* call hpmv routines to be tested */
275 FPU_FIX_STOP;
276 BLAS_zhpmv_z_c(order_type,
277 uplo_type, n, alpha, a, x, incx, beta,
278 y, incy);
279 FPU_FIX_START;
280
281 /* now compute the ratio using test_BLAS_xdot */
282 /* copy a row from A, use x, run
283 dot test */
284
285 incyi = incy;
286
287 incri = 1;
288
289 incyi *= 2;
290 incri *= 2;
291 if (incy < 0) {
292 y_starti = (-n + 1) * incyi;
293 } else {
294 y_starti = 0;
295 }
296
297 for (i = 0, yi = y_starti, ri = 0;
298 i < n_i; i++, yi += incyi, ri += incri) {
299 zhpmv_copy_row(order_type, uplo_type, n_i, a, a_vec, i);
300
301 /* just use the x vector -
302 it was unchanged (in theory) */
303
304
305 rin[0] = y_gen[yi];
306 rin[1] = y_gen[yi + 1];
307 rout[0] = y[yi];
308 rout[1] = y[yi + 1];
309 head_r_true_elem[0] = head_r_true[ri];
310 head_r_true_elem[1] = head_r_true[ri + 1];
311 tail_r_true_elem[0] = tail_r_true[ri];
312 tail_r_true_elem[1] = tail_r_true[ri + 1];
313
314 test_BLAS_zdot_z_c(n_i,
315 blas_no_conj,
316 alpha, beta, rin, rout,
317 head_r_true_elem, tail_r_true_elem,
318 a_vec, 1, x, incx, eps_int, un_int,
319 &ratios[ri]);
320
321 /* take the max ratio */
322 if (ri == 0) {
323 ratio = ratios[0];
324 } else if (ratios[ri] > ratio) {
325 ratio = ratios[ri];
326 }
327
328 } /* end of dot-test loop */
329
330 if (ratio > thresh) {
331
332 if (debug == 3) {
333 printf("\n\t\tTest # %d\n", test_count);
334 printf("y type : z, a type : z, x type : c\n");
335 printf("Seed = %d\n", saved_seed);
336 printf("n %d\n", n);
337 printf("INCX %d INCY %d\n", incx, incx);
338
339 if (order_type == blas_rowmajor)
340 printf("row ");
341 else
342 printf("col ");
343
344 if (uplo_type == blas_upper)
345 printf("upper ");
346 else
347 printf("lower");
348
349 printf("NORM %d, ALPHA %d, BETA %d\n",
350 norm, alpha_val, beta_val);
351 printf("E %d\n", prec);
352
353 /* print out info */
354 printf("alpha = ");
355 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
356 printf(" ");
357 printf("beta = ");
358 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
359 printf("\n");
360
361 printf("a\n");
362 zprint_hpmv_matrix(a, n_i, order_type, uplo_type);
363 cprint_vector(x, n, incx, "x");
364 zprint_vector(y_gen, n, incy, "y_gen");
365 zprint_vector(y, n, incy, "y");
366 dprint_vector(head_r_true, n, 1, "head_r_true");
367 dprint_vector(ratios, n, 1, "ratios");
368 printf("ratio = %g\n", ratio);
369 }
370 bad_ratio_count++;
371 }
372
373 if (ratio > ratio_max)
374 ratio_max = ratio;
375
376 if (ratio != 0.0 && ratio < ratio_min)
377 ratio_min = ratio;
378
379 } /* end of randmize loop */
380
381 } /* end of incy loop */
382
383 } /* end of incx loop */
384
385 } /* end of uplo loop */
386
387 } /* end of order loop */
388
389 } /* end of nr test loop */
390
391 } /* end of norm loop */
392
393
394
395 } /* end of beta loop */
396
397 } /* end of alpha loop */
398
399 FPU_FIX_STOP;
400
401 blas_free(y);
402 blas_free(a);
403 blas_free(x);
404 blas_free(y_gen);
405 blas_free(head_r_true);
406 blas_free(tail_r_true);
407 blas_free(ratios);
408 blas_free(a_vec);
409 blas_free(x_vec);
410
411 *max_ratio = ratio_max;
412 *min_ratio = ratio_min;
413 *num_tests = test_count;
414 *num_bad_ratio = bad_ratio_count;
415
416 }
do_test_zhpmv_c_z(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)417 void do_test_zhpmv_c_z
418 (int n,
419 int ntests, int *seed, double thresh, int debug, float test_prob,
420 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
421
422 /* Function name */
423 const char fname[] = "BLAS_zhpmv_c_z";
424
425 int i;
426 int yi;
427 int incyi, y_starti;
428 int test_count;
429 int bad_ratio_count;
430
431 int ri;
432 int incri;
433 int inca, incx, incy;
434
435 double ratio;
436
437 double ratio_min, ratio_max;
438
439 double eps_int; /* internal machine epsilon */
440 double un_int; /* internal underflow threshold */
441
442 double rin[2];
443 double rout[2];
444 double head_r_true_elem[2], tail_r_true_elem[2];
445
446 enum blas_order_type order_type;
447 enum blas_uplo_type uplo_type;
448 enum blas_prec_type prec;
449
450 int order_val, uplo_val;
451 int incx_val, incy_val;
452 int alpha_val, beta_val;
453 int randomize_val;
454
455
456
457 int alpha_flag, beta_flag;
458 int saved_seed;
459 int norm;
460 int test_no;
461
462 int n_i;
463
464 double alpha[2];
465 double beta[2];
466 float *a;
467 double *x;
468 double *y;
469 float *a_vec;
470 double *x_vec;
471
472 /* generated test values for c */
473 double *y_gen;
474
475 double *ratios;
476
477 /* true result calculated by testgen, in double-double */
478 double *head_r_true, *tail_r_true;
479
480
481 FPU_FIX_DECL;
482
483 if (n < 0 || ntests < 0)
484 BLAS_error(fname, 0, 0, NULL);
485
486 /* initialization */
487 saved_seed = *seed;
488 ratio = 0.0;
489 ratio_min = 1e308;
490 ratio_max = 0.0;
491
492 *num_tests = 0;
493 *num_bad_ratio = 0;
494 *min_ratio = 0.0;
495 *max_ratio = 0.0;
496
497 if (n == 0)
498 return;
499
500 FPU_FIX_START;
501
502 n_i = n;
503
504 inca = incx = incy = 1;
505 inca *= 2;
506 incx *= 2;
507 incy *= 2;
508
509 /* allocate memory for arrays */
510 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
511 if (3 * n_i > 0 && y == NULL) {
512 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
513 }
514 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
515 if (3 * n_i > 0 && y_gen == NULL) {
516 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
517 }
518 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
519 if (2 * n_i * n_i > 0 && a == NULL) {
520 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
521 }
522 x = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
523 if (3 * n_i > 0 && x == NULL) {
524 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
525 }
526 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
527 if (n_i > 0 && a_vec == NULL) {
528 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
529 }
530 x_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
531 if (n_i > 0 && x_vec == NULL) {
532 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
533 }
534 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
535 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
536 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
537 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
538 }
539 ratios = (double *) blas_malloc(2 * n * sizeof(double));
540 if (2 * n > 0 && ratios == NULL) {
541 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
542 }
543
544 test_count = 0;
545 bad_ratio_count = 0;
546
547 /* vary alpha */
548 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
549
550 alpha_flag = 0;
551 switch (alpha_val) {
552 case 0:
553 alpha[0] = alpha[1] = 0.0;
554 alpha_flag = 1;
555 break;
556 case 1:
557 alpha[0] = 1.0;
558 alpha[1] = 0.0;
559 alpha_flag = 1;
560 break;
561 }
562
563 /* vary beta */
564 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
565 beta_flag = 0;
566 switch (beta_val) {
567 case 0:
568 beta[0] = beta[1] = 0.0;
569 beta_flag = 1;
570 break;
571 case 1:
572 beta[0] = 1.0;
573 beta[1] = 0.0;
574 beta_flag = 1;
575 break;
576 }
577
578
579 eps_int = power(2, -BITS_D);
580 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
581 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
582 prec = blas_prec_double;
583
584 /* vary norm -- underflow, approx 1, overflow */
585 for (norm = NORM_START; norm <= NORM_END; norm++) {
586
587 /* number of tests */
588 for (test_no = 0; test_no < ntests; test_no++) {
589
590
591 /* vary storage format */
592 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
593
594 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
595
596 /* vary upper / lower variation */
597 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
598
599 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
600
601 /* vary incx = 1, 2 */
602 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
603
604 incx = incx_val;
605 if (0 == incx)
606 continue;
607
608 /* vary incy = 1, 2 */
609 for (incy_val = INCY_START; incy_val <= INCY_END; incy_val++) {
610
611 incy = incy_val;
612 if (0 == incy)
613 continue;
614
615 for (randomize_val = RANDOMIZE_START;
616 randomize_val <= RANDOMIZE_END; randomize_val++) {
617
618 /* For the sake of speed, we throw out this case at random */
619 if (xrand(seed) >= test_prob)
620 continue;
621
622 saved_seed = *seed;
623
624 /* finally we are here to generate the test case */
625 BLAS_zhpmv_c_z_testgen(norm, order_type,
626 uplo_type, n, randomize_val,
627 &alpha, alpha_flag, &beta,
628 beta_flag, a, x, incx, y, incy,
629 seed, head_r_true, tail_r_true);
630 test_count++;
631
632 /* copy generated y vector since this will be
633 over written */
634 zcopy_vector(y, n, incy, y_gen, incy);
635
636 /* call hpmv routines to be tested */
637 FPU_FIX_STOP;
638 BLAS_zhpmv_c_z(order_type,
639 uplo_type, n, alpha, a, x, incx, beta,
640 y, incy);
641 FPU_FIX_START;
642
643 /* now compute the ratio using test_BLAS_xdot */
644 /* copy a row from A, use x, run
645 dot test */
646
647 incyi = incy;
648
649 incri = 1;
650
651 incyi *= 2;
652 incri *= 2;
653 if (incy < 0) {
654 y_starti = (-n + 1) * incyi;
655 } else {
656 y_starti = 0;
657 }
658
659 for (i = 0, yi = y_starti, ri = 0;
660 i < n_i; i++, yi += incyi, ri += incri) {
661 chpmv_copy_row(order_type, uplo_type, n_i, a, a_vec, i);
662
663 /* just use the x vector -
664 it was unchanged (in theory) */
665
666
667 rin[0] = y_gen[yi];
668 rin[1] = y_gen[yi + 1];
669 rout[0] = y[yi];
670 rout[1] = y[yi + 1];
671 head_r_true_elem[0] = head_r_true[ri];
672 head_r_true_elem[1] = head_r_true[ri + 1];
673 tail_r_true_elem[0] = tail_r_true[ri];
674 tail_r_true_elem[1] = tail_r_true[ri + 1];
675
676 test_BLAS_zdot_c_z(n_i,
677 blas_no_conj,
678 alpha, beta, rin, rout,
679 head_r_true_elem, tail_r_true_elem,
680 a_vec, 1, x, incx, eps_int, un_int,
681 &ratios[ri]);
682
683 /* take the max ratio */
684 if (ri == 0) {
685 ratio = ratios[0];
686 } else if (ratios[ri] > ratio) {
687 ratio = ratios[ri];
688 }
689
690 } /* end of dot-test loop */
691
692 if (ratio > thresh) {
693
694 if (debug == 3) {
695 printf("\n\t\tTest # %d\n", test_count);
696 printf("y type : z, a type : c, x type : z\n");
697 printf("Seed = %d\n", saved_seed);
698 printf("n %d\n", n);
699 printf("INCX %d INCY %d\n", incx, incx);
700
701 if (order_type == blas_rowmajor)
702 printf("row ");
703 else
704 printf("col ");
705
706 if (uplo_type == blas_upper)
707 printf("upper ");
708 else
709 printf("lower");
710
711 printf("NORM %d, ALPHA %d, BETA %d\n",
712 norm, alpha_val, beta_val);
713 printf("E %d\n", prec);
714
715 /* print out info */
716 printf("alpha = ");
717 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
718 printf(" ");
719 printf("beta = ");
720 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
721 printf("\n");
722
723 printf("a\n");
724 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
725 zprint_vector(x, n, incx, "x");
726 zprint_vector(y_gen, n, incy, "y_gen");
727 zprint_vector(y, n, incy, "y");
728 dprint_vector(head_r_true, n, 1, "head_r_true");
729 dprint_vector(ratios, n, 1, "ratios");
730 printf("ratio = %g\n", ratio);
731 }
732 bad_ratio_count++;
733 }
734
735 if (ratio > ratio_max)
736 ratio_max = ratio;
737
738 if (ratio != 0.0 && ratio < ratio_min)
739 ratio_min = ratio;
740
741 } /* end of randmize loop */
742
743 } /* end of incy loop */
744
745 } /* end of incx loop */
746
747 } /* end of uplo loop */
748
749 } /* end of order loop */
750
751 } /* end of nr test loop */
752
753 } /* end of norm loop */
754
755
756
757 } /* end of beta loop */
758
759 } /* end of alpha loop */
760
761 FPU_FIX_STOP;
762
763 blas_free(y);
764 blas_free(a);
765 blas_free(x);
766 blas_free(y_gen);
767 blas_free(head_r_true);
768 blas_free(tail_r_true);
769 blas_free(ratios);
770 blas_free(a_vec);
771 blas_free(x_vec);
772
773 *max_ratio = ratio_max;
774 *min_ratio = ratio_min;
775 *num_tests = test_count;
776 *num_bad_ratio = bad_ratio_count;
777
778 }
do_test_zhpmv_c_c(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)779 void do_test_zhpmv_c_c
780 (int n,
781 int ntests, int *seed, double thresh, int debug, float test_prob,
782 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
783
784 /* Function name */
785 const char fname[] = "BLAS_zhpmv_c_c";
786
787 int i;
788 int yi;
789 int incyi, y_starti;
790 int test_count;
791 int bad_ratio_count;
792
793 int ri;
794 int incri;
795 int inca, incx, incy;
796
797 double ratio;
798
799 double ratio_min, ratio_max;
800
801 double eps_int; /* internal machine epsilon */
802 double un_int; /* internal underflow threshold */
803
804 double rin[2];
805 double rout[2];
806 double head_r_true_elem[2], tail_r_true_elem[2];
807
808 enum blas_order_type order_type;
809 enum blas_uplo_type uplo_type;
810 enum blas_prec_type prec;
811
812 int order_val, uplo_val;
813 int incx_val, incy_val;
814 int alpha_val, beta_val;
815 int randomize_val;
816
817
818
819 int alpha_flag, beta_flag;
820 int saved_seed;
821 int norm;
822 int test_no;
823
824 int n_i;
825
826 double alpha[2];
827 double beta[2];
828 float *a;
829 float *x;
830 double *y;
831 float *a_vec;
832 float *x_vec;
833
834 /* generated test values for c */
835 double *y_gen;
836
837 double *ratios;
838
839 /* true result calculated by testgen, in double-double */
840 double *head_r_true, *tail_r_true;
841
842
843 FPU_FIX_DECL;
844
845 if (n < 0 || ntests < 0)
846 BLAS_error(fname, 0, 0, NULL);
847
848 /* initialization */
849 saved_seed = *seed;
850 ratio = 0.0;
851 ratio_min = 1e308;
852 ratio_max = 0.0;
853
854 *num_tests = 0;
855 *num_bad_ratio = 0;
856 *min_ratio = 0.0;
857 *max_ratio = 0.0;
858
859 if (n == 0)
860 return;
861
862 FPU_FIX_START;
863
864 n_i = n;
865
866 inca = incx = incy = 1;
867 inca *= 2;
868 incx *= 2;
869 incy *= 2;
870
871 /* allocate memory for arrays */
872 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
873 if (3 * n_i > 0 && y == NULL) {
874 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
875 }
876 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
877 if (3 * n_i > 0 && y_gen == NULL) {
878 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
879 }
880 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
881 if (2 * n_i * n_i > 0 && a == NULL) {
882 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
883 }
884 x = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
885 if (3 * n_i > 0 && x == NULL) {
886 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
887 }
888 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
889 if (n_i > 0 && a_vec == NULL) {
890 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
891 }
892 x_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
893 if (n_i > 0 && x_vec == NULL) {
894 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
895 }
896 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
897 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
898 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
899 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
900 }
901 ratios = (double *) blas_malloc(2 * n * sizeof(double));
902 if (2 * n > 0 && ratios == NULL) {
903 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
904 }
905
906 test_count = 0;
907 bad_ratio_count = 0;
908
909 /* vary alpha */
910 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
911
912 alpha_flag = 0;
913 switch (alpha_val) {
914 case 0:
915 alpha[0] = alpha[1] = 0.0;
916 alpha_flag = 1;
917 break;
918 case 1:
919 alpha[0] = 1.0;
920 alpha[1] = 0.0;
921 alpha_flag = 1;
922 break;
923 }
924
925 /* vary beta */
926 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
927 beta_flag = 0;
928 switch (beta_val) {
929 case 0:
930 beta[0] = beta[1] = 0.0;
931 beta_flag = 1;
932 break;
933 case 1:
934 beta[0] = 1.0;
935 beta[1] = 0.0;
936 beta_flag = 1;
937 break;
938 }
939
940
941 eps_int = power(2, -BITS_D);
942 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
943 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
944 prec = blas_prec_double;
945
946 /* vary norm -- underflow, approx 1, overflow */
947 for (norm = NORM_START; norm <= NORM_END; norm++) {
948
949 /* number of tests */
950 for (test_no = 0; test_no < ntests; test_no++) {
951
952
953 /* vary storage format */
954 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
955
956 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
957
958 /* vary upper / lower variation */
959 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
960
961 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
962
963 /* vary incx = 1, 2 */
964 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
965
966 incx = incx_val;
967 if (0 == incx)
968 continue;
969
970 /* vary incy = 1, 2 */
971 for (incy_val = INCY_START; incy_val <= INCY_END; incy_val++) {
972
973 incy = incy_val;
974 if (0 == incy)
975 continue;
976
977 for (randomize_val = RANDOMIZE_START;
978 randomize_val <= RANDOMIZE_END; randomize_val++) {
979
980 /* For the sake of speed, we throw out this case at random */
981 if (xrand(seed) >= test_prob)
982 continue;
983
984 saved_seed = *seed;
985
986 /* finally we are here to generate the test case */
987 BLAS_zhpmv_c_c_testgen(norm, order_type,
988 uplo_type, n, randomize_val,
989 &alpha, alpha_flag, &beta,
990 beta_flag, a, x, incx, y, incy,
991 seed, head_r_true, tail_r_true);
992 test_count++;
993
994 /* copy generated y vector since this will be
995 over written */
996 zcopy_vector(y, n, incy, y_gen, incy);
997
998 /* call hpmv routines to be tested */
999 FPU_FIX_STOP;
1000 BLAS_zhpmv_c_c(order_type,
1001 uplo_type, n, alpha, a, x, incx, beta,
1002 y, incy);
1003 FPU_FIX_START;
1004
1005 /* now compute the ratio using test_BLAS_xdot */
1006 /* copy a row from A, use x, run
1007 dot test */
1008
1009 incyi = incy;
1010
1011 incri = 1;
1012
1013 incyi *= 2;
1014 incri *= 2;
1015 if (incy < 0) {
1016 y_starti = (-n + 1) * incyi;
1017 } else {
1018 y_starti = 0;
1019 }
1020
1021 for (i = 0, yi = y_starti, ri = 0;
1022 i < n_i; i++, yi += incyi, ri += incri) {
1023 chpmv_copy_row(order_type, uplo_type, n_i, a, a_vec, i);
1024
1025 /* just use the x vector -
1026 it was unchanged (in theory) */
1027
1028
1029 rin[0] = y_gen[yi];
1030 rin[1] = y_gen[yi + 1];
1031 rout[0] = y[yi];
1032 rout[1] = y[yi + 1];
1033 head_r_true_elem[0] = head_r_true[ri];
1034 head_r_true_elem[1] = head_r_true[ri + 1];
1035 tail_r_true_elem[0] = tail_r_true[ri];
1036 tail_r_true_elem[1] = tail_r_true[ri + 1];
1037
1038 test_BLAS_zdot_c_c(n_i,
1039 blas_no_conj,
1040 alpha, beta, rin, rout,
1041 head_r_true_elem, tail_r_true_elem,
1042 a_vec, 1, x, incx, eps_int, un_int,
1043 &ratios[ri]);
1044
1045 /* take the max ratio */
1046 if (ri == 0) {
1047 ratio = ratios[0];
1048 } else if (ratios[ri] > ratio) {
1049 ratio = ratios[ri];
1050 }
1051
1052 } /* end of dot-test loop */
1053
1054 if (ratio > thresh) {
1055
1056 if (debug == 3) {
1057 printf("\n\t\tTest # %d\n", test_count);
1058 printf("y type : z, a type : c, x type : c\n");
1059 printf("Seed = %d\n", saved_seed);
1060 printf("n %d\n", n);
1061 printf("INCX %d INCY %d\n", incx, incx);
1062
1063 if (order_type == blas_rowmajor)
1064 printf("row ");
1065 else
1066 printf("col ");
1067
1068 if (uplo_type == blas_upper)
1069 printf("upper ");
1070 else
1071 printf("lower");
1072
1073 printf("NORM %d, ALPHA %d, BETA %d\n",
1074 norm, alpha_val, beta_val);
1075 printf("E %d\n", prec);
1076
1077 /* print out info */
1078 printf("alpha = ");
1079 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
1080 printf(" ");
1081 printf("beta = ");
1082 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
1083 printf("\n");
1084
1085 printf("a\n");
1086 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
1087 cprint_vector(x, n, incx, "x");
1088 zprint_vector(y_gen, n, incy, "y_gen");
1089 zprint_vector(y, n, incy, "y");
1090 dprint_vector(head_r_true, n, 1, "head_r_true");
1091 dprint_vector(ratios, n, 1, "ratios");
1092 printf("ratio = %g\n", ratio);
1093 }
1094 bad_ratio_count++;
1095 }
1096
1097 if (ratio > ratio_max)
1098 ratio_max = ratio;
1099
1100 if (ratio != 0.0 && ratio < ratio_min)
1101 ratio_min = ratio;
1102
1103 } /* end of randmize loop */
1104
1105 } /* end of incy loop */
1106
1107 } /* end of incx loop */
1108
1109 } /* end of uplo loop */
1110
1111 } /* end of order loop */
1112
1113 } /* end of nr test loop */
1114
1115 } /* end of norm loop */
1116
1117
1118
1119 } /* end of beta loop */
1120
1121 } /* end of alpha loop */
1122
1123 FPU_FIX_STOP;
1124
1125 blas_free(y);
1126 blas_free(a);
1127 blas_free(x);
1128 blas_free(y_gen);
1129 blas_free(head_r_true);
1130 blas_free(tail_r_true);
1131 blas_free(ratios);
1132 blas_free(a_vec);
1133 blas_free(x_vec);
1134
1135 *max_ratio = ratio_max;
1136 *min_ratio = ratio_min;
1137 *num_tests = test_count;
1138 *num_bad_ratio = bad_ratio_count;
1139
1140 }
do_test_chpmv_c_s(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)1141 void do_test_chpmv_c_s
1142 (int n,
1143 int ntests, int *seed, double thresh, int debug, float test_prob,
1144 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
1145
1146 /* Function name */
1147 const char fname[] = "BLAS_chpmv_c_s";
1148
1149 int i;
1150 int yi;
1151 int incyi, y_starti;
1152 int test_count;
1153 int bad_ratio_count;
1154
1155 int ri;
1156 int incri;
1157 int inca, incx, incy;
1158
1159 double ratio;
1160
1161 double ratio_min, ratio_max;
1162
1163 double eps_int; /* internal machine epsilon */
1164 double un_int; /* internal underflow threshold */
1165
1166 float rin[2];
1167 float rout[2];
1168 double head_r_true_elem[2], tail_r_true_elem[2];
1169
1170 enum blas_order_type order_type;
1171 enum blas_uplo_type uplo_type;
1172 enum blas_prec_type prec;
1173
1174 int order_val, uplo_val;
1175 int incx_val, incy_val;
1176 int alpha_val, beta_val;
1177 int randomize_val;
1178
1179
1180
1181 int alpha_flag, beta_flag;
1182 int saved_seed;
1183 int norm;
1184 int test_no;
1185
1186 int n_i;
1187
1188 float alpha[2];
1189 float beta[2];
1190 float *a;
1191 float *x;
1192 float *y;
1193 float *a_vec;
1194 float *x_vec;
1195
1196 /* generated test values for c */
1197 float *y_gen;
1198
1199 double *ratios;
1200
1201 /* true result calculated by testgen, in double-double */
1202 double *head_r_true, *tail_r_true;
1203
1204
1205 FPU_FIX_DECL;
1206
1207 if (n < 0 || ntests < 0)
1208 BLAS_error(fname, 0, 0, NULL);
1209
1210 /* initialization */
1211 saved_seed = *seed;
1212 ratio = 0.0;
1213 ratio_min = 1e308;
1214 ratio_max = 0.0;
1215
1216 *num_tests = 0;
1217 *num_bad_ratio = 0;
1218 *min_ratio = 0.0;
1219 *max_ratio = 0.0;
1220
1221 if (n == 0)
1222 return;
1223
1224 FPU_FIX_START;
1225
1226 n_i = n;
1227
1228 inca = incx = incy = 1;
1229 inca *= 2;
1230
1231 incy *= 2;
1232
1233 /* allocate memory for arrays */
1234 y = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
1235 if (3 * n_i > 0 && y == NULL) {
1236 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1237 }
1238 y_gen = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
1239 if (3 * n_i > 0 && y_gen == NULL) {
1240 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1241 }
1242 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
1243 if (2 * n_i * n_i > 0 && a == NULL) {
1244 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1245 }
1246 x = (float *) blas_malloc(3 * n_i * sizeof(float));
1247 if (3 * n_i > 0 && x == NULL) {
1248 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1249 }
1250 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
1251 if (n_i > 0 && a_vec == NULL) {
1252 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1253 }
1254 x_vec = (float *) blas_malloc(n_i * sizeof(float));
1255 if (n_i > 0 && x_vec == NULL) {
1256 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1257 }
1258 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1259 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1260 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
1261 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1262 }
1263 ratios = (double *) blas_malloc(2 * n * sizeof(double));
1264 if (2 * n > 0 && ratios == NULL) {
1265 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1266 }
1267
1268 test_count = 0;
1269 bad_ratio_count = 0;
1270
1271 /* vary alpha */
1272 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
1273
1274 alpha_flag = 0;
1275 switch (alpha_val) {
1276 case 0:
1277 alpha[0] = alpha[1] = 0.0;
1278 alpha_flag = 1;
1279 break;
1280 case 1:
1281 alpha[0] = 1.0;
1282 alpha[1] = 0.0;
1283 alpha_flag = 1;
1284 break;
1285 }
1286
1287 /* vary beta */
1288 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
1289 beta_flag = 0;
1290 switch (beta_val) {
1291 case 0:
1292 beta[0] = beta[1] = 0.0;
1293 beta_flag = 1;
1294 break;
1295 case 1:
1296 beta[0] = 1.0;
1297 beta[1] = 0.0;
1298 beta_flag = 1;
1299 break;
1300 }
1301
1302
1303 eps_int = power(2, -BITS_S);
1304 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
1305 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
1306 prec = blas_prec_single;
1307
1308 /* vary norm -- underflow, approx 1, overflow */
1309 for (norm = NORM_START; norm <= NORM_END; norm++) {
1310
1311 /* number of tests */
1312 for (test_no = 0; test_no < ntests; test_no++) {
1313
1314
1315 /* vary storage format */
1316 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
1317
1318 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
1319
1320 /* vary upper / lower variation */
1321 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
1322
1323 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
1324
1325 /* vary incx = 1, 2 */
1326 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
1327
1328 incx = incx_val;
1329 if (0 == incx)
1330 continue;
1331
1332 /* vary incy = 1, 2 */
1333 for (incy_val = INCY_START; incy_val <= INCY_END; incy_val++) {
1334
1335 incy = incy_val;
1336 if (0 == incy)
1337 continue;
1338
1339 for (randomize_val = RANDOMIZE_START;
1340 randomize_val <= RANDOMIZE_END; randomize_val++) {
1341
1342 /* For the sake of speed, we throw out this case at random */
1343 if (xrand(seed) >= test_prob)
1344 continue;
1345
1346 saved_seed = *seed;
1347
1348 /* finally we are here to generate the test case */
1349 BLAS_chpmv_c_s_testgen(norm, order_type,
1350 uplo_type, n, randomize_val,
1351 &alpha, alpha_flag, &beta,
1352 beta_flag, a, x, incx, y, incy,
1353 seed, head_r_true, tail_r_true);
1354 test_count++;
1355
1356 /* copy generated y vector since this will be
1357 over written */
1358 ccopy_vector(y, n, incy, y_gen, incy);
1359
1360 /* call hpmv routines to be tested */
1361 FPU_FIX_STOP;
1362 BLAS_chpmv_c_s(order_type,
1363 uplo_type, n, alpha, a, x, incx, beta,
1364 y, incy);
1365 FPU_FIX_START;
1366
1367 /* now compute the ratio using test_BLAS_xdot */
1368 /* copy a row from A, use x, run
1369 dot test */
1370
1371 incyi = incy;
1372
1373 incri = 1;
1374
1375 incyi *= 2;
1376 incri *= 2;
1377 if (incy < 0) {
1378 y_starti = (-n + 1) * incyi;
1379 } else {
1380 y_starti = 0;
1381 }
1382
1383 for (i = 0, yi = y_starti, ri = 0;
1384 i < n_i; i++, yi += incyi, ri += incri) {
1385 chpmv_copy_row(order_type, uplo_type, n_i, a, a_vec, i);
1386
1387 /* just use the x vector -
1388 it was unchanged (in theory) */
1389
1390
1391 rin[0] = y_gen[yi];
1392 rin[1] = y_gen[yi + 1];
1393 rout[0] = y[yi];
1394 rout[1] = y[yi + 1];
1395 head_r_true_elem[0] = head_r_true[ri];
1396 head_r_true_elem[1] = head_r_true[ri + 1];
1397 tail_r_true_elem[0] = tail_r_true[ri];
1398 tail_r_true_elem[1] = tail_r_true[ri + 1];
1399
1400 test_BLAS_cdot_c_s(n_i,
1401 blas_no_conj,
1402 alpha, beta, rin, rout,
1403 head_r_true_elem, tail_r_true_elem,
1404 a_vec, 1, x, incx, eps_int, un_int,
1405 &ratios[ri]);
1406
1407 /* take the max ratio */
1408 if (ri == 0) {
1409 ratio = ratios[0];
1410 } else if (ratios[ri] > ratio) {
1411 ratio = ratios[ri];
1412 }
1413
1414 } /* end of dot-test loop */
1415
1416 if (ratio > thresh) {
1417
1418 if (debug == 3) {
1419 printf("\n\t\tTest # %d\n", test_count);
1420 printf("y type : c, a type : c, x type : s\n");
1421 printf("Seed = %d\n", saved_seed);
1422 printf("n %d\n", n);
1423 printf("INCX %d INCY %d\n", incx, incx);
1424
1425 if (order_type == blas_rowmajor)
1426 printf("row ");
1427 else
1428 printf("col ");
1429
1430 if (uplo_type == blas_upper)
1431 printf("upper ");
1432 else
1433 printf("lower");
1434
1435 printf("NORM %d, ALPHA %d, BETA %d\n",
1436 norm, alpha_val, beta_val);
1437 printf("E %d\n", prec);
1438
1439 /* print out info */
1440 printf("alpha = ");
1441 printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
1442 printf(" ");
1443 printf("beta = ");
1444 printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
1445 printf("\n");
1446
1447 printf("a\n");
1448 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
1449 sprint_vector(x, n, incx, "x");
1450 cprint_vector(y_gen, n, incy, "y_gen");
1451 cprint_vector(y, n, incy, "y");
1452 dprint_vector(head_r_true, n, 1, "head_r_true");
1453 dprint_vector(ratios, n, 1, "ratios");
1454 printf("ratio = %g\n", ratio);
1455 }
1456 bad_ratio_count++;
1457 }
1458
1459 if (ratio > ratio_max)
1460 ratio_max = ratio;
1461
1462 if (ratio != 0.0 && ratio < ratio_min)
1463 ratio_min = ratio;
1464
1465 } /* end of randmize loop */
1466
1467 } /* end of incy loop */
1468
1469 } /* end of incx loop */
1470
1471 } /* end of uplo loop */
1472
1473 } /* end of order loop */
1474
1475 } /* end of nr test loop */
1476
1477 } /* end of norm loop */
1478
1479
1480
1481 } /* end of beta loop */
1482
1483 } /* end of alpha loop */
1484
1485 FPU_FIX_STOP;
1486
1487 blas_free(y);
1488 blas_free(a);
1489 blas_free(x);
1490 blas_free(y_gen);
1491 blas_free(head_r_true);
1492 blas_free(tail_r_true);
1493 blas_free(ratios);
1494 blas_free(a_vec);
1495 blas_free(x_vec);
1496
1497 *max_ratio = ratio_max;
1498 *min_ratio = ratio_min;
1499 *num_tests = test_count;
1500 *num_bad_ratio = bad_ratio_count;
1501
1502 }
do_test_zhpmv_z_d(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)1503 void do_test_zhpmv_z_d
1504 (int n,
1505 int ntests, int *seed, double thresh, int debug, float test_prob,
1506 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
1507
1508 /* Function name */
1509 const char fname[] = "BLAS_zhpmv_z_d";
1510
1511 int i;
1512 int yi;
1513 int incyi, y_starti;
1514 int test_count;
1515 int bad_ratio_count;
1516
1517 int ri;
1518 int incri;
1519 int inca, incx, incy;
1520
1521 double ratio;
1522
1523 double ratio_min, ratio_max;
1524
1525 double eps_int; /* internal machine epsilon */
1526 double un_int; /* internal underflow threshold */
1527
1528 double rin[2];
1529 double rout[2];
1530 double head_r_true_elem[2], tail_r_true_elem[2];
1531
1532 enum blas_order_type order_type;
1533 enum blas_uplo_type uplo_type;
1534 enum blas_prec_type prec;
1535
1536 int order_val, uplo_val;
1537 int incx_val, incy_val;
1538 int alpha_val, beta_val;
1539 int randomize_val;
1540
1541
1542
1543 int alpha_flag, beta_flag;
1544 int saved_seed;
1545 int norm;
1546 int test_no;
1547
1548 int n_i;
1549
1550 double alpha[2];
1551 double beta[2];
1552 double *a;
1553 double *x;
1554 double *y;
1555 double *a_vec;
1556 double *x_vec;
1557
1558 /* generated test values for c */
1559 double *y_gen;
1560
1561 double *ratios;
1562
1563 /* true result calculated by testgen, in double-double */
1564 double *head_r_true, *tail_r_true;
1565
1566
1567 FPU_FIX_DECL;
1568
1569 if (n < 0 || ntests < 0)
1570 BLAS_error(fname, 0, 0, NULL);
1571
1572 /* initialization */
1573 saved_seed = *seed;
1574 ratio = 0.0;
1575 ratio_min = 1e308;
1576 ratio_max = 0.0;
1577
1578 *num_tests = 0;
1579 *num_bad_ratio = 0;
1580 *min_ratio = 0.0;
1581 *max_ratio = 0.0;
1582
1583 if (n == 0)
1584 return;
1585
1586 FPU_FIX_START;
1587
1588 n_i = n;
1589
1590 inca = incx = incy = 1;
1591 inca *= 2;
1592
1593 incy *= 2;
1594
1595 /* allocate memory for arrays */
1596 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
1597 if (3 * n_i > 0 && y == NULL) {
1598 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1599 }
1600 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
1601 if (3 * n_i > 0 && y_gen == NULL) {
1602 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1603 }
1604 a = (double *) blas_malloc(2 * n_i * n_i * sizeof(double) * 2);
1605 if (2 * n_i * n_i > 0 && a == NULL) {
1606 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1607 }
1608 x = (double *) blas_malloc(3 * n_i * sizeof(double));
1609 if (3 * n_i > 0 && x == NULL) {
1610 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1611 }
1612 a_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
1613 if (n_i > 0 && a_vec == NULL) {
1614 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1615 }
1616 x_vec = (double *) blas_malloc(n_i * sizeof(double));
1617 if (n_i > 0 && x_vec == NULL) {
1618 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1619 }
1620 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1621 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1622 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
1623 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1624 }
1625 ratios = (double *) blas_malloc(2 * n * sizeof(double));
1626 if (2 * n > 0 && ratios == NULL) {
1627 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1628 }
1629
1630 test_count = 0;
1631 bad_ratio_count = 0;
1632
1633 /* vary alpha */
1634 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
1635
1636 alpha_flag = 0;
1637 switch (alpha_val) {
1638 case 0:
1639 alpha[0] = alpha[1] = 0.0;
1640 alpha_flag = 1;
1641 break;
1642 case 1:
1643 alpha[0] = 1.0;
1644 alpha[1] = 0.0;
1645 alpha_flag = 1;
1646 break;
1647 }
1648
1649 /* vary beta */
1650 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
1651 beta_flag = 0;
1652 switch (beta_val) {
1653 case 0:
1654 beta[0] = beta[1] = 0.0;
1655 beta_flag = 1;
1656 break;
1657 case 1:
1658 beta[0] = 1.0;
1659 beta[1] = 0.0;
1660 beta_flag = 1;
1661 break;
1662 }
1663
1664
1665 eps_int = power(2, -BITS_D);
1666 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
1667 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
1668 prec = blas_prec_double;
1669
1670 /* vary norm -- underflow, approx 1, overflow */
1671 for (norm = NORM_START; norm <= NORM_END; norm++) {
1672
1673 /* number of tests */
1674 for (test_no = 0; test_no < ntests; test_no++) {
1675
1676
1677 /* vary storage format */
1678 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
1679
1680 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
1681
1682 /* vary upper / lower variation */
1683 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
1684
1685 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
1686
1687 /* vary incx = 1, 2 */
1688 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
1689
1690 incx = incx_val;
1691 if (0 == incx)
1692 continue;
1693
1694 /* vary incy = 1, 2 */
1695 for (incy_val = INCY_START; incy_val <= INCY_END; incy_val++) {
1696
1697 incy = incy_val;
1698 if (0 == incy)
1699 continue;
1700
1701 for (randomize_val = RANDOMIZE_START;
1702 randomize_val <= RANDOMIZE_END; randomize_val++) {
1703
1704 /* For the sake of speed, we throw out this case at random */
1705 if (xrand(seed) >= test_prob)
1706 continue;
1707
1708 saved_seed = *seed;
1709
1710 /* finally we are here to generate the test case */
1711 BLAS_zhpmv_z_d_testgen(norm, order_type,
1712 uplo_type, n, randomize_val,
1713 &alpha, alpha_flag, &beta,
1714 beta_flag, a, x, incx, y, incy,
1715 seed, head_r_true, tail_r_true);
1716 test_count++;
1717
1718 /* copy generated y vector since this will be
1719 over written */
1720 zcopy_vector(y, n, incy, y_gen, incy);
1721
1722 /* call hpmv routines to be tested */
1723 FPU_FIX_STOP;
1724 BLAS_zhpmv_z_d(order_type,
1725 uplo_type, n, alpha, a, x, incx, beta,
1726 y, incy);
1727 FPU_FIX_START;
1728
1729 /* now compute the ratio using test_BLAS_xdot */
1730 /* copy a row from A, use x, run
1731 dot test */
1732
1733 incyi = incy;
1734
1735 incri = 1;
1736
1737 incyi *= 2;
1738 incri *= 2;
1739 if (incy < 0) {
1740 y_starti = (-n + 1) * incyi;
1741 } else {
1742 y_starti = 0;
1743 }
1744
1745 for (i = 0, yi = y_starti, ri = 0;
1746 i < n_i; i++, yi += incyi, ri += incri) {
1747 zhpmv_copy_row(order_type, uplo_type, n_i, a, a_vec, i);
1748
1749 /* just use the x vector -
1750 it was unchanged (in theory) */
1751
1752
1753 rin[0] = y_gen[yi];
1754 rin[1] = y_gen[yi + 1];
1755 rout[0] = y[yi];
1756 rout[1] = y[yi + 1];
1757 head_r_true_elem[0] = head_r_true[ri];
1758 head_r_true_elem[1] = head_r_true[ri + 1];
1759 tail_r_true_elem[0] = tail_r_true[ri];
1760 tail_r_true_elem[1] = tail_r_true[ri + 1];
1761
1762 test_BLAS_zdot_z_d(n_i,
1763 blas_no_conj,
1764 alpha, beta, rin, rout,
1765 head_r_true_elem, tail_r_true_elem,
1766 a_vec, 1, x, incx, eps_int, un_int,
1767 &ratios[ri]);
1768
1769 /* take the max ratio */
1770 if (ri == 0) {
1771 ratio = ratios[0];
1772 } else if (ratios[ri] > ratio) {
1773 ratio = ratios[ri];
1774 }
1775
1776 } /* end of dot-test loop */
1777
1778 if (ratio > thresh) {
1779
1780 if (debug == 3) {
1781 printf("\n\t\tTest # %d\n", test_count);
1782 printf("y type : z, a type : z, x type : d\n");
1783 printf("Seed = %d\n", saved_seed);
1784 printf("n %d\n", n);
1785 printf("INCX %d INCY %d\n", incx, incx);
1786
1787 if (order_type == blas_rowmajor)
1788 printf("row ");
1789 else
1790 printf("col ");
1791
1792 if (uplo_type == blas_upper)
1793 printf("upper ");
1794 else
1795 printf("lower");
1796
1797 printf("NORM %d, ALPHA %d, BETA %d\n",
1798 norm, alpha_val, beta_val);
1799 printf("E %d\n", prec);
1800
1801 /* print out info */
1802 printf("alpha = ");
1803 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
1804 printf(" ");
1805 printf("beta = ");
1806 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
1807 printf("\n");
1808
1809 printf("a\n");
1810 zprint_hpmv_matrix(a, n_i, order_type, uplo_type);
1811 dprint_vector(x, n, incx, "x");
1812 zprint_vector(y_gen, n, incy, "y_gen");
1813 zprint_vector(y, n, incy, "y");
1814 dprint_vector(head_r_true, n, 1, "head_r_true");
1815 dprint_vector(ratios, n, 1, "ratios");
1816 printf("ratio = %g\n", ratio);
1817 }
1818 bad_ratio_count++;
1819 }
1820
1821 if (ratio > ratio_max)
1822 ratio_max = ratio;
1823
1824 if (ratio != 0.0 && ratio < ratio_min)
1825 ratio_min = ratio;
1826
1827 } /* end of randmize loop */
1828
1829 } /* end of incy loop */
1830
1831 } /* end of incx loop */
1832
1833 } /* end of uplo loop */
1834
1835 } /* end of order loop */
1836
1837 } /* end of nr test loop */
1838
1839 } /* end of norm loop */
1840
1841
1842
1843 } /* end of beta loop */
1844
1845 } /* end of alpha loop */
1846
1847 FPU_FIX_STOP;
1848
1849 blas_free(y);
1850 blas_free(a);
1851 blas_free(x);
1852 blas_free(y_gen);
1853 blas_free(head_r_true);
1854 blas_free(tail_r_true);
1855 blas_free(ratios);
1856 blas_free(a_vec);
1857 blas_free(x_vec);
1858
1859 *max_ratio = ratio_max;
1860 *min_ratio = ratio_min;
1861 *num_tests = test_count;
1862 *num_bad_ratio = bad_ratio_count;
1863
1864 }
do_test_chpmv_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)1865 void do_test_chpmv_x
1866 (int n,
1867 int ntests, int *seed, double thresh, int debug, float test_prob,
1868 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
1869
1870 /* Function name */
1871 const char fname[] = "BLAS_chpmv_x";
1872
1873 int i;
1874 int yi;
1875 int incyi, y_starti;
1876 int test_count;
1877 int bad_ratio_count;
1878
1879 int ri;
1880 int incri;
1881 int inca, incx, incy;
1882
1883 double ratio;
1884
1885 double ratio_min, ratio_max;
1886
1887 double eps_int; /* internal machine epsilon */
1888 double un_int; /* internal underflow threshold */
1889
1890 float rin[2];
1891 float rout[2];
1892 double head_r_true_elem[2], tail_r_true_elem[2];
1893
1894 enum blas_order_type order_type;
1895 enum blas_uplo_type uplo_type;
1896 enum blas_prec_type prec;
1897
1898 int order_val, uplo_val;
1899 int incx_val, incy_val;
1900 int alpha_val, beta_val;
1901 int randomize_val;
1902
1903 int prec_val;
1904
1905 int alpha_flag, beta_flag;
1906 int saved_seed;
1907 int norm;
1908 int test_no;
1909
1910 int n_i;
1911
1912 float alpha[2];
1913 float beta[2];
1914 float *a;
1915 float *x;
1916 float *y;
1917 float *a_vec;
1918 float *x_vec;
1919
1920 /* generated test values for c */
1921 float *y_gen;
1922
1923 double *ratios;
1924
1925 /* true result calculated by testgen, in double-double */
1926 double *head_r_true, *tail_r_true;
1927
1928
1929 FPU_FIX_DECL;
1930
1931 if (n < 0 || ntests < 0)
1932 BLAS_error(fname, 0, 0, NULL);
1933
1934 /* initialization */
1935 saved_seed = *seed;
1936 ratio = 0.0;
1937 ratio_min = 1e308;
1938 ratio_max = 0.0;
1939
1940 *num_tests = 0;
1941 *num_bad_ratio = 0;
1942 *min_ratio = 0.0;
1943 *max_ratio = 0.0;
1944
1945 if (n == 0)
1946 return;
1947
1948 FPU_FIX_START;
1949
1950 n_i = n;
1951
1952 inca = incx = incy = 1;
1953 inca *= 2;
1954 incx *= 2;
1955 incy *= 2;
1956
1957 /* allocate memory for arrays */
1958 y = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
1959 if (3 * n_i > 0 && y == NULL) {
1960 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1961 }
1962 y_gen = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
1963 if (3 * n_i > 0 && y_gen == NULL) {
1964 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1965 }
1966 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
1967 if (2 * n_i * n_i > 0 && a == NULL) {
1968 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1969 }
1970 x = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
1971 if (3 * n_i > 0 && x == NULL) {
1972 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1973 }
1974 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
1975 if (n_i > 0 && a_vec == NULL) {
1976 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1977 }
1978 x_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
1979 if (n_i > 0 && x_vec == NULL) {
1980 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1981 }
1982 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1983 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
1984 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
1985 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1986 }
1987 ratios = (double *) blas_malloc(2 * n * sizeof(double));
1988 if (2 * n > 0 && ratios == NULL) {
1989 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
1990 }
1991
1992 test_count = 0;
1993 bad_ratio_count = 0;
1994
1995 /* vary alpha */
1996 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
1997
1998 alpha_flag = 0;
1999 switch (alpha_val) {
2000 case 0:
2001 alpha[0] = alpha[1] = 0.0;
2002 alpha_flag = 1;
2003 break;
2004 case 1:
2005 alpha[0] = 1.0;
2006 alpha[1] = 0.0;
2007 alpha_flag = 1;
2008 break;
2009 }
2010
2011 /* vary beta */
2012 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
2013 beta_flag = 0;
2014 switch (beta_val) {
2015 case 0:
2016 beta[0] = beta[1] = 0.0;
2017 beta_flag = 1;
2018 break;
2019 case 1:
2020 beta[0] = 1.0;
2021 beta[1] = 0.0;
2022 beta_flag = 1;
2023 break;
2024 }
2025
2026
2027 /* varying extra precs */
2028 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
2029 switch (prec_val) {
2030 case 0:
2031 eps_int = power(2, -BITS_S);
2032 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
2033 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
2034 prec = blas_prec_single;
2035 break;
2036 case 1:
2037 eps_int = power(2, -BITS_D);
2038 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
2039 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
2040 prec = blas_prec_double;
2041 break;
2042 case 2:
2043 default:
2044 eps_int = power(2, -BITS_E);
2045 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
2046 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
2047 prec = blas_prec_extra;
2048 break;
2049 }
2050
2051 /* vary norm -- underflow, approx 1, overflow */
2052 for (norm = NORM_START; norm <= NORM_END; norm++) {
2053
2054 /* number of tests */
2055 for (test_no = 0; test_no < ntests; test_no++) {
2056
2057
2058 /* vary storage format */
2059 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
2060
2061 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
2062
2063 /* vary upper / lower variation */
2064 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
2065
2066 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
2067
2068 /* vary incx = 1, 2 */
2069 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
2070
2071 incx = incx_val;
2072 if (0 == incx)
2073 continue;
2074
2075 /* vary incy = 1, 2 */
2076 for (incy_val = INCY_START; incy_val <= INCY_END;
2077 incy_val++) {
2078
2079 incy = incy_val;
2080 if (0 == incy)
2081 continue;
2082
2083 for (randomize_val = RANDOMIZE_START;
2084 randomize_val <= RANDOMIZE_END; randomize_val++) {
2085
2086 /* For the sake of speed, we throw out this case at random */
2087 if (xrand(seed) >= test_prob)
2088 continue;
2089
2090 saved_seed = *seed;
2091
2092 /* finally we are here to generate the test case */
2093 BLAS_chpmv_testgen(norm, order_type,
2094 uplo_type, n, randomize_val, &alpha,
2095 alpha_flag, &beta, beta_flag, a, x,
2096 incx, y, incy, seed, head_r_true,
2097 tail_r_true);
2098 test_count++;
2099
2100 /* copy generated y vector since this will be
2101 over written */
2102 ccopy_vector(y, n, incy, y_gen, incy);
2103
2104 /* call hpmv routines to be tested */
2105 FPU_FIX_STOP;
2106 BLAS_chpmv_x(order_type,
2107 uplo_type, n, alpha, a, x, incx, beta,
2108 y, incy, prec);
2109 FPU_FIX_START;
2110
2111 /* now compute the ratio using test_BLAS_xdot */
2112 /* copy a row from A, use x, run
2113 dot test */
2114
2115 incyi = incy;
2116
2117 incri = 1;
2118
2119 incyi *= 2;
2120 incri *= 2;
2121 if (incy < 0) {
2122 y_starti = (-n + 1) * incyi;
2123 } else {
2124 y_starti = 0;
2125 }
2126
2127 for (i = 0, yi = y_starti, ri = 0;
2128 i < n_i; i++, yi += incyi, ri += incri) {
2129 chpmv_copy_row(order_type, uplo_type,
2130 n_i, a, a_vec, i);
2131
2132 /* just use the x vector -
2133 it was unchanged (in theory) */
2134
2135
2136 rin[0] = y_gen[yi];
2137 rin[1] = y_gen[yi + 1];
2138 rout[0] = y[yi];
2139 rout[1] = y[yi + 1];
2140 head_r_true_elem[0] = head_r_true[ri];
2141 head_r_true_elem[1] = head_r_true[ri + 1];
2142 tail_r_true_elem[0] = tail_r_true[ri];
2143 tail_r_true_elem[1] = tail_r_true[ri + 1];
2144
2145 test_BLAS_cdot(n_i,
2146 blas_no_conj,
2147 alpha, beta, rin, rout,
2148 head_r_true_elem, tail_r_true_elem,
2149 a_vec, 1, x, incx, eps_int, un_int,
2150 &ratios[ri]);
2151
2152 /* take the max ratio */
2153 if (ri == 0) {
2154 ratio = ratios[0];
2155 } else if (ratios[ri] > ratio) {
2156 ratio = ratios[ri];
2157 }
2158
2159 } /* end of dot-test loop */
2160
2161 if (ratio > thresh) {
2162
2163 if (debug == 3) {
2164 printf("\n\t\tTest # %d\n", test_count);
2165 printf("y type : c, a type : c, x type : c\n");
2166 printf("Seed = %d\n", saved_seed);
2167 printf("n %d\n", n);
2168 printf("INCX %d INCY %d\n", incx, incx);
2169
2170 if (order_type == blas_rowmajor)
2171 printf("row ");
2172 else
2173 printf("col ");
2174
2175 if (uplo_type == blas_upper)
2176 printf("upper ");
2177 else
2178 printf("lower");
2179
2180 printf("NORM %d, ALPHA %d, BETA %d\n",
2181 norm, alpha_val, beta_val);
2182 printf("E %d\n", prec);
2183
2184 /* print out info */
2185 printf("alpha = ");
2186 printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
2187 printf(" ");
2188 printf("beta = ");
2189 printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
2190 printf("\n");
2191
2192 printf("a\n");
2193 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
2194 cprint_vector(x, n, incx, "x");
2195 cprint_vector(y_gen, n, incy, "y_gen");
2196 cprint_vector(y, n, incy, "y");
2197 dprint_vector(head_r_true, n, 1, "head_r_true");
2198 dprint_vector(ratios, n, 1, "ratios");
2199 printf("ratio = %g\n", ratio);
2200 }
2201 bad_ratio_count++;
2202 }
2203
2204 if (ratio > ratio_max)
2205 ratio_max = ratio;
2206
2207 if (ratio != 0.0 && ratio < ratio_min)
2208 ratio_min = ratio;
2209
2210 } /* end of randmize loop */
2211
2212 } /* end of incy loop */
2213
2214 } /* end of incx loop */
2215
2216 } /* end of uplo loop */
2217
2218 } /* end of order loop */
2219
2220 } /* end of nr test loop */
2221
2222 } /* end of norm loop */
2223
2224
2225 } /* end of prec loop */
2226
2227 } /* end of beta loop */
2228
2229 } /* end of alpha loop */
2230
2231 FPU_FIX_STOP;
2232
2233 blas_free(y);
2234 blas_free(a);
2235 blas_free(x);
2236 blas_free(y_gen);
2237 blas_free(head_r_true);
2238 blas_free(tail_r_true);
2239 blas_free(ratios);
2240 blas_free(a_vec);
2241 blas_free(x_vec);
2242
2243 *max_ratio = ratio_max;
2244 *min_ratio = ratio_min;
2245 *num_tests = test_count;
2246 *num_bad_ratio = bad_ratio_count;
2247
2248 }
do_test_zhpmv_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)2249 void do_test_zhpmv_x
2250 (int n,
2251 int ntests, int *seed, double thresh, int debug, float test_prob,
2252 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
2253
2254 /* Function name */
2255 const char fname[] = "BLAS_zhpmv_x";
2256
2257 int i;
2258 int yi;
2259 int incyi, y_starti;
2260 int test_count;
2261 int bad_ratio_count;
2262
2263 int ri;
2264 int incri;
2265 int inca, incx, incy;
2266
2267 double ratio;
2268
2269 double ratio_min, ratio_max;
2270
2271 double eps_int; /* internal machine epsilon */
2272 double un_int; /* internal underflow threshold */
2273
2274 double rin[2];
2275 double rout[2];
2276 double head_r_true_elem[2], tail_r_true_elem[2];
2277
2278 enum blas_order_type order_type;
2279 enum blas_uplo_type uplo_type;
2280 enum blas_prec_type prec;
2281
2282 int order_val, uplo_val;
2283 int incx_val, incy_val;
2284 int alpha_val, beta_val;
2285 int randomize_val;
2286
2287 int prec_val;
2288
2289 int alpha_flag, beta_flag;
2290 int saved_seed;
2291 int norm;
2292 int test_no;
2293
2294 int n_i;
2295
2296 double alpha[2];
2297 double beta[2];
2298 double *a;
2299 double *x;
2300 double *y;
2301 double *a_vec;
2302 double *x_vec;
2303
2304 /* generated test values for c */
2305 double *y_gen;
2306
2307 double *ratios;
2308
2309 /* true result calculated by testgen, in double-double */
2310 double *head_r_true, *tail_r_true;
2311
2312
2313 FPU_FIX_DECL;
2314
2315 if (n < 0 || ntests < 0)
2316 BLAS_error(fname, 0, 0, NULL);
2317
2318 /* initialization */
2319 saved_seed = *seed;
2320 ratio = 0.0;
2321 ratio_min = 1e308;
2322 ratio_max = 0.0;
2323
2324 *num_tests = 0;
2325 *num_bad_ratio = 0;
2326 *min_ratio = 0.0;
2327 *max_ratio = 0.0;
2328
2329 if (n == 0)
2330 return;
2331
2332 FPU_FIX_START;
2333
2334 n_i = n;
2335
2336 inca = incx = incy = 1;
2337 inca *= 2;
2338 incx *= 2;
2339 incy *= 2;
2340
2341 /* allocate memory for arrays */
2342 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
2343 if (3 * n_i > 0 && y == NULL) {
2344 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2345 }
2346 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
2347 if (3 * n_i > 0 && y_gen == NULL) {
2348 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2349 }
2350 a = (double *) blas_malloc(2 * n_i * n_i * sizeof(double) * 2);
2351 if (2 * n_i * n_i > 0 && a == NULL) {
2352 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2353 }
2354 x = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
2355 if (3 * n_i > 0 && x == NULL) {
2356 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2357 }
2358 a_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
2359 if (n_i > 0 && a_vec == NULL) {
2360 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2361 }
2362 x_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
2363 if (n_i > 0 && x_vec == NULL) {
2364 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2365 }
2366 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
2367 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
2368 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
2369 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2370 }
2371 ratios = (double *) blas_malloc(2 * n * sizeof(double));
2372 if (2 * n > 0 && ratios == NULL) {
2373 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2374 }
2375
2376 test_count = 0;
2377 bad_ratio_count = 0;
2378
2379 /* vary alpha */
2380 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
2381
2382 alpha_flag = 0;
2383 switch (alpha_val) {
2384 case 0:
2385 alpha[0] = alpha[1] = 0.0;
2386 alpha_flag = 1;
2387 break;
2388 case 1:
2389 alpha[0] = 1.0;
2390 alpha[1] = 0.0;
2391 alpha_flag = 1;
2392 break;
2393 }
2394
2395 /* vary beta */
2396 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
2397 beta_flag = 0;
2398 switch (beta_val) {
2399 case 0:
2400 beta[0] = beta[1] = 0.0;
2401 beta_flag = 1;
2402 break;
2403 case 1:
2404 beta[0] = 1.0;
2405 beta[1] = 0.0;
2406 beta_flag = 1;
2407 break;
2408 }
2409
2410
2411 /* varying extra precs */
2412 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
2413 switch (prec_val) {
2414 case 0:
2415 eps_int = power(2, -BITS_D);
2416 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
2417 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
2418 prec = blas_prec_double;
2419 break;
2420 case 1:
2421 eps_int = power(2, -BITS_D);
2422 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
2423 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
2424 prec = blas_prec_double;
2425 break;
2426 case 2:
2427 default:
2428 eps_int = power(2, -BITS_E);
2429 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
2430 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
2431 prec = blas_prec_extra;
2432 break;
2433 }
2434
2435 /* vary norm -- underflow, approx 1, overflow */
2436 for (norm = NORM_START; norm <= NORM_END; norm++) {
2437
2438 /* number of tests */
2439 for (test_no = 0; test_no < ntests; test_no++) {
2440
2441
2442 /* vary storage format */
2443 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
2444
2445 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
2446
2447 /* vary upper / lower variation */
2448 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
2449
2450 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
2451
2452 /* vary incx = 1, 2 */
2453 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
2454
2455 incx = incx_val;
2456 if (0 == incx)
2457 continue;
2458
2459 /* vary incy = 1, 2 */
2460 for (incy_val = INCY_START; incy_val <= INCY_END;
2461 incy_val++) {
2462
2463 incy = incy_val;
2464 if (0 == incy)
2465 continue;
2466
2467 for (randomize_val = RANDOMIZE_START;
2468 randomize_val <= RANDOMIZE_END; randomize_val++) {
2469
2470 /* For the sake of speed, we throw out this case at random */
2471 if (xrand(seed) >= test_prob)
2472 continue;
2473
2474 saved_seed = *seed;
2475
2476 /* finally we are here to generate the test case */
2477 BLAS_zhpmv_testgen(norm, order_type,
2478 uplo_type, n, randomize_val, &alpha,
2479 alpha_flag, &beta, beta_flag, a, x,
2480 incx, y, incy, seed, head_r_true,
2481 tail_r_true);
2482 test_count++;
2483
2484 /* copy generated y vector since this will be
2485 over written */
2486 zcopy_vector(y, n, incy, y_gen, incy);
2487
2488 /* call hpmv routines to be tested */
2489 FPU_FIX_STOP;
2490 BLAS_zhpmv_x(order_type,
2491 uplo_type, n, alpha, a, x, incx, beta,
2492 y, incy, prec);
2493 FPU_FIX_START;
2494
2495 /* now compute the ratio using test_BLAS_xdot */
2496 /* copy a row from A, use x, run
2497 dot test */
2498
2499 incyi = incy;
2500
2501 incri = 1;
2502
2503 incyi *= 2;
2504 incri *= 2;
2505 if (incy < 0) {
2506 y_starti = (-n + 1) * incyi;
2507 } else {
2508 y_starti = 0;
2509 }
2510
2511 for (i = 0, yi = y_starti, ri = 0;
2512 i < n_i; i++, yi += incyi, ri += incri) {
2513 zhpmv_copy_row(order_type, uplo_type,
2514 n_i, a, a_vec, i);
2515
2516 /* just use the x vector -
2517 it was unchanged (in theory) */
2518
2519
2520 rin[0] = y_gen[yi];
2521 rin[1] = y_gen[yi + 1];
2522 rout[0] = y[yi];
2523 rout[1] = y[yi + 1];
2524 head_r_true_elem[0] = head_r_true[ri];
2525 head_r_true_elem[1] = head_r_true[ri + 1];
2526 tail_r_true_elem[0] = tail_r_true[ri];
2527 tail_r_true_elem[1] = tail_r_true[ri + 1];
2528
2529 test_BLAS_zdot(n_i,
2530 blas_no_conj,
2531 alpha, beta, rin, rout,
2532 head_r_true_elem, tail_r_true_elem,
2533 a_vec, 1, x, incx, eps_int, un_int,
2534 &ratios[ri]);
2535
2536 /* take the max ratio */
2537 if (ri == 0) {
2538 ratio = ratios[0];
2539 } else if (ratios[ri] > ratio) {
2540 ratio = ratios[ri];
2541 }
2542
2543 } /* end of dot-test loop */
2544
2545 if (ratio > thresh) {
2546
2547 if (debug == 3) {
2548 printf("\n\t\tTest # %d\n", test_count);
2549 printf("y type : z, a type : z, x type : z\n");
2550 printf("Seed = %d\n", saved_seed);
2551 printf("n %d\n", n);
2552 printf("INCX %d INCY %d\n", incx, incx);
2553
2554 if (order_type == blas_rowmajor)
2555 printf("row ");
2556 else
2557 printf("col ");
2558
2559 if (uplo_type == blas_upper)
2560 printf("upper ");
2561 else
2562 printf("lower");
2563
2564 printf("NORM %d, ALPHA %d, BETA %d\n",
2565 norm, alpha_val, beta_val);
2566 printf("E %d\n", prec);
2567
2568 /* print out info */
2569 printf("alpha = ");
2570 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
2571 printf(" ");
2572 printf("beta = ");
2573 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
2574 printf("\n");
2575
2576 printf("a\n");
2577 zprint_hpmv_matrix(a, n_i, order_type, uplo_type);
2578 zprint_vector(x, n, incx, "x");
2579 zprint_vector(y_gen, n, incy, "y_gen");
2580 zprint_vector(y, n, incy, "y");
2581 dprint_vector(head_r_true, n, 1, "head_r_true");
2582 dprint_vector(ratios, n, 1, "ratios");
2583 printf("ratio = %g\n", ratio);
2584 }
2585 bad_ratio_count++;
2586 }
2587
2588 if (ratio > ratio_max)
2589 ratio_max = ratio;
2590
2591 if (ratio != 0.0 && ratio < ratio_min)
2592 ratio_min = ratio;
2593
2594 } /* end of randmize loop */
2595
2596 } /* end of incy loop */
2597
2598 } /* end of incx loop */
2599
2600 } /* end of uplo loop */
2601
2602 } /* end of order loop */
2603
2604 } /* end of nr test loop */
2605
2606 } /* end of norm loop */
2607
2608
2609 } /* end of prec loop */
2610
2611 } /* end of beta loop */
2612
2613 } /* end of alpha loop */
2614
2615 FPU_FIX_STOP;
2616
2617 blas_free(y);
2618 blas_free(a);
2619 blas_free(x);
2620 blas_free(y_gen);
2621 blas_free(head_r_true);
2622 blas_free(tail_r_true);
2623 blas_free(ratios);
2624 blas_free(a_vec);
2625 blas_free(x_vec);
2626
2627 *max_ratio = ratio_max;
2628 *min_ratio = ratio_min;
2629 *num_tests = test_count;
2630 *num_bad_ratio = bad_ratio_count;
2631
2632 }
do_test_zhpmv_z_c_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)2633 void do_test_zhpmv_z_c_x
2634 (int n,
2635 int ntests, int *seed, double thresh, int debug, float test_prob,
2636 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
2637
2638 /* Function name */
2639 const char fname[] = "BLAS_zhpmv_z_c_x";
2640
2641 int i;
2642 int yi;
2643 int incyi, y_starti;
2644 int test_count;
2645 int bad_ratio_count;
2646
2647 int ri;
2648 int incri;
2649 int inca, incx, incy;
2650
2651 double ratio;
2652
2653 double ratio_min, ratio_max;
2654
2655 double eps_int; /* internal machine epsilon */
2656 double un_int; /* internal underflow threshold */
2657
2658 double rin[2];
2659 double rout[2];
2660 double head_r_true_elem[2], tail_r_true_elem[2];
2661
2662 enum blas_order_type order_type;
2663 enum blas_uplo_type uplo_type;
2664 enum blas_prec_type prec;
2665
2666 int order_val, uplo_val;
2667 int incx_val, incy_val;
2668 int alpha_val, beta_val;
2669 int randomize_val;
2670
2671 int prec_val;
2672
2673 int alpha_flag, beta_flag;
2674 int saved_seed;
2675 int norm;
2676 int test_no;
2677
2678 int n_i;
2679
2680 double alpha[2];
2681 double beta[2];
2682 double *a;
2683 float *x;
2684 double *y;
2685 double *a_vec;
2686 float *x_vec;
2687
2688 /* generated test values for c */
2689 double *y_gen;
2690
2691 double *ratios;
2692
2693 /* true result calculated by testgen, in double-double */
2694 double *head_r_true, *tail_r_true;
2695
2696
2697 FPU_FIX_DECL;
2698
2699 if (n < 0 || ntests < 0)
2700 BLAS_error(fname, 0, 0, NULL);
2701
2702 /* initialization */
2703 saved_seed = *seed;
2704 ratio = 0.0;
2705 ratio_min = 1e308;
2706 ratio_max = 0.0;
2707
2708 *num_tests = 0;
2709 *num_bad_ratio = 0;
2710 *min_ratio = 0.0;
2711 *max_ratio = 0.0;
2712
2713 if (n == 0)
2714 return;
2715
2716 FPU_FIX_START;
2717
2718 n_i = n;
2719
2720 inca = incx = incy = 1;
2721 inca *= 2;
2722 incx *= 2;
2723 incy *= 2;
2724
2725 /* allocate memory for arrays */
2726 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
2727 if (3 * n_i > 0 && y == NULL) {
2728 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2729 }
2730 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
2731 if (3 * n_i > 0 && y_gen == NULL) {
2732 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2733 }
2734 a = (double *) blas_malloc(2 * n_i * n_i * sizeof(double) * 2);
2735 if (2 * n_i * n_i > 0 && a == NULL) {
2736 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2737 }
2738 x = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
2739 if (3 * n_i > 0 && x == NULL) {
2740 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2741 }
2742 a_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
2743 if (n_i > 0 && a_vec == NULL) {
2744 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2745 }
2746 x_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
2747 if (n_i > 0 && x_vec == NULL) {
2748 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2749 }
2750 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
2751 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
2752 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
2753 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2754 }
2755 ratios = (double *) blas_malloc(2 * n * sizeof(double));
2756 if (2 * n > 0 && ratios == NULL) {
2757 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
2758 }
2759
2760 test_count = 0;
2761 bad_ratio_count = 0;
2762
2763 /* vary alpha */
2764 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
2765
2766 alpha_flag = 0;
2767 switch (alpha_val) {
2768 case 0:
2769 alpha[0] = alpha[1] = 0.0;
2770 alpha_flag = 1;
2771 break;
2772 case 1:
2773 alpha[0] = 1.0;
2774 alpha[1] = 0.0;
2775 alpha_flag = 1;
2776 break;
2777 }
2778
2779 /* vary beta */
2780 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
2781 beta_flag = 0;
2782 switch (beta_val) {
2783 case 0:
2784 beta[0] = beta[1] = 0.0;
2785 beta_flag = 1;
2786 break;
2787 case 1:
2788 beta[0] = 1.0;
2789 beta[1] = 0.0;
2790 beta_flag = 1;
2791 break;
2792 }
2793
2794
2795 /* varying extra precs */
2796 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
2797 switch (prec_val) {
2798 case 0:
2799 eps_int = power(2, -BITS_D);
2800 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
2801 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
2802 prec = blas_prec_double;
2803 break;
2804 case 1:
2805 eps_int = power(2, -BITS_D);
2806 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
2807 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
2808 prec = blas_prec_double;
2809 break;
2810 case 2:
2811 default:
2812 eps_int = power(2, -BITS_E);
2813 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
2814 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
2815 prec = blas_prec_extra;
2816 break;
2817 }
2818
2819 /* vary norm -- underflow, approx 1, overflow */
2820 for (norm = NORM_START; norm <= NORM_END; norm++) {
2821
2822 /* number of tests */
2823 for (test_no = 0; test_no < ntests; test_no++) {
2824
2825
2826 /* vary storage format */
2827 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
2828
2829 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
2830
2831 /* vary upper / lower variation */
2832 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
2833
2834 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
2835
2836 /* vary incx = 1, 2 */
2837 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
2838
2839 incx = incx_val;
2840 if (0 == incx)
2841 continue;
2842
2843 /* vary incy = 1, 2 */
2844 for (incy_val = INCY_START; incy_val <= INCY_END;
2845 incy_val++) {
2846
2847 incy = incy_val;
2848 if (0 == incy)
2849 continue;
2850
2851 for (randomize_val = RANDOMIZE_START;
2852 randomize_val <= RANDOMIZE_END; randomize_val++) {
2853
2854 /* For the sake of speed, we throw out this case at random */
2855 if (xrand(seed) >= test_prob)
2856 continue;
2857
2858 saved_seed = *seed;
2859
2860 /* finally we are here to generate the test case */
2861 BLAS_zhpmv_z_c_testgen(norm, order_type,
2862 uplo_type, n, randomize_val,
2863 &alpha, alpha_flag, &beta,
2864 beta_flag, a, x, incx, y, incy,
2865 seed, head_r_true, tail_r_true);
2866 test_count++;
2867
2868 /* copy generated y vector since this will be
2869 over written */
2870 zcopy_vector(y, n, incy, y_gen, incy);
2871
2872 /* call hpmv routines to be tested */
2873 FPU_FIX_STOP;
2874 BLAS_zhpmv_z_c_x(order_type,
2875 uplo_type, n, alpha, a, x, incx, beta,
2876 y, incy, prec);
2877 FPU_FIX_START;
2878
2879 /* now compute the ratio using test_BLAS_xdot */
2880 /* copy a row from A, use x, run
2881 dot test */
2882
2883 incyi = incy;
2884
2885 incri = 1;
2886
2887 incyi *= 2;
2888 incri *= 2;
2889 if (incy < 0) {
2890 y_starti = (-n + 1) * incyi;
2891 } else {
2892 y_starti = 0;
2893 }
2894
2895 for (i = 0, yi = y_starti, ri = 0;
2896 i < n_i; i++, yi += incyi, ri += incri) {
2897 zhpmv_copy_row(order_type, uplo_type,
2898 n_i, a, a_vec, i);
2899
2900 /* just use the x vector -
2901 it was unchanged (in theory) */
2902
2903
2904 rin[0] = y_gen[yi];
2905 rin[1] = y_gen[yi + 1];
2906 rout[0] = y[yi];
2907 rout[1] = y[yi + 1];
2908 head_r_true_elem[0] = head_r_true[ri];
2909 head_r_true_elem[1] = head_r_true[ri + 1];
2910 tail_r_true_elem[0] = tail_r_true[ri];
2911 tail_r_true_elem[1] = tail_r_true[ri + 1];
2912
2913 test_BLAS_zdot_z_c(n_i,
2914 blas_no_conj,
2915 alpha, beta, rin, rout,
2916 head_r_true_elem, tail_r_true_elem,
2917 a_vec, 1, x, incx, eps_int, un_int,
2918 &ratios[ri]);
2919
2920 /* take the max ratio */
2921 if (ri == 0) {
2922 ratio = ratios[0];
2923 } else if (ratios[ri] > ratio) {
2924 ratio = ratios[ri];
2925 }
2926
2927 } /* end of dot-test loop */
2928
2929 if (ratio > thresh) {
2930
2931 if (debug == 3) {
2932 printf("\n\t\tTest # %d\n", test_count);
2933 printf("y type : z, a type : z, x type : c\n");
2934 printf("Seed = %d\n", saved_seed);
2935 printf("n %d\n", n);
2936 printf("INCX %d INCY %d\n", incx, incx);
2937
2938 if (order_type == blas_rowmajor)
2939 printf("row ");
2940 else
2941 printf("col ");
2942
2943 if (uplo_type == blas_upper)
2944 printf("upper ");
2945 else
2946 printf("lower");
2947
2948 printf("NORM %d, ALPHA %d, BETA %d\n",
2949 norm, alpha_val, beta_val);
2950 printf("E %d\n", prec);
2951
2952 /* print out info */
2953 printf("alpha = ");
2954 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
2955 printf(" ");
2956 printf("beta = ");
2957 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
2958 printf("\n");
2959
2960 printf("a\n");
2961 zprint_hpmv_matrix(a, n_i, order_type, uplo_type);
2962 cprint_vector(x, n, incx, "x");
2963 zprint_vector(y_gen, n, incy, "y_gen");
2964 zprint_vector(y, n, incy, "y");
2965 dprint_vector(head_r_true, n, 1, "head_r_true");
2966 dprint_vector(ratios, n, 1, "ratios");
2967 printf("ratio = %g\n", ratio);
2968 }
2969 bad_ratio_count++;
2970 }
2971
2972 if (ratio > ratio_max)
2973 ratio_max = ratio;
2974
2975 if (ratio != 0.0 && ratio < ratio_min)
2976 ratio_min = ratio;
2977
2978 } /* end of randmize loop */
2979
2980 } /* end of incy loop */
2981
2982 } /* end of incx loop */
2983
2984 } /* end of uplo loop */
2985
2986 } /* end of order loop */
2987
2988 } /* end of nr test loop */
2989
2990 } /* end of norm loop */
2991
2992
2993 } /* end of prec loop */
2994
2995 } /* end of beta loop */
2996
2997 } /* end of alpha loop */
2998
2999 FPU_FIX_STOP;
3000
3001 blas_free(y);
3002 blas_free(a);
3003 blas_free(x);
3004 blas_free(y_gen);
3005 blas_free(head_r_true);
3006 blas_free(tail_r_true);
3007 blas_free(ratios);
3008 blas_free(a_vec);
3009 blas_free(x_vec);
3010
3011 *max_ratio = ratio_max;
3012 *min_ratio = ratio_min;
3013 *num_tests = test_count;
3014 *num_bad_ratio = bad_ratio_count;
3015
3016 }
do_test_zhpmv_c_z_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)3017 void do_test_zhpmv_c_z_x
3018 (int n,
3019 int ntests, int *seed, double thresh, int debug, float test_prob,
3020 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
3021
3022 /* Function name */
3023 const char fname[] = "BLAS_zhpmv_c_z_x";
3024
3025 int i;
3026 int yi;
3027 int incyi, y_starti;
3028 int test_count;
3029 int bad_ratio_count;
3030
3031 int ri;
3032 int incri;
3033 int inca, incx, incy;
3034
3035 double ratio;
3036
3037 double ratio_min, ratio_max;
3038
3039 double eps_int; /* internal machine epsilon */
3040 double un_int; /* internal underflow threshold */
3041
3042 double rin[2];
3043 double rout[2];
3044 double head_r_true_elem[2], tail_r_true_elem[2];
3045
3046 enum blas_order_type order_type;
3047 enum blas_uplo_type uplo_type;
3048 enum blas_prec_type prec;
3049
3050 int order_val, uplo_val;
3051 int incx_val, incy_val;
3052 int alpha_val, beta_val;
3053 int randomize_val;
3054
3055 int prec_val;
3056
3057 int alpha_flag, beta_flag;
3058 int saved_seed;
3059 int norm;
3060 int test_no;
3061
3062 int n_i;
3063
3064 double alpha[2];
3065 double beta[2];
3066 float *a;
3067 double *x;
3068 double *y;
3069 float *a_vec;
3070 double *x_vec;
3071
3072 /* generated test values for c */
3073 double *y_gen;
3074
3075 double *ratios;
3076
3077 /* true result calculated by testgen, in double-double */
3078 double *head_r_true, *tail_r_true;
3079
3080
3081 FPU_FIX_DECL;
3082
3083 if (n < 0 || ntests < 0)
3084 BLAS_error(fname, 0, 0, NULL);
3085
3086 /* initialization */
3087 saved_seed = *seed;
3088 ratio = 0.0;
3089 ratio_min = 1e308;
3090 ratio_max = 0.0;
3091
3092 *num_tests = 0;
3093 *num_bad_ratio = 0;
3094 *min_ratio = 0.0;
3095 *max_ratio = 0.0;
3096
3097 if (n == 0)
3098 return;
3099
3100 FPU_FIX_START;
3101
3102 n_i = n;
3103
3104 inca = incx = incy = 1;
3105 inca *= 2;
3106 incx *= 2;
3107 incy *= 2;
3108
3109 /* allocate memory for arrays */
3110 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
3111 if (3 * n_i > 0 && y == NULL) {
3112 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3113 }
3114 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
3115 if (3 * n_i > 0 && y_gen == NULL) {
3116 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3117 }
3118 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
3119 if (2 * n_i * n_i > 0 && a == NULL) {
3120 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3121 }
3122 x = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
3123 if (3 * n_i > 0 && x == NULL) {
3124 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3125 }
3126 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
3127 if (n_i > 0 && a_vec == NULL) {
3128 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3129 }
3130 x_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
3131 if (n_i > 0 && x_vec == NULL) {
3132 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3133 }
3134 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3135 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3136 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
3137 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3138 }
3139 ratios = (double *) blas_malloc(2 * n * sizeof(double));
3140 if (2 * n > 0 && ratios == NULL) {
3141 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3142 }
3143
3144 test_count = 0;
3145 bad_ratio_count = 0;
3146
3147 /* vary alpha */
3148 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
3149
3150 alpha_flag = 0;
3151 switch (alpha_val) {
3152 case 0:
3153 alpha[0] = alpha[1] = 0.0;
3154 alpha_flag = 1;
3155 break;
3156 case 1:
3157 alpha[0] = 1.0;
3158 alpha[1] = 0.0;
3159 alpha_flag = 1;
3160 break;
3161 }
3162
3163 /* vary beta */
3164 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
3165 beta_flag = 0;
3166 switch (beta_val) {
3167 case 0:
3168 beta[0] = beta[1] = 0.0;
3169 beta_flag = 1;
3170 break;
3171 case 1:
3172 beta[0] = 1.0;
3173 beta[1] = 0.0;
3174 beta_flag = 1;
3175 break;
3176 }
3177
3178
3179 /* varying extra precs */
3180 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
3181 switch (prec_val) {
3182 case 0:
3183 eps_int = power(2, -BITS_D);
3184 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
3185 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
3186 prec = blas_prec_double;
3187 break;
3188 case 1:
3189 eps_int = power(2, -BITS_D);
3190 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
3191 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
3192 prec = blas_prec_double;
3193 break;
3194 case 2:
3195 default:
3196 eps_int = power(2, -BITS_E);
3197 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
3198 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
3199 prec = blas_prec_extra;
3200 break;
3201 }
3202
3203 /* vary norm -- underflow, approx 1, overflow */
3204 for (norm = NORM_START; norm <= NORM_END; norm++) {
3205
3206 /* number of tests */
3207 for (test_no = 0; test_no < ntests; test_no++) {
3208
3209
3210 /* vary storage format */
3211 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
3212
3213 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
3214
3215 /* vary upper / lower variation */
3216 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
3217
3218 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
3219
3220 /* vary incx = 1, 2 */
3221 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
3222
3223 incx = incx_val;
3224 if (0 == incx)
3225 continue;
3226
3227 /* vary incy = 1, 2 */
3228 for (incy_val = INCY_START; incy_val <= INCY_END;
3229 incy_val++) {
3230
3231 incy = incy_val;
3232 if (0 == incy)
3233 continue;
3234
3235 for (randomize_val = RANDOMIZE_START;
3236 randomize_val <= RANDOMIZE_END; randomize_val++) {
3237
3238 /* For the sake of speed, we throw out this case at random */
3239 if (xrand(seed) >= test_prob)
3240 continue;
3241
3242 saved_seed = *seed;
3243
3244 /* finally we are here to generate the test case */
3245 BLAS_zhpmv_c_z_testgen(norm, order_type,
3246 uplo_type, n, randomize_val,
3247 &alpha, alpha_flag, &beta,
3248 beta_flag, a, x, incx, y, incy,
3249 seed, head_r_true, tail_r_true);
3250 test_count++;
3251
3252 /* copy generated y vector since this will be
3253 over written */
3254 zcopy_vector(y, n, incy, y_gen, incy);
3255
3256 /* call hpmv routines to be tested */
3257 FPU_FIX_STOP;
3258 BLAS_zhpmv_c_z_x(order_type,
3259 uplo_type, n, alpha, a, x, incx, beta,
3260 y, incy, prec);
3261 FPU_FIX_START;
3262
3263 /* now compute the ratio using test_BLAS_xdot */
3264 /* copy a row from A, use x, run
3265 dot test */
3266
3267 incyi = incy;
3268
3269 incri = 1;
3270
3271 incyi *= 2;
3272 incri *= 2;
3273 if (incy < 0) {
3274 y_starti = (-n + 1) * incyi;
3275 } else {
3276 y_starti = 0;
3277 }
3278
3279 for (i = 0, yi = y_starti, ri = 0;
3280 i < n_i; i++, yi += incyi, ri += incri) {
3281 chpmv_copy_row(order_type, uplo_type,
3282 n_i, a, a_vec, i);
3283
3284 /* just use the x vector -
3285 it was unchanged (in theory) */
3286
3287
3288 rin[0] = y_gen[yi];
3289 rin[1] = y_gen[yi + 1];
3290 rout[0] = y[yi];
3291 rout[1] = y[yi + 1];
3292 head_r_true_elem[0] = head_r_true[ri];
3293 head_r_true_elem[1] = head_r_true[ri + 1];
3294 tail_r_true_elem[0] = tail_r_true[ri];
3295 tail_r_true_elem[1] = tail_r_true[ri + 1];
3296
3297 test_BLAS_zdot_c_z(n_i,
3298 blas_no_conj,
3299 alpha, beta, rin, rout,
3300 head_r_true_elem, tail_r_true_elem,
3301 a_vec, 1, x, incx, eps_int, un_int,
3302 &ratios[ri]);
3303
3304 /* take the max ratio */
3305 if (ri == 0) {
3306 ratio = ratios[0];
3307 } else if (ratios[ri] > ratio) {
3308 ratio = ratios[ri];
3309 }
3310
3311 } /* end of dot-test loop */
3312
3313 if (ratio > thresh) {
3314
3315 if (debug == 3) {
3316 printf("\n\t\tTest # %d\n", test_count);
3317 printf("y type : z, a type : c, x type : z\n");
3318 printf("Seed = %d\n", saved_seed);
3319 printf("n %d\n", n);
3320 printf("INCX %d INCY %d\n", incx, incx);
3321
3322 if (order_type == blas_rowmajor)
3323 printf("row ");
3324 else
3325 printf("col ");
3326
3327 if (uplo_type == blas_upper)
3328 printf("upper ");
3329 else
3330 printf("lower");
3331
3332 printf("NORM %d, ALPHA %d, BETA %d\n",
3333 norm, alpha_val, beta_val);
3334 printf("E %d\n", prec);
3335
3336 /* print out info */
3337 printf("alpha = ");
3338 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
3339 printf(" ");
3340 printf("beta = ");
3341 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
3342 printf("\n");
3343
3344 printf("a\n");
3345 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
3346 zprint_vector(x, n, incx, "x");
3347 zprint_vector(y_gen, n, incy, "y_gen");
3348 zprint_vector(y, n, incy, "y");
3349 dprint_vector(head_r_true, n, 1, "head_r_true");
3350 dprint_vector(ratios, n, 1, "ratios");
3351 printf("ratio = %g\n", ratio);
3352 }
3353 bad_ratio_count++;
3354 }
3355
3356 if (ratio > ratio_max)
3357 ratio_max = ratio;
3358
3359 if (ratio != 0.0 && ratio < ratio_min)
3360 ratio_min = ratio;
3361
3362 } /* end of randmize loop */
3363
3364 } /* end of incy loop */
3365
3366 } /* end of incx loop */
3367
3368 } /* end of uplo loop */
3369
3370 } /* end of order loop */
3371
3372 } /* end of nr test loop */
3373
3374 } /* end of norm loop */
3375
3376
3377 } /* end of prec loop */
3378
3379 } /* end of beta loop */
3380
3381 } /* end of alpha loop */
3382
3383 FPU_FIX_STOP;
3384
3385 blas_free(y);
3386 blas_free(a);
3387 blas_free(x);
3388 blas_free(y_gen);
3389 blas_free(head_r_true);
3390 blas_free(tail_r_true);
3391 blas_free(ratios);
3392 blas_free(a_vec);
3393 blas_free(x_vec);
3394
3395 *max_ratio = ratio_max;
3396 *min_ratio = ratio_min;
3397 *num_tests = test_count;
3398 *num_bad_ratio = bad_ratio_count;
3399
3400 }
do_test_zhpmv_c_c_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)3401 void do_test_zhpmv_c_c_x
3402 (int n,
3403 int ntests, int *seed, double thresh, int debug, float test_prob,
3404 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
3405
3406 /* Function name */
3407 const char fname[] = "BLAS_zhpmv_c_c_x";
3408
3409 int i;
3410 int yi;
3411 int incyi, y_starti;
3412 int test_count;
3413 int bad_ratio_count;
3414
3415 int ri;
3416 int incri;
3417 int inca, incx, incy;
3418
3419 double ratio;
3420
3421 double ratio_min, ratio_max;
3422
3423 double eps_int; /* internal machine epsilon */
3424 double un_int; /* internal underflow threshold */
3425
3426 double rin[2];
3427 double rout[2];
3428 double head_r_true_elem[2], tail_r_true_elem[2];
3429
3430 enum blas_order_type order_type;
3431 enum blas_uplo_type uplo_type;
3432 enum blas_prec_type prec;
3433
3434 int order_val, uplo_val;
3435 int incx_val, incy_val;
3436 int alpha_val, beta_val;
3437 int randomize_val;
3438
3439 int prec_val;
3440
3441 int alpha_flag, beta_flag;
3442 int saved_seed;
3443 int norm;
3444 int test_no;
3445
3446 int n_i;
3447
3448 double alpha[2];
3449 double beta[2];
3450 float *a;
3451 float *x;
3452 double *y;
3453 float *a_vec;
3454 float *x_vec;
3455
3456 /* generated test values for c */
3457 double *y_gen;
3458
3459 double *ratios;
3460
3461 /* true result calculated by testgen, in double-double */
3462 double *head_r_true, *tail_r_true;
3463
3464
3465 FPU_FIX_DECL;
3466
3467 if (n < 0 || ntests < 0)
3468 BLAS_error(fname, 0, 0, NULL);
3469
3470 /* initialization */
3471 saved_seed = *seed;
3472 ratio = 0.0;
3473 ratio_min = 1e308;
3474 ratio_max = 0.0;
3475
3476 *num_tests = 0;
3477 *num_bad_ratio = 0;
3478 *min_ratio = 0.0;
3479 *max_ratio = 0.0;
3480
3481 if (n == 0)
3482 return;
3483
3484 FPU_FIX_START;
3485
3486 n_i = n;
3487
3488 inca = incx = incy = 1;
3489 inca *= 2;
3490 incx *= 2;
3491 incy *= 2;
3492
3493 /* allocate memory for arrays */
3494 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
3495 if (3 * n_i > 0 && y == NULL) {
3496 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3497 }
3498 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
3499 if (3 * n_i > 0 && y_gen == NULL) {
3500 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3501 }
3502 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
3503 if (2 * n_i * n_i > 0 && a == NULL) {
3504 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3505 }
3506 x = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
3507 if (3 * n_i > 0 && x == NULL) {
3508 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3509 }
3510 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
3511 if (n_i > 0 && a_vec == NULL) {
3512 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3513 }
3514 x_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
3515 if (n_i > 0 && x_vec == NULL) {
3516 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3517 }
3518 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3519 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3520 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
3521 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3522 }
3523 ratios = (double *) blas_malloc(2 * n * sizeof(double));
3524 if (2 * n > 0 && ratios == NULL) {
3525 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3526 }
3527
3528 test_count = 0;
3529 bad_ratio_count = 0;
3530
3531 /* vary alpha */
3532 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
3533
3534 alpha_flag = 0;
3535 switch (alpha_val) {
3536 case 0:
3537 alpha[0] = alpha[1] = 0.0;
3538 alpha_flag = 1;
3539 break;
3540 case 1:
3541 alpha[0] = 1.0;
3542 alpha[1] = 0.0;
3543 alpha_flag = 1;
3544 break;
3545 }
3546
3547 /* vary beta */
3548 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
3549 beta_flag = 0;
3550 switch (beta_val) {
3551 case 0:
3552 beta[0] = beta[1] = 0.0;
3553 beta_flag = 1;
3554 break;
3555 case 1:
3556 beta[0] = 1.0;
3557 beta[1] = 0.0;
3558 beta_flag = 1;
3559 break;
3560 }
3561
3562
3563 /* varying extra precs */
3564 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
3565 switch (prec_val) {
3566 case 0:
3567 eps_int = power(2, -BITS_D);
3568 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
3569 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
3570 prec = blas_prec_double;
3571 break;
3572 case 1:
3573 eps_int = power(2, -BITS_D);
3574 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
3575 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
3576 prec = blas_prec_double;
3577 break;
3578 case 2:
3579 default:
3580 eps_int = power(2, -BITS_E);
3581 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
3582 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
3583 prec = blas_prec_extra;
3584 break;
3585 }
3586
3587 /* vary norm -- underflow, approx 1, overflow */
3588 for (norm = NORM_START; norm <= NORM_END; norm++) {
3589
3590 /* number of tests */
3591 for (test_no = 0; test_no < ntests; test_no++) {
3592
3593
3594 /* vary storage format */
3595 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
3596
3597 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
3598
3599 /* vary upper / lower variation */
3600 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
3601
3602 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
3603
3604 /* vary incx = 1, 2 */
3605 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
3606
3607 incx = incx_val;
3608 if (0 == incx)
3609 continue;
3610
3611 /* vary incy = 1, 2 */
3612 for (incy_val = INCY_START; incy_val <= INCY_END;
3613 incy_val++) {
3614
3615 incy = incy_val;
3616 if (0 == incy)
3617 continue;
3618
3619 for (randomize_val = RANDOMIZE_START;
3620 randomize_val <= RANDOMIZE_END; randomize_val++) {
3621
3622 /* For the sake of speed, we throw out this case at random */
3623 if (xrand(seed) >= test_prob)
3624 continue;
3625
3626 saved_seed = *seed;
3627
3628 /* finally we are here to generate the test case */
3629 BLAS_zhpmv_c_c_testgen(norm, order_type,
3630 uplo_type, n, randomize_val,
3631 &alpha, alpha_flag, &beta,
3632 beta_flag, a, x, incx, y, incy,
3633 seed, head_r_true, tail_r_true);
3634 test_count++;
3635
3636 /* copy generated y vector since this will be
3637 over written */
3638 zcopy_vector(y, n, incy, y_gen, incy);
3639
3640 /* call hpmv routines to be tested */
3641 FPU_FIX_STOP;
3642 BLAS_zhpmv_c_c_x(order_type,
3643 uplo_type, n, alpha, a, x, incx, beta,
3644 y, incy, prec);
3645 FPU_FIX_START;
3646
3647 /* now compute the ratio using test_BLAS_xdot */
3648 /* copy a row from A, use x, run
3649 dot test */
3650
3651 incyi = incy;
3652
3653 incri = 1;
3654
3655 incyi *= 2;
3656 incri *= 2;
3657 if (incy < 0) {
3658 y_starti = (-n + 1) * incyi;
3659 } else {
3660 y_starti = 0;
3661 }
3662
3663 for (i = 0, yi = y_starti, ri = 0;
3664 i < n_i; i++, yi += incyi, ri += incri) {
3665 chpmv_copy_row(order_type, uplo_type,
3666 n_i, a, a_vec, i);
3667
3668 /* just use the x vector -
3669 it was unchanged (in theory) */
3670
3671
3672 rin[0] = y_gen[yi];
3673 rin[1] = y_gen[yi + 1];
3674 rout[0] = y[yi];
3675 rout[1] = y[yi + 1];
3676 head_r_true_elem[0] = head_r_true[ri];
3677 head_r_true_elem[1] = head_r_true[ri + 1];
3678 tail_r_true_elem[0] = tail_r_true[ri];
3679 tail_r_true_elem[1] = tail_r_true[ri + 1];
3680
3681 test_BLAS_zdot_c_c(n_i,
3682 blas_no_conj,
3683 alpha, beta, rin, rout,
3684 head_r_true_elem, tail_r_true_elem,
3685 a_vec, 1, x, incx, eps_int, un_int,
3686 &ratios[ri]);
3687
3688 /* take the max ratio */
3689 if (ri == 0) {
3690 ratio = ratios[0];
3691 } else if (ratios[ri] > ratio) {
3692 ratio = ratios[ri];
3693 }
3694
3695 } /* end of dot-test loop */
3696
3697 if (ratio > thresh) {
3698
3699 if (debug == 3) {
3700 printf("\n\t\tTest # %d\n", test_count);
3701 printf("y type : z, a type : c, x type : c\n");
3702 printf("Seed = %d\n", saved_seed);
3703 printf("n %d\n", n);
3704 printf("INCX %d INCY %d\n", incx, incx);
3705
3706 if (order_type == blas_rowmajor)
3707 printf("row ");
3708 else
3709 printf("col ");
3710
3711 if (uplo_type == blas_upper)
3712 printf("upper ");
3713 else
3714 printf("lower");
3715
3716 printf("NORM %d, ALPHA %d, BETA %d\n",
3717 norm, alpha_val, beta_val);
3718 printf("E %d\n", prec);
3719
3720 /* print out info */
3721 printf("alpha = ");
3722 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
3723 printf(" ");
3724 printf("beta = ");
3725 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
3726 printf("\n");
3727
3728 printf("a\n");
3729 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
3730 cprint_vector(x, n, incx, "x");
3731 zprint_vector(y_gen, n, incy, "y_gen");
3732 zprint_vector(y, n, incy, "y");
3733 dprint_vector(head_r_true, n, 1, "head_r_true");
3734 dprint_vector(ratios, n, 1, "ratios");
3735 printf("ratio = %g\n", ratio);
3736 }
3737 bad_ratio_count++;
3738 }
3739
3740 if (ratio > ratio_max)
3741 ratio_max = ratio;
3742
3743 if (ratio != 0.0 && ratio < ratio_min)
3744 ratio_min = ratio;
3745
3746 } /* end of randmize loop */
3747
3748 } /* end of incy loop */
3749
3750 } /* end of incx loop */
3751
3752 } /* end of uplo loop */
3753
3754 } /* end of order loop */
3755
3756 } /* end of nr test loop */
3757
3758 } /* end of norm loop */
3759
3760
3761 } /* end of prec loop */
3762
3763 } /* end of beta loop */
3764
3765 } /* end of alpha loop */
3766
3767 FPU_FIX_STOP;
3768
3769 blas_free(y);
3770 blas_free(a);
3771 blas_free(x);
3772 blas_free(y_gen);
3773 blas_free(head_r_true);
3774 blas_free(tail_r_true);
3775 blas_free(ratios);
3776 blas_free(a_vec);
3777 blas_free(x_vec);
3778
3779 *max_ratio = ratio_max;
3780 *min_ratio = ratio_min;
3781 *num_tests = test_count;
3782 *num_bad_ratio = bad_ratio_count;
3783
3784 }
do_test_chpmv_c_s_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)3785 void do_test_chpmv_c_s_x
3786 (int n,
3787 int ntests, int *seed, double thresh, int debug, float test_prob,
3788 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
3789
3790 /* Function name */
3791 const char fname[] = "BLAS_chpmv_c_s_x";
3792
3793 int i;
3794 int yi;
3795 int incyi, y_starti;
3796 int test_count;
3797 int bad_ratio_count;
3798
3799 int ri;
3800 int incri;
3801 int inca, incx, incy;
3802
3803 double ratio;
3804
3805 double ratio_min, ratio_max;
3806
3807 double eps_int; /* internal machine epsilon */
3808 double un_int; /* internal underflow threshold */
3809
3810 float rin[2];
3811 float rout[2];
3812 double head_r_true_elem[2], tail_r_true_elem[2];
3813
3814 enum blas_order_type order_type;
3815 enum blas_uplo_type uplo_type;
3816 enum blas_prec_type prec;
3817
3818 int order_val, uplo_val;
3819 int incx_val, incy_val;
3820 int alpha_val, beta_val;
3821 int randomize_val;
3822
3823 int prec_val;
3824
3825 int alpha_flag, beta_flag;
3826 int saved_seed;
3827 int norm;
3828 int test_no;
3829
3830 int n_i;
3831
3832 float alpha[2];
3833 float beta[2];
3834 float *a;
3835 float *x;
3836 float *y;
3837 float *a_vec;
3838 float *x_vec;
3839
3840 /* generated test values for c */
3841 float *y_gen;
3842
3843 double *ratios;
3844
3845 /* true result calculated by testgen, in double-double */
3846 double *head_r_true, *tail_r_true;
3847
3848
3849 FPU_FIX_DECL;
3850
3851 if (n < 0 || ntests < 0)
3852 BLAS_error(fname, 0, 0, NULL);
3853
3854 /* initialization */
3855 saved_seed = *seed;
3856 ratio = 0.0;
3857 ratio_min = 1e308;
3858 ratio_max = 0.0;
3859
3860 *num_tests = 0;
3861 *num_bad_ratio = 0;
3862 *min_ratio = 0.0;
3863 *max_ratio = 0.0;
3864
3865 if (n == 0)
3866 return;
3867
3868 FPU_FIX_START;
3869
3870 n_i = n;
3871
3872 inca = incx = incy = 1;
3873 inca *= 2;
3874
3875 incy *= 2;
3876
3877 /* allocate memory for arrays */
3878 y = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
3879 if (3 * n_i > 0 && y == NULL) {
3880 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3881 }
3882 y_gen = (float *) blas_malloc(3 * n_i * sizeof(float) * 2);
3883 if (3 * n_i > 0 && y_gen == NULL) {
3884 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3885 }
3886 a = (float *) blas_malloc(2 * n_i * n_i * sizeof(float) * 2);
3887 if (2 * n_i * n_i > 0 && a == NULL) {
3888 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3889 }
3890 x = (float *) blas_malloc(3 * n_i * sizeof(float));
3891 if (3 * n_i > 0 && x == NULL) {
3892 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3893 }
3894 a_vec = (float *) blas_malloc(n_i * sizeof(float) * 2);
3895 if (n_i > 0 && a_vec == NULL) {
3896 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3897 }
3898 x_vec = (float *) blas_malloc(n_i * sizeof(float));
3899 if (n_i > 0 && x_vec == NULL) {
3900 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3901 }
3902 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3903 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
3904 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
3905 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3906 }
3907 ratios = (double *) blas_malloc(2 * n * sizeof(double));
3908 if (2 * n > 0 && ratios == NULL) {
3909 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
3910 }
3911
3912 test_count = 0;
3913 bad_ratio_count = 0;
3914
3915 /* vary alpha */
3916 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
3917
3918 alpha_flag = 0;
3919 switch (alpha_val) {
3920 case 0:
3921 alpha[0] = alpha[1] = 0.0;
3922 alpha_flag = 1;
3923 break;
3924 case 1:
3925 alpha[0] = 1.0;
3926 alpha[1] = 0.0;
3927 alpha_flag = 1;
3928 break;
3929 }
3930
3931 /* vary beta */
3932 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
3933 beta_flag = 0;
3934 switch (beta_val) {
3935 case 0:
3936 beta[0] = beta[1] = 0.0;
3937 beta_flag = 1;
3938 break;
3939 case 1:
3940 beta[0] = 1.0;
3941 beta[1] = 0.0;
3942 beta_flag = 1;
3943 break;
3944 }
3945
3946
3947 /* varying extra precs */
3948 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
3949 switch (prec_val) {
3950 case 0:
3951 eps_int = power(2, -BITS_S);
3952 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
3953 (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
3954 prec = blas_prec_single;
3955 break;
3956 case 1:
3957 eps_int = power(2, -BITS_D);
3958 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
3959 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
3960 prec = blas_prec_double;
3961 break;
3962 case 2:
3963 default:
3964 eps_int = power(2, -BITS_E);
3965 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
3966 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
3967 prec = blas_prec_extra;
3968 break;
3969 }
3970
3971 /* vary norm -- underflow, approx 1, overflow */
3972 for (norm = NORM_START; norm <= NORM_END; norm++) {
3973
3974 /* number of tests */
3975 for (test_no = 0; test_no < ntests; test_no++) {
3976
3977
3978 /* vary storage format */
3979 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
3980
3981 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
3982
3983 /* vary upper / lower variation */
3984 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
3985
3986 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
3987
3988 /* vary incx = 1, 2 */
3989 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
3990
3991 incx = incx_val;
3992 if (0 == incx)
3993 continue;
3994
3995 /* vary incy = 1, 2 */
3996 for (incy_val = INCY_START; incy_val <= INCY_END;
3997 incy_val++) {
3998
3999 incy = incy_val;
4000 if (0 == incy)
4001 continue;
4002
4003 for (randomize_val = RANDOMIZE_START;
4004 randomize_val <= RANDOMIZE_END; randomize_val++) {
4005
4006 /* For the sake of speed, we throw out this case at random */
4007 if (xrand(seed) >= test_prob)
4008 continue;
4009
4010 saved_seed = *seed;
4011
4012 /* finally we are here to generate the test case */
4013 BLAS_chpmv_c_s_testgen(norm, order_type,
4014 uplo_type, n, randomize_val,
4015 &alpha, alpha_flag, &beta,
4016 beta_flag, a, x, incx, y, incy,
4017 seed, head_r_true, tail_r_true);
4018 test_count++;
4019
4020 /* copy generated y vector since this will be
4021 over written */
4022 ccopy_vector(y, n, incy, y_gen, incy);
4023
4024 /* call hpmv routines to be tested */
4025 FPU_FIX_STOP;
4026 BLAS_chpmv_c_s_x(order_type,
4027 uplo_type, n, alpha, a, x, incx, beta,
4028 y, incy, prec);
4029 FPU_FIX_START;
4030
4031 /* now compute the ratio using test_BLAS_xdot */
4032 /* copy a row from A, use x, run
4033 dot test */
4034
4035 incyi = incy;
4036
4037 incri = 1;
4038
4039 incyi *= 2;
4040 incri *= 2;
4041 if (incy < 0) {
4042 y_starti = (-n + 1) * incyi;
4043 } else {
4044 y_starti = 0;
4045 }
4046
4047 for (i = 0, yi = y_starti, ri = 0;
4048 i < n_i; i++, yi += incyi, ri += incri) {
4049 chpmv_copy_row(order_type, uplo_type,
4050 n_i, a, a_vec, i);
4051
4052 /* just use the x vector -
4053 it was unchanged (in theory) */
4054
4055
4056 rin[0] = y_gen[yi];
4057 rin[1] = y_gen[yi + 1];
4058 rout[0] = y[yi];
4059 rout[1] = y[yi + 1];
4060 head_r_true_elem[0] = head_r_true[ri];
4061 head_r_true_elem[1] = head_r_true[ri + 1];
4062 tail_r_true_elem[0] = tail_r_true[ri];
4063 tail_r_true_elem[1] = tail_r_true[ri + 1];
4064
4065 test_BLAS_cdot_c_s(n_i,
4066 blas_no_conj,
4067 alpha, beta, rin, rout,
4068 head_r_true_elem, tail_r_true_elem,
4069 a_vec, 1, x, incx, eps_int, un_int,
4070 &ratios[ri]);
4071
4072 /* take the max ratio */
4073 if (ri == 0) {
4074 ratio = ratios[0];
4075 } else if (ratios[ri] > ratio) {
4076 ratio = ratios[ri];
4077 }
4078
4079 } /* end of dot-test loop */
4080
4081 if (ratio > thresh) {
4082
4083 if (debug == 3) {
4084 printf("\n\t\tTest # %d\n", test_count);
4085 printf("y type : c, a type : c, x type : s\n");
4086 printf("Seed = %d\n", saved_seed);
4087 printf("n %d\n", n);
4088 printf("INCX %d INCY %d\n", incx, incx);
4089
4090 if (order_type == blas_rowmajor)
4091 printf("row ");
4092 else
4093 printf("col ");
4094
4095 if (uplo_type == blas_upper)
4096 printf("upper ");
4097 else
4098 printf("lower");
4099
4100 printf("NORM %d, ALPHA %d, BETA %d\n",
4101 norm, alpha_val, beta_val);
4102 printf("E %d\n", prec);
4103
4104 /* print out info */
4105 printf("alpha = ");
4106 printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
4107 printf(" ");
4108 printf("beta = ");
4109 printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
4110 printf("\n");
4111
4112 printf("a\n");
4113 cprint_hpmv_matrix(a, n_i, order_type, uplo_type);
4114 sprint_vector(x, n, incx, "x");
4115 cprint_vector(y_gen, n, incy, "y_gen");
4116 cprint_vector(y, n, incy, "y");
4117 dprint_vector(head_r_true, n, 1, "head_r_true");
4118 dprint_vector(ratios, n, 1, "ratios");
4119 printf("ratio = %g\n", ratio);
4120 }
4121 bad_ratio_count++;
4122 }
4123
4124 if (ratio > ratio_max)
4125 ratio_max = ratio;
4126
4127 if (ratio != 0.0 && ratio < ratio_min)
4128 ratio_min = ratio;
4129
4130 } /* end of randmize loop */
4131
4132 } /* end of incy loop */
4133
4134 } /* end of incx loop */
4135
4136 } /* end of uplo loop */
4137
4138 } /* end of order loop */
4139
4140 } /* end of nr test loop */
4141
4142 } /* end of norm loop */
4143
4144
4145 } /* end of prec loop */
4146
4147 } /* end of beta loop */
4148
4149 } /* end of alpha loop */
4150
4151 FPU_FIX_STOP;
4152
4153 blas_free(y);
4154 blas_free(a);
4155 blas_free(x);
4156 blas_free(y_gen);
4157 blas_free(head_r_true);
4158 blas_free(tail_r_true);
4159 blas_free(ratios);
4160 blas_free(a_vec);
4161 blas_free(x_vec);
4162
4163 *max_ratio = ratio_max;
4164 *min_ratio = ratio_min;
4165 *num_tests = test_count;
4166 *num_bad_ratio = bad_ratio_count;
4167
4168 }
do_test_zhpmv_z_d_x(int n,int ntests,int * seed,double thresh,int debug,float test_prob,double * min_ratio,double * max_ratio,int * num_bad_ratio,int * num_tests)4169 void do_test_zhpmv_z_d_x
4170 (int n,
4171 int ntests, int *seed, double thresh, int debug, float test_prob,
4172 double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
4173
4174 /* Function name */
4175 const char fname[] = "BLAS_zhpmv_z_d_x";
4176
4177 int i;
4178 int yi;
4179 int incyi, y_starti;
4180 int test_count;
4181 int bad_ratio_count;
4182
4183 int ri;
4184 int incri;
4185 int inca, incx, incy;
4186
4187 double ratio;
4188
4189 double ratio_min, ratio_max;
4190
4191 double eps_int; /* internal machine epsilon */
4192 double un_int; /* internal underflow threshold */
4193
4194 double rin[2];
4195 double rout[2];
4196 double head_r_true_elem[2], tail_r_true_elem[2];
4197
4198 enum blas_order_type order_type;
4199 enum blas_uplo_type uplo_type;
4200 enum blas_prec_type prec;
4201
4202 int order_val, uplo_val;
4203 int incx_val, incy_val;
4204 int alpha_val, beta_val;
4205 int randomize_val;
4206
4207 int prec_val;
4208
4209 int alpha_flag, beta_flag;
4210 int saved_seed;
4211 int norm;
4212 int test_no;
4213
4214 int n_i;
4215
4216 double alpha[2];
4217 double beta[2];
4218 double *a;
4219 double *x;
4220 double *y;
4221 double *a_vec;
4222 double *x_vec;
4223
4224 /* generated test values for c */
4225 double *y_gen;
4226
4227 double *ratios;
4228
4229 /* true result calculated by testgen, in double-double */
4230 double *head_r_true, *tail_r_true;
4231
4232
4233 FPU_FIX_DECL;
4234
4235 if (n < 0 || ntests < 0)
4236 BLAS_error(fname, 0, 0, NULL);
4237
4238 /* initialization */
4239 saved_seed = *seed;
4240 ratio = 0.0;
4241 ratio_min = 1e308;
4242 ratio_max = 0.0;
4243
4244 *num_tests = 0;
4245 *num_bad_ratio = 0;
4246 *min_ratio = 0.0;
4247 *max_ratio = 0.0;
4248
4249 if (n == 0)
4250 return;
4251
4252 FPU_FIX_START;
4253
4254 n_i = n;
4255
4256 inca = incx = incy = 1;
4257 inca *= 2;
4258
4259 incy *= 2;
4260
4261 /* allocate memory for arrays */
4262 y = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
4263 if (3 * n_i > 0 && y == NULL) {
4264 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4265 }
4266 y_gen = (double *) blas_malloc(3 * n_i * sizeof(double) * 2);
4267 if (3 * n_i > 0 && y_gen == NULL) {
4268 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4269 }
4270 a = (double *) blas_malloc(2 * n_i * n_i * sizeof(double) * 2);
4271 if (2 * n_i * n_i > 0 && a == NULL) {
4272 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4273 }
4274 x = (double *) blas_malloc(3 * n_i * sizeof(double));
4275 if (3 * n_i > 0 && x == NULL) {
4276 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4277 }
4278 a_vec = (double *) blas_malloc(n_i * sizeof(double) * 2);
4279 if (n_i > 0 && a_vec == NULL) {
4280 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4281 }
4282 x_vec = (double *) blas_malloc(n_i * sizeof(double));
4283 if (n_i > 0 && x_vec == NULL) {
4284 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4285 }
4286 head_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
4287 tail_r_true = (double *) blas_malloc(n_i * sizeof(double) * 2);
4288 if (n_i > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
4289 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4290 }
4291 ratios = (double *) blas_malloc(2 * n * sizeof(double));
4292 if (2 * n > 0 && ratios == NULL) {
4293 BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
4294 }
4295
4296 test_count = 0;
4297 bad_ratio_count = 0;
4298
4299 /* vary alpha */
4300 for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
4301
4302 alpha_flag = 0;
4303 switch (alpha_val) {
4304 case 0:
4305 alpha[0] = alpha[1] = 0.0;
4306 alpha_flag = 1;
4307 break;
4308 case 1:
4309 alpha[0] = 1.0;
4310 alpha[1] = 0.0;
4311 alpha_flag = 1;
4312 break;
4313 }
4314
4315 /* vary beta */
4316 for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
4317 beta_flag = 0;
4318 switch (beta_val) {
4319 case 0:
4320 beta[0] = beta[1] = 0.0;
4321 beta_flag = 1;
4322 break;
4323 case 1:
4324 beta[0] = 1.0;
4325 beta[1] = 0.0;
4326 beta_flag = 1;
4327 break;
4328 }
4329
4330
4331 /* varying extra precs */
4332 for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
4333 switch (prec_val) {
4334 case 0:
4335 eps_int = power(2, -BITS_D);
4336 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
4337 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
4338 prec = blas_prec_double;
4339 break;
4340 case 1:
4341 eps_int = power(2, -BITS_D);
4342 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
4343 (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
4344 prec = blas_prec_double;
4345 break;
4346 case 2:
4347 default:
4348 eps_int = power(2, -BITS_E);
4349 un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
4350 (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
4351 prec = blas_prec_extra;
4352 break;
4353 }
4354
4355 /* vary norm -- underflow, approx 1, overflow */
4356 for (norm = NORM_START; norm <= NORM_END; norm++) {
4357
4358 /* number of tests */
4359 for (test_no = 0; test_no < ntests; test_no++) {
4360
4361
4362 /* vary storage format */
4363 for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
4364
4365 order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
4366
4367 /* vary upper / lower variation */
4368 for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
4369
4370 uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
4371
4372 /* vary incx = 1, 2 */
4373 for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
4374
4375 incx = incx_val;
4376 if (0 == incx)
4377 continue;
4378
4379 /* vary incy = 1, 2 */
4380 for (incy_val = INCY_START; incy_val <= INCY_END;
4381 incy_val++) {
4382
4383 incy = incy_val;
4384 if (0 == incy)
4385 continue;
4386
4387 for (randomize_val = RANDOMIZE_START;
4388 randomize_val <= RANDOMIZE_END; randomize_val++) {
4389
4390 /* For the sake of speed, we throw out this case at random */
4391 if (xrand(seed) >= test_prob)
4392 continue;
4393
4394 saved_seed = *seed;
4395
4396 /* finally we are here to generate the test case */
4397 BLAS_zhpmv_z_d_testgen(norm, order_type,
4398 uplo_type, n, randomize_val,
4399 &alpha, alpha_flag, &beta,
4400 beta_flag, a, x, incx, y, incy,
4401 seed, head_r_true, tail_r_true);
4402 test_count++;
4403
4404 /* copy generated y vector since this will be
4405 over written */
4406 zcopy_vector(y, n, incy, y_gen, incy);
4407
4408 /* call hpmv routines to be tested */
4409 FPU_FIX_STOP;
4410 BLAS_zhpmv_z_d_x(order_type,
4411 uplo_type, n, alpha, a, x, incx, beta,
4412 y, incy, prec);
4413 FPU_FIX_START;
4414
4415 /* now compute the ratio using test_BLAS_xdot */
4416 /* copy a row from A, use x, run
4417 dot test */
4418
4419 incyi = incy;
4420
4421 incri = 1;
4422
4423 incyi *= 2;
4424 incri *= 2;
4425 if (incy < 0) {
4426 y_starti = (-n + 1) * incyi;
4427 } else {
4428 y_starti = 0;
4429 }
4430
4431 for (i = 0, yi = y_starti, ri = 0;
4432 i < n_i; i++, yi += incyi, ri += incri) {
4433 zhpmv_copy_row(order_type, uplo_type,
4434 n_i, a, a_vec, i);
4435
4436 /* just use the x vector -
4437 it was unchanged (in theory) */
4438
4439
4440 rin[0] = y_gen[yi];
4441 rin[1] = y_gen[yi + 1];
4442 rout[0] = y[yi];
4443 rout[1] = y[yi + 1];
4444 head_r_true_elem[0] = head_r_true[ri];
4445 head_r_true_elem[1] = head_r_true[ri + 1];
4446 tail_r_true_elem[0] = tail_r_true[ri];
4447 tail_r_true_elem[1] = tail_r_true[ri + 1];
4448
4449 test_BLAS_zdot_z_d(n_i,
4450 blas_no_conj,
4451 alpha, beta, rin, rout,
4452 head_r_true_elem, tail_r_true_elem,
4453 a_vec, 1, x, incx, eps_int, un_int,
4454 &ratios[ri]);
4455
4456 /* take the max ratio */
4457 if (ri == 0) {
4458 ratio = ratios[0];
4459 } else if (ratios[ri] > ratio) {
4460 ratio = ratios[ri];
4461 }
4462
4463 } /* end of dot-test loop */
4464
4465 if (ratio > thresh) {
4466
4467 if (debug == 3) {
4468 printf("\n\t\tTest # %d\n", test_count);
4469 printf("y type : z, a type : z, x type : d\n");
4470 printf("Seed = %d\n", saved_seed);
4471 printf("n %d\n", n);
4472 printf("INCX %d INCY %d\n", incx, incx);
4473
4474 if (order_type == blas_rowmajor)
4475 printf("row ");
4476 else
4477 printf("col ");
4478
4479 if (uplo_type == blas_upper)
4480 printf("upper ");
4481 else
4482 printf("lower");
4483
4484 printf("NORM %d, ALPHA %d, BETA %d\n",
4485 norm, alpha_val, beta_val);
4486 printf("E %d\n", prec);
4487
4488 /* print out info */
4489 printf("alpha = ");
4490 printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
4491 printf(" ");
4492 printf("beta = ");
4493 printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
4494 printf("\n");
4495
4496 printf("a\n");
4497 zprint_hpmv_matrix(a, n_i, order_type, uplo_type);
4498 dprint_vector(x, n, incx, "x");
4499 zprint_vector(y_gen, n, incy, "y_gen");
4500 zprint_vector(y, n, incy, "y");
4501 dprint_vector(head_r_true, n, 1, "head_r_true");
4502 dprint_vector(ratios, n, 1, "ratios");
4503 printf("ratio = %g\n", ratio);
4504 }
4505 bad_ratio_count++;
4506 }
4507
4508 if (ratio > ratio_max)
4509 ratio_max = ratio;
4510
4511 if (ratio != 0.0 && ratio < ratio_min)
4512 ratio_min = ratio;
4513
4514 } /* end of randmize loop */
4515
4516 } /* end of incy loop */
4517
4518 } /* end of incx loop */
4519
4520 } /* end of uplo loop */
4521
4522 } /* end of order loop */
4523
4524 } /* end of nr test loop */
4525
4526 } /* end of norm loop */
4527
4528
4529 } /* end of prec loop */
4530
4531 } /* end of beta loop */
4532
4533 } /* end of alpha loop */
4534
4535 FPU_FIX_STOP;
4536
4537 blas_free(y);
4538 blas_free(a);
4539 blas_free(x);
4540 blas_free(y_gen);
4541 blas_free(head_r_true);
4542 blas_free(tail_r_true);
4543 blas_free(ratios);
4544 blas_free(a_vec);
4545 blas_free(x_vec);
4546
4547 *max_ratio = ratio_max;
4548 *min_ratio = ratio_min;
4549 *num_tests = test_count;
4550 *num_bad_ratio = bad_ratio_count;
4551
4552 }
4553
main(int argc,char ** argv)4554 int main(int argc, char **argv)
4555 {
4556 int nsizes, ntests, debug;
4557 double thresh, test_prob;
4558 double total_min_ratio, total_max_ratio;
4559 int total_bad_ratios;
4560 int seed, num_bad_ratio, num_tests;
4561 int total_tests, nr_failed_routines = 0, nr_routines = 0;
4562 double min_ratio, max_ratio;
4563 const char *base_routine = "hpmv";
4564 char *fname;
4565 int n;
4566
4567 int i;
4568 int n_data[NUM_DATA][1] = { {4}, {2}, {3}, {8}, {10}, {1}, {7} };
4569
4570 if (argc != 6) {
4571 printf("Usage:\n");
4572 printf("do_test_hpmv <nsizes> <ntests> <thresh> <debug> <test_prob>\n");
4573 printf(" <nsizes>: number of sizes to be run.\n");
4574 printf
4575 (" <ntests>: the number of tests performed for each set of attributes\n");
4576 printf
4577 (" <thresh>: to catch bad ratios if it is greater than <thresh>\n");
4578 printf(" <debug>: 0, 1, 2, or 3; \n");
4579 printf(" if 0, no printing \n");
4580 printf(" if 1, print error summary only if tests fail\n");
4581 printf(" if 2, print error summary for each n\n");
4582 printf(" if 3, print complete info each test fails \n");
4583 printf("<test_prob>: probability of preforming a given \n");
4584 printf(" test case: 0.0 does no tests, 1.0 does all tests\n");
4585 return -1;
4586 } else {
4587 nsizes = atoi(argv[1]);
4588 ntests = atoi(argv[2]);
4589 thresh = atof(argv[3]);
4590 debug = atoi(argv[4]);
4591 test_prob = atof(argv[5]);
4592 }
4593
4594 seed = 1999;
4595
4596 if (nsizes < 0 || ntests < 0 || debug < 0 || debug > 3)
4597 BLAS_error("Testing hpmv", 0, 0, NULL);
4598
4599 printf("Testing %s...\n", base_routine);
4600 printf("INPUT: nsizes = %d, ntests = %d, thresh = %4.2f, debug = %d\n\n",
4601 nsizes, ntests, thresh, debug);
4602
4603
4604
4605
4606
4607 fname = "BLAS_zhpmv_z_c";
4608 printf("Testing %s...\n", fname);
4609 total_tests = 0;
4610 total_bad_ratios = 0;
4611 total_min_ratio = 1e308;
4612 total_max_ratio = 0.0;
4613 for (i = 0; i < nsizes; i++) {
4614 n = n_data[i][0];
4615
4616 do_test_zhpmv_z_c(n, ntests, &seed, thresh, debug,
4617 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4618 &num_tests);
4619
4620 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4621 printf(" [%d %d]: ", n, n);
4622 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4623 num_bad_ratio, num_tests, min_ratio, max_ratio);
4624 }
4625
4626 total_tests += num_tests;
4627 total_bad_ratios += num_bad_ratio;
4628 if (total_min_ratio > min_ratio)
4629 total_min_ratio = min_ratio;
4630 if (total_max_ratio < max_ratio)
4631 total_max_ratio = max_ratio;
4632 }
4633
4634 nr_routines++;
4635 if (total_bad_ratios == 0)
4636 printf("PASS> ");
4637 else {
4638 printf("FAIL> ");
4639 nr_failed_routines++;
4640 }
4641 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4642 fname, total_bad_ratios, total_tests, max_ratio);
4643
4644 fname = "BLAS_zhpmv_c_z";
4645 printf("Testing %s...\n", fname);
4646 total_tests = 0;
4647 total_bad_ratios = 0;
4648 total_min_ratio = 1e308;
4649 total_max_ratio = 0.0;
4650 for (i = 0; i < nsizes; i++) {
4651 n = n_data[i][0];
4652
4653 do_test_zhpmv_c_z(n, ntests, &seed, thresh, debug,
4654 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4655 &num_tests);
4656
4657 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4658 printf(" [%d %d]: ", n, n);
4659 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4660 num_bad_ratio, num_tests, min_ratio, max_ratio);
4661 }
4662
4663 total_tests += num_tests;
4664 total_bad_ratios += num_bad_ratio;
4665 if (total_min_ratio > min_ratio)
4666 total_min_ratio = min_ratio;
4667 if (total_max_ratio < max_ratio)
4668 total_max_ratio = max_ratio;
4669 }
4670
4671 nr_routines++;
4672 if (total_bad_ratios == 0)
4673 printf("PASS> ");
4674 else {
4675 printf("FAIL> ");
4676 nr_failed_routines++;
4677 }
4678 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4679 fname, total_bad_ratios, total_tests, max_ratio);
4680
4681 fname = "BLAS_zhpmv_c_c";
4682 printf("Testing %s...\n", fname);
4683 total_tests = 0;
4684 total_bad_ratios = 0;
4685 total_min_ratio = 1e308;
4686 total_max_ratio = 0.0;
4687 for (i = 0; i < nsizes; i++) {
4688 n = n_data[i][0];
4689
4690 do_test_zhpmv_c_c(n, ntests, &seed, thresh, debug,
4691 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4692 &num_tests);
4693
4694 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4695 printf(" [%d %d]: ", n, n);
4696 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4697 num_bad_ratio, num_tests, min_ratio, max_ratio);
4698 }
4699
4700 total_tests += num_tests;
4701 total_bad_ratios += num_bad_ratio;
4702 if (total_min_ratio > min_ratio)
4703 total_min_ratio = min_ratio;
4704 if (total_max_ratio < max_ratio)
4705 total_max_ratio = max_ratio;
4706 }
4707
4708 nr_routines++;
4709 if (total_bad_ratios == 0)
4710 printf("PASS> ");
4711 else {
4712 printf("FAIL> ");
4713 nr_failed_routines++;
4714 }
4715 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4716 fname, total_bad_ratios, total_tests, max_ratio);
4717
4718 fname = "BLAS_chpmv_c_s";
4719 printf("Testing %s...\n", fname);
4720 total_tests = 0;
4721 total_bad_ratios = 0;
4722 total_min_ratio = 1e308;
4723 total_max_ratio = 0.0;
4724 for (i = 0; i < nsizes; i++) {
4725 n = n_data[i][0];
4726
4727 do_test_chpmv_c_s(n, ntests, &seed, thresh, debug,
4728 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4729 &num_tests);
4730
4731 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4732 printf(" [%d %d]: ", n, n);
4733 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4734 num_bad_ratio, num_tests, min_ratio, max_ratio);
4735 }
4736
4737 total_tests += num_tests;
4738 total_bad_ratios += num_bad_ratio;
4739 if (total_min_ratio > min_ratio)
4740 total_min_ratio = min_ratio;
4741 if (total_max_ratio < max_ratio)
4742 total_max_ratio = max_ratio;
4743 }
4744
4745 nr_routines++;
4746 if (total_bad_ratios == 0)
4747 printf("PASS> ");
4748 else {
4749 printf("FAIL> ");
4750 nr_failed_routines++;
4751 }
4752 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4753 fname, total_bad_ratios, total_tests, max_ratio);
4754
4755 fname = "BLAS_zhpmv_z_d";
4756 printf("Testing %s...\n", fname);
4757 total_tests = 0;
4758 total_bad_ratios = 0;
4759 total_min_ratio = 1e308;
4760 total_max_ratio = 0.0;
4761 for (i = 0; i < nsizes; i++) {
4762 n = n_data[i][0];
4763
4764 do_test_zhpmv_z_d(n, ntests, &seed, thresh, debug,
4765 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4766 &num_tests);
4767
4768 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4769 printf(" [%d %d]: ", n, n);
4770 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4771 num_bad_ratio, num_tests, min_ratio, max_ratio);
4772 }
4773
4774 total_tests += num_tests;
4775 total_bad_ratios += num_bad_ratio;
4776 if (total_min_ratio > min_ratio)
4777 total_min_ratio = min_ratio;
4778 if (total_max_ratio < max_ratio)
4779 total_max_ratio = max_ratio;
4780 }
4781
4782 nr_routines++;
4783 if (total_bad_ratios == 0)
4784 printf("PASS> ");
4785 else {
4786 printf("FAIL> ");
4787 nr_failed_routines++;
4788 }
4789 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4790 fname, total_bad_ratios, total_tests, max_ratio);
4791
4792 fname = "BLAS_chpmv_x";
4793 printf("Testing %s...\n", fname);
4794 total_tests = 0;
4795 total_bad_ratios = 0;
4796 total_min_ratio = 1e308;
4797 total_max_ratio = 0.0;
4798 for (i = 0; i < nsizes; i++) {
4799 n = n_data[i][0];
4800
4801 do_test_chpmv_x(n, ntests, &seed, thresh, debug,
4802 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4803 &num_tests);
4804
4805 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4806 printf(" [%d %d]: ", n, n);
4807 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4808 num_bad_ratio, num_tests, min_ratio, max_ratio);
4809 }
4810
4811 total_tests += num_tests;
4812 total_bad_ratios += num_bad_ratio;
4813 if (total_min_ratio > min_ratio)
4814 total_min_ratio = min_ratio;
4815 if (total_max_ratio < max_ratio)
4816 total_max_ratio = max_ratio;
4817 }
4818
4819 nr_routines++;
4820 if (total_bad_ratios == 0)
4821 printf("PASS> ");
4822 else {
4823 printf("FAIL> ");
4824 nr_failed_routines++;
4825 }
4826 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4827 fname, total_bad_ratios, total_tests, max_ratio);
4828
4829 fname = "BLAS_zhpmv_x";
4830 printf("Testing %s...\n", fname);
4831 total_tests = 0;
4832 total_bad_ratios = 0;
4833 total_min_ratio = 1e308;
4834 total_max_ratio = 0.0;
4835 for (i = 0; i < nsizes; i++) {
4836 n = n_data[i][0];
4837
4838 do_test_zhpmv_x(n, ntests, &seed, thresh, debug,
4839 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4840 &num_tests);
4841
4842 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4843 printf(" [%d %d]: ", n, n);
4844 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4845 num_bad_ratio, num_tests, min_ratio, max_ratio);
4846 }
4847
4848 total_tests += num_tests;
4849 total_bad_ratios += num_bad_ratio;
4850 if (total_min_ratio > min_ratio)
4851 total_min_ratio = min_ratio;
4852 if (total_max_ratio < max_ratio)
4853 total_max_ratio = max_ratio;
4854 }
4855
4856 nr_routines++;
4857 if (total_bad_ratios == 0)
4858 printf("PASS> ");
4859 else {
4860 printf("FAIL> ");
4861 nr_failed_routines++;
4862 }
4863 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4864 fname, total_bad_ratios, total_tests, max_ratio);
4865
4866 fname = "BLAS_zhpmv_z_c_x";
4867 printf("Testing %s...\n", fname);
4868 total_tests = 0;
4869 total_bad_ratios = 0;
4870 total_min_ratio = 1e308;
4871 total_max_ratio = 0.0;
4872 for (i = 0; i < nsizes; i++) {
4873 n = n_data[i][0];
4874
4875 do_test_zhpmv_z_c_x(n, ntests, &seed, thresh, debug,
4876 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4877 &num_tests);
4878
4879 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4880 printf(" [%d %d]: ", n, n);
4881 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4882 num_bad_ratio, num_tests, min_ratio, max_ratio);
4883 }
4884
4885 total_tests += num_tests;
4886 total_bad_ratios += num_bad_ratio;
4887 if (total_min_ratio > min_ratio)
4888 total_min_ratio = min_ratio;
4889 if (total_max_ratio < max_ratio)
4890 total_max_ratio = max_ratio;
4891 }
4892
4893 nr_routines++;
4894 if (total_bad_ratios == 0)
4895 printf("PASS> ");
4896 else {
4897 printf("FAIL> ");
4898 nr_failed_routines++;
4899 }
4900 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4901 fname, total_bad_ratios, total_tests, max_ratio);
4902
4903 fname = "BLAS_zhpmv_c_z_x";
4904 printf("Testing %s...\n", fname);
4905 total_tests = 0;
4906 total_bad_ratios = 0;
4907 total_min_ratio = 1e308;
4908 total_max_ratio = 0.0;
4909 for (i = 0; i < nsizes; i++) {
4910 n = n_data[i][0];
4911
4912 do_test_zhpmv_c_z_x(n, ntests, &seed, thresh, debug,
4913 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4914 &num_tests);
4915
4916 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4917 printf(" [%d %d]: ", n, n);
4918 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4919 num_bad_ratio, num_tests, min_ratio, max_ratio);
4920 }
4921
4922 total_tests += num_tests;
4923 total_bad_ratios += num_bad_ratio;
4924 if (total_min_ratio > min_ratio)
4925 total_min_ratio = min_ratio;
4926 if (total_max_ratio < max_ratio)
4927 total_max_ratio = max_ratio;
4928 }
4929
4930 nr_routines++;
4931 if (total_bad_ratios == 0)
4932 printf("PASS> ");
4933 else {
4934 printf("FAIL> ");
4935 nr_failed_routines++;
4936 }
4937 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4938 fname, total_bad_ratios, total_tests, max_ratio);
4939
4940 fname = "BLAS_zhpmv_c_c_x";
4941 printf("Testing %s...\n", fname);
4942 total_tests = 0;
4943 total_bad_ratios = 0;
4944 total_min_ratio = 1e308;
4945 total_max_ratio = 0.0;
4946 for (i = 0; i < nsizes; i++) {
4947 n = n_data[i][0];
4948
4949 do_test_zhpmv_c_c_x(n, ntests, &seed, thresh, debug,
4950 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4951 &num_tests);
4952
4953 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4954 printf(" [%d %d]: ", n, n);
4955 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4956 num_bad_ratio, num_tests, min_ratio, max_ratio);
4957 }
4958
4959 total_tests += num_tests;
4960 total_bad_ratios += num_bad_ratio;
4961 if (total_min_ratio > min_ratio)
4962 total_min_ratio = min_ratio;
4963 if (total_max_ratio < max_ratio)
4964 total_max_ratio = max_ratio;
4965 }
4966
4967 nr_routines++;
4968 if (total_bad_ratios == 0)
4969 printf("PASS> ");
4970 else {
4971 printf("FAIL> ");
4972 nr_failed_routines++;
4973 }
4974 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
4975 fname, total_bad_ratios, total_tests, max_ratio);
4976
4977 fname = "BLAS_chpmv_c_s_x";
4978 printf("Testing %s...\n", fname);
4979 total_tests = 0;
4980 total_bad_ratios = 0;
4981 total_min_ratio = 1e308;
4982 total_max_ratio = 0.0;
4983 for (i = 0; i < nsizes; i++) {
4984 n = n_data[i][0];
4985
4986 do_test_chpmv_c_s_x(n, ntests, &seed, thresh, debug,
4987 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
4988 &num_tests);
4989
4990 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
4991 printf(" [%d %d]: ", n, n);
4992 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
4993 num_bad_ratio, num_tests, min_ratio, max_ratio);
4994 }
4995
4996 total_tests += num_tests;
4997 total_bad_ratios += num_bad_ratio;
4998 if (total_min_ratio > min_ratio)
4999 total_min_ratio = min_ratio;
5000 if (total_max_ratio < max_ratio)
5001 total_max_ratio = max_ratio;
5002 }
5003
5004 nr_routines++;
5005 if (total_bad_ratios == 0)
5006 printf("PASS> ");
5007 else {
5008 printf("FAIL> ");
5009 nr_failed_routines++;
5010 }
5011 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
5012 fname, total_bad_ratios, total_tests, max_ratio);
5013
5014 fname = "BLAS_zhpmv_z_d_x";
5015 printf("Testing %s...\n", fname);
5016 total_tests = 0;
5017 total_bad_ratios = 0;
5018 total_min_ratio = 1e308;
5019 total_max_ratio = 0.0;
5020 for (i = 0; i < nsizes; i++) {
5021 n = n_data[i][0];
5022
5023 do_test_zhpmv_z_d_x(n, ntests, &seed, thresh, debug,
5024 test_prob, &min_ratio, &max_ratio, &num_bad_ratio,
5025 &num_tests);
5026
5027 if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
5028 printf(" [%d %d]: ", n, n);
5029 printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
5030 num_bad_ratio, num_tests, min_ratio, max_ratio);
5031 }
5032
5033 total_tests += num_tests;
5034 total_bad_ratios += num_bad_ratio;
5035 if (total_min_ratio > min_ratio)
5036 total_min_ratio = min_ratio;
5037 if (total_max_ratio < max_ratio)
5038 total_max_ratio = max_ratio;
5039 }
5040
5041 nr_routines++;
5042 if (total_bad_ratios == 0)
5043 printf("PASS> ");
5044 else {
5045 printf("FAIL> ");
5046 nr_failed_routines++;
5047 }
5048 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
5049 fname, total_bad_ratios, total_tests, max_ratio);
5050
5051
5052
5053 printf("\n");
5054 if (nr_failed_routines)
5055 printf("FAILED ");
5056 else
5057 printf("PASSED ");
5058 printf("%-10s: FAIL/TOTAL = %d/%d\n",
5059 base_routine, nr_failed_routines, nr_routines);
5060
5061 return 0;
5062 }
5063