1dnl Generates test code for gemv 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(gemv/gemv-common.m4)dnl 11dnl 12dnl 13dnl ----------------------------------------------------------------------- 14dnl Usage: DO_TEST_GEMV_COMMENT(extended) 15dnl if extended, then print info about prec loop in the code 16dnl structure 17dnl ----------------------------------------------------------------------- 18define(`DO_TEST_GEMV_COMMENT',` 19/* 20 * Purpose 21 * ======= 22 * 23 * Runs a series of tests on GEMV. 24 * 25 * Arguments 26 * ========= 27 * 28 * m (input) int 29 * The number of rows 30 * 31 * n (input) int 32 * The number of columns 33 * 34 * ntests (input) int 35 * The number of tests to run for each set of attributes. 36 * 37 * seed (input/output) int 38 * The seed for the random number generator used in testgen(). 39 * 40 * thresh (input) double 41 * When the ratio returned from test() exceeds the specified 42 * threshold, the current size, r_true, r_comp, and ratio will be 43 * printed. (Since ratio is supposed to be O(1), we can set thresh 44 * to ~10.) 45 * 46 * debug (input) int 47 * If debug=3, print summary 48 * If debug=2, print summary only if the number of bad ratios > 0 49 * If debug=1, print complete info if tests fail 50 * If debug=0, return max ratio 51 * 52 * test_prob (input) float 53 * The specified test will be performed only if the generated 54 * random exceeds this threshold. 55 * 56 * min_ratio (output) double 57 * The minimum ratio 58 * 59 * num_bad_ratio (output) int 60 * The number of tests fail; they are above the threshold. 61 * 62 * num_tests (output) int 63 * The number of tests is being performed. 64 * 65 * Return value 66 * ============ 67 * 68 * The maximum ratio if run successfully, otherwise return -1 69 * 70 * Code structure 71 * ============== 72 * 73 * debug loop -- if debug is one, the first loop computes the max ratio 74 * -- and the last(second) loop outputs debugging information, 75 * -- if the test fail and its ratio > 0.5 * max ratio. 76 * -- if debug is zero, the loop is executed once 77 * alpha loop -- varying alpha: 0, 1, or random 78 * beta loop -- varying beta: 0, 1, or random 79ifelse(`$1', `_x',` * prec loop -- varying internal prec: single, double, or extra', `') 80 * norm loop -- varying norm: near undeflow, near one, or 81 * -- near overflow 82 * numtest loop -- how many times the test is perform with 83 * -- above set of attributes 84 * order loop -- varying order type: rowmajor or colmajor 85 * trans loop -- varying uplo type: upper or lower 86 * lda loop -- varying lda: m, m+1, 2m 87 * incx loop -- varying incx: -2, -1, 1, 2 88 * incy loop -- varying incy: -2, -1, 1, 2 89 */')dnl 90dnl 91dnl 92dnl 93dnl ----------------------------------------------------------------------- 94dnl Usage: DO_TEST_GEMV(abr_typeltr, x_typeltr, y_typeltr, extended) 95dnl 96dnl aby_typeltr : the type and precision of alpha, beta and r 97dnl A_typeltr : the type and precision of x 98dnl x_typeltr : the type and precision of y 99dnl extended : `' if no extended, or `_x' if extended 100dnl Each type and precision specifier can be one of 101dnl s ... real and single 102dnl d ... real and double 103dnl c ... complex and single 104dnl z ... complex and double 105dnl ---------------------------------------------------------------------- 106define(`DO_TEST_GEMV', `dnl 107double DO_TEST_GEMV_NAME($1, $2, $3, $4)(int m, int n, int ntests, dnl 108 int *seed, double thresh, int debug, float test_prob, dnl 109 double *min_ratio, int *num_bad_ratio, int *num_tests) 110DO_TEST_GEMV_COMMENT($4) 111DO_TEST_GEMV_BODY($1, $2, $3, $4) /* end of DO_TEST_GEMV_NAME($1, $2, $3, $4) */')dnl 112dnl 113dnl 114dnl -------------------------------------------------------------------- 115dnl Usage: DO_TEST_GEMV_BODY(aby_typeltr, A_typeltr, x_typeltr, extended) 116dnl 117dnl abr_typeltr : the type and precision of alpha, beta 118dnl x_typeltr : the type and precision of x 119dnl y_typeltr : the type and precision of y 120dnl extended : `' if no extended, or `_x' if extended 121dnl Each type and precision specifier can be one of 122dnl s ... real and single 123dnl d ... real and double 124dnl c ... complex and single 125dnl z ... complex and double 126dnl --------------------------------------------------------------------- 127define(`DO_TEST_GEMV_BODY', 128`{ 129 /* function name */ 130 const char fname[] = "GEMV_NAME($1, $2, $3, $4)"; 131 132 /* max number of debug lines to print */ 133 const int max_print = 8; 134 135 /* Variables in the "x_val" form are loop vars for corresponding 136 variables */ 137 int i; /* iterate through the repeating tests */ 138 int j, k; /* multipurpose counters or variables */ 139 int iy; /* use to index y */ 140 int incx_val, incy_val, /* for testing different inc values */ 141 incx, incy; 142 int incy_gen; /* for complex case inc=2, for real case inc=1 */ 143 int d_count; /* counter for debug */ 144 int find_max_ratio; /* find_max_ratio = 1 only if debug = 3 */ 145 int p_count; /* counter for the number of debug lines printed*/ 146 int tot_tests; /* total number of tests to be done */ 147 int norm; /* input values of near underflow/one/overflow */ 148 double ratio_max; /* the current maximum ratio */ 149 double ratio_min; /* the current minimum ratio */ 150 double *ratios; /* a temporary variable for calculating ratio */ 151 double ratio; /* the per-use test ratio from test() */ 152 int bad_ratios; /* the number of ratios over the threshold */ 153 double eps_int; /* the internal epsilon expected--2^(-24) for float */ 154 double un_int; /* the internal underflow threshold */ 155 DECLARE(alpha, $1_type) 156 DECLARE(beta, $1_type) 157 DECLARE_VECTOR(A, $2_type) 158 DECLARE_VECTOR(x, $3_type) 159 DECLARE_VECTOR(y, $1_type) 160 DECLARE_VECTOR(temp, $2_type) /* use for calculating ratio */ 161 162 /* x_gen and y_gen are used to store vectors generated by testgen. 163 they eventually are copied back to x and y */ 164 DECLARE_VECTOR(x_gen, $3_type) 165 DECLARE_VECTOR(y_gen, $1_type) 166 167 /* the true r calculated by testgen(), in double-double */ 168 DECLARE_VECTOR(r_true, EXTRA_TYPE($1_type)) 169 int alpha_val; 170 int alpha_flag; /* input flag for TESTGEN_GEMV_NAME($1, $2, $3, $4) */ 171 int beta_val; 172 int beta_flag; /* input flag for TESTGEN_GEMV_NAME($1, $2, $3, $4) */ 173 int order_val; 174 enum blas_order_type order_type; 175 ifelse(`$4', `_x', `int prec_val;') 176 enum blas_prec_type prec; 177 int trans_val; 178 enum blas_trans_type trans_type; 179 int m_i; 180 int n_i; 181 int max_mn; /* the max of m and n */ 182 int lda_val; 183 int ld, lda; 184 int saved_seed; /* for saving the original seed */ 185 int count, old_count; /* use for counting the number of testgen calls * 2 */ 186 187 FPU_FIX_DECL; 188 189 /* test for bad arguments */ 190 if (n < 0 || m < 0 || ntests < 0) 191 BLAS_error(fname, 0, 0, NULL); 192 193 /* initialization */ 194 *num_bad_ratio = 0; 195 *num_tests = 0; 196 *min_ratio = 0.0; 197 198 saved_seed = *seed; 199 ratio_min = 1e308; 200 ratio_max = 0.0; 201 ratio = 0.0; 202 tot_tests = 0; 203 p_count = 0; 204 count = 0; 205 find_max_ratio = 0; 206 bad_ratios = 0; 207 old_count = 0; 208 209 if (debug == 3) 210 find_max_ratio = 1; 211 max_mn = MAX(m, n); 212 if (m == 0 || n == 0) { 213 return 0.0; 214 } 215 216 FPU_FIX_START; 217 218 incy_gen = 1; 219 INC_ADJUST(incy_gen, $1_type) 220 221 /* get space for calculation */ 222 MALLOC_VECTOR(x, $3_type, max_mn*2) 223 MALLOC_VECTOR(y, $1_type, max_mn*2) 224 MALLOC_VECTOR(x_gen, $3_type, max_mn) 225 MALLOC_VECTOR(y_gen, $1_type, max_mn) 226 MALLOC_VECTOR(temp, $2_type, max_mn) 227 MALLOC_VECTOR(r_true, EXTRA_TYPE($1_type), max_mn) 228 MALLOC_VECTOR(ratios, real_D, max_mn) 229 MALLOC_VECTOR(A, $2_type, (m-1+n-1+1)*max_mn*2) 230 231 /* The debug iteration: 232 If debug=1, then will execute the iteration twice. First, compute the 233 max ratio. Second, print info if ratio > (50% * ratio_max). */ 234 for (d_count=0; d_count<= find_max_ratio; d_count++) { 235 bad_ratios = 0; /* set to zero */ 236 237 if ((debug == 3) && (d_count == find_max_ratio)) 238 *seed = saved_seed; /* restore the original seed */ 239 240 /* varying alpha */ 241 for (alpha_val=0; alpha_val<3; alpha_val++) { 242 243 SET_ALPHA($1_type) 244 245 /* varying beta */ 246 for (beta_val=0; beta_val<3; beta_val++) { 247 SET_BETA($1_type) 248 249 ifelse($4, _x, ` 250 /* varying extra precs */ 251 for (prec_val = 0; prec_val <= 2; prec_val++) {') 252 SET_INTERNAL_PARAMS($1_type, $4) 253 254 /* values near underflow, 1, or overflow */ 255 for (norm = -1; norm <= 1; norm++) { 256 257 /* number of tests */ 258 for (i=0; i<ntests; i++){ 259 260 /* row or col major */ 261 for (order_val=0; order_val<2; order_val++) { 262 switch(order_val){ 263 case 0: 264 order_type = blas_rowmajor; 265 ld = n; 266 break; 267 case 1: default: 268 order_type = blas_colmajor; 269 ld = m; 270 break; 271 } 272 273 /* no_trans, trans, or conj_trans */ 274 for (trans_val=0; trans_val<3; trans_val++) { 275 switch(trans_val){ 276 case 0: trans_type = blas_no_trans; m_i=m; n_i=n; break; 277 case 1: trans_type = blas_trans; m_i=n; n_i=m; break; 278 case 2: default: trans_type = blas_conj_trans; m_i=n; n_i=m; break; 279 } 280 281 /* lda=n, n+1, or 2n*/ 282 for (lda_val=0; lda_val<3; lda_val++){ 283 switch(lda_val){ 284 case 0: lda=ld; break; 285 case 1: lda=ld+1; break; 286 case 2: default: lda=2*ld; break; 287 } 288 289 /* For the sake of speed, we throw out this case at random */ 290 if ( xrand(seed) >= test_prob ) continue; 291 292 /* in the trivial cases, no need to run testgen */ 293 if (m > 0 && n > 0) 294 TESTGEN_GEMV_NAME($1, $2, $3)(norm, order_type, dnl 295 trans_type, m, n, &alpha, alpha_flag, A, lda, dnl 296 x_gen, &beta, beta_flag, y_gen, seed, dnl 297 HEAD(r_true), TAIL(r_true)); 298 299 count++; 300 301 /* varying incx */ 302 for (incx_val = -2; incx_val <= 2; incx_val++){ 303 if (incx_val == 0) continue; 304 305 /* setting incx */ 306 incx = incx_val; 307 INC_ADJUST(incx, $3_type) 308 309 $3copy_vector(x_gen, n_i, 1, x, incx_val); 310 311 /* varying incy */ 312 for (incy_val = -2; incy_val <= 2; incy_val++){ 313 if (incy_val == 0) continue; 314 315 /* setting incy */ 316 incy = incy_val; 317 INC_ADJUST(incy, $1_type) 318 319 $1copy_vector(y_gen, m_i, 1, y, incy_val); 320 321 FPU_FIX_STOP; 322 GEMV_NAME($1, $2, $3, $4)(order_type, trans_type, m, n, alpha, A, dnl 323 lda, x, incx_val, beta, y, incy_val ifelse(`$4', `_x', `, prec')); 324 FPU_FIX_START; 325 326 /* set y starting index */ 327 iy=0; 328 if (incy < 0) iy = -(m_i-1)*incy; 329 330 /* computing the ratio */ 331 if (m>0 && n>0) 332 for(j=0, k=0; j<m_i; j++, k += incy_gen){ 333 /* copy row j of A to temp */ 334 $2ge_copy_row(order_type, trans_type, m_i, n_i, A, lda, temp, j); 335 336 TEST_DOT_NAME($1, $2, $3, $4)(n_i, blas_no_conj, dnl 337 alpha, beta, VECTOR_ELEMENT(y_gen, k, $1_type), dnl 338 VECTOR_ELEMENT(y, iy, $1_type), dnl 339 VECTOR_ELEMENT(r_true, k, EXTRA_TYPE($1_type)), dnl 340 temp, 1, x, incx_val, eps_int, un_int, &ratios[j]); 341 342 /* take the max ratio */ 343 if (j==0) { 344 ratio = ratios[0]; 345 /* The !<= below causes NaN error to be detected. 346 Note that (NaN > thresh) is always false. */ 347 } else if ( !(ratios[j] <= ratio) ) { 348 ratio = ratios[j]; 349 } 350 iy += incy; 351 } 352 353 /* Increase the number of bad ratio, if the ratio 354 is bigger than the threshold. 355 The !<= below causes NaN error to be detected. 356 Note that (NaN > thresh) is always false. */ 357 if ( !(ratio <= thresh) ) { 358 bad_ratios++; 359 360 if ((debug==3) && /* print only when debug is on */ 361 (count != old_count) && /* print if old vector is different 362 from the current one */ 363 (d_count == find_max_ratio) && 364 (p_count <= max_print) && 365 (ratio > 0.5*ratio_max)) 366 { 367 old_count = count; 368 369 printf("FAIL> %s: m = %d, n = %d, ntests = %d, threshold = %4.2f,\n", 370 fname, m, n, ntests, thresh); 371 372 PRINT_PREC(prec) 373 PRINT_NORM(norm) 374 PRINT_ORDER(order_type) 375 PRINT_TRANS(trans_type) 376 377 printf("lda=%d, incx=%d, incy=%d:\n", lda, incx, incy); 378 379 $2ge_print_matrix(A, m_i, n_i, lda, order_type, "A"); 380 $3print_vector(x, n_i, incx_val, "x"); 381 $1print_vector(y_gen, m_i, 1, "y"); 382 $1print_vector(y, m_i, incy_val, "y_final"); 383 384 printf(" "); PRINT_VAR(alpha, $1_type) 385 printf("\n "); PRINT_VAR(beta, $1_type) 386 printf("\n"); 387 for (j=0, k=0; j<m_i*incy_gen; j += incy_gen, k++){ 388 printf(" "); 389 PRINT_ARRAY_ELEM(r_true, j, EXTRA_TYPE($1_type)) 390 printf(", ratio[%d]=%.4e\n", k, ratios[k]); 391 } 392 393 printf(" ratio=%.4e\n", ratio); 394 p_count++; 395 } 396 if (bad_ratios >= MAX_BAD_TESTS) { 397 printf("\ntoo many failures, exiting...."); 398 printf("\nTesting and compilation"); 399 printf(" are incomplete\n\n"); 400 goto end; 401 } 402 if ( !(ratio <= TOTAL_FAILURE_THRESHOLD) ) { 403 printf("\nFlagrant ratio error, exiting..."); 404 printf("\nTesting and compilation"); 405 printf(" are incomplete\n\n"); 406 goto end; 407 } 408 } 409 if (d_count==0) { 410 if (ratio > ratio_max) 411 ratio_max = ratio; 412 413 if (ratio != 0.0 && ratio < ratio_min) 414 ratio_min = ratio; 415 416 tot_tests++; 417 } 418 }/* incy */ 419 }/* incx */ 420 }/* lda */ 421 } /* trans */ 422 } /* order */ 423 } /* tests */ 424 } /* norm */ 425ifelse(`$4', `_x', ` } /* prec */') 426 } /* beta */ 427 } /* alpha */ 428 } /* debug */ 429 430 if ((debug == 2) || 431 ((debug == 1) && bad_ratios > 0)){ 432 printf(" %s: m = %d, n = %d, ntests = %d, thresh = %4.2f\n", 433 fname, m, n, ntests, thresh); 434 printf(" bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n", 435 bad_ratios, tot_tests, 436 ((double)bad_ratios)/((double)tot_tests), ratio_min, ratio_max); 437 } 438 439end: 440 FPU_FIX_STOP; 441 442 FREE_VECTOR(x, $3_type) 443 FREE_VECTOR(y, $1_type) 444 FREE_VECTOR(x_gen, $3_type) 445 FREE_VECTOR(y_gen, $1_type) 446 FREE_VECTOR(temp, $2_type) 447 FREE_VECTOR(A, $2_type) 448 FREE_VECTOR(r_true, EXTRA_TYPE($1_type)) 449 FREE_VECTOR(ratios, real_D) 450 451 *min_ratio = ratio_min; 452 *num_bad_ratio = bad_ratios; 453 *num_tests = tot_tests; 454 return ratio_max; 455}' )dnl 456dnl 457dnl 458dnl -------------------------------------------------------------------- 459dnl Usage: TESTGEN_GEMV_NAME(aby_typeltr, A_typeltr, x_typeltr) 460dnl create a testgen_gemv name 461dnl -------------------------------------------------------------------- 462define(`TESTGEN_GEMV_NAME', `ifelse( 463 `$2&&$3', `$1&&$1', `BLAS_$1gemv_testgen', 464 `BLAS_$1gemv_$2_$3_testgen')')dnl 465dnl 466dnl 467dnl ------------------------------------------------------------------- 468dnl Usage: DO_TEST_GEMV_NAME(abr_typeltr, x_typeltr, y_typeltr, extended) 469dnl create do_test_gemv name 470dnl ------------------------------------------------------------------- 471define(`DO_TEST_GEMV_NAME', `ifelse( 472 `$2&&$3', `$1&&$1', 473 `do_test_$1gemv$4', 474 `do_test_$1gemv_$2_$3$4')') dnl 475dnl 476dnl 477dnl 478dnl ------------------------------------------------------------------- 479dnl Usage: CALL_DO_TEST_GEMV(abr_typeltr, x_typeltr, y_typeltr, extended) 480dnl 481dnl abr_type : the type and precision of alpha, beta and r 482dnl x_type : the type and precision of x 483dnl y_type : the type and precision of y 484dnl extended : `' if no extended, or `_x' if extended 485dnl Each type and precision specifier can be one of 486dnl s ... real and single 487dnl d ... real and double 488dnl c ... complex and single 489dnl z ... complex and double 490dnl ------------------------------------------------------------------- 491define(`CALL_DO_TEST_GEMV', 492` min_ratio = 1e308; max_ratio = 0.0; 493 total_bad_ratios = 0; total_tests = 0; 494 fname = "GEMV_NAME($1, $2, $3, $4)"; 495 printf("Testing %s...\n", fname); 496 for(i=0; i<nsizes; i++){ 497 m = mn_pairs[i][0]; 498 n = mn_pairs[i][1]; 499 total_max_ratio = DO_TEST_GEMV_NAME($1, $2, $3, $4)(m, n, 1, &seed, dnl 500 thresh, debug, test_prob, &total_min_ratio, &num_bad_ratio, dnl 501 &num_tests); 502 if (total_max_ratio > max_ratio) 503 max_ratio = total_max_ratio; 504 505 if (total_min_ratio != 0 && total_min_ratio < min_ratio) 506 min_ratio = total_min_ratio; 507 508 total_bad_ratios += num_bad_ratio; 509 total_tests += num_tests; 510 } 511 512 if (min_ratio == 1e308) min_ratio = 0.0; 513 514 nr_routines++; 515 if (total_bad_ratios == 0) 516 printf("PASS> "); 517 else{ 518 nr_failed_routines++; 519 printf("FAIL> "); 520 } 521 522 printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n", 523 fname, total_bad_ratios, total_tests, max_ratio); 524')dnl 525dnl 526dnl 527dnl 528FOREACH(`GEMV_ARGS', ` 529DO_TEST_GEMV(arg)')dnl 530 531#define NUMPAIRS 12 532MAIN(` 533 int i, m; 534 int mn_pairs[NUMPAIRS][2]={{0, 0}, {1, 0}, {0, 1}, {1, 1}, {1, 2}, {2, 1}, 535 {3, 1}, {2, 3}, {3, 3}, {2, 4}, {6, 6}, {10, 8}};', ` 536FOREACH(`GEMV_ARGS', ` 537CALL_DO_TEST_GEMV(arg)')')dnl 538 539