LAPACK
3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cblas_chpmv.c
Go to the documentation of this file.
1
/*
2
* cblas_chpmv.c
3
* The program is a C interface of chpmv
4
*
5
* Keita Teranishi 5/18/98
6
*
7
*/
8
#include <stdio.h>
9
#include <stdlib.h>
10
#include "
cblas.h
"
11
#include "
cblas_f77.h
"
12
void
API_SUFFIX
(
cblas_chpmv
)(
const
CBLAS_LAYOUT
layout,
13
const
CBLAS_UPLO
Uplo,
const
CBLAS_INT
N,
14
const
void
*alpha,
const
void
*AP,
15
const
void
*X,
const
CBLAS_INT
incX,
const
void
*beta,
16
void
*Y,
const
CBLAS_INT
incY)
17
{
18
char
UL;
19
#ifdef F77_CHAR
20
F77_CHAR
F77_UL
;
21
#else
22
#define F77_UL &UL
23
#endif
24
#ifdef F77_INT
25
F77_INT
F77_N
=N,
F77_incX
=incX,
F77_incY
=incY;
26
#else
27
#define F77_N N
28
#define F77_incX incx
29
#define F77_incY incY
30
#endif
31
CBLAS_INT
n, i=0, incx=incX;
32
const
float
*xx= (
float
*)X, *alp= (
float
*)alpha, *bet = (
float
*)beta;
33
float
ALPHA[2],BETA[2];
34
CBLAS_INT
tincY, tincx;
35
float
*x=(
float
*)X, *y=(
float
*)Y, *st=0, *tx;
36
extern
int
CBLAS_CallFromC
;
37
extern
int
RowMajorStrg
;
38
RowMajorStrg
= 0;
39
40
CBLAS_CallFromC
= 1;
41
if
(layout ==
CblasColMajor
)
42
{
43
if
(Uplo ==
CblasLower
) UL =
'L'
;
44
else
if
(Uplo ==
CblasUpper
) UL =
'U'
;
45
else
46
{
47
API_SUFFIX
(
cblas_xerbla
)(2,
"cblas_chpmv"
,
"Illegal Uplo setting, %d\n"
,Uplo );
48
CBLAS_CallFromC
= 0;
49
RowMajorStrg
= 0;
50
return
;
51
}
52
#ifdef F77_CHAR
53
F77_UL
= C2F_CHAR(&UL);
54
#endif
55
F77_chpmv
(
F77_UL
, &
F77_N
, alpha, AP, X,
56
&
F77_incX
, beta, Y, &
F77_incY
);
57
}
58
else
if
(layout ==
CblasRowMajor
)
59
{
60
RowMajorStrg
= 1;
61
ALPHA[0]= *alp;
62
ALPHA[1]= -alp[1];
63
BETA[0]= *bet;
64
BETA[1]= -bet[1];
65
66
if
(N > 0)
67
{
68
n = N << 1;
69
x = malloc(n*
sizeof
(
float
));
70
71
tx = x;
72
if
( incX > 0 ) {
73
i = incX << 1;
74
tincx = 2;
75
st= x+n;
76
}
else
{
77
i = incX *(-2);
78
tincx = -2;
79
st = x-2;
80
x +=(n-2);
81
}
82
83
do
84
{
85
*x = *xx;
86
x[1] = -xx[1];
87
x += tincx ;
88
xx += i;
89
}
90
while
(x != st);
91
x=tx;
92
93
94
#ifdef F77_INT
95
F77_incX
= 1;
96
#else
97
incx = 1;
98
#endif
99
100
if
(incY > 0)
101
tincY = incY;
102
else
103
tincY = -incY;
104
y++;
105
106
i = tincY << 1;
107
n = i * N ;
108
st = y + n;
109
do
{
110
*y = -(*y);
111
y += i;
112
}
while
(y != st);
113
y -= n;
114
}
else
115
x = (
float
*) X;
116
117
118
if
(Uplo ==
CblasUpper
) UL =
'L'
;
119
else
if
(Uplo ==
CblasLower
) UL =
'U'
;
120
else
121
{
122
API_SUFFIX
(
cblas_xerbla
)(2,
"cblas_chpmv"
,
"Illegal Uplo setting, %d\n"
, Uplo );
123
CBLAS_CallFromC
= 0;
124
RowMajorStrg
= 0;
125
return
;
126
}
127
#ifdef F77_CHAR
128
F77_UL
= C2F_CHAR(&UL);
129
#endif
130
131
F77_chpmv
(
F77_UL
, &
F77_N
, ALPHA,
132
AP, x, &
F77_incX
, BETA, Y, &
F77_incY
);
133
}
134
else
135
{
136
API_SUFFIX
(
cblas_xerbla
)(1,
"cblas_chpmv"
,
"Illegal layout setting, %d\n"
, layout);
137
CBLAS_CallFromC
= 0;
138
RowMajorStrg
= 0;
139
return
;
140
}
141
if
( layout ==
CblasRowMajor
)
142
{
143
RowMajorStrg
= 1;
144
if
(X!=x)
145
free(x);
146
if
(N > 0)
147
{
148
do
149
{
150
*y = -(*y);
151
y += i;
152
}
153
while
(y != st);
154
}
155
}
156
157
CBLAS_CallFromC
= 0;
158
RowMajorStrg
= 0;
159
return
;
160
}
CBLAS_UPLO
CBLAS_UPLO
Definition
cblas.h:41
CblasLower
@ CblasLower
Definition
cblas.h:41
CblasUpper
@ CblasUpper
Definition
cblas.h:41
cblas_xerbla
void cblas_xerbla(CBLAS_INT p, const char *rout, const char *form,...)
Definition
cblas_xerbla.c:12
CBLAS_LAYOUT
CBLAS_LAYOUT
Definition
cblas.h:39
CblasColMajor
@ CblasColMajor
Definition
cblas.h:39
CblasRowMajor
@ CblasRowMajor
Definition
cblas.h:39
API_SUFFIX
#define API_SUFFIX(a)
Definition
cblas.h:57
CBLAS_INT
#define CBLAS_INT
Definition
cblas.h:24
cblas.h
F77_incX
#define F77_incX
F77_incY
#define F77_incY
F77_N
#define F77_N
F77_UL
#define F77_UL
cblas_chpmv
void API_SUFFIX() cblas_chpmv(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_INT N, const void *alpha, const void *AP, const void *X, const CBLAS_INT incX, const void *beta, void *Y, const CBLAS_INT incY)
Definition
cblas_chpmv.c:12
F77_INT
#define F77_INT
Definition
cblas_example2_64.c:7
F77_chpmv
#define F77_chpmv(...)
Definition
cblas_f77.h:351
cblas_f77.h
CBLAS_CallFromC
int CBLAS_CallFromC
Definition
cblas_globals.c:1
RowMajorStrg
int RowMajorStrg
Definition
cblas_globals.c:2
CBLAS
src
cblas_chpmv.c
Generated on Tue Nov 28 2023 11:55:04 for LAPACK by
1.9.7