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