OpenRadioss
2025.1.11
OpenRadioss project
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
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
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
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
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
}
C2F_CHAR
#define C2F_CHAR(a)
Definition
pblas.h:125
cblas.h
CBLAS_UPLO
CBLAS_UPLO
Definition
cblas.h:29
CblasLower
@ CblasLower
Definition
cblas.h:29
CblasUpper
@ CblasUpper
Definition
cblas.h:29
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:27
CblasColMajor
@ CblasColMajor
Definition
cblas.h:27
CblasRowMajor
@ CblasRowMajor
Definition
cblas.h:27
CBLAS_INT
#define CBLAS_INT
Definition
cblas.h:23
F77_incX
#define F77_incX
F77_incY
#define F77_incY
F77_N
#define F77_N
F77_UL
#define F77_UL
cblas_chpmv
void 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
cblas_f77.h
F77_chpmv
#define F77_chpmv(...)
Definition
cblas_f77.h:323
F77_INT
#define F77_INT
Definition
cblas_f77.h:32
CBLAS_CallFromC
int CBLAS_CallFromC
Definition
cblas_globals.c:1
RowMajorStrg
int RowMajorStrg
Definition
cblas_globals.c:2
alpha
#define alpha
Definition
eval.h:35
N
#define N
Definition
example_user.c:10
y
y
Definition
schur_example.m:54
x
x
Definition
schur_example.m:53
n
n
Definition
schur_example.m:9
engine
extlib
lapack-3.10.1
CBLAS
src
cblas_chpmv.c
Generated by
1.15.0