1 /* 2 * Written by D.P. Manley, Digital Equipment Corporation. 3 * Prefixed "C_" to BLAS routines and their declarations. 4 * 5 * Modified by T. H. Do, 4/08/98, SGI/CRAY Research. 6 */ 7 #include <stdlib.h> 8 #include "cblas.h" 9 #include "cblas_test.h" 10 11 void F77_cgemv(int *order, char *transp, int *m, int *n, 12 const void *alpha, 13 CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx, 14 const void *beta, void *y, int *incy) { 15 16 CBLAS_TEST_COMPLEX *A; 17 int i,j,LDA; 18 enum CBLAS_TRANSPOSE trans; 19 20 get_transpose_type(transp, &trans); 21 if (*order == TEST_ROW_MJR) { 22 LDA = *n+1; 23 A = (CBLAS_TEST_COMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_COMPLEX) ); 24 for( i=0; i<*m; i++ ) 25 for( j=0; j<*n; j++ ){ 26 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 27 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 28 } 29 cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx, 30 beta, y, *incy ); 31 free(A); 32 } 33 else if (*order == TEST_COL_MJR) 34 cblas_cgemv( CblasColMajor, trans, 35 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); 36 else 37 cblas_cgemv( UNDEFINED, trans, 38 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy ); 39 } 40 41 void F77_cgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku, 42 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, 43 CBLAS_TEST_COMPLEX *x, int *incx, 44 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) { 45 46 CBLAS_TEST_COMPLEX *A; 47 int i,j,irow,jcol,LDA; 48 enum CBLAS_TRANSPOSE trans; 49 50 get_transpose_type(transp, &trans); 51 if (*order == TEST_ROW_MJR) { 52 LDA = *ku+*kl+2; 53 A=( CBLAS_TEST_COMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 54 for( i=0; i<*ku; i++ ){ 55 irow=*ku+*kl-i; 56 jcol=(*ku)-i; 57 for( j=jcol; j<*n; j++ ){ 58 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real; 59 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag; 60 } 61 } 62 i=*ku; 63 irow=*ku+*kl-i; 64 for( j=0; j<*n; j++ ){ 65 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 66 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 67 } 68 for( i=*ku+1; i<*ku+*kl+1; i++ ){ 69 irow=*ku+*kl-i; 70 jcol=i-(*ku); 71 for( j=jcol; j<(*n+*kl); j++ ){ 72 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real; 73 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; 74 } 75 } 76 cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x, 77 *incx, beta, y, *incy ); 78 free(A); 79 } 80 else if (*order == TEST_COL_MJR) 81 cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, 82 *incx, beta, y, *incy ); 83 else 84 cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x, 85 *incx, beta, y, *incy ); 86 } 87 88 void F77_cgeru(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, 89 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 90 CBLAS_TEST_COMPLEX *a, int *lda){ 91 92 CBLAS_TEST_COMPLEX *A; 93 int i,j,LDA; 94 95 if (*order == TEST_ROW_MJR) { 96 LDA = *n+1; 97 A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 98 for( i=0; i<*m; i++ ) 99 for( j=0; j<*n; j++ ){ 100 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 101 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 102 } 103 cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); 104 for( i=0; i<*m; i++ ) 105 for( j=0; j<*n; j++ ){ 106 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; 107 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag; 108 } 109 free(A); 110 } 111 else if (*order == TEST_COL_MJR) 112 cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); 113 else 114 cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); 115 } 116 117 void F77_cgerc(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha, 118 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 119 CBLAS_TEST_COMPLEX *a, int *lda) { 120 CBLAS_TEST_COMPLEX *A; 121 int i,j,LDA; 122 123 if (*order == TEST_ROW_MJR) { 124 LDA = *n+1; 125 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); 126 for( i=0; i<*m; i++ ) 127 for( j=0; j<*n; j++ ){ 128 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 129 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 130 } 131 cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA ); 132 for( i=0; i<*m; i++ ) 133 for( j=0; j<*n; j++ ){ 134 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; 135 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag; 136 } 137 free(A); 138 } 139 else if (*order == TEST_COL_MJR) 140 cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); 141 else 142 cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda ); 143 } 144 145 void F77_chemv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, 146 CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, 147 int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){ 148 149 CBLAS_TEST_COMPLEX *A; 150 int i,j,LDA; 151 enum CBLAS_UPLO uplo; 152 153 get_uplo_type(uplow,&uplo); 154 155 if (*order == TEST_ROW_MJR) { 156 LDA = *n+1; 157 A = (CBLAS_TEST_COMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 158 for( i=0; i<*n; i++ ) 159 for( j=0; j<*n; j++ ){ 160 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 161 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 162 } 163 cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx, 164 beta, y, *incy ); 165 free(A); 166 } 167 else if (*order == TEST_COL_MJR) 168 cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, 169 beta, y, *incy ); 170 else 171 cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx, 172 beta, y, *incy ); 173 } 174 175 void F77_chbmv(int *order, char *uplow, int *n, int *k, 176 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda, 177 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta, 178 CBLAS_TEST_COMPLEX *y, int *incy){ 179 180 CBLAS_TEST_COMPLEX *A; 181 int i,irow,j,jcol,LDA; 182 183 enum CBLAS_UPLO uplo; 184 185 get_uplo_type(uplow,&uplo); 186 187 if (*order == TEST_ROW_MJR) { 188 if (uplo != CblasUpper && uplo != CblasLower ) 189 cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x, 190 *incx, beta, y, *incy ); 191 else { 192 LDA = *k+2; 193 A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 194 if (uplo == CblasUpper) { 195 for( i=0; i<*k; i++ ){ 196 irow=*k-i; 197 jcol=(*k)-i; 198 for( j=jcol; j<*n; j++ ) { 199 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real; 200 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag; 201 } 202 } 203 i=*k; 204 irow=*k-i; 205 for( j=0; j<*n; j++ ) { 206 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 207 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 208 } 209 } 210 else { 211 i=0; 212 irow=*k-i; 213 for( j=0; j<*n; j++ ) { 214 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 215 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 216 } 217 for( i=1; i<*k+1; i++ ){ 218 irow=*k-i; 219 jcol=i; 220 for( j=jcol; j<(*n+*k); j++ ) { 221 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real; 222 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; 223 } 224 } 225 } 226 cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx, 227 beta, y, *incy ); 228 free(A); 229 } 230 } 231 else if (*order == TEST_COL_MJR) 232 cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx, 233 beta, y, *incy ); 234 else 235 cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx, 236 beta, y, *incy ); 237 } 238 239 void F77_chpmv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, 240 CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx, 241 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){ 242 243 CBLAS_TEST_COMPLEX *A, *AP; 244 int i,j,k,LDA; 245 enum CBLAS_UPLO uplo; 246 247 get_uplo_type(uplow,&uplo); 248 if (*order == TEST_ROW_MJR) { 249 if (uplo != CblasUpper && uplo != CblasLower ) 250 cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx, 251 beta, y, *incy); 252 else { 253 LDA = *n; 254 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX )); 255 AP = (CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)* 256 sizeof( CBLAS_TEST_COMPLEX )); 257 if (uplo == CblasUpper) { 258 for( j=0, k=0; j<*n; j++ ) 259 for( i=0; i<j+1; i++, k++ ) { 260 A[ LDA*i+j ].real=ap[ k ].real; 261 A[ LDA*i+j ].imag=ap[ k ].imag; 262 } 263 for( i=0, k=0; i<*n; i++ ) 264 for( j=i; j<*n; j++, k++ ) { 265 AP[ k ].real=A[ LDA*i+j ].real; 266 AP[ k ].imag=A[ LDA*i+j ].imag; 267 } 268 } 269 else { 270 for( j=0, k=0; j<*n; j++ ) 271 for( i=j; i<*n; i++, k++ ) { 272 A[ LDA*i+j ].real=ap[ k ].real; 273 A[ LDA*i+j ].imag=ap[ k ].imag; 274 } 275 for( i=0, k=0; i<*n; i++ ) 276 for( j=0; j<i+1; j++, k++ ) { 277 AP[ k ].real=A[ LDA*i+j ].real; 278 AP[ k ].imag=A[ LDA*i+j ].imag; 279 } 280 } 281 cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y, 282 *incy ); 283 free(A); 284 free(AP); 285 } 286 } 287 else if (*order == TEST_COL_MJR) 288 cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y, 289 *incy ); 290 else 291 cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y, 292 *incy ); 293 } 294 295 void F77_ctbmv(int *order, char *uplow, char *transp, char *diagn, 296 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, 297 int *incx) { 298 CBLAS_TEST_COMPLEX *A; 299 int irow, jcol, i, j, LDA; 300 enum CBLAS_TRANSPOSE trans; 301 enum CBLAS_UPLO uplo; 302 enum CBLAS_DIAG diag; 303 304 get_transpose_type(transp,&trans); 305 get_uplo_type(uplow,&uplo); 306 get_diag_type(diagn,&diag); 307 308 if (*order == TEST_ROW_MJR) { 309 if (uplo != CblasUpper && uplo != CblasLower ) 310 cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, 311 x, *incx); 312 else { 313 LDA = *k+2; 314 A=(CBLAS_TEST_COMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 315 if (uplo == CblasUpper) { 316 for( i=0; i<*k; i++ ){ 317 irow=*k-i; 318 jcol=(*k)-i; 319 for( j=jcol; j<*n; j++ ) { 320 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real; 321 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag; 322 } 323 } 324 i=*k; 325 irow=*k-i; 326 for( j=0; j<*n; j++ ) { 327 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 328 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 329 } 330 } 331 else { 332 i=0; 333 irow=*k-i; 334 for( j=0; j<*n; j++ ) { 335 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 336 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 337 } 338 for( i=1; i<*k+1; i++ ){ 339 irow=*k-i; 340 jcol=i; 341 for( j=jcol; j<(*n+*k); j++ ) { 342 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real; 343 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; 344 } 345 } 346 } 347 cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, 348 *incx); 349 free(A); 350 } 351 } 352 else if (*order == TEST_COL_MJR) 353 cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 354 else 355 cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 356 } 357 358 void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn, 359 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, 360 int *incx) { 361 362 CBLAS_TEST_COMPLEX *A; 363 int irow, jcol, i, j, LDA; 364 enum CBLAS_TRANSPOSE trans; 365 enum CBLAS_UPLO uplo; 366 enum CBLAS_DIAG diag; 367 368 get_transpose_type(transp,&trans); 369 get_uplo_type(uplow,&uplo); 370 get_diag_type(diagn,&diag); 371 372 if (*order == TEST_ROW_MJR) { 373 if (uplo != CblasUpper && uplo != CblasLower ) 374 cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x, 375 *incx); 376 else { 377 LDA = *k+2; 378 A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX )); 379 if (uplo == CblasUpper) { 380 for( i=0; i<*k; i++ ){ 381 irow=*k-i; 382 jcol=(*k)-i; 383 for( j=jcol; j<*n; j++ ) { 384 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real; 385 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag; 386 } 387 } 388 i=*k; 389 irow=*k-i; 390 for( j=0; j<*n; j++ ) { 391 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 392 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 393 } 394 } 395 else { 396 i=0; 397 irow=*k-i; 398 for( j=0; j<*n; j++ ) { 399 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real; 400 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag; 401 } 402 for( i=1; i<*k+1; i++ ){ 403 irow=*k-i; 404 jcol=i; 405 for( j=jcol; j<(*n+*k); j++ ) { 406 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real; 407 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag; 408 } 409 } 410 } 411 cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, 412 x, *incx); 413 free(A); 414 } 415 } 416 else if (*order == TEST_COL_MJR) 417 cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 418 else 419 cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 420 } 421 422 void F77_ctpmv(int *order, char *uplow, char *transp, char *diagn, 423 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) { 424 CBLAS_TEST_COMPLEX *A, *AP; 425 int i, j, k, LDA; 426 enum CBLAS_TRANSPOSE trans; 427 enum CBLAS_UPLO uplo; 428 enum CBLAS_DIAG diag; 429 430 get_transpose_type(transp,&trans); 431 get_uplo_type(uplow,&uplo); 432 get_diag_type(diagn,&diag); 433 434 if (*order == TEST_ROW_MJR) { 435 if (uplo != CblasUpper && uplo != CblasLower ) 436 cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); 437 else { 438 LDA = *n; 439 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX)); 440 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)* 441 sizeof(CBLAS_TEST_COMPLEX)); 442 if (uplo == CblasUpper) { 443 for( j=0, k=0; j<*n; j++ ) 444 for( i=0; i<j+1; i++, k++ ) { 445 A[ LDA*i+j ].real=ap[ k ].real; 446 A[ LDA*i+j ].imag=ap[ k ].imag; 447 } 448 for( i=0, k=0; i<*n; i++ ) 449 for( j=i; j<*n; j++, k++ ) { 450 AP[ k ].real=A[ LDA*i+j ].real; 451 AP[ k ].imag=A[ LDA*i+j ].imag; 452 } 453 } 454 else { 455 for( j=0, k=0; j<*n; j++ ) 456 for( i=j; i<*n; i++, k++ ) { 457 A[ LDA*i+j ].real=ap[ k ].real; 458 A[ LDA*i+j ].imag=ap[ k ].imag; 459 } 460 for( i=0, k=0; i<*n; i++ ) 461 for( j=0; j<i+1; j++, k++ ) { 462 AP[ k ].real=A[ LDA*i+j ].real; 463 AP[ k ].imag=A[ LDA*i+j ].imag; 464 } 465 } 466 cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); 467 free(A); 468 free(AP); 469 } 470 } 471 else if (*order == TEST_COL_MJR) 472 cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); 473 else 474 cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); 475 } 476 477 void F77_ctpsv(int *order, char *uplow, char *transp, char *diagn, 478 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) { 479 CBLAS_TEST_COMPLEX *A, *AP; 480 int i, j, k, LDA; 481 enum CBLAS_TRANSPOSE trans; 482 enum CBLAS_UPLO uplo; 483 enum CBLAS_DIAG diag; 484 485 get_transpose_type(transp,&trans); 486 get_uplo_type(uplow,&uplo); 487 get_diag_type(diagn,&diag); 488 489 if (*order == TEST_ROW_MJR) { 490 if (uplo != CblasUpper && uplo != CblasLower ) 491 cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx ); 492 else { 493 LDA = *n; 494 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX)); 495 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)* 496 sizeof(CBLAS_TEST_COMPLEX)); 497 if (uplo == CblasUpper) { 498 for( j=0, k=0; j<*n; j++ ) 499 for( i=0; i<j+1; i++, k++ ) { 500 A[ LDA*i+j ].real=ap[ k ].real; 501 A[ LDA*i+j ].imag=ap[ k ].imag; 502 } 503 for( i=0, k=0; i<*n; i++ ) 504 for( j=i; j<*n; j++, k++ ) { 505 AP[ k ].real=A[ LDA*i+j ].real; 506 AP[ k ].imag=A[ LDA*i+j ].imag; 507 } 508 } 509 else { 510 for( j=0, k=0; j<*n; j++ ) 511 for( i=j; i<*n; i++, k++ ) { 512 A[ LDA*i+j ].real=ap[ k ].real; 513 A[ LDA*i+j ].imag=ap[ k ].imag; 514 } 515 for( i=0, k=0; i<*n; i++ ) 516 for( j=0; j<i+1; j++, k++ ) { 517 AP[ k ].real=A[ LDA*i+j ].real; 518 AP[ k ].imag=A[ LDA*i+j ].imag; 519 } 520 } 521 cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); 522 free(A); 523 free(AP); 524 } 525 } 526 else if (*order == TEST_COL_MJR) 527 cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); 528 else 529 cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx ); 530 } 531 532 void F77_ctrmv(int *order, char *uplow, char *transp, char *diagn, 533 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, 534 int *incx) { 535 CBLAS_TEST_COMPLEX *A; 536 int i,j,LDA; 537 enum CBLAS_TRANSPOSE trans; 538 enum CBLAS_UPLO uplo; 539 enum CBLAS_DIAG diag; 540 541 get_transpose_type(transp,&trans); 542 get_uplo_type(uplow,&uplo); 543 get_diag_type(diagn,&diag); 544 545 if (*order == TEST_ROW_MJR) { 546 LDA=*n+1; 547 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX)); 548 for( i=0; i<*n; i++ ) 549 for( j=0; j<*n; j++ ) { 550 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 551 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 552 } 553 cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); 554 free(A); 555 } 556 else if (*order == TEST_COL_MJR) 557 cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); 558 else 559 cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); 560 } 561 void F77_ctrsv(int *order, char *uplow, char *transp, char *diagn, 562 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x, 563 int *incx) { 564 CBLAS_TEST_COMPLEX *A; 565 int i,j,LDA; 566 enum CBLAS_TRANSPOSE trans; 567 enum CBLAS_UPLO uplo; 568 enum CBLAS_DIAG diag; 569 570 get_transpose_type(transp,&trans); 571 get_uplo_type(uplow,&uplo); 572 get_diag_type(diagn,&diag); 573 574 if (*order == TEST_ROW_MJR) { 575 LDA = *n+1; 576 A =(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); 577 for( i=0; i<*n; i++ ) 578 for( j=0; j<*n; j++ ) { 579 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 580 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 581 } 582 cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); 583 free(A); 584 } 585 else if (*order == TEST_COL_MJR) 586 cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); 587 else 588 cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx ); 589 } 590 591 void F77_chpr(int *order, char *uplow, int *n, float *alpha, 592 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) { 593 CBLAS_TEST_COMPLEX *A, *AP; 594 int i,j,k,LDA; 595 enum CBLAS_UPLO uplo; 596 597 get_uplo_type(uplow,&uplo); 598 599 if (*order == TEST_ROW_MJR) { 600 if (uplo != CblasUpper && uplo != CblasLower ) 601 cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap ); 602 else { 603 LDA = *n; 604 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); 605 AP = ( CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)* 606 sizeof( CBLAS_TEST_COMPLEX )); 607 if (uplo == CblasUpper) { 608 for( j=0, k=0; j<*n; j++ ) 609 for( i=0; i<j+1; i++, k++ ){ 610 A[ LDA*i+j ].real=ap[ k ].real; 611 A[ LDA*i+j ].imag=ap[ k ].imag; 612 } 613 for( i=0, k=0; i<*n; i++ ) 614 for( j=i; j<*n; j++, k++ ){ 615 AP[ k ].real=A[ LDA*i+j ].real; 616 AP[ k ].imag=A[ LDA*i+j ].imag; 617 } 618 } 619 else { 620 for( j=0, k=0; j<*n; j++ ) 621 for( i=j; i<*n; i++, k++ ){ 622 A[ LDA*i+j ].real=ap[ k ].real; 623 A[ LDA*i+j ].imag=ap[ k ].imag; 624 } 625 for( i=0, k=0; i<*n; i++ ) 626 for( j=0; j<i+1; j++, k++ ){ 627 AP[ k ].real=A[ LDA*i+j ].real; 628 AP[ k ].imag=A[ LDA*i+j ].imag; 629 } 630 } 631 cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); 632 if (uplo == CblasUpper) { 633 for( i=0, k=0; i<*n; i++ ) 634 for( j=i; j<*n; j++, k++ ){ 635 A[ LDA*i+j ].real=AP[ k ].real; 636 A[ LDA*i+j ].imag=AP[ k ].imag; 637 } 638 for( j=0, k=0; j<*n; j++ ) 639 for( i=0; i<j+1; i++, k++ ){ 640 ap[ k ].real=A[ LDA*i+j ].real; 641 ap[ k ].imag=A[ LDA*i+j ].imag; 642 } 643 } 644 else { 645 for( i=0, k=0; i<*n; i++ ) 646 for( j=0; j<i+1; j++, k++ ){ 647 A[ LDA*i+j ].real=AP[ k ].real; 648 A[ LDA*i+j ].imag=AP[ k ].imag; 649 } 650 for( j=0, k=0; j<*n; j++ ) 651 for( i=j; i<*n; i++, k++ ){ 652 ap[ k ].real=A[ LDA*i+j ].real; 653 ap[ k ].imag=A[ LDA*i+j ].imag; 654 } 655 } 656 free(A); 657 free(AP); 658 } 659 } 660 else if (*order == TEST_COL_MJR) 661 cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); 662 else 663 cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap ); 664 } 665 666 void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, 667 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 668 CBLAS_TEST_COMPLEX *ap) { 669 CBLAS_TEST_COMPLEX *A, *AP; 670 int i,j,k,LDA; 671 enum CBLAS_UPLO uplo; 672 673 get_uplo_type(uplow,&uplo); 674 675 if (*order == TEST_ROW_MJR) { 676 if (uplo != CblasUpper && uplo != CblasLower ) 677 cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y, 678 *incy, ap ); 679 else { 680 LDA = *n; 681 A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); 682 AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)* 683 sizeof( CBLAS_TEST_COMPLEX )); 684 if (uplo == CblasUpper) { 685 for( j=0, k=0; j<*n; j++ ) 686 for( i=0; i<j+1; i++, k++ ) { 687 A[ LDA*i+j ].real=ap[ k ].real; 688 A[ LDA*i+j ].imag=ap[ k ].imag; 689 } 690 for( i=0, k=0; i<*n; i++ ) 691 for( j=i; j<*n; j++, k++ ) { 692 AP[ k ].real=A[ LDA*i+j ].real; 693 AP[ k ].imag=A[ LDA*i+j ].imag; 694 } 695 } 696 else { 697 for( j=0, k=0; j<*n; j++ ) 698 for( i=j; i<*n; i++, k++ ) { 699 A[ LDA*i+j ].real=ap[ k ].real; 700 A[ LDA*i+j ].imag=ap[ k ].imag; 701 } 702 for( i=0, k=0; i<*n; i++ ) 703 for( j=0; j<i+1; j++, k++ ) { 704 AP[ k ].real=A[ LDA*i+j ].real; 705 AP[ k ].imag=A[ LDA*i+j ].imag; 706 } 707 } 708 cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP ); 709 if (uplo == CblasUpper) { 710 for( i=0, k=0; i<*n; i++ ) 711 for( j=i; j<*n; j++, k++ ) { 712 A[ LDA*i+j ].real=AP[ k ].real; 713 A[ LDA*i+j ].imag=AP[ k ].imag; 714 } 715 for( j=0, k=0; j<*n; j++ ) 716 for( i=0; i<j+1; i++, k++ ) { 717 ap[ k ].real=A[ LDA*i+j ].real; 718 ap[ k ].imag=A[ LDA*i+j ].imag; 719 } 720 } 721 else { 722 for( i=0, k=0; i<*n; i++ ) 723 for( j=0; j<i+1; j++, k++ ) { 724 A[ LDA*i+j ].real=AP[ k ].real; 725 A[ LDA*i+j ].imag=AP[ k ].imag; 726 } 727 for( j=0, k=0; j<*n; j++ ) 728 for( i=j; i<*n; i++, k++ ) { 729 ap[ k ].real=A[ LDA*i+j ].real; 730 ap[ k ].imag=A[ LDA*i+j ].imag; 731 } 732 } 733 free(A); 734 free(AP); 735 } 736 } 737 else if (*order == TEST_COL_MJR) 738 cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap ); 739 else 740 cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap ); 741 } 742 743 void F77_cher(int *order, char *uplow, int *n, float *alpha, 744 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) { 745 CBLAS_TEST_COMPLEX *A; 746 int i,j,LDA; 747 enum CBLAS_UPLO uplo; 748 749 get_uplo_type(uplow,&uplo); 750 751 if (*order == TEST_ROW_MJR) { 752 LDA = *n+1; 753 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_COMPLEX )); 754 755 for( i=0; i<*n; i++ ) 756 for( j=0; j<*n; j++ ) { 757 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 758 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 759 } 760 761 cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA ); 762 for( i=0; i<*n; i++ ) 763 for( j=0; j<*n; j++ ) { 764 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; 765 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag; 766 } 767 free(A); 768 } 769 else if (*order == TEST_COL_MJR) 770 cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda ); 771 else 772 cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda ); 773 } 774 775 void F77_cher2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha, 776 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy, 777 CBLAS_TEST_COMPLEX *a, int *lda) { 778 779 CBLAS_TEST_COMPLEX *A; 780 int i,j,LDA; 781 enum CBLAS_UPLO uplo; 782 783 get_uplo_type(uplow,&uplo); 784 785 if (*order == TEST_ROW_MJR) { 786 LDA = *n+1; 787 A= ( CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) ); 788 789 for( i=0; i<*n; i++ ) 790 for( j=0; j<*n; j++ ) { 791 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real; 792 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag; 793 } 794 795 cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA ); 796 for( i=0; i<*n; i++ ) 797 for( j=0; j<*n; j++ ) { 798 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real; 799 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag; 800 } 801 free(A); 802 } 803 else if (*order == TEST_COL_MJR) 804 cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); 805 else 806 cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda); 807 } 808
