1 #include "bli_config.h"
2 #include "bli_system.h"
3 #include "bli_type_defs.h"
4 #include "bli_cblas.h"
5 #ifdef BLIS_ENABLE_CBLAS
6 /*
7 * cblas_stbmv.c
8 * This program is a C interface to stbmv.
9 * Written by Keita Teranishi
10 * 3/3/1998
11 */
12 #include "cblas.h"
13 #include "cblas_f77.h"
15 void cblas_stbmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
16 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
17 const int N, const int K, const float *A, const int lda,
18 float *X, const int incX)
19 {
20 char TA;
21 char UL;
22 char DI;
23 #ifdef F77_CHAR
24 F77_CHAR F77_TA, F77_UL, F77_DI;
25 #else
26 #define F77_TA &TA
27 #define F77_UL &UL
28 #define F77_DI &DI
29 #endif
30 #ifdef F77_INT
31 F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
32 #else
33 #define F77_N N
34 #define F77_K K
35 #define F77_lda lda
36 #define F77_incX incX
37 #endif
38 extern int CBLAS_CallFromC;
39 extern int RowMajorStrg;
40 RowMajorStrg = 0;
42 CBLAS_CallFromC = 1;
43 if (order == CblasColMajor)
44 {
45 if (Uplo == CblasUpper) UL = 'U';
46 else if (Uplo == CblasLower) UL = 'L';
47 else
48 {
49 cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
50 CBLAS_CallFromC = 0;
51 RowMajorStrg = 0;
52 return;
53 }
54 if (TransA == CblasNoTrans) TA = 'N';
55 else if (TransA == CblasTrans) TA = 'T';
56 else if (TransA == CblasConjTrans) TA = 'C';
57 else
58 {
59 cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
60 CBLAS_CallFromC = 0;
61 RowMajorStrg = 0;
62 return;
63 }
64 if (Diag == CblasUnit) DI = 'U';
65 else if (Diag == CblasNonUnit) DI = 'N';
66 else
67 {
68 cblas_xerbla(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag);
69 CBLAS_CallFromC = 0;
70 RowMajorStrg = 0;
71 return;
72 }
73 #ifdef F77_CHAR
74 F77_UL = C2F_CHAR(&UL);
75 F77_TA = C2F_CHAR(&TA);
76 F77_DI = C2F_CHAR(&DI);
77 #endif
78 F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
79 &F77_incX);
80 }
81 else if (order == CblasRowMajor)
82 {
83 RowMajorStrg = 1;
84 if (Uplo == CblasUpper) UL = 'L';
85 else if (Uplo == CblasLower) UL = 'U';
86 else
87 {
88 cblas_xerbla(2, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
89 CBLAS_CallFromC = 0;
90 RowMajorStrg = 0;
91 return;
92 }
94 if (TransA == CblasNoTrans) TA = 'T';
95 else if (TransA == CblasTrans) TA = 'N';
96 else if (TransA == CblasConjTrans) TA = 'N';
97 else
98 {
99 cblas_xerbla(3, "cblas_stbmv","Illegal TransA setting, %d\n", TransA);
100 CBLAS_CallFromC = 0;
101 RowMajorStrg = 0;
102 return;
103 }
105 if (Diag == CblasUnit) DI = 'U';
106 else if (Diag == CblasNonUnit) DI = 'N';
107 else
108 {
109 cblas_xerbla(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo);
110 CBLAS_CallFromC = 0;
111 RowMajorStrg = 0;
112 return;
113 }
114 #ifdef F77_CHAR
115 F77_UL = C2F_CHAR(&UL);
116 F77_TA = C2F_CHAR(&TA);
117 F77_DI = C2F_CHAR(&DI);
118 #endif
120 F77_stbmv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
121 &F77_incX);
122 }
123 else cblas_xerbla(1, "cblas_stbmv", "Illegal Order setting, %d\n", order);
124 CBLAS_CallFromC = 0;
125 RowMajorStrg = 0;
126 return;
127 }
128 #endif