void F77_dspr(int *order, char *uplow, int *n, double *alpha, double *x,
int *incx, double *ap ){
double *A, *AP;
int i,j,k,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
LDA = *n;
A = ( double* )malloc( LDA*LDA*sizeof( double ) );
AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
if (uplo == CblasUpper) {
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
else {
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
cblas_dspr( CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
if (uplo == CblasUpper) {
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ )
A[ LDA*i+j ]=AP[ k ];
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ )
ap[ k ]=A[ LDA*i+j ];
}
else {
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ )
A[ LDA*i+j ]=AP[ k ];
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ )
ap[ k ]=A[ LDA*i+j ];
}
free(A);
free(AP);
}
else
cblas_dspr( CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
}
void F77_strsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
int *m, int *n, float *alpha, float *a, int *lda, float *b,
int *ldb) {
int i,j,LDA,LDB;
float *A, *B;
enum CBLAS_SIDE side;
enum CBLAS_DIAG diag;
enum CBLAS_UPLO uplo;
enum CBLAS_TRANSPOSE trans;
get_uplo_type(uplow,&uplo);
get_transpose_type(transp,&trans);
get_diag_type(diagn,&diag);
get_side_type(rtlf,&side);
if (*order == TEST_ROW_MJR) {
if (side == CblasLeft) {
LDA = *m+1;
A = ( float* )malloc( (*m)*LDA*sizeof( float ) );
for( i=0; i<*m; i++ )
for( j=0; j<*m; j++ )
A[i*LDA+j]=a[j*(*lda)+i];
}
else{
LDA = *n+1;
A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
A[i*LDA+j]=a[j*(*lda)+i];
}
LDB = *n+1;
B = ( float* )malloc( (*m)*LDB*sizeof( float ) );
for( i=0; i<*m; i++ )
for( j=0; j<*n; j++ )
B[i*LDB+j]=b[j*(*ldb)+i];
cblas_strsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha,
A, LDA, B, LDB );
for( j=0; j<*n; j++ )
for( i=0; i<*m; i++ )
b[j*(*ldb)+i]=B[i*LDB+j];
free(A);
free(B);
}
else if (*order == TEST_COL_MJR)
cblas_strsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
a, *lda, b, *ldb);
else
cblas_strsm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha,
a, *lda, b, *ldb);
}
void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
float *alpha, float *a, int *lda,
float *beta, float *c, int *ldc ) {
int i,j,LDA,LDC;
float *A, *C;
enum CBLAS_UPLO uplo;
enum CBLAS_TRANSPOSE trans;
get_uplo_type(uplow,&uplo);
get_transpose_type(transp,&trans);
if (*order == TEST_ROW_MJR) {
if (trans == CblasNoTrans) {
LDA = *k+1;
A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
for( i=0; i<*n; i++ )
for( j=0; j<*k; j++ )
A[i*LDA+j]=a[j*(*lda)+i];
}
else{
LDA = *n+1;
A = ( float* )malloc( (*k)*LDA*sizeof( float ) );
for( i=0; i<*k; i++ )
for( j=0; j<*n; j++ )
A[i*LDA+j]=a[j*(*lda)+i];
}
LDC = *n+1;
C = ( float* )malloc( (*n)*LDC*sizeof( float ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
C[i*LDC+j]=c[j*(*ldc)+i];
cblas_ssyrk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta,
C, LDC );
for( j=0; j<*n; j++ )
for( i=0; i<*n; i++ )
c[j*(*ldc)+i]=C[i*LDC+j];
free(A);
free(C);
}
else if (*order == TEST_COL_MJR)
cblas_ssyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
c, *ldc );
else
cblas_ssyrk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
c, *ldc );
}
void F77_stbsv(int *order, char *uplow, char *transp, char *diagn,
int *n, int *k, float *a, int *lda, float *x, int *incx) {
float *A;
int irow, jcol, i, j, LDA;
enum CBLAS_TRANSPOSE trans;
enum CBLAS_UPLO uplo;
enum CBLAS_DIAG diag;
get_transpose_type(transp,&trans);
get_uplo_type(uplow,&uplo);
get_diag_type(diagn,&diag);
if (*order == TEST_ROW_MJR) {
LDA = *k+1;
A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) );
if (uplo == CblasUpper) {
for( i=0; i<*k; i++ ){
irow=*k-i;
jcol=(*k)-i;
for( j=jcol; j<*n; j++ )
A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
}
i=*k;
irow=*k-i;
for( j=0; j<*n; j++ )
A[ LDA*j+irow ]=a[ (*lda)*j+i ];
}
else {
i=0;
irow=*k-i;
for( j=0; j<*n; j++ )
A[ LDA*j+irow ]=a[ (*lda)*j+i ];
for( i=1; i<*k+1; i++ ){
irow=*k-i;
jcol=i;
for( j=jcol; j<(*n+*k); j++ )
A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
}
}
cblas_stbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, *incx);
free(A);
}
else
cblas_stbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
}
void F77_ssbmv(int *order, char *uplow, int *n, int *k, float *alpha,
float *a, int *lda, float *x, int *incx, float *beta,
float *y, int *incy) {
float *A;
int i,j,irow,jcol,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
LDA = *k+1;
A = ( float* )malloc( (*n+*k)*LDA*sizeof( float ) );
if (uplo == CblasUpper) {
for( i=0; i<*k; i++ ){
irow=*k-i;
jcol=(*k)-i;
for( j=jcol; j<*n; j++ )
A[ LDA*(j-jcol)+irow ]=a[ (*lda)*j+i ];
}
i=*k;
irow=*k-i;
for( j=0; j<*n; j++ )
A[ LDA*j+irow ]=a[ (*lda)*j+i ];
}
else {
i=0;
irow=*k-i;
for( j=0; j<*n; j++ )
A[ LDA*j+irow ]=a[ (*lda)*j+i ];
for( i=1; i<*k+1; i++ ){
irow=*k-i;
jcol=i;
for( j=jcol; j<(*n+*k); j++ )
A[ LDA*j+irow ]=a[ (*lda)*(j-jcol)+i ];
}
}
cblas_ssbmv(CblasRowMajor, uplo, *n, *k, *alpha, A, LDA, x, *incx,
*beta, y, *incy );
free(A);
}
else
cblas_ssbmv(CblasColMajor, uplo, *n, *k, *alpha, a, *lda, x, *incx,
*beta, y, *incy );
}
void F77_dtpsv(int *order, char *uplow, char *transp, char *diagn,
int *n, double *ap, double *x, int *incx) {
double *A, *AP;
int i, j, k, LDA;
enum CBLAS_TRANSPOSE trans;
enum CBLAS_UPLO uplo;
enum CBLAS_DIAG diag;
get_transpose_type(transp,&trans);
get_uplo_type(uplow,&uplo);
get_diag_type(diagn,&diag);
if (*order == TEST_ROW_MJR) {
LDA = *n;
A = ( double* )malloc( LDA*LDA*sizeof( double ) );
AP = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
if (uplo == CblasUpper) {
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
else {
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
cblas_dtpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
free(A);
free(AP);
}
else
cblas_dtpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
}
void F77_ssyr2(int *order, char *uplow, int *n, float *alpha, float *x,
int *incx, float *y, int *incy, float *a, int *lda) {
float *A;
int i,j,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
LDA = *n+1;
A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
A[ LDA*i+j ]=a[ (*lda)*j+i ];
cblas_ssyr2(CblasRowMajor, uplo, *n, *alpha, x, *incx, y, *incy, A, LDA);
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
a[ (*lda)*j+i ]=A[ LDA*i+j ];
free(A);
}
else
cblas_ssyr2(CblasColMajor, uplo, *n, *alpha, x, *incx, y, *incy, a, *lda);
}
void F77_dsyr(int *order, char *uplow, int *n, double *alpha, double *x,
int *incx, double *a, int *lda) {
double *A;
int i,j,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
LDA = *n+1;
A = ( double* )malloc( (*n)*LDA*sizeof( double ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
A[ LDA*i+j ]=a[ (*lda)*j+i ];
cblas_dsyr(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA);
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
a[ (*lda)*j+i ]=A[ LDA*i+j ];
free(A);
}
else
cblas_dsyr(CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda);
}
void F77_strsv(int *order, char *uplow, char *transp, char *diagn,
int *n, float *a, int *lda, float *x, int *incx ) {
float *A;
int i,j,LDA;
enum CBLAS_TRANSPOSE trans;
enum CBLAS_UPLO uplo;
enum CBLAS_DIAG diag;
get_transpose_type(transp,&trans);
get_uplo_type(uplow,&uplo);
get_diag_type(diagn,&diag);
if (*order == TEST_ROW_MJR) {
LDA = *n+1;
A = ( float* )malloc( (*n)*LDA*sizeof( float ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ )
A[ LDA*i+j ]=a[ (*lda)*j+i ];
cblas_strsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
free(A);
}
else
cblas_strsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
}
void F77_sspmv(int *order, char *uplow, int *n, float *alpha, float *ap,
float *x, int *incx, float *beta, float *y, int *incy) {
float *A,*AP;
int i,j,k,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
LDA = *n;
A = ( float* )malloc( LDA*LDA*sizeof( float ) );
AP = ( float* )malloc( (((LDA+1)*LDA)/2)*sizeof( float ) );
if (uplo == CblasUpper) {
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
else {
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ )
A[ LDA*i+j ]=ap[ k ];
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ )
AP[ k ]=A[ LDA*i+j ];
}
cblas_sspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y,
*incy );
free(A); free(AP);
}
else
cblas_sspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y,
*incy );
}
void F77_chemm(int *layout, char *rtlf, char *uplow, int *m, int *n,
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
CBLAS_TEST_COMPLEX *c, int *ldc ) {
CBLAS_TEST_COMPLEX *A, *B, *C;
int i,j,LDA, LDB, LDC;
CBLAS_UPLO uplo;
CBLAS_SIDE side;
get_uplo_type(uplow,&uplo);
get_side_type(rtlf,&side);
if (*layout == TEST_ROW_MJR) {
if (side == CblasLeft) {
LDA = *m+1;
A= (CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
for( i=0; i<*m; i++ )
for( j=0; j<*m; j++ ) {
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
}
}
else{
LDA = *n+1;
A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ ) {
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
}
}
LDB = *n+1;
B=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ) );
for( i=0; i<*m; i++ )
for( j=0; j<*n; j++ ) {
B[i*LDB+j].real=b[j*(*ldb)+i].real;
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
}
LDC = *n+1;
C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
for( j=0; j<*n; j++ )
for( i=0; i<*m; i++ ) {
C[i*LDC+j].real=c[j*(*ldc)+i].real;
C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
}
cblas_chemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
beta, C, LDC );
for( j=0; j<*n; j++ )
for( i=0; i<*m; i++ ) {
c[j*(*ldc)+i].real=C[i*LDC+j].real;
c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
}
free(A);
free(B);
free(C);
}
else if (*layout == TEST_COL_MJR)
cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
beta, c, *ldc );
else
cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
beta, c, *ldc );
}
void F77_csyr2k(int *layout, char *uplow, char *transp, int *n, int *k,
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
CBLAS_TEST_COMPLEX *c, int *ldc ) {
int i,j,LDA,LDB,LDC;
CBLAS_TEST_COMPLEX *A, *B, *C;
CBLAS_UPLO uplo;
CBLAS_TRANSPOSE trans;
get_uplo_type(uplow,&uplo);
get_transpose_type(transp,&trans);
if (*layout == TEST_ROW_MJR) {
if (trans == CblasNoTrans) {
LDA = *k+1;
LDB = *k+1;
A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX));
for( i=0; i<*n; i++ )
for( j=0; j<*k; j++ ) {
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
B[i*LDB+j].real=b[j*(*ldb)+i].real;
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
}
}
else {
LDA = *n+1;
LDB = *n+1;
A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX));
for( i=0; i<*k; i++ )
for( j=0; j<*n; j++ ){
A[i*LDA+j].real=a[j*(*lda)+i].real;
A[i*LDA+j].imag=a[j*(*lda)+i].imag;
B[i*LDB+j].real=b[j*(*ldb)+i].real;
B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
}
}
LDC = *n+1;
C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
for( i=0; i<*n; i++ )
for( j=0; j<*n; j++ ) {
C[i*LDC+j].real=c[j*(*ldc)+i].real;
C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
}
cblas_csyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
B, LDB, beta, C, LDC );
for( j=0; j<*n; j++ )
for( i=0; i<*n; i++ ) {
c[j*(*ldc)+i].real=C[i*LDC+j].real;
c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
}
free(A);
free(B);
free(C);
}
else if (*layout == TEST_COL_MJR)
cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
b, *ldb, beta, c, *ldc );
else
cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
b, *ldb, beta, c, *ldc );
}
void F77_chpr2(int *order, char *uplow, int *n, CBLAS_TEST_COMPLEX *alpha,
CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *y, int *incy,
CBLAS_TEST_COMPLEX *ap) {
CBLAS_TEST_COMPLEX *A, *AP;
int i,j,k,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
if (uplo != CblasUpper && uplo != CblasLower )
cblas_chpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y,
*incy, ap );
else {
LDA = *n;
A=(CBLAS_TEST_COMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
AP=(CBLAS_TEST_COMPLEX*)malloc( (((LDA+1)*LDA)/2)*
sizeof( CBLAS_TEST_COMPLEX ));
if (uplo == CblasUpper) {
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ ) {
A[ LDA*i+j ].real=ap[ k ].real;
A[ LDA*i+j ].imag=ap[ k ].imag;
}
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ ) {
AP[ k ].real=A[ LDA*i+j ].real;
AP[ k ].imag=A[ LDA*i+j ].imag;
}
}
else {
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ ) {
A[ LDA*i+j ].real=ap[ k ].real;
A[ LDA*i+j ].imag=ap[ k ].imag;
}
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ ) {
AP[ k ].real=A[ LDA*i+j ].real;
AP[ k ].imag=A[ LDA*i+j ].imag;
}
}
cblas_chpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
if (uplo == CblasUpper) {
for( i=0, k=0; i<*n; i++ )
for( j=i; j<*n; j++, k++ ) {
A[ LDA*i+j ].real=AP[ k ].real;
A[ LDA*i+j ].imag=AP[ k ].imag;
}
for( j=0, k=0; j<*n; j++ )
for( i=0; i<j+1; i++, k++ ) {
ap[ k ].real=A[ LDA*i+j ].real;
ap[ k ].imag=A[ LDA*i+j ].imag;
}
}
else {
for( i=0, k=0; i<*n; i++ )
for( j=0; j<i+1; j++, k++ ) {
A[ LDA*i+j ].real=AP[ k ].real;
A[ LDA*i+j ].imag=AP[ k ].imag;
}
for( j=0, k=0; j<*n; j++ )
for( i=j; i<*n; i++, k++ ) {
ap[ k ].real=A[ LDA*i+j ].real;
ap[ k ].imag=A[ LDA*i+j ].imag;
}
}
free(A);
free(AP);
}
}
else if (*order == TEST_COL_MJR)
cblas_chpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
else
cblas_chpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
}
void F77_ctbsv(int *order, char *uplow, char *transp, char *diagn,
int *n, int *k, CBLAS_TEST_COMPLEX *a, int *lda, CBLAS_TEST_COMPLEX *x,
int *incx) {
CBLAS_TEST_COMPLEX *A;
int irow, jcol, i, j, LDA;
enum CBLAS_TRANSPOSE trans;
enum CBLAS_UPLO uplo;
enum CBLAS_DIAG diag;
get_transpose_type(transp,&trans);
get_uplo_type(uplow,&uplo);
get_diag_type(diagn,&diag);
if (*order == TEST_ROW_MJR) {
if (uplo != CblasUpper && uplo != CblasLower )
cblas_ctbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x,
*incx);
else {
LDA = *k+2;
A=(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
if (uplo == CblasUpper) {
for( i=0; i<*k; i++ ){
irow=*k-i;
jcol=(*k)-i;
for( j=jcol; j<*n; j++ ) {
A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
}
}
i=*k;
irow=*k-i;
for( j=0; j<*n; j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
}
}
else {
i=0;
irow=*k-i;
for( j=0; j<*n; j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
}
for( i=1; i<*k+1; i++ ){
irow=*k-i;
jcol=i;
for( j=jcol; j<(*n+*k); j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
}
}
}
cblas_ctbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA,
x, *incx);
free(A);
}
}
else if (*order == TEST_COL_MJR)
cblas_ctbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
else
cblas_ctbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
}
void F77_chbmv(int *order, char *uplow, int *n, int *k,
CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
CBLAS_TEST_COMPLEX *x, int *incx, CBLAS_TEST_COMPLEX *beta,
CBLAS_TEST_COMPLEX *y, int *incy){
CBLAS_TEST_COMPLEX *A;
int i,irow,j,jcol,LDA;
enum CBLAS_UPLO uplo;
get_uplo_type(uplow,&uplo);
if (*order == TEST_ROW_MJR) {
if (uplo != CblasUpper && uplo != CblasLower )
cblas_chbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x,
*incx, beta, y, *incy );
else {
LDA = *k+2;
A =(CBLAS_TEST_COMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_COMPLEX));
if (uplo == CblasUpper) {
for( i=0; i<*k; i++ ){
irow=*k-i;
jcol=(*k)-i;
for( j=jcol; j<*n; j++ ) {
A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
}
}
i=*k;
irow=*k-i;
for( j=0; j<*n; j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
}
}
else {
i=0;
irow=*k-i;
for( j=0; j<*n; j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
}
for( i=1; i<*k+1; i++ ){
irow=*k-i;
jcol=i;
for( j=jcol; j<(*n+*k); j++ ) {
A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
}
}
}
cblas_chbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
beta, y, *incy );
free(A);
}
}
else if (*order == TEST_COL_MJR)
cblas_chbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
beta, y, *incy );
else
cblas_chbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
beta, y, *incy );
}
