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