Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
OpenDAS
dlib
Commits
36fdfe68
Commit
36fdfe68
authored
Feb 04, 2016
by
Davis King
Browse files
Added a copy of CBLAS so we can use it when linking against a BLAS that
doesn't have it.
parent
64c7e966
Changes
167
Hide whitespace changes
Inline
Side-by-side
Showing
20 changed files
with
1141 additions
and
0 deletions
+1141
-0
dlib/external/cblas/cblas_ztbsv.c
dlib/external/cblas/cblas_ztbsv.c
+143
-0
dlib/external/cblas/cblas_ztpmv.c
dlib/external/cblas/cblas_ztpmv.c
+133
-0
dlib/external/cblas/cblas_ztpsv.c
dlib/external/cblas/cblas_ztpsv.c
+138
-0
dlib/external/cblas/cblas_ztrmm.c
dlib/external/cblas/cblas_ztrmm.c
+126
-0
dlib/external/cblas/cblas_ztrmv.c
dlib/external/cblas/cblas_ztrmv.c
+137
-0
dlib/external/cblas/cblas_ztrsm.c
dlib/external/cblas/cblas_ztrsm.c
+132
-0
dlib/external/cblas/cblas_ztrsv.c
dlib/external/cblas/cblas_ztrsv.c
+137
-0
dlib/external/cblas/cdotcsub.f
dlib/external/cblas/cdotcsub.f
+15
-0
dlib/external/cblas/cdotusub.f
dlib/external/cblas/cdotusub.f
+15
-0
dlib/external/cblas/dasumsub.f
dlib/external/cblas/dasumsub.f
+15
-0
dlib/external/cblas/ddotsub.f
dlib/external/cblas/ddotsub.f
+15
-0
dlib/external/cblas/dnrm2sub.f
dlib/external/cblas/dnrm2sub.f
+15
-0
dlib/external/cblas/dsdotsub.f
dlib/external/cblas/dsdotsub.f
+15
-0
dlib/external/cblas/dzasumsub.f
dlib/external/cblas/dzasumsub.f
+15
-0
dlib/external/cblas/dznrm2sub.f
dlib/external/cblas/dznrm2sub.f
+15
-0
dlib/external/cblas/icamaxsub.f
dlib/external/cblas/icamaxsub.f
+15
-0
dlib/external/cblas/idamaxsub.f
dlib/external/cblas/idamaxsub.f
+15
-0
dlib/external/cblas/isamaxsub.f
dlib/external/cblas/isamaxsub.f
+15
-0
dlib/external/cblas/izamaxsub.f
dlib/external/cblas/izamaxsub.f
+15
-0
dlib/external/cblas/sasumsub.f
dlib/external/cblas/sasumsub.f
+15
-0
No files found.
dlib/external/cblas/cblas_ztbsv.c
0 → 100644
View file @
36fdfe68
/*
* cblas_ztbsv.c
* The program is a C interface to ztbsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztbsv
(
const
enum
CBLAS_ORDER
order
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
N
,
const
int
K
,
const
void
*
A
,
const
int
lda
,
void
*
X
,
const
int
incX
)
{
char
TA
;
char
UL
;
char
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_N
=
N
,
F77_lda
=
lda
,
F77_K
=
K
,
F77_incX
=
incX
;
#else
#define F77_N N
#define F77_K K
#define F77_lda lda
#define F77_incX incX
#endif
int
n
,
i
=
0
,
tincX
;
double
*
st
=
0
,
*
x
=
(
double
*
)
X
;
if
(
order
==
CblasColMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztbsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztbsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztbsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztbsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
&
F77_K
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
}
else
if
(
order
==
CblasRowMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztbsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasConjTrans
)
{
TA
=
'N'
;
if
(
N
>
0
)
{
if
(
incX
>
0
)
tincX
=
incX
;
else
tincX
=
-
incX
;
n
=
N
*
2
*
(
tincX
);
x
++
;
st
=
x
+
n
;
i
=
tincX
<<
1
;
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
x
-=
n
;
}
}
else
{
cblas_xerbla
(
3
,
"cblas_ztbsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztbsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztbsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
&
F77_K
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
if
(
TransA
==
CblasConjTrans
)
{
if
(
N
>
0
)
{
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
}
}
}
else
cblas_xerbla
(
1
,
"cblas_ztbsv"
,
"Illegal Order setting, %d
\n
"
,
order
);
return
;
}
dlib/external/cblas/cblas_ztpmv.c
0 → 100644
View file @
36fdfe68
/*
* cblas_ztpmv.c
* The program is a C interface to ztpmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztpmv
(
const
enum
CBLAS_ORDER
order
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
N
,
const
void
*
Ap
,
void
*
X
,
const
int
incX
)
{
char
TA
;
char
UL
;
char
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_N
=
N
,
F77_incX
=
incX
;
#else
#define F77_N N
#define F77_incX incX
#endif
int
n
,
i
=
0
,
tincX
;
double
*
st
=
0
,
*
x
=
(
double
*
)
X
;
if
(
order
==
CblasColMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztpmv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztpmv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztpmv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztpmv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
Ap
,
X
,
&
F77_incX
);
}
else
if
(
order
==
CblasRowMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztpmv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasConjTrans
)
{
TA
=
'N'
;
if
(
N
>
0
)
{
if
(
incX
>
0
)
tincX
=
incX
;
else
tincX
=
-
incX
;
i
=
tincX
<<
1
;
n
=
i
*
N
;
x
++
;
st
=
x
+
n
;
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
x
-=
n
;
}
}
else
{
cblas_xerbla
(
3
,
"cblas_ztpmv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztpmv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztpmv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
Ap
,
X
,
&
F77_incX
);
if
(
TransA
==
CblasConjTrans
)
{
if
(
N
>
0
)
{
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
}
}
}
else
cblas_xerbla
(
1
,
"cblas_ztpmv"
,
"Illegal Order setting, %d
\n
"
,
order
);
return
;
}
dlib/external/cblas/cblas_ztpsv.c
0 → 100644
View file @
36fdfe68
/*
* cblas_ztpsv.c
* The program is a C interface to ztpsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztpsv
(
const
enum
CBLAS_ORDER
order
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
N
,
const
void
*
Ap
,
void
*
X
,
const
int
incX
)
{
char
TA
;
char
UL
;
char
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_N
=
N
,
F77_incX
=
incX
;
#else
#define F77_N N
#define F77_incX incX
#endif
int
n
,
i
=
0
,
tincX
;
double
*
st
=
0
,
*
x
=
(
double
*
)
X
;
if
(
order
==
CblasColMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztpsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztpsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztpsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztpsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
Ap
,
X
,
&
F77_incX
);
}
else
if
(
order
==
CblasRowMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztpsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasConjTrans
)
{
TA
=
'N'
;
if
(
N
>
0
)
{
if
(
incX
>
0
)
tincX
=
incX
;
else
tincX
=
-
incX
;
n
=
N
*
2
*
(
tincX
);
x
++
;
st
=
x
+
n
;
i
=
tincX
<<
1
;
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
x
-=
n
;
}
}
else
{
cblas_xerbla
(
3
,
"cblas_ztpsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztpsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztpsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
Ap
,
X
,
&
F77_incX
);
if
(
TransA
==
CblasConjTrans
)
{
if
(
N
>
0
)
{
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
}
}
}
else
cblas_xerbla
(
1
,
"cblas_ztpsv"
,
"Illegal Order setting, %d
\n
"
,
order
);
return
;
}
dlib/external/cblas/cblas_ztrmm.c
0 → 100644
View file @
36fdfe68
/*
*
* cblas_ztrmm.c
* This program is a C interface to ztrmm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztrmm
(
const
enum
CBLAS_ORDER
Order
,
const
enum
CBLAS_SIDE
Side
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
M
,
const
int
N
,
const
void
*
alpha
,
const
void
*
A
,
const
int
lda
,
void
*
B
,
const
int
ldb
)
{
char
UL
,
TA
,
SD
,
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_SD
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_M
=
M
,
F77_N
=
N
,
F77_lda
=
lda
,
F77_ldb
=
ldb
;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if
(
Order
==
CblasColMajor
)
{
if
(
Side
==
CblasRight
)
SD
=
'R'
;
else
if
(
Side
==
CblasLeft
)
SD
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrmm"
,
"Illegal Side setting, %d
\n
"
,
Side
);
return
;
}
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrmm"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrmm"
,
"Illegal Trans setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
5
,
"cblas_ztrmm"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_SD
=
C2F_CHAR
(
&
SD
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrmm
(
F77_SD
,
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_M
,
&
F77_N
,
alpha
,
A
,
&
F77_lda
,
B
,
&
F77_ldb
);
}
else
if
(
Order
==
CblasRowMajor
)
{
if
(
Side
==
CblasRight
)
SD
=
'L'
;
else
if
(
Side
==
CblasLeft
)
SD
=
'R'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrmm"
,
"Illegal Side setting, %d
\n
"
,
Side
);
return
;
}
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrmm"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrmm"
,
"Illegal Trans setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
5
,
"cblas_ztrmm"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_SD
=
C2F_CHAR
(
&
SD
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrmm
(
F77_SD
,
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
&
F77_M
,
alpha
,
A
,
&
F77_lda
,
B
,
&
F77_ldb
);
}
else
cblas_xerbla
(
1
,
"cblas_ztrmm"
,
"Illegal Order setting, %d
\n
"
,
Order
);
return
;
}
dlib/external/cblas/cblas_ztrmv.c
0 → 100644
View file @
36fdfe68
/*
* cblas_ztrmv.c
* The program is a C interface to ztrmv.
*
* Keita Teranishi 5/20/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztrmv
(
const
enum
CBLAS_ORDER
order
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
N
,
const
void
*
A
,
const
int
lda
,
void
*
X
,
const
int
incX
)
{
char
TA
;
char
UL
;
char
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_N
=
N
,
F77_lda
=
lda
,
F77_incX
=
incX
;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int
n
,
i
=
0
,
tincX
;
double
*
st
=
0
,
*
x
=
(
double
*
)
X
;
if
(
order
==
CblasColMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrmv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrmv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrmv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrmv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
}
else
if
(
order
==
CblasRowMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrmv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasConjTrans
)
{
TA
=
'N'
;
if
(
N
>
0
)
{
if
(
incX
>
0
)
tincX
=
incX
;
else
tincX
=
-
incX
;
i
=
tincX
<<
1
;
n
=
i
*
N
;
x
++
;
st
=
x
+
n
;
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
x
-=
n
;
}
}
else
{
cblas_xerbla
(
3
,
"cblas_ztrmv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrmv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrmv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
if
(
TransA
==
CblasConjTrans
)
{
if
(
N
>
0
)
{
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
}
}
}
else
cblas_xerbla
(
1
,
"cblas_ztrmv"
,
"Illegal Order setting, %d
\n
"
,
order
);
return
;
}
dlib/external/cblas/cblas_ztrsm.c
0 → 100644
View file @
36fdfe68
/*
*
* cblas_ztrsm.c
* This program is a C interface to ztrsm.
* Written by Keita Teranishi
* 4/8/1998
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztrsm
(
const
enum
CBLAS_ORDER
Order
,
const
enum
CBLAS_SIDE
Side
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
M
,
const
int
N
,
const
void
*
alpha
,
const
void
*
A
,
const
int
lda
,
void
*
B
,
const
int
ldb
)
{
char
UL
,
TA
,
SD
,
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_SD
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_SD &SD
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_M
=
M
,
F77_N
=
N
,
F77_lda
=
lda
,
F77_ldb
=
ldb
;
#else
#define F77_M M
#define F77_N N
#define F77_lda lda
#define F77_ldb ldb
#endif
if
(
Order
==
CblasColMajor
)
{
if
(
Side
==
CblasRight
)
SD
=
'R'
;
else
if
(
Side
==
CblasLeft
)
SD
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrsm"
,
"Illegal Side setting, %d
\n
"
,
Side
);
return
;
}
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrsm"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrsm"
,
"Illegal Trans setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
5
,
"cblas_ztrsm"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_SD
=
C2F_CHAR
(
&
SD
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrsm
(
F77_SD
,
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_M
,
&
F77_N
,
alpha
,
A
,
&
F77_lda
,
B
,
&
F77_ldb
);
}
else
if
(
Order
==
CblasRowMajor
)
{
if
(
Side
==
CblasRight
)
SD
=
'L'
;
else
if
(
Side
==
CblasLeft
)
SD
=
'R'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrsm"
,
"Illegal Side setting, %d
\n
"
,
Side
);
return
;
}
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrsm"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrsm"
,
"Illegal Trans setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
5
,
"cblas_ztrsm"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_SD
=
C2F_CHAR
(
&
SD
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrsm
(
F77_SD
,
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
&
F77_M
,
alpha
,
A
,
&
F77_lda
,
B
,
&
F77_ldb
);
}
else
cblas_xerbla
(
1
,
"cblas_ztrsm"
,
"Illegal Order setting, %d
\n
"
,
Order
);
return
;
}
dlib/external/cblas/cblas_ztrsv.c
0 → 100644
View file @
36fdfe68
/*
* cblas_ztrsv.c
* The program is a C interface to ztrsv.
*
* Keita Teranishi 3/23/98
*
*/
#include "cblas.h"
#include "cblas_f77.h"
void
cblas_ztrsv
(
const
enum
CBLAS_ORDER
order
,
const
enum
CBLAS_UPLO
Uplo
,
const
enum
CBLAS_TRANSPOSE
TransA
,
const
enum
CBLAS_DIAG
Diag
,
const
int
N
,
const
void
*
A
,
const
int
lda
,
void
*
X
,
const
int
incX
)
{
char
TA
;
char
UL
;
char
DI
;
#ifdef F77_CHAR
F77_CHAR
F77_TA
,
F77_UL
,
F77_DI
;
#else
#define F77_TA &TA
#define F77_UL &UL
#define F77_DI &DI
#endif
#ifdef F77_INT
F77_INT
F77_N
=
N
,
F77_lda
=
lda
,
F77_incX
=
incX
;
#else
#define F77_N N
#define F77_lda lda
#define F77_incX incX
#endif
int
n
,
i
=
0
,
tincX
;
double
*
st
=
0
,
*
x
=
(
double
*
)
X
;
if
(
order
==
CblasColMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'U'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'L'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasConjTrans
)
TA
=
'C'
;
else
{
cblas_xerbla
(
3
,
"cblas_ztrsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
}
else
if
(
order
==
CblasRowMajor
)
{
if
(
Uplo
==
CblasUpper
)
UL
=
'L'
;
else
if
(
Uplo
==
CblasLower
)
UL
=
'U'
;
else
{
cblas_xerbla
(
2
,
"cblas_ztrsv"
,
"Illegal Uplo setting, %d
\n
"
,
Uplo
);
return
;
}
if
(
TransA
==
CblasNoTrans
)
TA
=
'T'
;
else
if
(
TransA
==
CblasTrans
)
TA
=
'N'
;
else
if
(
TransA
==
CblasConjTrans
)
{
TA
=
'N'
;
if
(
N
>
0
)
{
if
(
incX
>
0
)
tincX
=
incX
;
else
tincX
=
-
incX
;
n
=
N
*
2
*
(
tincX
);
x
++
;
st
=
x
+
n
;
i
=
tincX
<<
1
;
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
x
-=
n
;
}
}
else
{
cblas_xerbla
(
3
,
"cblas_ztrsv"
,
"Illegal TransA setting, %d
\n
"
,
TransA
);
return
;
}
if
(
Diag
==
CblasUnit
)
DI
=
'U'
;
else
if
(
Diag
==
CblasNonUnit
)
DI
=
'N'
;
else
{
cblas_xerbla
(
4
,
"cblas_ztrsv"
,
"Illegal Diag setting, %d
\n
"
,
Diag
);
return
;
}
#ifdef F77_CHAR
F77_UL
=
C2F_CHAR
(
&
UL
);
F77_TA
=
C2F_CHAR
(
&
TA
);
F77_DI
=
C2F_CHAR
(
&
DI
);
#endif
F77_ztrsv
(
F77_UL
,
F77_TA
,
F77_DI
,
&
F77_N
,
A
,
&
F77_lda
,
X
,
&
F77_incX
);
if
(
TransA
==
CblasConjTrans
)
{
if
(
N
>
0
)
{
do
{
*
x
=
-
(
*
x
);
x
+=
i
;
}
while
(
x
!=
st
);
}
}
}
else
cblas_xerbla
(
1
,
"cblas_ztrsv"
,
"Illegal Order setting, %d
\n
"
,
order
);
return
;
}
dlib/external/cblas/cdotcsub.f
0 → 100644
View file @
36fdfe68
c
cdotcsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
cdotc
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
cdotcsub
(
n
,
x
,
incx
,
y
,
incy
,
dotc
)
c
external
cdotc
complex
cdotc
,
dotc
integer
n
,
incx
,
incy
complex
x
(
*
),
y
(
*
)
c
dotc
=
cdotc
(
n
,
x
,
incx
,
y
,
incy
)
return
end
dlib/external/cblas/cdotusub.f
0 → 100644
View file @
36fdfe68
c
cdotusub
.
f
c
c
The
program
is
a
fortran
wrapper
for
cdotu
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
cdotusub
(
n
,
x
,
incx
,
y
,
incy
,
dotu
)
c
external
cdotu
complex
cdotu
,
dotu
integer
n
,
incx
,
incy
complex
x
(
*
),
y
(
*
)
c
dotu
=
cdotu
(
n
,
x
,
incx
,
y
,
incy
)
return
end
dlib/external/cblas/dasumsub.f
0 → 100644
View file @
36fdfe68
c
dasumsun
.
f
c
c
The
program
is
a
fortran
wrapper
for
dasum
..
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
dasumsub
(
n
,
x
,
incx
,
asum
)
c
external
dasum
double precision
dasum
,
asum
integer
n
,
incx
double precision
x
(
*
)
c
asum
=
dasum
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/ddotsub.f
0 → 100644
View file @
36fdfe68
c
ddotsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
ddot
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
ddotsub
(
n
,
x
,
incx
,
y
,
incy
,
dot
)
c
external
ddot
double precision
ddot
integer
n
,
incx
,
incy
double precision
x
(
*
),
y
(
*
),
dot
c
dot
=
ddot
(
n
,
x
,
incx
,
y
,
incy
)
return
end
dlib/external/cblas/dnrm2sub.f
0 → 100644
View file @
36fdfe68
c
dnrm2sub
.
f
c
c
The
program
is
a
fortran
wrapper
for
dnrm2
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
dnrm2sub
(
n
,
x
,
incx
,
nrm2
)
c
external
dnrm2
double precision
dnrm2
,
nrm2
integer
n
,
incx
double precision
x
(
*
)
c
nrm2
=
dnrm2
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/dsdotsub.f
0 → 100644
View file @
36fdfe68
c
dsdotsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
dsdot
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
dsdotsub
(
n
,
x
,
incx
,
y
,
incy
,
dot
)
c
external
dsdot
double precision
dsdot
,
dot
integer
n
,
incx
,
incy
real
x
(
*
),
y
(
*
)
c
dot
=
dsdot
(
n
,
x
,
incx
,
y
,
incy
)
return
end
dlib/external/cblas/dzasumsub.f
0 → 100644
View file @
36fdfe68
c
dzasumsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
dzasum
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
dzasumsub
(
n
,
x
,
incx
,
asum
)
c
external
dzasum
double precision
dzasum
,
asum
integer
n
,
incx
double
complex
x
(
*
)
c
asum
=
dzasum
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/dznrm2sub.f
0 → 100644
View file @
36fdfe68
c
dznrm2sub
.
f
c
c
The
program
is
a
fortran
wrapper
for
dznrm2
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
dznrm2sub
(
n
,
x
,
incx
,
nrm2
)
c
external
dznrm2
double precision
dznrm2
,
nrm2
integer
n
,
incx
double
complex
x
(
*
)
c
nrm2
=
dznrm2
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/icamaxsub.f
0 → 100644
View file @
36fdfe68
c
icamaxsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
icamax
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
icamaxsub
(
n
,
x
,
incx
,
iamax
)
c
external
icamax
integer
icamax
,
iamax
integer
n
,
incx
complex
x
(
*
)
c
iamax
=
icamax
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/idamaxsub.f
0 → 100644
View file @
36fdfe68
c
icamaxsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
idamax
.
c
Witten
by
Keita
Teranishi
.
2
/
22
/
1998
c
subroutine
idamaxsub
(
n
,
x
,
incx
,
iamax
)
c
external
idamax
integer
idamax
,
iamax
integer
n
,
incx
double precision
x
(
*
)
c
iamax
=
idamax
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/isamaxsub.f
0 → 100644
View file @
36fdfe68
c
isamaxsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
isamax
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
isamaxsub
(
n
,
x
,
incx
,
iamax
)
c
external
isamax
integer
isamax
,
iamax
integer
n
,
incx
real
x
(
*
)
c
iamax
=
isamax
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/izamaxsub.f
0 → 100644
View file @
36fdfe68
c
izamaxsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
izamax
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
izamaxsub
(
n
,
x
,
incx
,
iamax
)
c
external
izamax
integer
izamax
,
iamax
integer
n
,
incx
double
complex
x
(
*
)
c
iamax
=
izamax
(
n
,
x
,
incx
)
return
end
dlib/external/cblas/sasumsub.f
0 → 100644
View file @
36fdfe68
c
sasumsub
.
f
c
c
The
program
is
a
fortran
wrapper
for
sasum
.
c
Witten
by
Keita
Teranishi
.
2
/
11
/
1998
c
subroutine
sasumsub
(
n
,
x
,
incx
,
asum
)
c
external
sasum
real
sasum
,
asum
integer
n
,
incx
real
x
(
*
)
c
asum
=
sasum
(
n
,
x
,
incx
)
return
end
Prev
1
…
4
5
6
7
8
9
Next
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment