LAPACK
3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cblas_zhpr.c
Go to the documentation of this file.
1
/*
2
* cblas_zhpr.c
3
* The program is a C interface to zhpr.
4
*
5
* Keita Teranishi 3/23/98
6
*
7
*/
8
#include <stdio.h>
9
#include <stdlib.h>
10
#include "
cblas.h
"
11
#include "
cblas_f77.h
"
12
void
cblas_zhpr
(
const
CBLAS_LAYOUT
layout,
const
CBLAS_UPLO
Uplo,
13
const
CBLAS_INT
N
,
const
double
alpha,
const
void
*X,
14
const
CBLAS_INT
incX,
void
*A)
15
{
16
char
UL;
17
#ifdef F77_CHAR
18
F77_CHAR
F77_UL
;
19
#else
20
#define F77_UL &UL
21
#endif
22
23
#ifdef F77_INT
24
F77_INT
F77_N
=
N
,
F77_incX
=incX;
25
#else
26
#define F77_N N
27
#define F77_incX incx
28
#endif
29
CBLAS_INT
n, i, tincx, incx=incX;
30
double
*x=(
double
*)X, *xx=(
double
*)X, *tx, *st;
31
32
extern
int
CBLAS_CallFromC
;
33
extern
int
RowMajorStrg
;
34
RowMajorStrg
= 0;
35
36
CBLAS_CallFromC
= 1;
37
if
(layout ==
CblasColMajor
)
38
{
39
if
(Uplo ==
CblasLower
) UL =
'L'
;
40
else
if
(Uplo ==
CblasUpper
) UL =
'U'
;
41
else
42
{
43
cblas_xerbla
(2,
"cblas_zhpr"
,
"Illegal Uplo setting, %d\n"
,Uplo );
44
CBLAS_CallFromC
= 0;
45
RowMajorStrg
= 0;
46
return
;
47
}
48
#ifdef F77_CHAR
49
F77_UL
= C2F_CHAR(&UL);
50
#endif
51
52
F77_zhpr
(
F77_UL
, &
F77_N
, &alpha, X, &
F77_incX
, A);
53
54
}
else
if
(layout ==
CblasRowMajor
)
55
{
56
RowMajorStrg
= 1;
57
if
(Uplo ==
CblasUpper
) UL =
'L'
;
58
else
if
(Uplo ==
CblasLower
) UL =
'U'
;
59
else
60
{
61
cblas_xerbla
(2,
"cblas_zhpr"
,
"Illegal Uplo setting, %d\n"
, Uplo);
62
CBLAS_CallFromC
= 0;
63
RowMajorStrg
= 0;
64
return
;
65
}
66
#ifdef F77_CHAR
67
F77_UL
= C2F_CHAR(&UL);
68
#endif
69
if
(
N
> 0)
70
{
71
n =
N
<< 1;
72
x = malloc(n*
sizeof
(
double
));
73
tx = x;
74
if
( incX > 0 ) {
75
i = incX << 1;
76
tincx = 2;
77
st= x+n;
78
}
else
{
79
i = incX *(-2);
80
tincx = -2;
81
st = x-2;
82
x +=(n-2);
83
}
84
do
85
{
86
*x = *xx;
87
x[1] = -xx[1];
88
x += tincx ;
89
xx += i;
90
}
91
while
(x != st);
92
x=tx;
93
#ifdef F77_INT
94
F77_incX
= 1;
95
#else
96
incx = 1;
97
#endif
98
}
99
else
x = (
double
*) X;
100
101
F77_zhpr
(
F77_UL
, &
F77_N
, &alpha, x, &
F77_incX
, A);
102
103
}
else
104
{
105
cblas_xerbla
(1,
"cblas_zhpr"
,
"Illegal layout setting, %d\n"
, layout);
106
CBLAS_CallFromC
= 0;
107
RowMajorStrg
= 0;
108
return
;
109
}
110
if
(X!=x)
111
free(x);
112
CBLAS_CallFromC
= 0;
113
RowMajorStrg
= 0;
114
return
;
115
}
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
CBLAS_INT
#define CBLAS_INT
Definition:
cblas.h:24
cblas.h
F77_zhpr
#define F77_zhpr(...)
Definition:
cblas_f77.h:364
F77_INT
#define F77_INT
Definition:
cblas_f77.h:32
cblas_f77.h
CBLAS_CallFromC
int CBLAS_CallFromC
Definition:
cblas_globals.c:1
RowMajorStrg
int RowMajorStrg
Definition:
cblas_globals.c:2
F77_incX
#define F77_incX
F77_N
#define F77_N
F77_UL
#define F77_UL
cblas_zhpr
void cblas_zhpr(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, const CBLAS_INT N, const double alpha, const void *X, const CBLAS_INT incX, void *A)
Definition:
cblas_zhpr.c:12
N
#define N
Definition:
example_user.c:10
CBLAS
src
cblas_zhpr.c
Generated on Mon Nov 14 2022 13:12:13 for LAPACK by
1.9.5