1dnl ********************************************************************** 2dnl * Generates alpha, T, x, and y, where T is a triangular matrix; * 3dnl * and computes r_true. * 4dnl ********************************************************************** 5dnl 6dnl 7include(cblas.m4)dnl 8include(test-common.m4)dnl 9dnl 10dnl 11define(`TRSV_TESTGEN_COMMENT', ` 12/* 13 * Purpose 14 * ======= 15 * 16 * Generates alpha, x and T, where T is a triangular matrix; and computes r_true. 17 * 18 * Arguments 19 * ========= 20 * 21 * norm (input) blas_norm_type 22 * 23 * order (input) blas_order_type 24 * Order of T; row or column major 25 * 26 * uplo (input) blas_uplo_type 27 * Whether T is upper or lower 28 * 29 * trans (input) blas_trans_type 30 * No trans, trans, conj trans 31 * 32 * diag (input) blas_diag_type 33 * non unit, unit 34 * 35 * n (input) int 36 * Dimension of AP and the length of vector x 37 * 38 * alpha (input/output) $1_array 39 * If alpha_flag = 1, alpha is input. 40 * If alpha_flag = 0, alpha is output. 41 * 42 * alpha_flag (input) int 43 * = 0 : alpha is free, and is output. 44 * = 1 : alpha is fixed on input. 45 * 46 * T (output) $2_array 47 * 48 * x (input/output) $1_array 49 * 50 * seed (input/output) int 51 * 52 * HEAD(r_true) (output) double* 53 * The leading part of the truth in double-double. 54 * 55 * TAIL(r_true) (output) double* 56 * The trailing part of the truth in double-double. 57 * 58 * row (input) int 59 * The true row being generated 60 * 61 * prec (input) blas_prec_type 62 * single, double, or extra precision 63 * 64 */')dnl 65dnl 66dnl 67dnl 68dnl --------------------------------------------------------------------- 69dnl Usage: TRSV_TESTGEN(ax_typeltr, T_typeltr) 70dnl produce trsv_prepare signature 71dnl --------------------------------------------------------------------- 72define(`TRSV_TESTGEN_NAME', 73 `BLAS_$1trsv`'ifelse(`$1', `$2', `', `_$2')_testgen')dnl 74dnl 75dnl 76define(`TRSV_TESTGEN_HEAD', 77 `void TRSV_TESTGEN_NAME($1, $2)(int norm, enum blas_order_type order, dnl 78 enum blas_uplo_type uplo, enum blas_trans_type trans, dnl 79 enum blas_diag_type diag, int n, $1_array alpha, int alpha_flag, dnl 80 $2_array T, int lda, $1_array x, int *seed, dnl 81 double *HEAD(r_true), double *TAIL(r_true), int row, dnl 82 enum blas_prec_type prec)')dnl 83dnl 84dnl 85define(`TRSV_TESTGEN', `dnl 86TRSV_TESTGEN_HEAD($1, $2) 87TRSV_TESTGEN_COMMENT($1, $2) 88IF_REAL($1_type, `TRSV_TESTGEN_BODY($1, $2)', 89 `IF_REAL($2_type, 90 `TRSV_TESTGEN_MIX_COMPLEX_BODY($1, $2)', 91 `TRSV_TESTGEN_PURE_COMPLEX_BODY($1, $2)')' 92)')dnl 93dnl 94dnl 95dnl --------------------------------------------------------------------- 96dnl Usage: TRSV_TESTGEN_BODY(ax_typeltr, T_typeltr) 97dnl 98dnl --------------------------------------------------------------------- 99define(`TRSV_TESTGEN_BODY', 100`{ 101 int start; 102 int length; 103 int i, j; 104 DECLARE(alpha_i, real_S) 105 DECLARE(minus_one, $1_type) 106 DECLARE(Tii, $2_type) 107 DECLARE_VECTOR(temp, $2_type) 108 DECLARE_VECTOR(xtemp2, $1_type) 109 110 MALLOC_VECTOR(temp, $2_type, n) 111 112 xtemp2 = NULL; 113 if (prec!=blas_prec_extra){ 114 MALLOC_VECTOR(xtemp2, $1_type, n) 115 } 116 117 minus_one = -1.0; 118 119 /* if alpha_flag=0, gives a random value to alpha */ 120 if (alpha_flag == 0){ 121 alpha_i = xrand(seed); 122 *alpha = alpha_i; 123 alpha_flag = 1; 124 } 125 126 for(i=0; i<4*n*n; i++){ 127 ZERO(T[i], $1_type) 128 } 129 130 for(i=0; i<n; i++){ 131 132 if (i!=row){ 133 if (diag == blas_non_unit_diag){ 134 Tii = xrand(seed); 135 SET_VECTOR_ELEMENT(T, i*lda+i, Tii, $2_type) 136 } 137 else { 138 ONE(Tii, $2_type) 139 SET_VECTOR_ELEMENT(T, i*lda+i, Tii, $2_type) 140 } 141 142 x[i] = xrand(seed); 143 144 switch(prec){ 145 case blas_prec_single: 146 { 147 DECLARE(multemp, $1_type) 148 DECLARE(divtemp, $1_type) 149 150 MUL(multemp, $1_type, x[i], $1_type, *alpha, $1_type) 151 DIV(divtemp, $1_type, multemp, $1_type, Tii, $2_type) 152 ASSIGN(HEAD(r_true)[i], real_D, divtemp, $1_type) 153 TAIL(r_true)[i]=0.0; 154 ASSIGN(xtemp2[i], $1_type, divtemp, $1_type) 155 break; 156 } 157 case blas_prec_double: 158 case blas_prec_indigenous: 159 { 160 ifelse(`$1', `s', 161 `DECLARE(multemp, real_D) 162 DECLARE(divtemp, real_D) 163 164 MUL(multemp, real_D, x[i], $1_type, *alpha, $1_type) 165 DIV(divtemp, real_D, multemp, $1_type, Tii, $2_type) 166 ASSIGN(HEAD(r_true)[i], real_D, divtemp, real_D) 167 TAIL(r_true)[i]=0.0;', 168 `$1', `d', 169 `DECLARE(multemp, $1_type) 170 DECLARE(divtemp, $1_type) 171 172 MUL(multemp, $1_type, x[i], $1_type, *alpha, $1_type) 173 DIV(divtemp, $1_type, multemp, $1_type, Tii, $2_type) 174 ASSIGN(HEAD(r_true)[i], real_D, divtemp, $1_type) 175 TAIL(r_true)[i]=0.0; 176 ASSIGN(xtemp2[i], $1_type, divtemp, $1_type)') 177 break; 178 } 179 case blas_prec_extra: 180 { 181 DECLARE(multemp, real_E) 182 DECLARE(divtemp, real_E) 183 184 MUL(multemp, real_E, x[i], $1_type, *alpha, $1_type) 185 DIV(divtemp, real_E, multemp, real_E, Tii, $2_type) 186 ASSIGN(HEAD(r_true)[i], real_D, HEAD(divtemp), real_D) 187 ASSIGN(TAIL(r_true)[i], real_D, TAIL(divtemp), real_D) 188 break; 189 } 190 } /* case */ 191 } /* if */ 192 } /* for */ 193 194 for(j=0; j<n; j++){ 195 SET_ZERO_VECTOR_ELEMENT(temp, j, $2_type) 196 } 197 198 SET_VECTOR_ELEMENT(T, row*lda+row, 1.0, $2_type) 199 200 if ((uplo==blas_lower && trans==blas_no_trans) || 201 (uplo==blas_upper && trans!=blas_no_trans)){ 202 length = row; 203 start = 0; 204 } 205 else{ 206 length = n-row-1; 207 start = row+1; 208 } 209 210 if (length != 0){ 211 212ifelse(`$1', `$2', ` 213 switch (prec){ 214 case blas_prec_single: BLAS_$1dot_testgen(length, 0, length, norm, 215 blas_no_conj, &minus_one, 1, alpha, 1, 216 &xtemp2[start], temp, seed, &x[row], 217 &HEAD(r_true)[row], &TAIL(r_true)[row]); 218 break; 219 case blas_prec_double: 220 case blas_prec_indigenous: 221 case blas_prec_extra: BLAS_$1dot_x_testgen(length,0, length, norm, 222 blas_no_conj, &minus_one, 1, alpha, 1, 223 &HEAD(r_true)[start], &TAIL(r_true)[start], temp, 224 seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]); 225 break; 226 }', 227 `$1&&$2', `d&&s', 228` switch (prec){ 229 case blas_prec_single: 230 case blas_prec_double: 231 case blas_prec_indigenous: 232 /*BLAS_ddot_s_x_testgen(length, 0, length, norm, 233 blas_no_conj, &minus_one, 1, alpha, 1, 234 &HEAD(r_true)[start], &TAIL(r_true)[start], temp, 235 seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]); 236 break;*/ 237 case blas_prec_extra: BLAS_ddot_s_x_testgen(length,0, length, norm, 238 blas_no_conj, &minus_one, 1, alpha, 1, 239 &HEAD(r_true)[start], &TAIL(r_true)[start], temp, 240 seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]); 241 break; 242 }') 243 $2trsv_commit(order, uplo, trans, length, T, lda, temp, row); 244 } 245 else{ 246 x[row] = xrand(seed); 247 248 switch(prec){ 249 case blas_prec_single: 250 { 251 DECLARE(multemp, $1_type) 252 253 MUL(multemp, $1_type, x[row], $1_type, *alpha, $1_type) 254 HEAD(r_true)[row]=multemp; 255 TAIL(r_true)[row]=0.0; 256 break; 257 } 258 case blas_prec_indigenous: 259 case blas_prec_double: 260 { 261ifelse(`$1', `s', 262 `DECLARE(multemp, real_D) 263 264 MUL(multemp, real_D, x[row], $1_type, *alpha, $1_type) 265 HEAD(r_true)[row]=multemp; 266 TAIL(r_true)[row]=0.0;', 267 `$1', `d', 268 `DECLARE(multemp, $1_type) 269 270 MUL(multemp, $1_type, x[row], $1_type, *alpha, $1_type) 271 HEAD(r_true)[row]=multemp; 272 TAIL(r_true)[row]=0.0;') 273 break; 274 } 275 case blas_prec_extra: 276 { 277 DECLARE(multemp, real_E) 278 279 MUL(multemp, real_E, x[row], $1_type, *alpha, $1_type) 280 ASSIGN(HEAD(r_true)[row], real_D, HEAD(multemp), real_D) 281 ASSIGN(TAIL(r_true)[row], real_D, TAIL(multemp), real_D) 282 break; 283 } 284 } 285 } 286 287 FREE_VECTOR(temp, $2_type) 288 289 if (prec!=blas_prec_extra) 290 FREE_VECTOR(xtemp2, $1_type) 291}')dnl 292dnl 293dnl 294dnl --------------------------------------------------------------------- 295dnl Usage: DOT_TRSV_NAME(abr_typeltr, x_typeltr, y_typeltr) 296dnl produce dot_testgen name 297dnl --------------------------------------------------------------------- 298define(`DOT_TESTGEN_X_NAME', `ifelse( 299 `$1&&$2', `$1&&$1', `BLAS_$1dot_x_testgen', 300 `BLAS_$1dot_$2_x_testgen')')dnl 301dnl 302dnl 303define(`TRSV_TESTGEN_PURE_COMPLEX_BODY', 304`{ 305 PTR_CAST(x, $1_type) 306 PTR_CAST(alpha, $1_type) 307 PTR_CAST(T, $2_type) 308 DECLARE(alpha_r, REAL_TYPE($1_type)) 309 DECLARE_VECTOR(T_r, REAL_TYPE($2_type)) 310 DECLARE_VECTOR(x_r, REAL_TYPE($1_type)) 311 DECLARE_VECTOR(r_true_r, real_E) 312 int i, inc=2, length; 313 314 MALLOC_VECTOR(T_r, REAL_TYPE($2_type), 4*n*n) 315 MALLOC_VECTOR(x_r, REAL_TYPE($1_type), n) 316 MALLOC_VECTOR(r_true_r, real_E, n) 317 318 if (alpha_flag == 1){ 319 alpha_r = alpha_i[0]; 320 } 321 322 if ((uplo==blas_lower && trans==blas_no_trans) || 323 (uplo==blas_upper && trans!=blas_no_trans)) { 324 length = row; 325 } else { 326 length = n-row-1; 327 } 328 329 REAL_TRSV_NAME($1, $2)(norm, order, uplo, trans, diag, n, &alpha_r, 330 alpha_flag, T_r, lda, x_r, seed, HEAD(r_true_r), TAIL(r_true_r), 331 row, prec); 332 333 alpha_i[0] = alpha_r; 334 alpha_i[1] = alpha_r; 335 336 if (diag == blas_non_unit_diag){ 337 for(i=0; i<n; i++){ 338 x_i[i*inc] = 0.0; 339 x_i[i*inc+1] = x_r[i]; 340 341 if (i != row){ 342 HEAD(r_true)[i*inc] = 0.0; 343 HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i]; 344 TAIL(r_true)[i*inc] = 0.0; 345 TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i]; 346 } 347 else{ 348 HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i]; 349 HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i]; 350 TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i]; 351 TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i]; 352 } 353 } 354 355 for(i=0; i<4*n*n; i++){ 356 T_i[i*inc] = T_r[i]; 357 358 if (trans != blas_conj_trans) 359 T_i[i*inc+1] = T_r[i]; 360 else 361 T_i[i*inc+1] = -T_r[i]; 362 } 363 364 T_i[(row+lda*row)*inc+1] = 0.0; 365 } else { 366 for(i=0; i<n; i++){ 367 x_i[i*inc] = 0.0; 368 x_i[i*inc+1] = x_r[i]; 369 370 if (i != row || length == 0){ 371 HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i]; 372 HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i]; 373 TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i]; 374 TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i]; 375 } 376 else{ 377 x_i[i*inc] = x_r[i]; 378 x_i[i*inc+1] = x_r[i]; 379 380 HEAD(r_true)[i*inc] = 0.0; 381 HEAD(r_true)[i*inc+1] = 2*HEAD(r_true_r)[i]; 382 TAIL(r_true)[i*inc] = 0.0; 383 TAIL(r_true)[i*inc+1] = 2*TAIL(r_true_r)[i]; 384 } 385 } 386 387 for(i=0; i<4*n*n; i++){ 388 T_i[i*inc] = T_r[i]; 389 390 if (trans != blas_conj_trans) 391 T_i[i*inc+1] = -T_r[i]; 392 else 393 T_i[i*inc+1] = T_r[i]; 394 } 395 396 for(i=0; i<n; i++){ 397 T_i[(i+lda*i)*inc+1] = 0.0; 398 } 399 } 400 401 FREE_VECTOR(T_r, REAL_TYPE($2_type)) 402 FREE_VECTOR(x_r, REAL_TYPE($1_type)) 403 FREE_VECTOR(HEAD(r_true_r), real_D) 404 FREE_VECTOR(TAIL(r_true_r), real_D) 405}')dnl 406dnl 407dnl 408dnl 409define(`TRSV_TESTGEN_MIX_COMPLEX_BODY', 410`{ 411 PTR_CAST(x, $1_type) 412 PTR_CAST(alpha, $1_type) 413 PTR_CAST(T, $2_type) 414 DECLARE(alpha_r, REAL_TYPE($1_type)) 415 DECLARE_VECTOR(x_r, REAL_TYPE($1_type)) 416 double *HEAD(r_true_r), *TAIL(r_true_r); 417 int i, inc=2; 418 419 MALLOC_VECTOR(x_r, REAL_TYPE($1_type), n) 420 MALLOC_VECTOR(HEAD(r_true_r), real_D, n) 421 MALLOC_VECTOR(TAIL(r_true_r), real_D, n) 422 423 if (alpha_flag == 1){ 424 alpha_r = alpha_i[0]; 425 } 426 427 REAL_TRSV_NAME($1, $2)(norm, order, uplo, trans, diag, n, &alpha_r, 428 alpha_flag, T_i, lda, x_r, seed, HEAD(r_true_r), TAIL(r_true_r), 429 row, prec); 430 431 alpha_i[0] = alpha_r; 432 alpha_i[1] = alpha_r; 433 434 for(i=0; i<n; i++){ 435 x_i[i*inc] = 0.0; 436 x_i[i*inc+1] = x_r[i]; 437 438 HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i]; 439 HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i]; 440 TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i]; 441 TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i]; 442 } 443 444 FREE_VECTOR(x_r, REAL_TYPE($1_type)) 445 FREE_VECTOR(HEAD(r_true_r), real_D) 446 FREE_VECTOR(TAIL(r_true_r), real_D) 447}')dnl 448dnl 449dnl 450define(`REAL_TRSV_NAME', `ifelse( 451 `$1&&$2', `c&&c', `BLAS_strsv_testgen', 452 `$1&&$2', `z&&z', `BLAS_dtrsv_testgen', 453 `$1&&$2', `z&&c', `BLAS_dtrsv_s_testgen', 454 `$1&&$2', `c&&s', `BLAS_strsv_testgen', 455 `$1&&$2', `z&&d', `BLAS_dtrsv_testgen')')dnl 456dnl 457dnl 458define(`PROTOTYPES', `dnl 459TRSV_TESTGEN_HEAD(s, s); 460TRSV_TESTGEN_HEAD(d, d); 461TRSV_TESTGEN_HEAD(d, s); 462TRSV_TESTGEN_HEAD(c, c); 463TRSV_TESTGEN_HEAD(z, c); 464TRSV_TESTGEN_HEAD(z, z); 465TRSV_TESTGEN_HEAD(c, s); 466TRSV_TESTGEN_HEAD(z, d); 467')dnl 468dnl 469dnl 470define(`SOURCE', `dnl 471#include "blas_extended.h" 472#include "blas_extended_private.h" 473#include "blas_extended_test.h" 474 475TRSV_TESTGEN(s, s) 476TRSV_TESTGEN(d, d) 477TRSV_TESTGEN(d, s) 478TRSV_TESTGEN(c, c) 479TRSV_TESTGEN(z, c) 480TRSV_TESTGEN(z, z) 481TRSV_TESTGEN(c, s) 482TRSV_TESTGEN(z, d) 483')dnl 484dnl 485dnl 486ifdef(`prototypes_only', `PROTOTYPES()', `SOURCE()')dnl 487dnl 488dnl 489