1/*
2 * cblas_cgemv.c
3 * The program is a C interface of cgemv
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_cgemv(const enum CBLAS_ORDER order,
13                 const enum CBLAS_TRANSPOSE TransA, const int M, const int N,
14                 const void *alpha, const void  *A, const int lda,
15                 const void  *X, const int incX, const void *beta,
16                 void  *Y, const int incY)
17{
18   char TA;
19#ifdef F77_CHAR
20   F77_CHAR F77_TA;
21#else
22   #define F77_TA &TA
23#endif
24#ifdef F77_INT
25   F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
26#else
27   #define F77_M M
28   #define F77_N N
29   #define F77_lda lda
30   #define F77_incX incx
31   #define F77_incY incY
32#endif
33
34   int n=0, i=0, incx=incX;
35   const float *xx= (const float *)X;
36   float ALPHA[2],BETA[2];
37   int tincY, tincx;
38   float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
39   const float *stx = x;
40   extern int CBLAS_CallFromC;
41   extern int RowMajorStrg;
42   RowMajorStrg = 0;
43
44   CBLAS_CallFromC = 1;
45
46   if (order == CblasColMajor)
47   {
48      if (TransA == CblasNoTrans) TA = 'N';
49      else if (TransA == CblasTrans) TA = 'T';
50      else if (TransA == CblasConjTrans) TA = 'C';
51      else
52      {
53         cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
54         CBLAS_CallFromC = 0;
55         RowMajorStrg = 0;
56         return;
57      }
58      #ifdef F77_CHAR
59         F77_TA = C2F_CHAR(&TA);
60      #endif
61      F77_cgemv(F77_TA, &F77_M, &F77_N, alpha, A, &F77_lda, X, &F77_incX,
62                beta, Y, &F77_incY);
63   }
64   else if (order == CblasRowMajor)
65   {
66      RowMajorStrg = 1;
67
68      if (TransA == CblasNoTrans) TA = 'T';
69      else if (TransA == CblasTrans) TA = 'N';
70      else if (TransA == CblasConjTrans)
71      {
72         ALPHA[0]=    *( (const float *)  alpha    );
73         ALPHA[1]= -( *( (const float *)  alpha+1) );
74         BETA[0]=     *( (const float *)  beta     );
75         BETA[1]= -(  *( (const float *)  beta+1 ) );
76         TA = 'N';
77         if (M > 0)
78         {
79            n = M << 1;
80            x = malloc(n*sizeof(float));
81            tx = x;
82            if( incX > 0 ) {
83               i = incX << 1 ;
84               tincx = 2;
85               st= x+n;
86            } else {
87               i = incX *(-2);
88               tincx = -2;
89               st = x-2;
90               x +=(n-2);
91            }
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            F77_incX = 1;
104
105            if(incY > 0)
106               tincY = incY;
107            else
108               tincY = -incY;
109
110            y++;
111
112            if (N > 0)
113            {
114               i = tincY << 1;
115               n = i * N ;
116               st = y + n;
117               do {
118                  *y = -(*y);
119                  y += i;
120               } while(y != st);
121               y -= n;
122            }
123            stx = x;
124         }
125         else stx = (const float *)X;
126      }
127      else
128      {
129         cblas_xerbla(2, "cblas_cgemv","Illegal TransA setting, %d\n", TransA);
130         CBLAS_CallFromC = 0;
131         RowMajorStrg = 0;
132         return;
133      }
134      #ifdef F77_CHAR
135         F77_TA = C2F_CHAR(&TA);
136      #endif
137      if (TransA == CblasConjTrans)
138         F77_cgemv(F77_TA, &F77_N, &F77_M, ALPHA, A, &F77_lda, stx,
139                &F77_incX, BETA, Y, &F77_incY);
140      else
141         F77_cgemv(F77_TA, &F77_N, &F77_M, alpha, A, &F77_lda, x,
142                &F77_incX, beta, Y, &F77_incY);
143
144      if (TransA == CblasConjTrans)
145      {
146         if (x != (const float *)X) free(x);
147         if (N > 0)
148         {
149            do
150            {
151               *y = -(*y);
152               y += i;
153            }
154            while (y != st);
155         }
156      }
157   }
158   else cblas_xerbla(1, "cblas_cgemv", "Illegal Order setting, %d\n", order);
159   CBLAS_CallFromC = 0;
160   RowMajorStrg = 0;
161   return;
162}
163