00001
00002
00003
00004
00005
00006
00007 #include <stdlib.h>
00008 #include "cblas.h"
00009 #include "cblas_test.h"
00010
00011 void F77_cgemv(int *order, char *transp, int *m, int *n,
00012 const void *alpha,
00013 CBLAS_TEST_COMPLEX *a, int *lda, const void *x, int *incx,
00014 const void *beta, void *y, int *incy) {
00015
00016 CBLAS_TEST_COMPLEX *A;
00017 int i,j,LDA;
00018 enum CBLAS_TRANSPOSE trans;
00019
00020 get_transpose_type(transp, &trans);
00021 if (*order == TEST_ROW_MJR) {
00022 LDA = *n+1;
00023 A = (CBLAS_TEST_COMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_COMPLEX) );
00024 for( i=0; i<*m; i++ )
00025 for( j=0; j<*n; j++ ){
00026 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00027 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00028 }
00029 cblas_cgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx,
00030 beta, y, *incy );
00031 free(A);
00032 }
00033 else if (*order == TEST_COL_MJR)
00034 cblas_cgemv( CblasColMajor, trans,
00035 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
00036 else
00037 cblas_cgemv( UNDEFINED, trans,
00038 *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
00039 }
00040
00041 void F77_cgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku,
00042 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00043 CBLAS_TEST_COMPLEX *x, int *incx,
00044 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy) {
00045
00046 CBLAS_TEST_COMPLEX *A;
00047 int i,j,irow,jcol,LDA;
00048 enum CBLAS_TRANSPOSE trans;
00049
00050 get_transpose_type(transp, &trans);
00051 if (*order == TEST_ROW_MJR) {
00052 LDA = *ku+*kl+2;
00053 A=( CBLAS_TEST_COMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00054 for( i=0; i<*ku; i++ ){
00055 irow=*ku+*kl-i;
00056 jcol=(*ku)-i;
00057 for( j=jcol; j<*n; j++ ){
00058 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00059 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00060 }
00061 }
00062 i=*ku;
00063 irow=*ku+*kl-i;
00064 for( j=0; j<*n; j++ ){
00065 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00066 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00067 }
00068 for( i=*ku+1; i<*ku+*kl+1; i++ ){
00069 irow=*ku+*kl-i;
00070 jcol=i-(*ku);
00071 for( j=jcol; j<(*n+*kl); j++ ){
00072 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00073 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00074 }
00075 }
00076 cblas_cgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x,
00077 *incx, beta, y, *incy );
00078 free(A);
00079 }
00080 else if (*order == TEST_COL_MJR)
00081 cblas_cgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
00082 *incx, beta, y, *incy );
00083 else
00084 cblas_cgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
00085 *incx, beta, y, *incy );
00086 }
00087
00088 void F77_cgeru(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
00089 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00090 CBLAS_TEST_COMPLEX *a, int *lda){
00091
00092 CBLAS_TEST_COMPLEX *A;
00093 int i,j,LDA;
00094
00095 if (*order == TEST_ROW_MJR) {
00096 LDA = *n+1;
00097 A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00098 for( i=0; i<*m; i++ )
00099 for( j=0; j<*n; j++ ){
00100 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00101 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00102 }
00103 cblas_cgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
00104 for( i=0; i<*m; i++ )
00105 for( j=0; j<*n; j++ ){
00106 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00107 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00108 }
00109 free(A);
00110 }
00111 else if (*order == TEST_COL_MJR)
00112 cblas_cgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00113 else
00114 cblas_cgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00115 }
00116
00117 void F77_cgerc(int *order, int *m, int *n, CBLAS_TEST_COMPLEX *alpha,
00118 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00119 CBLAS_TEST_COMPLEX *a, int *lda) {
00120 CBLAS_TEST_COMPLEX *A;
00121 int i,j,LDA;
00122
00123 if (*order == TEST_ROW_MJR) {
00124 LDA = *n+1;
00125 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00126 for( i=0; i<*m; i++ )
00127 for( j=0; j<*n; j++ ){
00128 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00129 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00130 }
00131 cblas_cgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
00132 for( i=0; i<*m; i++ )
00133 for( j=0; j<*n; j++ ){
00134 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00135 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00136 }
00137 free(A);
00138 }
00139 else if (*order == TEST_COL_MJR)
00140 cblas_cgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00141 else
00142 cblas_cgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
00143 }
00144
00145 void F77_chemv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00146 CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00147 int *incx, CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
00148
00149 CBLAS_TEST_COMPLEX *A;
00150 int i,j,LDA;
00151 enum CBLAS_UPLO uplo;
00152
00153 get_uplo_type(uplow,&uplo);
00154
00155 if (*order == TEST_ROW_MJR) {
00156 LDA = *n+1;
00157 A = (CBLAS_TEST_COMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00158 for( i=0; i<*n; i++ )
00159 for( j=0; j<*n; j++ ){
00160 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00161 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00162 }
00163 cblas_chemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx,
00164 beta, y, *incy );
00165 free(A);
00166 }
00167 else if (*order == TEST_COL_MJR)
00168 cblas_chemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx,
00169 beta, y, *incy );
00170 else
00171 cblas_chemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
00172 beta, y, *incy );
00173 }
00174
00175 void F77_chbmv(int *order, char *uplow, int *n, int *k,
00176 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00177 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta,
00178 CBLAS_TEST_COMPLEX *y, int *incy){
00179
00180 CBLAS_TEST_COMPLEX *A;
00181 int i,irow,j,jcol,LDA;
00182
00183 enum CBLAS_UPLO uplo;
00184
00185 get_uplo_type(uplow,&uplo);
00186
00187 if (*order == TEST_ROW_MJR) {
00188 if (uplo != CblasUpper && uplo != CblasLower )
00189 cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
00190 *incx, beta, y, *incy );
00191 else {
00192 LDA = *k+2;
00193 A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00194 if (uplo == CblasUpper) {
00195 for( i=0; i<*k; i++ ){
00196 irow=*k-i;
00197 jcol=(*k)-i;
00198 for( j=jcol; j<*n; j++ ) {
00199 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00200 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00201 }
00202 }
00203 i=*k;
00204 irow=*k-i;
00205 for( j=0; j<*n; j++ ) {
00206 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00207 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00208 }
00209 }
00210 else {
00211 i=0;
00212 irow=*k-i;
00213 for( j=0; j<*n; j++ ) {
00214 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00215 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00216 }
00217 for( i=1; i<*k+1; i++ ){
00218 irow=*k-i;
00219 jcol=i;
00220 for( j=jcol; j<(*n+*k); j++ ) {
00221 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00222 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00223 }
00224 }
00225 }
00226 cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
00227 beta, y, *incy );
00228 free(A);
00229 }
00230 }
00231 else if (*order == TEST_COL_MJR)
00232 cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
00233 beta, y, *incy );
00234 else
00235 cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
00236 beta, y, *incy );
00237 }
00238
00239 void F77_chpmv(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00240 CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx,
00241 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *y, int *incy){
00242
00243 CBLAS_TEST_COMPLEX *A, *AP;
00244 int i,j,k,LDA;
00245 enum CBLAS_UPLO uplo;
00246
00247 get_uplo_type(uplow,&uplo);
00248 if (*order == TEST_ROW_MJR) {
00249 if (uplo != CblasUpper && uplo != CblasLower )
00250 cblas_chpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx,
00251 beta, y, *incy);
00252 else {
00253 LDA = *n;
00254 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ));
00255 AP = (CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
00256 sizeof( CBLAS_TEST_COMPLEX ));
00257 if (uplo == CblasUpper) {
00258 for( j=0, k=0; j<*n; j++ )
00259 for( i=0; i<j+1; i++, k++ ) {
00260 A[ LDA*i+j ].real=ap[ k ].real;
00261 A[ LDA*i+j ].imag=ap[ k ].imag;
00262 }
00263 for( i=0, k=0; i<*n; i++ )
00264 for( j=i; j<*n; j++, k++ ) {
00265 AP[ k ].real=A[ LDA*i+j ].real;
00266 AP[ k ].imag=A[ LDA*i+j ].imag;
00267 }
00268 }
00269 else {
00270 for( j=0, k=0; j<*n; j++ )
00271 for( i=j; i<*n; i++, k++ ) {
00272 A[ LDA*i+j ].real=ap[ k ].real;
00273 A[ LDA*i+j ].imag=ap[ k ].imag;
00274 }
00275 for( i=0, k=0; i<*n; i++ )
00276 for( j=0; j<i+1; j++, k++ ) {
00277 AP[ k ].real=A[ LDA*i+j ].real;
00278 AP[ k ].imag=A[ LDA*i+j ].imag;
00279 }
00280 }
00281 cblas_chpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y,
00282 *incy );
00283 free(A);
00284 free(AP);
00285 }
00286 }
00287 else if (*order == TEST_COL_MJR)
00288 cblas_chpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
00289 *incy );
00290 else
00291 cblas_chpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
00292 *incy );
00293 }
00294
00295 void F77_ctbmv(int *order, char *uplow, char *transp, char *diagn,
00296 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00297 int *incx) {
00298 CBLAS_TEST_COMPLEX *A;
00299 int irow, jcol, i, j, LDA;
00300 enum CBLAS_TRANSPOSE trans;
00301 enum CBLAS_UPLO uplo;
00302 enum CBLAS_DIAG diag;
00303
00304 get_transpose_type(transp,&trans);
00305 get_uplo_type(uplow,&uplo);
00306 get_diag_type(diagn,&diag);
00307
00308 if (*order == TEST_ROW_MJR) {
00309 if (uplo != CblasUpper && uplo != CblasLower )
00310 cblas_ctbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
00311 x, *incx);
00312 else {
00313 LDA = *k+2;
00314 A=(CBLAS_TEST_COMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00315 if (uplo == CblasUpper) {
00316 for( i=0; i<*k; i++ ){
00317 irow=*k-i;
00318 jcol=(*k)-i;
00319 for( j=jcol; j<*n; j++ ) {
00320 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00321 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00322 }
00323 }
00324 i=*k;
00325 irow=*k-i;
00326 for( j=0; j<*n; j++ ) {
00327 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00328 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00329 }
00330 }
00331 else {
00332 i=0;
00333 irow=*k-i;
00334 for( j=0; j<*n; j++ ) {
00335 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00336 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00337 }
00338 for( i=1; i<*k+1; i++ ){
00339 irow=*k-i;
00340 jcol=i;
00341 for( j=jcol; j<(*n+*k); j++ ) {
00342 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00343 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00344 }
00345 }
00346 }
00347 cblas_ctbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x,
00348 *incx);
00349 free(A);
00350 }
00351 }
00352 else if (*order == TEST_COL_MJR)
00353 cblas_ctbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00354 else
00355 cblas_ctbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00356 }
00357
00358 void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn,
00359 int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00360 int *incx) {
00361
00362 CBLAS_TEST_COMPLEX *A;
00363 int irow, jcol, i, j, LDA;
00364 enum CBLAS_TRANSPOSE trans;
00365 enum CBLAS_UPLO uplo;
00366 enum CBLAS_DIAG diag;
00367
00368 get_transpose_type(transp,&trans);
00369 get_uplo_type(uplow,&uplo);
00370 get_diag_type(diagn,&diag);
00371
00372 if (*order == TEST_ROW_MJR) {
00373 if (uplo != CblasUpper && uplo != CblasLower )
00374 cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
00375 *incx);
00376 else {
00377 LDA = *k+2;
00378 A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
00379 if (uplo == CblasUpper) {
00380 for( i=0; i<*k; i++ ){
00381 irow=*k-i;
00382 jcol=(*k)-i;
00383 for( j=jcol; j<*n; j++ ) {
00384 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
00385 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
00386 }
00387 }
00388 i=*k;
00389 irow=*k-i;
00390 for( j=0; j<*n; j++ ) {
00391 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00392 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00393 }
00394 }
00395 else {
00396 i=0;
00397 irow=*k-i;
00398 for( j=0; j<*n; j++ ) {
00399 A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
00400 A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
00401 }
00402 for( i=1; i<*k+1; i++ ){
00403 irow=*k-i;
00404 jcol=i;
00405 for( j=jcol; j<(*n+*k); j++ ) {
00406 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
00407 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
00408 }
00409 }
00410 }
00411 cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA,
00412 x, *incx);
00413 free(A);
00414 }
00415 }
00416 else if (*order == TEST_COL_MJR)
00417 cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00418 else
00419 cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
00420 }
00421
00422 void F77_ctpmv(int *order, char *uplow, char *transp, char *diagn,
00423 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
00424 CBLAS_TEST_COMPLEX *A, *AP;
00425 int i, j, k, LDA;
00426 enum CBLAS_TRANSPOSE trans;
00427 enum CBLAS_UPLO uplo;
00428 enum CBLAS_DIAG diag;
00429
00430 get_transpose_type(transp,&trans);
00431 get_uplo_type(uplow,&uplo);
00432 get_diag_type(diagn,&diag);
00433
00434 if (*order == TEST_ROW_MJR) {
00435 if (uplo != CblasUpper && uplo != CblasLower )
00436 cblas_ctpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
00437 else {
00438 LDA = *n;
00439 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
00440 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
00441 sizeof(CBLAS_TEST_COMPLEX));
00442 if (uplo == CblasUpper) {
00443 for( j=0, k=0; j<*n; j++ )
00444 for( i=0; i<j+1; i++, k++ ) {
00445 A[ LDA*i+j ].real=ap[ k ].real;
00446 A[ LDA*i+j ].imag=ap[ k ].imag;
00447 }
00448 for( i=0, k=0; i<*n; i++ )
00449 for( j=i; j<*n; j++, k++ ) {
00450 AP[ k ].real=A[ LDA*i+j ].real;
00451 AP[ k ].imag=A[ LDA*i+j ].imag;
00452 }
00453 }
00454 else {
00455 for( j=0, k=0; j<*n; j++ )
00456 for( i=j; i<*n; i++, k++ ) {
00457 A[ LDA*i+j ].real=ap[ k ].real;
00458 A[ LDA*i+j ].imag=ap[ k ].imag;
00459 }
00460 for( i=0, k=0; i<*n; i++ )
00461 for( j=0; j<i+1; j++, k++ ) {
00462 AP[ k ].real=A[ LDA*i+j ].real;
00463 AP[ k ].imag=A[ LDA*i+j ].imag;
00464 }
00465 }
00466 cblas_ctpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00467 free(A);
00468 free(AP);
00469 }
00470 }
00471 else if (*order == TEST_COL_MJR)
00472 cblas_ctpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00473 else
00474 cblas_ctpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
00475 }
00476
00477 void F77_ctpsv(int *order, char *uplow, char *transp, char *diagn,
00478 int *n, CBLAS_TEST_COMPLEX *ap, CBLAS_TEST_COMPLEX *x, int *incx) {
00479 CBLAS_TEST_COMPLEX *A, *AP;
00480 int i, j, k, LDA;
00481 enum CBLAS_TRANSPOSE trans;
00482 enum CBLAS_UPLO uplo;
00483 enum CBLAS_DIAG diag;
00484
00485 get_transpose_type(transp,&trans);
00486 get_uplo_type(uplow,&uplo);
00487 get_diag_type(diagn,&diag);
00488
00489 if (*order == TEST_ROW_MJR) {
00490 if (uplo != CblasUpper && uplo != CblasLower )
00491 cblas_ctpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
00492 else {
00493 LDA = *n;
00494 A=(CBLAS_TEST_COMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX));
00495 AP=(CBLAS_TEST_COMPLEX*)malloc((((LDA+1)*LDA)/2)*
00496 sizeof(CBLAS_TEST_COMPLEX));
00497 if (uplo == CblasUpper) {
00498 for( j=0, k=0; j<*n; j++ )
00499 for( i=0; i<j+1; i++, k++ ) {
00500 A[ LDA*i+j ].real=ap[ k ].real;
00501 A[ LDA*i+j ].imag=ap[ k ].imag;
00502 }
00503 for( i=0, k=0; i<*n; i++ )
00504 for( j=i; j<*n; j++, k++ ) {
00505 AP[ k ].real=A[ LDA*i+j ].real;
00506 AP[ k ].imag=A[ LDA*i+j ].imag;
00507 }
00508 }
00509 else {
00510 for( j=0, k=0; j<*n; j++ )
00511 for( i=j; i<*n; i++, k++ ) {
00512 A[ LDA*i+j ].real=ap[ k ].real;
00513 A[ LDA*i+j ].imag=ap[ k ].imag;
00514 }
00515 for( i=0, k=0; i<*n; i++ )
00516 for( j=0; j<i+1; j++, k++ ) {
00517 AP[ k ].real=A[ LDA*i+j ].real;
00518 AP[ k ].imag=A[ LDA*i+j ].imag;
00519 }
00520 }
00521 cblas_ctpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
00522 free(A);
00523 free(AP);
00524 }
00525 }
00526 else if (*order == TEST_COL_MJR)
00527 cblas_ctpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
00528 else
00529 cblas_ctpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
00530 }
00531
00532 void F77_ctrmv(int *order, char *uplow, char *transp, char *diagn,
00533 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00534 int *incx) {
00535 CBLAS_TEST_COMPLEX *A;
00536 int i,j,LDA;
00537 enum CBLAS_TRANSPOSE trans;
00538 enum CBLAS_UPLO uplo;
00539 enum CBLAS_DIAG diag;
00540
00541 get_transpose_type(transp,&trans);
00542 get_uplo_type(uplow,&uplo);
00543 get_diag_type(diagn,&diag);
00544
00545 if (*order == TEST_ROW_MJR) {
00546 LDA=*n+1;
00547 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00548 for( i=0; i<*n; i++ )
00549 for( j=0; j<*n; j++ ) {
00550 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00551 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00552 }
00553 cblas_ctrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
00554 free(A);
00555 }
00556 else if (*order == TEST_COL_MJR)
00557 cblas_ctrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
00558 else
00559 cblas_ctrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
00560 }
00561 void F77_ctrsv(int *order, char *uplow, char *transp, char *diagn,
00562 int *n, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
00563 int *incx) {
00564 CBLAS_TEST_COMPLEX *A;
00565 int i,j,LDA;
00566 enum CBLAS_TRANSPOSE trans;
00567 enum CBLAS_UPLO uplo;
00568 enum CBLAS_DIAG diag;
00569
00570 get_transpose_type(transp,&trans);
00571 get_uplo_type(uplow,&uplo);
00572 get_diag_type(diagn,&diag);
00573
00574 if (*order == TEST_ROW_MJR) {
00575 LDA = *n+1;
00576 A =(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00577 for( i=0; i<*n; i++ )
00578 for( j=0; j<*n; j++ ) {
00579 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00580 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00581 }
00582 cblas_ctrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
00583 free(A);
00584 }
00585 else if (*order == TEST_COL_MJR)
00586 cblas_ctrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
00587 else
00588 cblas_ctrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
00589 }
00590
00591 void F77_chpr(int *order, char *uplow, int *n, float *alpha,
00592 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *ap) {
00593 CBLAS_TEST_COMPLEX *A, *AP;
00594 int i,j,k,LDA;
00595 enum CBLAS_UPLO uplo;
00596
00597 get_uplo_type(uplow,&uplo);
00598
00599 if (*order == TEST_ROW_MJR) {
00600 if (uplo != CblasUpper && uplo != CblasLower )
00601 cblas_chpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
00602 else {
00603 LDA = *n;
00604 A = (CBLAS_TEST_COMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00605 AP = ( CBLAS_TEST_COMPLEX* )malloc( (((LDA+1)*LDA)/2)*
00606 sizeof( CBLAS_TEST_COMPLEX ));
00607 if (uplo == CblasUpper) {
00608 for( j=0, k=0; j<*n; j++ )
00609 for( i=0; i<j+1; i++, k++ ){
00610 A[ LDA*i+j ].real=ap[ k ].real;
00611 A[ LDA*i+j ].imag=ap[ k ].imag;
00612 }
00613 for( i=0, k=0; i<*n; i++ )
00614 for( j=i; j<*n; j++, k++ ){
00615 AP[ k ].real=A[ LDA*i+j ].real;
00616 AP[ k ].imag=A[ LDA*i+j ].imag;
00617 }
00618 }
00619 else {
00620 for( j=0, k=0; j<*n; j++ )
00621 for( i=j; i<*n; i++, k++ ){
00622 A[ LDA*i+j ].real=ap[ k ].real;
00623 A[ LDA*i+j ].imag=ap[ k ].imag;
00624 }
00625 for( i=0, k=0; i<*n; i++ )
00626 for( j=0; j<i+1; j++, k++ ){
00627 AP[ k ].real=A[ LDA*i+j ].real;
00628 AP[ k ].imag=A[ LDA*i+j ].imag;
00629 }
00630 }
00631 cblas_chpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
00632 if (uplo == CblasUpper) {
00633 for( i=0, k=0; i<*n; i++ )
00634 for( j=i; j<*n; j++, k++ ){
00635 A[ LDA*i+j ].real=AP[ k ].real;
00636 A[ LDA*i+j ].imag=AP[ k ].imag;
00637 }
00638 for( j=0, k=0; j<*n; j++ )
00639 for( i=0; i<j+1; i++, k++ ){
00640 ap[ k ].real=A[ LDA*i+j ].real;
00641 ap[ k ].imag=A[ LDA*i+j ].imag;
00642 }
00643 }
00644 else {
00645 for( i=0, k=0; i<*n; i++ )
00646 for( j=0; j<i+1; j++, k++ ){
00647 A[ LDA*i+j ].real=AP[ k ].real;
00648 A[ LDA*i+j ].imag=AP[ k ].imag;
00649 }
00650 for( j=0, k=0; j<*n; j++ )
00651 for( i=j; i<*n; i++, k++ ){
00652 ap[ k ].real=A[ LDA*i+j ].real;
00653 ap[ k ].imag=A[ LDA*i+j ].imag;
00654 }
00655 }
00656 free(A);
00657 free(AP);
00658 }
00659 }
00660 else if (*order == TEST_COL_MJR)
00661 cblas_chpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
00662 else
00663 cblas_chpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
00664 }
00665
00666 void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00667 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00668 CBLAS_TEST_COMPLEX *ap) {
00669 CBLAS_TEST_COMPLEX *A, *AP;
00670 int i,j,k,LDA;
00671 enum CBLAS_UPLO uplo;
00672
00673 get_uplo_type(uplow,&uplo);
00674
00675 if (*order == TEST_ROW_MJR) {
00676 if (uplo != CblasUpper && uplo != CblasLower )
00677 cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
00678 *incy, ap );
00679 else {
00680 LDA = *n;
00681 A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00682 AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)*
00683 sizeof( CBLAS_TEST_COMPLEX ));
00684 if (uplo == CblasUpper) {
00685 for( j=0, k=0; j<*n; j++ )
00686 for( i=0; i<j+1; i++, k++ ) {
00687 A[ LDA*i+j ].real=ap[ k ].real;
00688 A[ LDA*i+j ].imag=ap[ k ].imag;
00689 }
00690 for( i=0, k=0; i<*n; i++ )
00691 for( j=i; j<*n; j++, k++ ) {
00692 AP[ k ].real=A[ LDA*i+j ].real;
00693 AP[ k ].imag=A[ LDA*i+j ].imag;
00694 }
00695 }
00696 else {
00697 for( j=0, k=0; j<*n; j++ )
00698 for( i=j; i<*n; i++, k++ ) {
00699 A[ LDA*i+j ].real=ap[ k ].real;
00700 A[ LDA*i+j ].imag=ap[ k ].imag;
00701 }
00702 for( i=0, k=0; i<*n; i++ )
00703 for( j=0; j<i+1; j++, k++ ) {
00704 AP[ k ].real=A[ LDA*i+j ].real;
00705 AP[ k ].imag=A[ LDA*i+j ].imag;
00706 }
00707 }
00708 cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
00709 if (uplo == CblasUpper) {
00710 for( i=0, k=0; i<*n; i++ )
00711 for( j=i; j<*n; j++, k++ ) {
00712 A[ LDA*i+j ].real=AP[ k ].real;
00713 A[ LDA*i+j ].imag=AP[ k ].imag;
00714 }
00715 for( j=0, k=0; j<*n; j++ )
00716 for( i=0; i<j+1; i++, k++ ) {
00717 ap[ k ].real=A[ LDA*i+j ].real;
00718 ap[ k ].imag=A[ LDA*i+j ].imag;
00719 }
00720 }
00721 else {
00722 for( i=0, k=0; i<*n; i++ )
00723 for( j=0; j<i+1; j++, k++ ) {
00724 A[ LDA*i+j ].real=AP[ k ].real;
00725 A[ LDA*i+j ].imag=AP[ k ].imag;
00726 }
00727 for( j=0, k=0; j<*n; j++ )
00728 for( i=j; i<*n; i++, k++ ) {
00729 ap[ k ].real=A[ LDA*i+j ].real;
00730 ap[ k ].imag=A[ LDA*i+j ].imag;
00731 }
00732 }
00733 free(A);
00734 free(AP);
00735 }
00736 }
00737 else if (*order == TEST_COL_MJR)
00738 cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
00739 else
00740 cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
00741 }
00742
00743 void F77_cher(int *order, char *uplow, int *n, float *alpha,
00744 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *a, int *lda) {
00745 CBLAS_TEST_COMPLEX *A;
00746 int i,j,LDA;
00747 enum CBLAS_UPLO uplo;
00748
00749 get_uplo_type(uplow,&uplo);
00750
00751 if (*order == TEST_ROW_MJR) {
00752 LDA = *n+1;
00753 A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_COMPLEX ));
00754
00755 for( i=0; i<*n; i++ )
00756 for( j=0; j<*n; j++ ) {
00757 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00758 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00759 }
00760
00761 cblas_cher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA );
00762 for( i=0; i<*n; i++ )
00763 for( j=0; j<*n; j++ ) {
00764 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00765 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00766 }
00767 free(A);
00768 }
00769 else if (*order == TEST_COL_MJR)
00770 cblas_cher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
00771 else
00772 cblas_cher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
00773 }
00774
00775 void F77_cher2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
00776 CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
00777 CBLAS_TEST_COMPLEX *a, int *lda) {
00778
00779 CBLAS_TEST_COMPLEX *A;
00780 int i,j,LDA;
00781 enum CBLAS_UPLO uplo;
00782
00783 get_uplo_type(uplow,&uplo);
00784
00785 if (*order == TEST_ROW_MJR) {
00786 LDA = *n+1;
00787 A= ( CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00788
00789 for( i=0; i<*n; i++ )
00790 for( j=0; j<*n; j++ ) {
00791 A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
00792 A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
00793 }
00794
00795 cblas_cher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA );
00796 for( i=0; i<*n; i++ )
00797 for( j=0; j<*n; j++ ) {
00798 a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
00799 a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
00800 }
00801 free(A);
00802 }
00803 else if (*order == TEST_COL_MJR)
00804 cblas_cher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
00805 else
00806 cblas_cher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
00807 }