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 int M,const int N,const int KL,const int KU,const void * alpha,const void * A,const int lda,const void * X,const int incX,const void * beta,void * Y,const int incY)12 void cblas_cgbmv(const enum CBLAS_ORDER order,
13                  const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
14                  const int KL, const int KU,
15                  const void *alpha, const void  *A, const int lda,
16                  const void  *X, const int incX, const void *beta,
17                  void  *Y, const int 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    int 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    int tincY, tincx;
41    float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
42    extern int CBLAS_CallFromC;
43    extern int RowMajorStrg;
44    RowMajorStrg = 0;
45 
46    CBLAS_CallFromC = 1;
47    if (order == CblasColMajor)
48    {
49       if (TransA == CblasNoTrans) TA = 'N';
50       else if (TransA == CblasTrans) TA = 'T';
51       else if (TransA == CblasConjTrans) TA = 'C';
52       else
53       {
54          cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
55          CBLAS_CallFromC = 0;
56          RowMajorStrg = 0;
57          return;
58       }
59       #ifdef F77_CHAR
60          F77_TA = C2F_CHAR(&TA);
61       #endif
62       F77_cgbmv(F77_TA, &F77_M, &F77_N, &F77_KL, &F77_KU, alpha,
63                      A, &F77_lda, X, &F77_incX, beta, Y, &F77_incY);
64    }
65    else if (order == CblasRowMajor)
66    {
67       RowMajorStrg = 1;
68       if (TransA == CblasNoTrans) TA = 'T';
69       else if (TransA == CblasTrans) TA = 'N';
70       else if (TransA == CblasConjTrans)
71       {
72          ALPHA[0]= *alp;
73          ALPHA[1]= -alp[1];
74          BETA[0]= *bet;
75          BETA[1]= -bet[1];
76          TA = 'N';
77          if (M > 0)
78          {
79             n = M << 1;
80             x = malloc(n*sizeof(float));
81             tx = x;
82 
83             if( incX > 0 ) {
84                i = incX << 1 ;
85                tincx = 2;
86                st= x+n;
87             } else {
88                i = incX *(-2);
89                tincx = -2;
90                st = x-2;
91                x +=(n-2);
92             }
93             do
94             {
95                *x = *xx;
96                x[1] = -xx[1];
97                x += tincx ;
98                xx += i;
99             }
100             while (x != st);
101             x=tx;
102 
103             #ifdef F77_INT
104                F77_incX = 1;
105             #else
106                incx = 1;
107             #endif
108 
109             if( incY > 0 )
110               tincY = incY;
111             else
112               tincY = -incY;
113 
114             y++;
115 
116             if (N > 0)
117             {
118                i = tincY << 1;
119                n = i * N ;
120                st = y + n;
121                do {
122                   *y = -(*y);
123                   y += i;
124                } while(y != st);
125                y -= n;
126             }
127          }
128          else x = (float *) X;
129 
130 
131       }
132       else
133       {
134          cblas_xerbla(2, "cblas_cgbmv","Illegal TransA setting, %d\n", TransA);
135          CBLAS_CallFromC = 0;
136          RowMajorStrg = 0;
137          return;
138       }
139       #ifdef F77_CHAR
140          F77_TA = C2F_CHAR(&TA);
141       #endif
142       if (TransA == CblasConjTrans)
143          F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, ALPHA,
144                         A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
145       else
146          F77_cgbmv(F77_TA, &F77_N, &F77_M, &F77_KU, &F77_KL, alpha,
147                         A ,&F77_lda, x,&F77_incX, beta, Y, &F77_incY);
148       if (TransA == CblasConjTrans)
149       {
150          if (x != X) free(x);
151          if (N > 0)
152          {
153             do
154             {
155                *y = -(*y);
156                y += i;
157             }
158             while (y != st);
159          }
160       }
161    }
162    else cblas_xerbla(1, "cblas_cgbmv", "Illegal Order setting, %d\n", order);
163    CBLAS_CallFromC = 0;
164    RowMajorStrg = 0;
165 }
166