1 /*
2 * cblas_cgbmv.c
3 * The program is a C interface of cgbmv
4 *
5 * Keita Teranishi 5/20/98
6 *
7 */
8 #include <stdio.h>
9 #include <stdlib.h>
10 #include "cblas.h"
11 #include "cblas_f77.h"
cblas_cgbmv(const enum CBLAS_ORDER order,const enum CBLAS_TRANSPOSE TransA,const CBLAS_INT_TYPE M,const CBLAS_INT_TYPE N,const CBLAS_INT_TYPE KL,const CBLAS_INT_TYPE KU,const void * alpha,const void * A,const CBLAS_INT_TYPE lda,const void * X,const CBLAS_INT_TYPE incX,const void * beta,void * Y,const CBLAS_INT_TYPE incY)12 void cblas_cgbmv(const enum CBLAS_ORDER order,
13 const enum CBLAS_TRANSPOSE TransA, const CBLAS_INT_TYPE M, const CBLAS_INT_TYPE N,
14 const CBLAS_INT_TYPE KL, const CBLAS_INT_TYPE KU,
15 const void *alpha, const void *A, const CBLAS_INT_TYPE lda,
16 const void *X, const CBLAS_INT_TYPE incX, const void *beta,
17 void *Y, const CBLAS_INT_TYPE incY)
18 {
19 char TA;
20 #ifdef F77_CHAR
21 F77_CHAR F77_TA;
22 #else
23 #define F77_TA &TA
24 #endif
25 #ifdef F77_INT
26 F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
27 F77_INT F77_KL=KL,F77_KU=KU;
28 #else
29 #define F77_M M
30 #define F77_N N
31 #define F77_lda lda
32 #define F77_KL KL
33 #define F77_KU KU
34 #define F77_incX incx
35 #define F77_incY incY
36 #endif
37 CBLAS_INT_TYPE n=0, i=0, incx=incX;
38 const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
39 float ALPHA[2],BETA[2];
40 CBLAS_INT_TYPE tincY, tincx;
41 float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
42
43 if (order == CblasColMajor)
44 {
45 if (TransA == CblasNoTrans) TA = 'N';
46 else if (TransA == CblasTrans) TA = 'T';
47 else if (TransA == CblasConjTrans) TA = 'C';
48 else
49 {
50 cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
51 return;
52 }
53 #ifdef F77_CHAR
54 F77_TA = C2F_CHAR(&TA);
55 #endif
56 F77_cgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
57 A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
58 }
59 else if (order == CblasRowMajor)
60 {
61 if (TransA == CblasNoTrans) TA = 'T';
62 else if (TransA == CblasTrans) TA = 'N';
63 else if (TransA == CblasConjTrans)
64 {
65 ALPHA[0]= *alp;
66 ALPHA[1]= -alp[1];
67 BETA[0]= *bet;
68 BETA[1]= -bet[1];
69 TA = 'N';
70 if (M > 0)
71 {
72 n = M << 1;
73 x = malloc(n*sizeof(float));
74 tx = x;
75
76 if( incX > 0 ) {
77 i = incX << 1 ;
78 tincx = 2;
79 st= x+n;
80 } else {
81 i = incX *(-2);
82 tincx = -2;
83 st = x-2;
84 x +=(n-2);
85 }
86 do
87 {
88 *x = *xx;
89 x[1] = -xx[1];
90 x += tincx ;
91 xx += i;
92 }
93 while (x != st);
94 x=tx;
95
96 #ifdef F77_INT
97 F77_incX = 1;
98 #else
99 incx = 1;
100 #endif
101
102 if( incY > 0 )
103 tincY = incY;
104 else
105 tincY = -incY;
106
107 y++;
108
109 if (N > 0)
110 {
111 i = tincY << 1;
112 n = i * N ;
113 st = y + n;
114 do {
115 *y = -(*y);
116 y += i;
117 } while(y != st);
118 y -= n;
119 }
120 }
121 else x = (float *) X;
122
123
124 }
125 else
126 {
127 cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
128 return;
129 }
130 #ifdef F77_CHAR
131 F77_TA = C2F_CHAR(&TA);
132 #endif
133 if (TransA == CblasConjTrans)
134 F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
135 A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
136 else
137 F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
138 A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
139 if (TransA == CblasConjTrans)
140 {
141 if (x != X) free(x);
142 if (N > 0)
143 {
144 do
145 {
146 *y = -(*y);
147 y += i;
148 }
149 while (y != st);
150 }
151 }
152 }
153 else cblas_xerbla(1, "cblas_cgbmv", "Illegal Order setting, %d\n", order);
154 }
155