LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cblas_zgemv.c
Go to the documentation of this file.
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"
13 const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N,
14 const void *alpha, const void *A, const CBLAS_INT lda,
15 const void *X, const CBLAS_INT incX, const void *beta,
16 void *Y, const CBLAS_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 CBLAS_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 CBLAS_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
44
45 if (layout == 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 API_SUFFIX(cblas_xerbla)(2, "cblas_zgemv","Illegal TransA setting, %d\n", TransA);
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 (layout == 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 API_SUFFIX(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 API_SUFFIX(cblas_xerbla)(1, "cblas_zgemv", "Illegal layout setting, %d\n", layout);
161 CBLAS_CallFromC = 0;
162 RowMajorStrg = 0;
163 return;
164}
void cblas_xerbla(CBLAS_INT p, const char *rout, const char *form,...)
CBLAS_TRANSPOSE
Definition cblas.h:40
@ CblasNoTrans
Definition cblas.h:40
@ CblasTrans
Definition cblas.h:40
@ CblasConjTrans
Definition cblas.h:40
CBLAS_LAYOUT
Definition cblas.h:39
@ CblasColMajor
Definition cblas.h:39
@ CblasRowMajor
Definition cblas.h:39
#define API_SUFFIX(a)
Definition cblas.h:57
#define CBLAS_INT
Definition cblas.h:24
#define F77_INT
#define F77_zgemv(...)
Definition cblas_f77.h:365
int CBLAS_CallFromC
int RowMajorStrg
#define F77_incX
#define F77_incY
#define F77_TA
#define F77_N
#define F77_lda
#define F77_M
void API_SUFFIX() cblas_zgemv(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE TransA, const CBLAS_INT M, const CBLAS_INT N, const void *alpha, const void *A, const CBLAS_INT lda, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition cblas_zgemv.c:12