1/*
2 * cblas_zgbmv.c
3 * The program is a C interface of zgbmv
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"
12void cblas_zgbmv(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, i=0, incx=incX;
38   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
39   double ALPHA[2],BETA[2];
40   int tincY, tincx;
41   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
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_zgbmv","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_zgbmv(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(double));
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 = (double *) X;
129
130
131      }
132      else
133      {
134         cblas_xerbla(2, "cblas_zgbmv","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_zgbmv(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_zgbmv(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_zgbmv", "Illegal Order setting, %d\n", order);
163   CBLAS_CallFromC = 0;
164   RowMajorStrg = 0;
165   return;
166}
167