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, 1/23/98, SGI/CRAY Research. 6 */ 7 #include <stdlib.h> 8 #include "cblas.h" 9 #include "cblas_test.h" 10 11 void F77_sgemv(int *order, char *transp, int *m, int *n, float *alpha, 12 float *a, int *lda, float *x, int *incx, float *beta, 13 float *y, int *incy ) { 14 15 float *A; 16 int i,j,LDA; 17 enum CBLAS_TRANSPOSE trans; 18 19 get_transpose_type(transp, &trans); 20 if (*order == TEST_ROW_MJR) { 21 LDA = *n+1; 22 A = ( float* )malloc( (*m)*LDA*sizeof( float ) ); 23 for( i=0; i<*m; i++ ) 24 for( j=0; j<*n; j++ ) 25 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 26 cblas_sgemv( CblasRowMajor, trans, 27 *m, *n, *alpha, A, LDA, x, *incx, *beta, y, *incy ); 28 free(A); 29 } 30 else if (*order == TEST_COL_MJR) 31 cblas_sgemv( CblasColMajor, trans, 32 *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); 33 else 34 cblas_sgemv( UNDEFINED, trans, 35 *m, *n, *alpha, a, *lda, x, *incx, *beta, y, *incy ); 36 } 37 38 void F77_sger(int *order, int *m, int *n, float *alpha, float *x, int *incx, 39 float *y, int *incy, float *a, int *lda ) { 40 41 float *A; 42 int i,j,LDA; 43 44 if (*order == TEST_ROW_MJR) { 45 LDA = *n+1; 46 A = ( float* )malloc( (*m)*LDA*sizeof( float ) ); 47 48 for( i=0; i<*m; i++ ) { 49 for( j=0; j<*n; j++ ) 50 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 51 } 52 53 cblas_sger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA ); 54 for( i=0; i<*m; i++ ) 55 for( j=0; j<*n; j++ ) 56 a[ (*lda)*j+i ]=A[ LDA*i+j ]; 57 free(A); 58 } 59 else 60 cblas_sger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda ); 61 } 62 63 void F77_strmv(int *order, char *uplow, char *transp, char *diagn, 64 int *n, float *a, int *lda, float *x, int *incx) { 65 float *A; 66 int i,j,LDA; 67 enum CBLAS_TRANSPOSE trans; 68 enum CBLAS_UPLO uplo; 69 enum CBLAS_DIAG diag; 70 71 get_transpose_type(transp,&trans); 72 get_uplo_type(uplow,&uplo); 73 get_diag_type(diagn,&diag); 74 75 if (*order == TEST_ROW_MJR) { 76 LDA = *n+1; 77 A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); 78 for( i=0; i<*n; i++ ) 79 for( j=0; j<*n; j++ ) 80 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 81 cblas_strmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx); 82 free(A); 83 } 84 else if (*order == TEST_COL_MJR) 85 cblas_strmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx); 86 else { 87 cblas_strmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx); 88 } 89 } 90 91 void F77_strsv(int *order, char *uplow, char *transp, char *diagn, 92 int *n, float *a, int *lda, float *x, int *incx ) { 93 float *A; 94 int i,j,LDA; 95 enum CBLAS_TRANSPOSE trans; 96 enum CBLAS_UPLO uplo; 97 enum CBLAS_DIAG diag; 98 99 get_transpose_type(transp,&trans); 100 get_uplo_type(uplow,&uplo); 101 get_diag_type(diagn,&diag); 102 103 if (*order == TEST_ROW_MJR) { 104 LDA = *n+1; 105 A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); 106 for( i=0; i<*n; i++ ) 107 for( j=0; j<*n; j++ ) 108 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 109 cblas_strsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx ); 110 free(A); 111 } 112 else 113 cblas_strsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx ); 114 } 115 void F77_ssymv(int *order, char *uplow, int *n, float *alpha, float *a, 116 int *lda, float *x, int *incx, float *beta, float *y, 117 int *incy) { 118 float *A; 119 int i,j,LDA; 120 enum CBLAS_UPLO uplo; 121 122 get_uplo_type(uplow,&uplo); 123 124 if (*order == TEST_ROW_MJR) { 125 LDA = *n+1; 126 A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); 127 for( i=0; i<*n; i++ ) 128 for( j=0; j<*n; j++ ) 129 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 130 cblas_ssymv(CblasRowMajor, uplo, *n, *alpha, A, LDA, x, *incx, 131 *beta, y, *incy ); 132 free(A); 133 } 134 else 135 cblas_ssymv(CblasColMajor, uplo, *n, *alpha, a, *lda, x, *incx, 136 *beta, y, *incy ); 137 } 138 139 void F77_ssyr(int *order, char *uplow, int *n, float *alpha, float *x, 140 int *incx, float *a, int *lda) { 141 float *A; 142 int i,j,LDA; 143 enum CBLAS_UPLO uplo; 144 145 get_uplo_type(uplow,&uplo); 146 147 if (*order == TEST_ROW_MJR) { 148 LDA = *n+1; 149 A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); 150 for( i=0; i<*n; i++ ) 151 for( j=0; j<*n; j++ ) 152 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 153 cblas_ssyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA); 154 for( i=0; i<*n; i++ ) 155 for( j=0; j<*n; j++ ) 156 a[ (*lda)*j+i ]=A[ LDA*i+j ]; 157 free(A); 158 } 159 else 160 cblas_ssyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda); 161 } 162 163 void F77_ssyr2(int *order, char *uplow, int *n, float *alpha, float *x, 164 int *incx, float *y, int *incy, float *a, int *lda) { 165 float *A; 166 int i,j,LDA; 167 enum CBLAS_UPLO uplo; 168 169 get_uplo_type(uplow,&uplo); 170 171 if (*order == TEST_ROW_MJR) { 172 LDA = *n+1; 173 A = ( float* )malloc( (*n)*LDA*sizeof( float ) ); 174 for( i=0; i<*n; i++ ) 175 for( j=0; j<*n; j++ ) 176 A[ LDA*i+j ]=a[ (*lda)*j+i ]; 177 cblas_ssyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA); 178 for( i=0; i<*n; i++ ) 179 for( j=0; j<*n; j++ ) 180 a[ (*lda)*j+i ]=A[ LDA*i+j ]; 181 free(A); 182 } 183 else 184 cblas_ssyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda); 185 } 186 187 void F77_sgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku, 188 float *alpha, float *a, int *lda, float *x, int *incx, 189 float *beta, float *y, int *incy ) { 190 191 float *A; 192 int i,irow,j,jcol,LDA; 193 enum CBLAS_TRANSPOSE trans; 194 195 get_transpose_type(transp, &trans); 196 197 if (*order == TEST_ROW_MJR) { 198 LDA = *ku+*kl+2; 199 A = ( float* )malloc( (*n+*kl)*LDA*sizeof( float ) ); 200 for( i=0; i<*ku; i++ ){ 201 irow=*ku+*kl-i; 202 jcol=(*ku)-i; 203 for( j=jcol; j<*n; j++ ) 204 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ]; 205 } 206 i=*ku; 207 irow=*ku+*kl-i; 208 for( j=0; j<*n; j++ ) 209 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 210 for( i=*ku+1; i<*ku+*kl+1; i++ ){ 211 irow=*ku+*kl-i; 212 jcol=i-(*ku); 213 for( j=jcol; j<(*n+*kl); j++ ) 214 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; 215 } 216 cblas_sgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, *alpha, 217 A, LDA, x, *incx, *beta, y, *incy ); 218 free(A); 219 } 220 else 221 cblas_sgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, *alpha, 222 a, *lda, x, *incx, *beta, y, *incy ); 223 } 224 225 void F77_stbmv(int *order, char *uplow, char *transp, char *diagn, 226 int *n, int *k, float *a, int *lda, float *x, int *incx) { 227 float *A; 228 int irow, jcol, i, j, LDA; 229 enum CBLAS_TRANSPOSE trans; 230 enum CBLAS_UPLO uplo; 231 enum CBLAS_DIAG diag; 232 233 get_transpose_type(transp,&trans); 234 get_uplo_type(uplow,&uplo); 235 get_diag_type(diagn,&diag); 236 237 if (*order == TEST_ROW_MJR) { 238 LDA = *k+1; 239 A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) ); 240 if (uplo == CblasUpper) { 241 for( i=0; i<*k; i++ ){ 242 irow=*k-i; 243 jcol=(*k)-i; 244 for( j=jcol; j<*n; j++ ) 245 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ]; 246 } 247 i=*k; 248 irow=*k-i; 249 for( j=0; j<*n; j++ ) 250 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 251 } 252 else { 253 i=0; 254 irow=*k-i; 255 for( j=0; j<*n; j++ ) 256 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 257 for( i=1; i<*k+1; i++ ){ 258 irow=*k-i; 259 jcol=i; 260 for( j=jcol; j<(*n+*k); j++ ) 261 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; 262 } 263 } 264 cblas_stbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); 265 free(A); 266 } 267 else 268 cblas_stbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 269 } 270 271 void F77_stbsv(int *order, char *uplow, char *transp, char *diagn, 272 int *n, int *k, float *a, int *lda, float *x, int *incx) { 273 float *A; 274 int irow, jcol, i, j, LDA; 275 enum CBLAS_TRANSPOSE trans; 276 enum CBLAS_UPLO uplo; 277 enum CBLAS_DIAG diag; 278 279 get_transpose_type(transp,&trans); 280 get_uplo_type(uplow,&uplo); 281 get_diag_type(diagn,&diag); 282 283 if (*order == TEST_ROW_MJR) { 284 LDA = *k+1; 285 A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) ); 286 if (uplo == CblasUpper) { 287 for( i=0; i<*k; i++ ){ 288 irow=*k-i; 289 jcol=(*k)-i; 290 for( j=jcol; j<*n; j++ ) 291 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ]; 292 } 293 i=*k; 294 irow=*k-i; 295 for( j=0; j<*n; j++ ) 296 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 297 } 298 else { 299 i=0; 300 irow=*k-i; 301 for( j=0; j<*n; j++ ) 302 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 303 for( i=1; i<*k+1; i++ ){ 304 irow=*k-i; 305 jcol=i; 306 for( j=jcol; j<(*n+*k); j++ ) 307 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; 308 } 309 } 310 cblas_stbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx); 311 free(A); 312 } 313 else 314 cblas_stbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx); 315 } 316 317 void F77_ssbmv(int *order, char *uplow, int *n, int *k, float *alpha, 318 float *a, int *lda, float *x, int *incx, float *beta, 319 float *y, int *incy) { 320 float *A; 321 int i,j,irow,jcol,LDA; 322 enum CBLAS_UPLO uplo; 323 324 get_uplo_type(uplow,&uplo); 325 326 if (*order == TEST_ROW_MJR) { 327 LDA = *k+1; 328 A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) ); 329 if (uplo == CblasUpper) { 330 for( i=0; i<*k; i++ ){ 331 irow=*k-i; 332 jcol=(*k)-i; 333 for( j=jcol; j<*n; j++ ) 334 A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ]; 335 } 336 i=*k; 337 irow=*k-i; 338 for( j=0; j<*n; j++ ) 339 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 340 } 341 else { 342 i=0; 343 irow=*k-i; 344 for( j=0; j<*n; j++ ) 345 A[ LDA*j+irow ]=a[ (*lda)*j+i ]; 346 for( i=1; i<*k+1; i++ ){ 347 irow=*k-i; 348 jcol=i; 349 for( j=jcol; j<(*n+*k); j++ ) 350 A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ]; 351 } 352 } 353 cblas_ssbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx, 354 *beta, y, *incy ); 355 free(A); 356 } 357 else 358 cblas_ssbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx, 359 *beta, y, *incy ); 360 } 361 362 void F77_sspmv(int *order, char *uplow, int *n, float *alpha, float *ap, 363 float *x, int *incx, float *beta, float *y, int *incy) { 364 float *A,*AP; 365 int i,j,k,LDA; 366 enum CBLAS_UPLO uplo; 367 368 get_uplo_type(uplow,&uplo); 369 370 if (*order == TEST_ROW_MJR) { 371 LDA = *n; 372 A = ( float* )malloc( LDA*LDA*sizeof( float ) ); 373 AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) ); 374 if (uplo == CblasUpper) { 375 for( j=0, k=0; j<*n; j++ ) 376 for( i=0; i<j+1; i++, k++ ) 377 A[ LDA*i+j ]=ap[ k ]; 378 for( i=0, k=0; i<*n; i++ ) 379 for( j=i; j<*n; j++, k++ ) 380 AP[ k ]=A[ LDA*i+j ]; 381 } 382 else { 383 for( j=0, k=0; j<*n; j++ ) 384 for( i=j; i<*n; i++, k++ ) 385 A[ LDA*i+j ]=ap[ k ]; 386 for( i=0, k=0; i<*n; i++ ) 387 for( j=0; j<i+1; j++, k++ ) 388 AP[ k ]=A[ LDA*i+j ]; 389 } 390 cblas_sspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y, 391 *incy ); 392 free(A); free(AP); 393 } 394 else 395 cblas_sspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y, 396 *incy ); 397 } 398 399 void F77_stpmv(int *order, char *uplow, char *transp, char *diagn, 400 int *n, float *ap, float *x, int *incx) { 401 float *A, *AP; 402 int i, j, k, LDA; 403 enum CBLAS_TRANSPOSE trans; 404 enum CBLAS_UPLO uplo; 405 enum CBLAS_DIAG diag; 406 407 get_transpose_type(transp,&trans); 408 get_uplo_type(uplow,&uplo); 409 get_diag_type(diagn,&diag); 410 411 if (*order == TEST_ROW_MJR) { 412 LDA = *n; 413 A = ( float* )malloc( LDA*LDA*sizeof( float ) ); 414 AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) ); 415 if (uplo == CblasUpper) { 416 for( j=0, k=0; j<*n; j++ ) 417 for( i=0; i<j+1; i++, k++ ) 418 A[ LDA*i+j ]=ap[ k ]; 419 for( i=0, k=0; i<*n; i++ ) 420 for( j=i; j<*n; j++, k++ ) 421 AP[ k ]=A[ LDA*i+j ]; 422 } 423 else { 424 for( j=0, k=0; j<*n; j++ ) 425 for( i=j; i<*n; i++, k++ ) 426 A[ LDA*i+j ]=ap[ k ]; 427 for( i=0, k=0; i<*n; i++ ) 428 for( j=0; j<i+1; j++, k++ ) 429 AP[ k ]=A[ LDA*i+j ]; 430 } 431 cblas_stpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); 432 free(A); free(AP); 433 } 434 else 435 cblas_stpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); 436 } 437 438 void F77_stpsv(int *order, char *uplow, char *transp, char *diagn, 439 int *n, float *ap, float *x, int *incx) { 440 float *A, *AP; 441 int i, j, k, LDA; 442 enum CBLAS_TRANSPOSE trans; 443 enum CBLAS_UPLO uplo; 444 enum CBLAS_DIAG diag; 445 446 get_transpose_type(transp,&trans); 447 get_uplo_type(uplow,&uplo); 448 get_diag_type(diagn,&diag); 449 450 if (*order == TEST_ROW_MJR) { 451 LDA = *n; 452 A = ( float* )malloc( LDA*LDA*sizeof( float ) ); 453 AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) ); 454 if (uplo == CblasUpper) { 455 for( j=0, k=0; j<*n; j++ ) 456 for( i=0; i<j+1; i++, k++ ) 457 A[ LDA*i+j ]=ap[ k ]; 458 for( i=0, k=0; i<*n; i++ ) 459 for( j=i; j<*n; j++, k++ ) 460 AP[ k ]=A[ LDA*i+j ]; 461 462 } 463 else { 464 for( j=0, k=0; j<*n; j++ ) 465 for( i=j; i<*n; i++, k++ ) 466 A[ LDA*i+j ]=ap[ k ]; 467 for( i=0, k=0; i<*n; i++ ) 468 for( j=0; j<i+1; j++, k++ ) 469 AP[ k ]=A[ LDA*i+j ]; 470 } 471 cblas_stpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx ); 472 free(A); free(AP); 473 } 474 else 475 cblas_stpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx ); 476 } 477 478 void F77_sspr(int *order, char *uplow, int *n, float *alpha, float *x, 479 int *incx, float *ap ){ 480 float *A, *AP; 481 int i,j,k,LDA; 482 enum CBLAS_UPLO uplo; 483 484 get_uplo_type(uplow,&uplo); 485 486 if (*order == TEST_ROW_MJR) { 487 LDA = *n; 488 A = ( float* )malloc( LDA*LDA*sizeof( float ) ); 489 AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) ); 490 if (uplo == CblasUpper) { 491 for( j=0, k=0; j<*n; j++ ) 492 for( i=0; i<j+1; i++, k++ ) 493 A[ LDA*i+j ]=ap[ k ]; 494 for( i=0, k=0; i<*n; i++ ) 495 for( j=i; j<*n; j++, k++ ) 496 AP[ k ]=A[ LDA*i+j ]; 497 } 498 else { 499 for( j=0, k=0; j<*n; j++ ) 500 for( i=j; i<*n; i++, k++ ) 501 A[ LDA*i+j ]=ap[ k ]; 502 for( i=0, k=0; i<*n; i++ ) 503 for( j=0; j<i+1; j++, k++ ) 504 AP[ k ]=A[ LDA*i+j ]; 505 } 506 cblas_sspr( CblasRowMajor, uplo, *n, *alpha, x, *incx, AP ); 507 if (uplo == CblasUpper) { 508 for( i=0, k=0; i<*n; i++ ) 509 for( j=i; j<*n; j++, k++ ) 510 A[ LDA*i+j ]=AP[ k ]; 511 for( j=0, k=0; j<*n; j++ ) 512 for( i=0; i<j+1; i++, k++ ) 513 ap[ k ]=A[ LDA*i+j ]; 514 } 515 else { 516 for( i=0, k=0; i<*n; i++ ) 517 for( j=0; j<i+1; j++, k++ ) 518 A[ LDA*i+j ]=AP[ k ]; 519 for( j=0, k=0; j<*n; j++ ) 520 for( i=j; i<*n; i++, k++ ) 521 ap[ k ]=A[ LDA*i+j ]; 522 } 523 free(A); free(AP); 524 } 525 else 526 cblas_sspr( CblasColMajor, uplo, *n, *alpha, x, *incx, ap ); 527 } 528 529 void F77_sspr2(int *order, char *uplow, int *n, float *alpha, float *x, 530 int *incx, float *y, int *incy, float *ap ){ 531 float *A, *AP; 532 int i,j,k,LDA; 533 enum CBLAS_UPLO uplo; 534 535 get_uplo_type(uplow,&uplo); 536 537 if (*order == TEST_ROW_MJR) { 538 LDA = *n; 539 A = ( float* )malloc( LDA*LDA*sizeof( float ) ); 540 AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) ); 541 if (uplo == CblasUpper) { 542 for( j=0, k=0; j<*n; j++ ) 543 for( i=0; i<j+1; i++, k++ ) 544 A[ LDA*i+j ]=ap[ k ]; 545 for( i=0, k=0; i<*n; i++ ) 546 for( j=i; j<*n; j++, k++ ) 547 AP[ k ]=A[ LDA*i+j ]; 548 } 549 else { 550 for( j=0, k=0; j<*n; j++ ) 551 for( i=j; i<*n; i++, k++ ) 552 A[ LDA*i+j ]=ap[ k ]; 553 for( i=0, k=0; i<*n; i++ ) 554 for( j=0; j<i+1; j++, k++ ) 555 AP[ k ]=A[ LDA*i+j ]; 556 } 557 cblas_sspr2( CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, AP ); 558 if (uplo == CblasUpper) { 559 for( i=0, k=0; i<*n; i++ ) 560 for( j=i; j<*n; j++, k++ ) 561 A[ LDA*i+j ]=AP[ k ]; 562 for( j=0, k=0; j<*n; j++ ) 563 for( i=0; i<j+1; i++, k++ ) 564 ap[ k ]=A[ LDA*i+j ]; 565 } 566 else { 567 for( i=0, k=0; i<*n; i++ ) 568 for( j=0; j<i+1; j++, k++ ) 569 A[ LDA*i+j ]=AP[ k ]; 570 for( j=0, k=0; j<*n; j++ ) 571 for( i=j; i<*n; i++, k++ ) 572 ap[ k ]=A[ LDA*i+j ]; 573 } 574 free(A); 575 free(AP); 576 } 577 else 578 cblas_sspr2( CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, ap ); 579 } 580