1dnl Generates test code for waxpby 2#include <stdlib.h> 3#include <stdio.h> 4#include <math.h> 5#include "blas_extended.h" 6#include "blas_extended_private.h" 7#include "blas_extended_test.h" 8include(cblas.m4)dnl 9include(test-common.m4)dnl 10include(waxpby/waxpby-common.m4)dnl 11dnl 12dnl 13dnl ----------------------------------------------------------------------- 14dnl Usage: DO_TEST_WAXPBY_COMMENT(extended) 15dnl if extended, then print info about prec loop in the code 16dnl structure 17dnl ----------------------------------------------------------------------- 18define(`DO_TEST_WAXPBY_COMMENT',` 19/* 20 * Purpose 21 * ======= 22 * 23 * Runs a series of tests on waxpby 24 * 25 * Arguments 26 * ========= 27 * 28 * n (input) int 29 * The size of vector being tested 30 * 31 * ntests (input) int 32 * The number of tests to run for each set of attributes. 33 * 34 * seed (input/output) int 35 * The seed for the random number generator used in testgen(). 36 * 37 * thresh (input) double 38 * When the ratio returned from test() exceeds the specified 39 * threshold, the current size, w_true, w, and ratio will be 40 * printed. (Since ratio is supposed to be O(1), we can set thresh 41 * to ~10.) 42 * 43 * debug (input) int 44 * If debug=3, print summary 45 * If debug=2, print summary only if the number of bad ratios > 0 46 * If debug=1, print complete info if tests fail 47 * If debug=0, return max ratio 48 * 49 * min_ratio (output) double 50 * The minimum ratio 51 * 52 * num_bad_ratio (output) int 53 * The number of tests fail; they are above the threshold. 54 * 55 * num_tests (output) int 56 * The number of tests is being performed. 57 * 58 * Return value 59 * ============ 60 * 61 * The maximum ratio if run successfully, otherwise return -1 62 * 63 * Code structure 64 * ============== 65 * 66 * debug loop -- if debug is one, the first loop computes the max ratio 67 * -- and the last(second) loop outputs debugging information, 68 * -- if the test fail and its ratio > 0.5 * max ratio. 69 * -- if debug is zero, the loop is executed once 70 * alpha loop -- varying alpha: 0, 1, or random 71 * beta loop -- varying beta: 0, 1, or random 72ifelse(`$1', `_x',` * prec loop -- varying internal prec: single, double, or extra', `') 73 * norm loop -- varying norm: near undeflow, near one, or 74 * -- near overflow 75 * numtest loop -- how many times the test is perform with 76 * -- above set of attributes 77 * incx loop -- varying incx: -2, -1, 1, 2 78 * incy loop -- varying incy: -2, -1, 1, 2 79 */')dnl 80dnl 81dnl 82dnl 83dnl ----------------------------------------------------------------------- 84dnl Usage: DO_TEST_WAXPBY(abw_typeltr, x_typeltr, y_typeltr, extended) 85dnl 86dnl abw_typeltr : the type and precision of alpha, beta and w 87dnl x_typeltr : the type and precision of x 88dnl y_typeltr : the type and precision of y 89dnl extended : `' if no extended, or `_x' if extended 90dnl Each type and precision specifier can be one of 91dnl s ... real and single 92dnl d ... real and double 93dnl c ... complex and single 94dnl z ... complex and double 95dnl ---------------------------------------------------------------------- 96define(`DO_TEST_WAXPBY', `ifelse( 97 `$1&&$1', `$2&&$3',` 98double do_test_$1waxpby$4(int n, 99 int ntests, 100 int *seed, 101 double thresh, 102 int debug, float test_prob, 103 double *min_ratio, 104 int *num_bad_ratio, 105 int *num_tests) 106DO_TEST_WAXPBY_COMMENT($4) 107DO_TEST_WAXPBY_BODY($1, $2, $3, $4) /* end of do_test_$1waxpby$4 */',` 108double do_test_$1waxpby_$2_$3$4 (int n, 109 int ntests, 110 int *seed, 111 double thresh, 112 int debug, float test_prob, 113 double *min_ratio, 114 int *num_bad_ratio, 115 int *num_tests) 116DO_TEST_WAXPBY_COMMENT($4) 117DO_TEST_WAXPBY_BODY($1, $2, $3, $4) /* end of do_test_$1waxpby_$2_$3$4 */')') dnl 118dnl 119dnl 120dnl 121dnl -------------------------------------------------------------------- 122dnl Usage: DO_TEST_WAXPBY_BODY(abw_typeltr, x_typeltr, y_typeltr, extended) 123dnl 124dnl abw_typeltr : the type and precision of alpha, beta and w 125dnl x_typeltr : the type and precision of x 126dnl y_typeltr : the type and precision of y 127dnl extended : `' if no extended, or `_x' if extended 128dnl Each type and precision specifier can be one of 129dnl s ... real and single 130dnl d ... real and double 131dnl c ... complex and single 132dnl z ... complex and double 133dnl --------------------------------------------------------------------- 134define(`DO_TEST_WAXPBY_BODY', 135`{ 136 /* function name */ 137 const char fname[] = "WAXPBY_NAME($1, $2, $3, $4)"; 138 139 /* max number of debug lines to print */ 140 const int max_print = 32; 141 142 /* Variables in the "x_val" form are loop vars for corresponding 143 variables */ 144 int i; /* iterate through the repeating tests */ 145 int j; /* multipurpose counter */ 146 int ix, iy, iw; /* use to index x, y, w respectively */ 147 int incx_val, incy_val, incw_val, /* for testing different inc values */ 148 incx, incy, incw, gen_val, test_val; 149 int d_count; /* counter for debug */ 150 int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ 151 int p_count; /* counter for the number of debug lines printed*/ 152 int tot_tests; /* total number of tests to be done */ 153 int norm; /* input values of near underflow/one/overflow */ 154 int X_int; 155 double X; 156 double ratio_max; /* the current maximum ratio */ 157 double ratio_min; /* the current minimum ratio */ 158 double ratio; /* the per-use test ratio from test() */ 159 double new_ratio; 160 int bad_ratios; /* the number of ratios over the threshold */ 161 double eps_int; /* the internal epsilon expected--2^(-24) for float */ 162 double un_int; /* the internal underflow threshold */ 163 DECLARE(x_i, $2_type) 164 DECLARE(y_i, $3_type) 165 DECLARE(alpha, $1_type) 166 DECLARE(beta, $1_type) 167 DECLARE_VECTOR(x, $2_type) 168 DECLARE_VECTOR(y, $3_type) 169 DECLARE_VECTOR(w, $1_type) /* the w computed by WAXPBY_NAME($1, $2, $3, $4) */ 170 DECLARE(x_fix1, $2_type) 171 DECLARE(x_fix2, $3_type) 172 DECLARE(zero, $1_type) 173 DECLARE(one, $1_type) 174 DECLARE(dummy, $1_type) 175 176 /* x_gen and y_gen are used to store vectors generated by testgen. 177 they eventually are copied back to x and y */ 178 DECLARE_VECTOR(x_gen, $2_type) 179 DECLARE_VECTOR(y_gen, $3_type) 180 DECLARE_VECTOR(temp_ab, $1_type) 181 DECLARE_VECTOR(temp_xy, $2_type) 182 183 184 /* added by DY */ 185 DECLARE(x_genj, $2_type) 186 DECLARE(y_genj, $3_type) 187 int incy_gen, incx_gen, incw_gen; 188 int xgen_val, ygen_val, wgen_val; 189 int iymax, ixmax; 190 float xtemp; 191 float ytemp; 192 float atemp; 193 float btemp; 194 double wltemp; 195 double wttemp; 196 float x_fix1_temp; 197 198 /* the true w calculated by testgen(), in double-double */ 199 DECLARE_VECTOR(w_true, EXTRA_TYPE($1_type)) 200 ifelse(`$4', `_x', `int prec_val;') 201 enum blas_prec_type prec; 202 int saved_seed; /* for saving the original seed */ 203 int count, old_count; /* use for counting the number of testgen calls * 2 */ 204 205 FPU_FIX_DECL; 206 207 /* There are there to get rid of compiler warnings. 208 Should modify M4 code to not even produce these variables when not 209 needed. */ 210 xtemp = ytemp = atemp = btemp = 0.0; 211 wltemp = wttemp = x_fix1_temp = 0.0; 212 ZERO(x_i, $2_type) 213 ZERO(y_i, $3_type) 214 X = 0.0; 215 X_int = 0; 216 gen_val = 0; 217 218 /* test for bad arguments */ 219 if (n < 0 ) 220 BLAS_error(fname, -1, n, NULL); 221 if (ntests < 0) 222 BLAS_error(fname, -2, ntests, NULL); 223 224 /* if there is nothing to test, return all zero */ 225 if (n == 0 || ntests == 0){ 226 *min_ratio = 0.0; 227 *num_bad_ratio = 0; 228 *num_tests = 0; 229 return 0.0; 230 } 231 232 FPU_FIX_START; 233 234 incw_gen = 1; 235 incx_gen = 1; 236 incy_gen = 1; 237 INC_ADJUST(incw_gen, $1_type) 238 INC_ADJUST(incx_gen, $2_type) 239 INC_ADJUST(incy_gen, $3_type) 240 241 /* get space for calculation */ 242 MALLOC_VECTOR(x, $2_type, n*2) 243 MALLOC_VECTOR(y, $3_type, n*2) 244 MALLOC_VECTOR(w, $1_type, n*2) 245 MALLOC_VECTOR(w_true, EXTRA_TYPE($1_type), n) 246 MALLOC_VECTOR(x_gen, $2_type, n) 247 MALLOC_VECTOR(y_gen, $3_type, n) 248 MALLOC_VECTOR(temp_ab, $1_type, 2) 249 MALLOC_VECTOR(temp_xy, $2_type, 2) 250 251 /* initialization */ 252 saved_seed = *seed; 253 ratio_min = 1e308; 254 ratio_max = 0.0; 255 tot_tests = 0; 256 p_count = 0; 257 count = 0; 258 old_count = 0; 259 bad_ratios = 0; 260 261 find_max_ratio = 0; 262 if (debug == 3) 263 find_max_ratio = 1; 264 ONE(x_fix1, $2_type) 265 ONE(x_fix2, $3_type) 266 ZERO(zero, $1_type) 267 ONE(one, $1_type) 268 ZERO(dummy, $1_type); 269 270 271 /* The debug iteration: 272 If debug=1, then will execute the iteration twice. First, compute the 273 max ratio. Second, print info if ratio > (50% * ratio_max). */ 274 for (d_count=0; d_count<= find_max_ratio; d_count++) { 275 bad_ratios = 0; /* set to zero */ 276 277 if ((debug == 3) && (d_count == find_max_ratio)) 278 *seed = saved_seed; /* restore the original seed */ 279 280 ifelse($4, _x, ` 281 /* varying extra precs */ 282 for (prec_val = 0; prec_val <= 2; prec_val++) {') 283 SET_INTERNAL_PARAMS($1_type, $4) 284 285 /* values near underflow, 1, or overflow */ 286 for (norm = -1; norm <= 1; norm++) { 287 288 /* number of tests */ 289 for (i=0; i<ntests; i++){ 290 291 /* generate test inputs */ 292 ifelse(`$1&&$1', `$2&&$3', `TESTGEN_CASE1($1, $2, $3)', 293 `$1', `c', `TESTGEN_CASE4($1, $2, $3)', 294 `$1', `z', `TESTGEN_CASE3($1, $2, $3)', 295 `TESTGEN_CASE2($1, $2, $3)') 296 297 count++; 298 299 300 /* varying incx */ 301 for (incx_val = -2; incx_val <= 2; incx_val++){ 302 if (incx_val == 0) continue; 303 304 /* setting incx */ 305 incx = incx_val; 306 INC_ADJUST(incx, $2_type) 307 308 /* set x starting index */ 309 ix=0; 310 if (incx < 0) ix = -(n-1)*incx; 311 312 /* copy x_gen to x */ 313 for(j=0 ; j<n*incx_gen; j+=incx_gen){ 314 GET_ARRAY_ELEMENT(x_genj, $2_type, x_gen, $2_type, j) 315 SET_ARRAY_ELEMENT(x_genj, $2_type, x, $2_type, ix) 316 ix += incx; 317 } 318 319 /* varying incy */ 320 for (incy_val = -2; incy_val <= 2; incy_val++){ 321 if (incy_val == 0) continue; 322 323 /* setting incy */ 324 incy = incy_val; 325 INC_ADJUST(incy, $3_type) 326 327 /* set y starting index */ 328 iy=0; 329 if (incy < 0) iy = -(n-1)*incy; 330 331 /* copy y_gen to y */ 332 for(j=0 ; j<n*incy_gen; j+=incy_gen){ 333 GET_ARRAY_ELEMENT(y_genj, $3_type, y_gen, $3_type, j) 334 SET_ARRAY_ELEMENT(y_genj, $3_type, y, $3_type, iy) 335 iy += incy; 336 } 337 338 /* varying incw */ 339 for (incw_val = -2; incw_val <= 2; incw_val++){ 340 if (incw_val == 0) continue; 341 342 /* setting incw */ 343 incw = incw_val; 344 INC_ADJUST(incw, $1_type) 345 346 /* For the sake of speed, we throw out this case at random */ 347 if ( xrand(seed) >= test_prob ) continue; 348 349 /* call WAXPBY_NAME($1, $2, $3, $4) to get w */ 350 FPU_FIX_STOP; 351 WAXPBY_NAME($1, $2, $3, $4)(n, alpha, x, incx_val, beta, y, incy_val, 352 w, incw_val ifelse(`$4', `_x', `, prec')); 353 FPU_FIX_START; 354 355 /* computing the ratio */ 356 ifelse(`$1', `$3', `TEST_CASE1($1, $2, $3)', 357 `ifelse(`$1', `$2', `TEST_CASE2($1, $2, $3)', 358 `TEST_CASE3($1, $2, $3)')') 359 360 /* Increase the number of bad ratio, if the ratio 361 is bigger than the threshold. 362 The !<= below causes NaN error to be detected. 363 Note that (NaN > thresh) is always false. */ 364 if ( !(ratio <= thresh) ) { 365 bad_ratios++; 366 367 if ((debug == 3) && /* print only when debug is on */ 368 (count != old_count) && /* print if old vector is different 369 from the current one */ 370 (d_count == find_max_ratio) && 371 (p_count <= max_print) && 372 (ratio > 0.5*ratio_max)) 373 { 374 old_count = count; 375 376 printf("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n", 377 fname, n, ntests, thresh); 378 printf("seed = %d\n", *seed); 379 printf("norm = %d\n", norm); 380 381 /* Print test info */ 382 PRINT_PREC(prec) 383 PRINT_NORM(norm) 384 385 printf("incx=%d, incy=%d, incw=%d:\n", incx, incy, incw); 386 387 ix=0; iy=0; iw=0; 388 if (incx < 0) ix = -(n-1)*incx; 389 if (incy < 0) iy = -(n-1)*incy; 390 if (incw < 0) iw = -(n-1)*incw; 391 392 for (j=0; j<n; j++){ 393 printf(" "); PRINT_ARRAY_ELEM(x, ix, $2_type) printf("; "); 394 PRINT_ARRAY_ELEM(y, iy, $3_type) printf("; "); 395 PRINT_ARRAY_ELEM(w, iw, $1_type) printf("; "); 396 ix += incx; iy += incy; iw += incw; 397 } 398 399 printf(" "); PRINT_VAR(alpha, $1_type) printf("; "); 400 PRINT_VAR(beta, $1_type) printf("\n"); 401 printf(" ratio=%.4e\n", ratio); 402 p_count++; 403 } 404 } 405 if (d_count == 0) { 406 407 if (ratio > ratio_max) 408 ratio_max = ratio; 409 410 if (ratio != 0.0 && ratio < ratio_min) 411 ratio_min = ratio; 412 413 tot_tests++; 414 } 415 } /* incw */ 416 } /* incy */ 417 } /* incx */ 418 } /* tests */ 419 } /* norm */ 420ifelse(`$4', `_x', ` } /* prec */') 421 } /* debug */ 422 423 if ((debug == 2) || 424 ((debug == 1) && (bad_ratios > 0))){ 425 printf(" %s: n = %d, ntests = %d, thresh = %4.2f\n", 426 fname, n, ntests, thresh); 427 if ( ratio_min == 1.0e+308 ) 428 ratio_min = 0.0; 429 printf(" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", 430 bad_ratios, tot_tests, 431 ((double)bad_ratios)/((double)tot_tests), ratio_min, ratio_max); 432 } 433 434 FREE_VECTOR(x, $2_type) 435 FREE_VECTOR(y, $3_type) 436 FREE_VECTOR(w, $1_type) 437 FREE_VECTOR(w_true, EXTRA_TYPE($1_type)) 438 FREE_VECTOR(x_gen, $2_type) 439 FREE_VECTOR(y_gen, $3_type) 440 FREE_VECTOR(temp_ab, $1_type) 441 FREE_VECTOR(temp_xy, $2_type) 442 443 *min_ratio = ratio_min; 444 *num_bad_ratio = bad_ratios; 445 *num_tests = tot_tests; 446 FPU_FIX_STOP; 447 return ratio_max; 448}' )dnl 449dnl 450dnl 451dnl-------------------------------------------------------------------------- 452dnl Usage TESTGEN_CASE1(abw_typeltr, x_typeltr, y_typeltr) 453dnl typeltr can be: 454dnl s ... real and single 455dnl d ... real and double 456dnl c ... complex and single 457dnl z ... complex and double 458dnl-------------------------------------------------------------------------- 459define(`TESTGEN_CASE1', 460` DOT_TESTGEN_NAME($1, $2, $2)(1, 0, 1, norm, blas_no_conj, 461 &alpha, 0, &beta, 0, 462 &x_fix1, &x_gen[0], seed, 463 &y_gen[0], &HEAD(w_true)[0], &TAIL(w_true)[0]); 464 465 xgen_val = incx_gen; 466 ygen_val = incy_gen; 467 for ( wgen_val = incw_gen; wgen_val < n*incw_gen; wgen_val+=incw_gen ) { 468 DOT_TESTGEN_NAME($1, $2, $2)(1, 0, 1, norm, blas_no_conj, 469 &alpha, 1, &beta, 1, 470 &x_fix1, &x_gen[xgen_val], seed, 471 &y_gen[ygen_val], &HEAD(w_true)[wgen_val], &TAIL(w_true)[wgen_val]); 472 xgen_val+=incx_gen; 473 ygen_val+=incy_gen; 474 }')dnl 475dnl 476dnl 477dnl 478dnl-------------------------------------------------------------------------- 479dnl Usage TESTGEN_CASE2(abw_typeltr, x_typeltr, y_typeltr) 480dnl typeltr can be: 481dnl s ... real and single 482dnl d ... real and double 483dnl c ... complex and single 484dnl z ... complex and double 485dnl-------------------------------------------------------------------------- 486define(`TESTGEN_CASE2', 487` X = xrand(seed); 488 X_int = X * (power(2,12)-1); 489 X = X_int; 490 491 alpha = X*X*X*X / power(2,48); 492 beta = (X*X+X+1)*(X*X-X+1) / power(2,48); 493 494 x_i = X*X / power(2,24); 495 y_i = -(X*X-1) / power(2,24); 496 497 xgen_val = 0; 498 ygen_val = 0; 499 for ( wgen_val = 0; wgen_val < n*incw_gen; wgen_val+=incw_gen ) { 500 x_gen[xgen_val] = x_i; 501 y_gen[ygen_val] = y_i; 502 HEAD(w_true)[wgen_val] = 1.0 / power(2,72); 503 TAIL(w_true)[wgen_val] = 0.0; 504 xgen_val += incx_gen; 505 ygen_val += incy_gen; 506 }')dnl 507dnl 508dnl 509dnl 510dnl 511dnl-------------------------------------------------------------------------- 512dnl Usage TESTGEN_CASE3(abw_typeltr, x_typeltr, y_typeltr) 513dnl typeltr can be: 514dnl s ... real and single 515dnl d ... real and double 516dnl c ... complex and single 517dnl z ... complex and double 518dnl-------------------------------------------------------------------------- 519define(`TESTGEN_CASE3', 520` X = xrand(seed); 521 X_int = X * (power(2,12)-1); 522 X = X_int; 523 524 ifelse(`$2', `c', 525 alpha[0] = X*X*X*X / power(2,48); 526 alpha[1] = X*X*X*X / power(2,48); 527 `x_i[0] = 0.0; 528 x_i[1] = X*X / power(2,24);', 529 `$2', `z', 530 alpha[0] = X*X*X*X / power(2,48); 531 alpha[1] = X*X*X*X / power(2,48); 532 `x_i[0] = 0.0; 533 x_i[1] = X*X / power(2,24);', 534 535 `alpha[0] = - X*X*X*X / power(2,48); 536 alpha[1] = X*X*X*X / power(2,48); 537 x_i = X*X / power(2,24);') 538 539 ifelse(`$3', `c', 540 `beta[0] = (X*X+X+1)*(X*X-X+1) / power(2,48); 541 beta[1] = (X*X+X+1)*(X*X-X+1) / power(2,48); 542 y_i[0] = 0.0; 543 y_i[1] = -(X*X-1) / power(2,24);', 544 `$3', `z', 545 `beta[0] = (X*X+X+1)*(X*X-X+1) / power(2,48); 546 beta[1] = (X*X+X+1)*(X*X-X+1) / power(2,48); 547 y_i[0] = 0.0; 548 y_i[1] = -(X*X-1) / power(2,24);', 549 550 `beta[0] = - (X*X+X+1)*(X*X-X+1) / power(2,48); 551 beta[1] = (X*X+X+1)*(X*X-X+1) / power(2,48); 552 y_i = -(X*X-1) / power(2,24);') 553 554 555 xgen_val = 0; 556 ygen_val = 0; 557 for ( wgen_val = 0; wgen_val < n*incw_gen; wgen_val+=incw_gen ) { 558 SET_ARRAY_ELEMENT(x_i, $2_type, x_gen, $2_type, xgen_val) 559 SET_ARRAY_ELEMENT(y_i, $3_type, y_gen, $3_type, ygen_val) 560 HEAD(w_true)[wgen_val] = - 1.0 / power(2,72); 561 HEAD(w_true)[wgen_val+1] = 1.0 / power(2,72); 562 TAIL(w_true)[wgen_val] = 0.0; 563 TAIL(w_true)[wgen_val+1] = 0.0; 564 xgen_val += incx_gen; 565 ygen_val += incy_gen; 566 }')dnl 567dnl 568dnl 569dnl 570dnl-------------------------------------------------------------------------- 571dnl Usage TESTGEN_CASE4(abw_typeltr, x_typeltr, y_typeltr) 572dnl typeltr can be: 573dnl s ... real and single 574dnl d ... real and double 575dnl c ... complex and single 576dnl z ... complex and double 577dnl-------------------------------------------------------------------------- 578define(`TESTGEN_CASE4', 579` x_fix1_temp = 1.0; 580 BLAS_sdot_testgen(1, 0, 1, norm, blas_no_conj, 581 &atemp, 0, &btemp, 0, 582 &x_fix1_temp, &xtemp, seed, 583 &ytemp, &wltemp, &wttemp); 584 ifelse(`$2',`c',`x_gen[0] = 0.0; 585 x_gen[1] = xtemp; 586 alpha[0] = atemp; 587 alpha[1] = atemp;' 588 ,`x_gen[0] = xtemp; 589 alpha[0] = -atemp; 590 alpha[1] = atemp;') 591 592 ifelse(`$3',`c',`y_gen[0] = 0.0; 593 y_gen[1] = ytemp; 594 beta[0] = btemp; 595 beta[1] = btemp;' 596 ,`y_gen[0] = ytemp; 597 beta[0] = -btemp; 598 beta[1] = btemp;') 599 600 HEAD(w_true)[0] = -wltemp; 601 HEAD(w_true)[1] = wltemp; 602 TAIL(w_true)[0] = 0.0; 603 TAIL(w_true)[1] = 0.0; 604 605 xgen_val = incx_gen; 606 ygen_val = incy_gen; 607 for ( wgen_val = incw_gen; wgen_val < n*incw_gen; wgen_val+=incw_gen ) { 608 BLAS_sdot_testgen(1, 0, 1, norm, blas_no_conj, 609 &atemp, 1, &btemp, 1, 610 &x_fix1_temp, &xtemp, seed, 611 &ytemp, &wltemp, &wttemp); 612 613 ifelse(`$2',`c',`x_gen[xgen_val] = 0; 614 x_gen[xgen_val+1] = xtemp;' 615 ,`x_gen[xgen_val] = xtemp;') 616 617 ifelse(`$3',`c',`y_gen[ygen_val] = 0; 618 y_gen[ygen_val+1] = ytemp;' 619 620 ,`y_gen[ygen_val] = ytemp;') 621 622 623 HEAD(w_true)[wgen_val] = -wltemp; 624 HEAD(w_true)[wgen_val+1] = wltemp; 625 TAIL(w_true)[wgen_val] = 0.0; 626 TAIL(w_true)[wgen_val+1] = 0.0; 627 xgen_val+=incx_gen; 628 ygen_val+=incy_gen; 629 }')dnl 630dnl 631dnl 632dnl 633dnl-------------------------------------------------------------------------- 634dnl Usage TEST_CASE1(abw_typeltr, x_typeltr, y_typeltr) 635dnl typeltr can be: 636dnl s ... real and single 637dnl d ... real and double 638dnl c ... complex and single 639dnl z ... complex and double 640dnl-------------------------------------------------------------------------- 641define(`TEST_CASE1', 642` ix = 0; 643 if (incx < 0) ix = -(n-1)*incx; 644 iy = 0; 645 if (incy < 0) iy = -(n-1)*incy; 646 iw = 0; 647 if (incw < 0) iw = -(n-1)*incw; 648 ratio = 0.0; 649 650 for ( test_val = 0; test_val < n*incw_gen; test_val+=incw_gen ) { 651 TEST_DOT_NAME($1, $2, $2, $4) TEST_CASE1_ARGS($1, $2, $2, $4) 652 ix += incx; 653 iy += incy; 654 iw += incw; 655 if (MAX(ratio, new_ratio) == new_ratio) { 656 iymax = iy - incy; 657 ixmax = ix - incx; 658 } 659 ratio = MAX(ratio, new_ratio); 660 }')dnl 661dnl 662dnl 663dnl 664dnl 665dnl-------------------------------------------------------------------------- 666dnl Usage TEST_CASE1_ARGS(abw_typeltr, x_typeltr, y_typeltr) 667dnl typeltr can be: 668dnl s ... real and single 669dnl d ... real and double 670dnl c ... complex and single 671dnl z ... complex and double 672dnl-------------------------------------------------------------------------- 673define(`TEST_CASE1_ARGS', `ifelse( 674 675 `$1', `c', `(1, blas_no_conj, alpha, beta, 676 &y[iy], &w[iw], 677 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 678 &x_fix1, incx, &x[ix], incx, 679 eps_int, un_int, &new_ratio);', 680 681 `$1', `z', `(1, blas_no_conj, alpha, beta, 682 &y[iy], &w[iw], 683 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 684 &x_fix1, incx, &x[ix], incx, 685 eps_int, un_int, &new_ratio);', 686 687 `(1, blas_no_conj, alpha, beta, 688 y[iy], w[iw], 689 HEAD(w_true)[test_val], TAIL(w_true)[test_val], 690 &x_fix1, incx, &x[ix], incx, 691 eps_int, un_int, &new_ratio);')')dnl 692dnl 693dnl 694dnl 695dnl-------------------------------------------------------------------------- 696dnl Usage TEST_CASE2(abw_typeltr, x_typeltr, y_typeltr) 697dnl typeltr can be: 698dnl s ... real and single 699dnl d ... real and double 700dnl c ... complex and single 701dnl z ... complex and double 702dnl-------------------------------------------------------------------------- 703define(`TEST_CASE2', 704` ix = 0; 705 if (incx < 0) ix = -(n-1)*incx; 706 iy = 0; 707 if (incy < 0) iy = -(n-1)*incy; 708 iw = 0; 709 if (incw < 0) iw = -(n-1)*incw; 710 ratio = 0.0; 711 712 for ( test_val = 0; test_val < n*incw_gen; test_val+=incw_gen ) { 713 TEST_DOT_NAME($1, $3, $3, $4) TEST_CASE2_ARGS($1, $3, $3, $4) 714 ix += incx; 715 iy += incy; 716 iw += incw; 717 if (MAX(ratio, new_ratio) == new_ratio) { 718 iymax = iy - incy; 719 ixmax = ix - incx; 720 } 721 ratio = MAX(ratio, new_ratio); 722 }')dnl 723dnl 724dnl 725dnl 726dnl-------------------------------------------------------------------------- 727dnl Usage TEST_CASE2_ARGS(abw_typeltr, x_typeltr, y_typeltr) 728dnl typeltr can be: 729dnl s ... real and single 730dnl d ... real and double 731dnl c ... complex and single 732dnl z ... complex and double 733dnl-------------------------------------------------------------------------- 734define(`TEST_CASE2_ARGS', `ifelse( 735 736 `$1', `c', `(1, blas_no_conj, beta, alpha, 737 &x[ix], &w[iw], 738 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 739 &x_fix2, incy, &y[iy], incy, 740 eps_int, un_int, &new_ratio);', 741 742 `$1', `z', `(1, blas_no_conj, beta, alpha, 743 &x[ix], &w[iw], 744 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 745 &x_fix2, incy, &y[iy], incy, 746 eps_int, un_int, &new_ratio);', 747 748 `(1, blas_no_conj, beta, alpha, 749 x[ix], w[iw], 750 HEAD(w_true)[test_val], TAIL(w_true)[test_val], 751 &x_fix2, incy, &y[iy], incy, 752 eps_int, un_int, &new_ratio);')')dnl 753dnl 754dnl 755dnl 756dnl 757dnl-------------------------------------------------------------------------- 758dnl Usage TEST_CASE3(abw_typeltr, x_typeltr, y_typeltr) 759dnl typeltr can be: 760dnl s ... real and single 761dnl d ... real and double 762dnl c ... complex and single 763dnl z ... complex and double 764dnl-------------------------------------------------------------------------- 765define(`TEST_CASE3', 766` ix = 0; 767 if (incx < 0) ix = -(n-1)*incx; 768 iy = 0; 769 if (incy < 0) iy = -(n-1)*incy; 770 iw = 0; 771 if (incw < 0) iw = -(n-1)*incw; 772 ratio = 0.0; 773 774 SET_VECTOR_ELEMENT(temp_ab, 0, alpha, $1_type) 775 SET_VECTOR_ELEMENT(temp_ab, incw_gen, beta, $1_type) 776 777 for ( test_val = 0; test_val < n*incw_gen; test_val+=incw_gen ) { 778 GET_ARRAY_ELEMENT(x_genj, $2_type, x, $2_type, ix) 779 SET_ARRAY_ELEMENT(x_genj, $2_type, temp_xy, $2_type, 0) 780 781 GET_ARRAY_ELEMENT(y_genj, $3_type, y, $3_type, iy) 782 SET_ARRAY_ELEMENT(y_genj, $3_type, temp_xy, $3_type, incy_gen) 783 784 TEST_DOT_NAME($1, $1, $2, $4) TEST_CASE3_ARGS($1, $1, $2, $4) 785 if (MAX(ratio, new_ratio) == new_ratio) { 786 iymax = iy; 787 ixmax = ix; 788 } 789 ratio = MAX(ratio, new_ratio); 790 791 ix += incx; 792 iy += incy; 793 iw += incw; 794 }')dnl 795dnl 796dnl 797dnl 798dnl 799dnl-------------------------------------------------------------------------- 800dnl Usage TEST_CASE3_ARGS(abw_typeltr, x_typeltr, y_typeltr) 801dnl typeltr can be: 802dnl s ... real and single 803dnl d ... real and double 804dnl c ... complex and single 805dnl z ... complex and double 806dnl-------------------------------------------------------------------------- 807define(`TEST_CASE3_ARGS', `ifelse( 808 `$1', `c', `(2, blas_no_conj, one, zero, 809 dummy, &w[iw], 810 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 811 &temp_ab[0], 1, &temp_xy[0], 1, 812 eps_int, un_int, &new_ratio);', 813 814 `$1', `z', `(2, blas_no_conj, one, zero, 815 dummy, &w[iw], 816 &HEAD(w_true)[test_val], &TAIL(w_true)[test_val], 817 &temp_ab[0], 1, &temp_xy[0], 1, 818 eps_int, un_int, &new_ratio);', 819 820 `(2, blas_no_conj, one, zero, 821 dummy, w[iw], 822 HEAD(w_true)[test_val], TAIL(w_true)[test_val], 823 temp_ab, 1, temp_xy, 1, 824 eps_int, un_int, &new_ratio);')')dnl 825dnl 826dnl 827dnl 828dnl 829dnl ------------------------------------------------------------------- 830dnl Usage: DO_TEST_WAXPBY_NAME(abw_typeltr, x_typeltr, y_typeltr, extended) 831dnl create do_test_waxpby name 832dnl ------------------------------------------------------------------- 833define(`DO_TEST_WAXPBY_NAME', `ifelse( 834 `$1&&$1', `$2&&$3', 835 `do_test_$1waxpby$4', 836 `do_test_$1waxpby_$2_$3$4')') dnl 837dnl 838dnl 839dnl 840dnl ------------------------------------------------------------------- 841dnl Usage: CALL_DO_TEST_WAXPBY(abw_typeltr, x_typeltr, y_typeltr, extended) 842dnl 843dnl abw_type : the type and precision of alpha, beta and w 844dnl x_type : the type and precision of x 845dnl y_type : the type and precision of y 846dnl extended : `' if no extended, or `_x' if extended 847dnl Each type and precision specifier can be one of 848dnl s ... real and single 849dnl d ... real and double 850dnl c ... complex and single 851dnl z ... complex and double 852dnl ------------------------------------------------------------------- 853define(`CALL_DO_TEST_WAXPBY', 854 ` fname = "WAXPBY_NAME($1, $2, $3, $4)"; 855 printf("Testing %s...\n", fname); 856 min_ratio = 1e308; max_ratio = 0.0; 857 total_bad_ratios = 0; total_tests = 0; 858 for(n=0; n<=nsizes; n++){ 859 860 total_max_ratio = DO_TEST_WAXPBY_NAME($1, $2, $3, $4)(n, ntests, &seed, thresh, debug, test_prob, 861 &total_min_ratio, &num_bad_ratio, &num_tests); 862 if (total_max_ratio > max_ratio) 863 max_ratio = total_max_ratio; 864 865 if (total_min_ratio < min_ratio) 866 min_ratio = total_min_ratio; 867 868 total_bad_ratios += num_bad_ratio; 869 total_tests += num_tests; 870 } 871 872 nr_routines++; 873 if (total_bad_ratios == 0) 874 printf("PASS> "); 875 else{ 876 printf("FAIL> "); 877 nr_failed_routines++; 878 } 879 880 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", 881 fname, total_bad_ratios, total_tests, max_ratio); 882') 883dnl 884dnl 885dnl 886FOREACH(`WAXPBY_ARGS', ` 887DO_TEST_WAXPBY(arg)')dnl 888 889MAIN(`', ` 890 891FOREACH(`WAXPBY_ARGS', ` 892CALL_DO_TEST_WAXPBY(arg)')')dnl 893 894