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